pragma Suppress (All_Checks);
pragma Polling (Off);
with System.Machine_Code;
with System.OS_Interface;
with System.OS_Primitives;
with System.Parameters;
with System.Storage_Elements;
with System.Tasking;
with Ada.Unchecked_Conversion;
package body System.Task_Primitives.Operations is
use System.Machine_Code,
System.OS_Interface,
System.OS_Primitives,
System.Parameters,
System.Tasking,
System.Storage_Elements;
Mod_Use_Count : Integer;
pragma Export (C, Mod_Use_Count, "mod_use_count_");
type Aliased_String is array (Positive range <>) of aliased Character;
pragma Convention (C, Aliased_String);
Kernel_Version : constant Aliased_String := "2.0.33" & ASCII.Nul;
pragma Export (C, Kernel_Version, "kernel_version");
function Init_Module return Integer;
pragma Export (C, Init_Module, "init_module");
procedure Cleanup_Module;
pragma Export (C, Cleanup_Module, "cleanup_module");
LF : constant String := ASCII.LF & ASCII.Nul;
LFHT : constant String := ASCII.LF & ASCII.HT;
Max_Tasks : constant := 10;
Known_Tasks : array (0 .. Max_Tasks) of Task_ID;
Max_Sensible_Delay : constant RTIME :=
365 * 24 * 60 * 60 * RT_TICKS_PER_SEC;
Tick_Count : constant := RT_TICKS_PER_SEC / 20;
Nano_Count : constant := 50_000_000;
Addr_Bytes : constant Storage_Offset :=
System.Address'Max_Size_In_Storage_Elements;
Guess : constant RTIME := 10;
TCB_Array : array (0 .. Max_Tasks)
of aliased Restricted_Ada_Task_Control_Block (Entry_Num => 0);
pragma Volatile_Components (TCB_Array);
Available_TCBs : Task_ID;
pragma Atomic (Available_TCBs);
Current_Task : Task_ID;
pragma Export (C, Current_Task, "current_task");
pragma Atomic (Current_Task);
Idle_Task : aliased Restricted_Ada_Task_Control_Block (Entry_Num => 0);
Scheduler_Idle : Boolean := False;
In_Elab_Code : Boolean := True;
Timer_Queue : aliased Restricted_Ada_Task_Control_Block (Entry_Num => 0);
Timer_Expired : Boolean := False;
Environment_Task_ID : Task_ID;
Single_RTS_Lock : aliased RTS_Lock;
Next_Serial_Number : Task_Serial_Number := 100;
pragma Volatile (Next_Serial_Number);
GNU_Linux_Irq_State : Integer := 0;
type Duration_As_Integer is delta 1.0
range -2.0**(Duration'Size - 1) .. 2.0**(Duration'Size - 1) - 1.0;
type Address_Ptr is access all System.Address;
pragma Convention (C, Address_Ptr);
function To_Task_ID is new
Ada.Unchecked_Conversion (System.Address, Task_ID);
function To_Address is new
Ada.Unchecked_Conversion (Task_ID, System.Address);
function RTIME_To_D_Int is new
Ada.Unchecked_Conversion (RTIME, Duration_As_Integer);
function Raw_RTIME is new
Ada.Unchecked_Conversion (Duration, RTIME);
function Raw_Duration is new
Ada.Unchecked_Conversion (RTIME, Duration);
function To_Duration (T : RTIME) return Duration;
pragma Inline (To_Duration);
function To_RTIME (D : Duration) return RTIME;
pragma Inline (To_RTIME);
function To_Integer is new
Ada.Unchecked_Conversion (System.Parameters.Size_Type, Integer);
function To_Address_Ptr is
new Ada.Unchecked_Conversion (System.Address, Address_Ptr);
function To_RTS_Lock_Ptr is new
Ada.Unchecked_Conversion (Lock_Ptr, RTS_Lock_Ptr);
procedure Rt_Switch_To (Tsk : Task_ID);
pragma Inline (Rt_Switch_To);
procedure R_Save_Flags (F : out Integer);
pragma Inline (R_Save_Flags);
procedure R_Restore_Flags (F : Integer);
pragma Inline (R_Restore_Flags);
procedure R_Cli;
pragma Inline (R_Cli);
procedure R_Sti;
pragma Inline (R_Sti);
procedure Timer_Wrapper;
procedure Rt_Schedule;
procedure Insert_R (T : Task_ID);
pragma Inline (Insert_R);
procedure Insert_RF (T : Task_ID);
pragma Inline (Insert_RF);
procedure Delete_R (T : Task_ID);
pragma Inline (Delete_R);
procedure Insert_T (T : Task_ID);
pragma Inline (Insert_T);
procedure Delete_T (T : Task_ID);
pragma Inline (Delete_T);
procedure Move_Top_Task_From_Timer_Queue_To_Ready_Queue;
pragma Inline (Move_Top_Task_From_Timer_Queue_To_Ready_Queue);
procedure Rt_Switch_To (Tsk : Task_ID) is
begin
pragma Debug (Printk ("procedure Rt_Switch_To called" & LF));
Asm (
"pushl %%eax" & LFHT &
"pushl %%ebp" & LFHT &
"pushl %%edi" & LFHT &
"pushl %%esi" & LFHT &
"pushl %%edx" & LFHT &
"pushl %%ecx" & LFHT &
"pushl %%ebx" & LFHT &
"movl current_task, %%edx" & LFHT &
"cmpl $0, 36(%%edx)" & LFHT &
"jz 25f" & LFHT &
"sub $108,%%esp" & LFHT &
"fsave (%%esp)" & LFHT &
"25: pushl $1f" & LFHT &
"movl %%esp, 32(%%edx)" & LFHT &
"movl 32(%%ecx), %%esp" & LFHT &
"movl %%ecx, current_task" & LFHT &
"ret" & LFHT &
"1: cmpl $0, 36(%%ecx)" & LFHT &
"jz 26f" & LFHT &
"frstor (%%esp)" & LFHT &
"add $108,%%esp" & LFHT &
"26: popl %%ebx" & LFHT &
"popl %%ecx" & LFHT &
"popl %%edx" & LFHT &
"popl %%esi" & LFHT &
"popl %%edi" & LFHT &
"popl %%ebp" & LFHT &
"popl %%eax",
Outputs => No_Output_Operands,
Inputs => Task_ID'Asm_Input ("c", Tsk),
Clobber => "cx",
Volatile => True);
end Rt_Switch_To;
procedure R_Save_Flags (F : out Integer) is
begin
Asm (
"pushfl" & LFHT &
"popl %0",
Outputs => Integer'Asm_Output ("=g", F),
Inputs => No_Input_Operands,
Clobber => "memory",
Volatile => True);
end R_Save_Flags;
procedure R_Restore_Flags (F : Integer) is
begin
Asm (
"pushl %0" & LFHT &
"popfl",
Outputs => No_Output_Operands,
Inputs => Integer'Asm_Input ("g", F),
Clobber => "memory",
Volatile => True);
end R_Restore_Flags;
procedure R_Sti is
begin
Asm (
"sti",
Outputs => No_Output_Operands,
Inputs => No_Input_Operands,
Clobber => "memory",
Volatile => True);
end R_Sti;
procedure R_Cli is
begin
Asm (
"cli",
Outputs => No_Output_Operands,
Inputs => No_Input_Operands,
Clobber => "memory",
Volatile => True);
end R_Cli;
procedure Timer_Wrapper is
begin
pragma Debug (Printk ("procedure Timer_Wrapper called" & LF));
Timer_Expired := True;
Rt_Schedule;
end Timer_Wrapper;
procedure Rt_Schedule is
Now : RTIME;
Top_Task : Task_ID;
Flags : Integer;
procedure Debug_Timer_Queue;
procedure Debug_Timer_Queue is
begin
if Timer_Queue.Common.LL.Succ /= Timer_Queue'Address then
Printk ("Timer_Queue not empty" & LF);
end if;
if To_Task_ID (Timer_Queue.Common.LL.Succ).Common.LL.Resume_Time <
Now + Guess
then
Printk ("and need to move top task to ready queue" & LF);
end if;
end Debug_Timer_Queue;
begin
pragma Debug (Printk ("procedure Rt_Schedule called" & LF));
if Scheduler_Idle then
return;
end if;
<<Idle>>
R_Save_Flags (Flags);
R_Cli;
Scheduler_Idle := False;
if Timer_Expired then
pragma Debug (Printk ("Timer expired" & LF));
Timer_Expired := False;
Now := Rt_Get_Time;
pragma Debug (Debug_Timer_Queue);
while Timer_Queue.Common.LL.Succ /= Timer_Queue'Address and then
To_Task_ID
(Timer_Queue.Common.LL.Succ).Common.LL.Resume_Time < Now + Guess
loop
To_Task_ID (Timer_Queue.Common.LL.Succ).Common.LL.State :=
RT_TASK_READY;
Move_Top_Task_From_Timer_Queue_To_Ready_Queue;
end loop;
if Timer_Queue.Common.LL.Succ /= Timer_Queue'Address then
Rt_Set_Timer
(To_Task_ID (Timer_Queue.Common.LL.Succ).Common.LL.Resume_Time);
else
Rt_No_Timer;
end if;
end if;
Top_Task := To_Task_ID (Idle_Task.Common.LL.Succ);
if Top_Task = To_Task_ID (Idle_Task'Address) then
Scheduler_Idle := True;
R_Restore_Flags (Flags);
pragma Debug (Printk ("!!!kernel idle!!!" & LF));
goto Idle;
end if;
if Top_Task = Current_Task then
pragma Debug (Printk ("Rt_Schedule: Top_Task = Current_Task" & LF));
R_Restore_Flags (Flags);
return;
end if;
if Top_Task = Environment_Task_ID then
pragma Debug (Printk
("Rt_Schedule: Top_Task = Environment_Task" & LF));
if not In_Elab_Code then
SFIF := GNU_Linux_Irq_State;
end if;
elsif Current_Task = Environment_Task_ID then
pragma Debug (Printk
("Rt_Schedule: Current_Task = Environment_Task" & LF));
GNU_Linux_Irq_State := SFIF;
SFIF := 0;
end if;
Top_Task.Common.LL.State := RT_TASK_READY;
Rt_Switch_To (Top_Task);
R_Restore_Flags (Flags);
end Rt_Schedule;
procedure Insert_R (T : Task_ID) is
Q : Task_ID := To_Task_ID (Idle_Task.Common.LL.Succ);
begin
pragma Debug (Printk ("procedure Insert_R called" & LF));
pragma Assert (T.Common.LL.Succ = To_Address (T));
pragma Assert (T.Common.LL.Pred = To_Address (T));
while Q /= To_Task_ID (Idle_Task'Address)
and then T.Common.LL.Active_Priority <= Q.Common.LL.Active_Priority
loop
Q := To_Task_ID (Q.Common.LL.Succ);
end loop;
T.Common.LL.Succ := To_Address (Q);
T.Common.LL.Pred := Q.Common.LL.Pred;
To_Task_ID (T.Common.LL.Pred).Common.LL.Succ := To_Address (T);
Q.Common.LL.Pred := To_Address (T);
end Insert_R;
procedure Insert_RF (T : Task_ID) is
Q : Task_ID := To_Task_ID (Idle_Task.Common.LL.Succ);
begin
pragma Debug (Printk ("procedure Insert_RF called" & LF));
pragma Assert (T.Common.LL.Succ = To_Address (T));
pragma Assert (T.Common.LL.Pred = To_Address (T));
while Q /= To_Task_ID (Idle_Task'Address) and then
T.Common.LL.Active_Priority < Q.Common.LL.Active_Priority
loop
Q := To_Task_ID (Q.Common.LL.Succ);
end loop;
T.Common.LL.Succ := To_Address (Q);
T.Common.LL.Pred := Q.Common.LL.Pred;
To_Task_ID (T.Common.LL.Pred).Common.LL.Succ := To_Address (T);
Q.Common.LL.Pred := To_Address (T);
end Insert_RF;
procedure Delete_R (T : Task_ID) is
Tpred : constant Task_ID := To_Task_ID (T.Common.LL.Pred);
Tsucc : constant Task_ID := To_Task_ID (T.Common.LL.Succ);
begin
pragma Debug (Printk ("procedure Delete_R called" & LF));
Tpred.Common.LL.Succ := To_Address (Tsucc);
Tsucc.Common.LL.Pred := To_Address (Tpred);
T.Common.LL.Succ := To_Address (T);
T.Common.LL.Pred := To_Address (T);
end Delete_R;
procedure Insert_T (T : Task_ID) is
Q : Task_ID := To_Task_ID (Timer_Queue.Common.LL.Succ);
begin
pragma Debug (Printk ("procedure Insert_T called" & LF));
pragma Assert (T.Common.LL.Succ = To_Address (T));
while Q /= To_Task_ID (Timer_Queue'Address) and then
T.Common.LL.Resume_Time > Q.Common.LL.Resume_Time
loop
Q := To_Task_ID (Q.Common.LL.Succ);
end loop;
while Q /= To_Task_ID (Timer_Queue'Address) and then
T.Common.LL.Resume_Time = Q.Common.LL.Resume_Time
loop
exit when T.Common.LL.Active_Priority > Q.Common.LL.Active_Priority;
Q := To_Task_ID (Q.Common.LL.Succ);
end loop;
T.Common.LL.Succ := To_Address (Q);
T.Common.LL.Pred := Q.Common.LL.Pred;
To_Task_ID (T.Common.LL.Pred).Common.LL.Succ := To_Address (T);
Q.Common.LL.Pred := To_Address (T);
end Insert_T;
procedure Delete_T (T : Task_ID) is
Tpred : constant Task_ID := To_Task_ID (T.Common.LL.Pred);
Tsucc : constant Task_ID := To_Task_ID (T.Common.LL.Succ);
begin
pragma Debug (Printk ("procedure Delete_T called" & LF));
pragma Assert (T /= To_Task_ID (Timer_Queue'Address));
Tpred.Common.LL.Succ := To_Address (Tsucc);
Tsucc.Common.LL.Pred := To_Address (Tpred);
T.Common.LL.Succ := To_Address (T);
T.Common.LL.Pred := To_Address (T);
end Delete_T;
procedure Move_Top_Task_From_Timer_Queue_To_Ready_Queue is
Top_Task : Task_ID := To_Task_ID (Timer_Queue.Common.LL.Succ);
begin
pragma Debug (Printk ("procedure Move_Top_Task called" & LF));
if Top_Task /= To_Task_ID (Timer_Queue'Address) then
Delete_T (Top_Task);
Top_Task.Common.LL.State := RT_TASK_READY;
Insert_R (Top_Task);
end if;
end Move_Top_Task_From_Timer_Queue_To_Ready_Queue;
function Self return Task_ID is
begin
pragma Debug (Printk ("function Self called" & LF));
return Current_Task;
end Self;
procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock) is
begin
pragma Debug (Printk ("procedure Initialize_Lock called" & LF));
L.Ceiling_Priority := Prio;
L.Owner := System.Null_Address;
end Initialize_Lock;
procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
begin
pragma Debug (Printk ("procedure Initialize_Lock (RTS) called" & LF));
L.Ceiling_Priority := System.Any_Priority'Last;
L.Owner := System.Null_Address;
end Initialize_Lock;
procedure Finalize_Lock (L : access Lock) is
begin
pragma Debug (Printk ("procedure Finalize_Lock called" & LF));
null;
end Finalize_Lock;
procedure Finalize_Lock (L : access RTS_Lock) is
begin
pragma Debug (Printk ("procedure Finalize_Lock (RTS) called" & LF));
null;
end Finalize_Lock;
procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
Prio : constant System.Any_Priority :=
Current_Task.Common.LL.Active_Priority;
begin
pragma Debug (Printk ("procedure Write_Lock called" & LF));
Ceiling_Violation := False;
if Prio > L.Ceiling_Priority then
Ceiling_Violation := True;
pragma Debug (Printk ("Ceiling Violation in Write_Lock" & LF));
return;
end if;
L.Pre_Locking_Priority := Prio;
L.Owner := To_Address (Current_Task);
Current_Task.Common.LL.Active_Priority := L.Ceiling_Priority;
if Current_Task.Common.LL.Outer_Lock = null then
Current_Task.Common.LL.Outer_Lock :=
To_RTS_Lock_Ptr (L.all'Unchecked_Access);
end if;
end Write_Lock;
procedure Write_Lock
(L : access RTS_Lock; Global_Lock : Boolean := False)
is
Prio : constant System.Any_Priority :=
Current_Task.Common.LL.Active_Priority;
begin
pragma Debug (Printk ("procedure Write_Lock (RTS) called" & LF));
if Prio > L.Ceiling_Priority then
Printk ("Ceiling Violation in Write_Lock (RTS)" & LF);
return;
end if;
L.Pre_Locking_Priority := Prio;
L.Owner := To_Address (Current_Task);
Current_Task.Common.LL.Active_Priority := L.Ceiling_Priority;
if Current_Task.Common.LL.Outer_Lock = null then
Current_Task.Common.LL.Outer_Lock := L.all'Unchecked_Access;
end if;
end Write_Lock;
procedure Write_Lock (T : Task_ID) is
Prio : constant System.Any_Priority :=
Current_Task.Common.LL.Active_Priority;
begin
pragma Debug (Printk ("procedure Write_Lock (Task_ID) called" & LF));
if Prio > T.Common.LL.L.Ceiling_Priority then
Printk ("Ceiling Violation in Write_Lock (Task)" & LF);
return;
end if;
T.Common.LL.L.Pre_Locking_Priority := Prio;
T.Common.LL.L.Owner := To_Address (Current_Task);
Current_Task.Common.LL.Active_Priority := T.Common.LL.L.Ceiling_Priority;
if Current_Task.Common.LL.Outer_Lock = null then
Current_Task.Common.LL.Outer_Lock := T.Common.LL.L'Access;
end if;
end Write_Lock;
procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
begin
pragma Debug (Printk ("procedure Read_Lock called" & LF));
Write_Lock (L, Ceiling_Violation);
end Read_Lock;
procedure Unlock (L : access Lock) is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Unlock called" & LF));
if L.Owner /= To_Address (Current_Task) then
null;
Printk ("The caller is not the owner of the lock" & LF);
return;
end if;
L.Owner := System.Null_Address;
if Current_Task.Common.LL.Outer_Lock =
To_RTS_Lock_Ptr (L.all'Unchecked_Access)
then
Current_Task.Common.LL.Active_Priority :=
Current_Task.Common.Current_Priority;
Current_Task.Common.LL.Outer_Lock := null;
else
Current_Task.Common.LL.Active_Priority := L.Pre_Locking_Priority;
end if;
if Current_Task.Common.LL.Active_Priority
< To_Task_ID (Current_Task.Common.LL.Succ).Common.LL.Active_Priority
then
R_Save_Flags (Flags);
R_Cli;
Delete_R (Current_Task);
Insert_RF (Current_Task);
R_Restore_Flags (Flags);
Rt_Schedule;
end if;
end Unlock;
procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Unlock (RTS_Lock) called" & LF));
if L.Owner /= To_Address (Current_Task) then
null;
Printk ("The caller is not the owner of the lock" & LF);
return;
end if;
L.Owner := System.Null_Address;
if Current_Task.Common.LL.Outer_Lock = L.all'Unchecked_Access then
Current_Task.Common.LL.Active_Priority :=
Current_Task.Common.Current_Priority;
Current_Task.Common.LL.Outer_Lock := null;
else
Current_Task.Common.LL.Active_Priority := L.Pre_Locking_Priority;
end if;
if Current_Task.Common.LL.Active_Priority
< To_Task_ID (Current_Task.Common.LL.Succ).Common.LL.Active_Priority
then
R_Save_Flags (Flags);
R_Cli;
Delete_R (Current_Task);
Insert_RF (Current_Task);
R_Restore_Flags (Flags);
Rt_Schedule;
end if;
end Unlock;
procedure Unlock (T : Task_ID) is
begin
pragma Debug (Printk ("procedure Unlock (Task_ID) called" & LF));
Unlock (T.Common.LL.L'Access);
end Unlock;
procedure Sleep
(Self_ID : Task_ID;
Reason : ST.Task_States)
is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Sleep called" & LF));
Self_ID.Common.State := Reason;
Self_ID.Common.LL.State := RT_TASK_DORMANT;
R_Save_Flags (Flags);
R_Cli;
Delete_R (Self_ID);
if Self_ID.Common.LL.L.Owner = To_Address (Self_ID) then
Self_ID.Common.LL.L.Owner := System.Null_Address;
if Self_ID.Common.LL.Outer_Lock = Self_ID.Common.LL.L'Access then
Self_ID.Common.LL.Active_Priority :=
Self_ID.Common.Current_Priority;
Self_ID.Common.LL.Outer_Lock := null;
else
Self_ID.Common.LL.Active_Priority :=
Self_ID.Common.LL.L.Pre_Locking_Priority;
end if;
end if;
R_Restore_Flags (Flags);
Rt_Schedule;
Write_Lock (Self_ID);
end Sleep;
procedure Timed_Sleep
(Self_ID : Task_ID;
Time : Duration;
Mode : ST.Delay_Modes;
Reason : Task_States;
Timedout : out Boolean;
Yielded : out Boolean)
is
Flags : Integer;
Abs_Time : RTIME;
begin
pragma Debug (Printk ("procedure Timed_Sleep called" & LF));
Timedout := True;
Yielded := False;
if Mode = Relative then
Abs_Time := To_RTIME (Time) + Rt_Get_Time;
else
Abs_Time := To_RTIME (Time);
end if;
Self_ID.Common.LL.Resume_Time := Abs_Time;
Self_ID.Common.LL.State := RT_TASK_DELAYED;
R_Save_Flags (Flags);
R_Cli;
Delete_R (Self_ID);
Insert_T (Self_ID);
if Timer_Queue.Common.LL.Succ = To_Address (Self_ID) then
Rt_Set_Timer (Abs_Time);
end if;
if Self_ID.Common.LL.L.Owner = To_Address (Self_ID) then
Self_ID.Common.LL.L.Owner := System.Null_Address;
if Self_ID.Common.LL.Outer_Lock = Self_ID.Common.LL.L'Access then
Self_ID.Common.LL.Active_Priority :=
Self_ID.Common.Current_Priority;
Self_ID.Common.LL.Outer_Lock := null;
else
Self_ID.Common.LL.Active_Priority :=
Self_ID.Common.LL.L.Pre_Locking_Priority;
end if;
end if;
R_Restore_Flags (Flags);
Rt_Schedule;
Write_Lock (Self_ID);
end Timed_Sleep;
procedure Timed_Delay
(Self_ID : Task_ID;
Time : Duration;
Mode : ST.Delay_Modes)
is
Flags : Integer;
Abs_Time : RTIME;
begin
pragma Debug (Printk ("procedure Timed_Delay called" & LF));
Write_Lock (Self_ID);
if Mode = Relative then
Abs_Time := To_RTIME (Time) + Rt_Get_Time;
else
Abs_Time := To_RTIME (Time);
end if;
Self_ID.Common.LL.Resume_Time := Abs_Time;
Self_ID.Common.LL.State := RT_TASK_DELAYED;
R_Save_Flags (Flags);
R_Cli;
Delete_R (Self_ID);
Insert_T (Self_ID);
if Timer_Queue.Common.LL.Succ = To_Address (Self_ID) then
Rt_Set_Timer (Abs_Time);
end if;
if To_Task_ID (Self_ID.Common.LL.L.Owner) = Self_ID then
Self_ID.Common.LL.L.Owner := System.Null_Address;
if Self_ID.Common.LL.Outer_Lock = Self_ID.Common.LL.L'Access then
Self_ID.Common.LL.Active_Priority :=
Self_ID.Common.Current_Priority;
Self_ID.Common.LL.Outer_Lock := null;
else
Self_ID.Common.LL.Active_Priority :=
Self_ID.Common.LL.L.Pre_Locking_Priority;
end if;
end if;
R_Restore_Flags (Flags);
Rt_Schedule;
end Timed_Delay;
function To_Duration (T : RTIME) return Duration is
Q, Q1, RN : RTIME;
begin
Q := T / Tick_Count;
RN := (T - Q * Tick_Count) * Nano_Count;
Q1 := RN / Tick_Count;
return Raw_Duration (Q * Nano_Count + Q1);
end To_Duration;
function To_RTIME (D : Duration) return RTIME is
N : RTIME := Raw_RTIME (D);
Q, Q1, RT : RTIME;
begin
Q := N / Nano_Count;
RT := (N - Q * Nano_Count) * Tick_Count;
Q1 := RT / Nano_Count;
return Q * Tick_Count + Q1;
end To_RTIME;
function Monotonic_Clock return Duration is
begin
pragma Debug (Printk ("procedure Clock called" & LF));
return To_Duration (Rt_Get_Time);
end Monotonic_Clock;
function RT_Resolution return Duration is
begin
return 10#1.0#E-6;
end RT_Resolution;
procedure Wakeup (T : Task_ID; Reason : ST.Task_States) is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Wakeup called" & LF));
T.Common.State := Reason;
T.Common.LL.State := RT_TASK_READY;
R_Save_Flags (Flags);
R_Cli;
if Timer_Queue.Common.LL.Succ = To_Address (T) then
if T.Common.LL.Succ = Timer_Queue'Address then
Rt_No_Timer;
else
Rt_Set_Timer (To_Task_ID (T.Common.LL.Succ).Common.LL.Resume_Time);
end if;
end if;
Delete_T (T);
Insert_R (T);
R_Restore_Flags (Flags);
Rt_Schedule;
end Wakeup;
procedure Yield (Do_Yield : Boolean := True) is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Yield called" & LF));
pragma Assert (Current_Task /= To_Task_ID (Idle_Task'Address));
R_Save_Flags (Flags);
R_Cli;
Delete_R (Current_Task);
Insert_R (Current_Task);
R_Restore_Flags (Flags);
Rt_Schedule;
end Yield;
procedure Set_Priority
(T : Task_ID;
Prio : System.Any_Priority;
Loss_Of_Inheritance : Boolean := False)
is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Set_Priority called" & LF));
pragma Assert (T = Self);
T.Common.Current_Priority := Prio;
if T.Common.LL.Outer_Lock /= null then
null;
else
R_Save_Flags (Flags);
R_Cli;
T.Common.LL.Active_Priority := Prio;
Delete_R (T);
Insert_RF (T);
R_Restore_Flags (Flags);
end if;
Rt_Schedule;
end Set_Priority;
function Get_Priority (T : Task_ID) return System.Any_Priority is
begin
pragma Debug (Printk ("procedure Get_Priority called" & LF));
return T.Common.Current_Priority;
end Get_Priority;
procedure Enter_Task (Self_ID : Task_ID) is
begin
pragma Debug (Printk ("procedure Enter_Task called" & LF));
R_Sti;
end Enter_Task;
function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is
T : constant Task_ID := Available_TCBs;
begin
pragma Debug (Printk ("function New_ATCB called" & LF));
if Entry_Num /= 0 then
null;
end if;
if T /= null then
Available_TCBs := To_Task_ID (T.Common.LL.Next);
T.Common.LL.Next := System.Null_Address;
Known_Tasks (T.Known_Tasks_Index) := T;
end if;
return T;
end New_ATCB;
procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is
begin
pragma Debug (Printk ("procedure Initialize_TCB called" & LF));
Self_ID.Serial_Number := Next_Serial_Number;
Next_Serial_Number := Next_Serial_Number + 1;
pragma Assert (Next_Serial_Number /= 0);
Self_ID.Common.LL.L.Ceiling_Priority := System.Any_Priority'Last;
Self_ID.Common.LL.L.Owner := System.Null_Address;
Succeeded := True;
end Initialize_TCB;
procedure Create_Task
(T : Task_ID;
Wrapper : System.Address;
Stack_Size : System.Parameters.Size_Type;
Priority : System.Any_Priority;
Succeeded : out Boolean)
is
Adjusted_Stack_Size : Integer;
Bottom : System.Address;
Flags : Integer;
begin
pragma Debug (Printk ("procedure Create_Task called" & LF));
Succeeded := True;
if T.Common.LL.Magic = RT_TASK_MAGIC then
Succeeded := False;
return;
end if;
if Stack_Size = Unspecified_Size then
Adjusted_Stack_Size := To_Integer (Default_Stack_Size);
elsif Stack_Size < Minimum_Stack_Size then
Adjusted_Stack_Size := To_Integer (Minimum_Stack_Size);
else
Adjusted_Stack_Size := To_Integer (Stack_Size);
end if;
Bottom := Kmalloc (Adjusted_Stack_Size, GFP_KERNEL);
if Bottom = System.Null_Address then
Succeeded := False;
return;
end if;
T.Common.LL.Uses_Fp := 1;
T.Common.LL.Magic := RT_TASK_MAGIC;
T.Common.LL.State := RT_TASK_READY;
T.Common.LL.Succ := To_Address (T);
T.Common.LL.Pred := To_Address (T);
T.Common.LL.Active_Priority := Priority;
T.Common.Current_Priority := Priority;
T.Common.LL.Stack_Bottom := Bottom;
T.Common.LL.Stack := Bottom + Storage_Offset (Adjusted_Stack_Size);
T.Common.LL.Stack := T.Common.LL.Stack - Addr_Bytes;
To_Address_Ptr (T.Common.LL.Stack).all := To_Address (T);
T.Common.LL.Stack := T.Common.LL.Stack - Addr_Bytes;
To_Address_Ptr (T.Common.LL.Stack).all := System.Null_Address;
T.Common.LL.Stack := T.Common.LL.Stack - Addr_Bytes;
To_Address_Ptr (T.Common.LL.Stack).all := Wrapper;
R_Save_Flags (Flags);
R_Cli;
Insert_R (T);
R_Restore_Flags (Flags);
end Create_Task;
procedure Finalize_TCB (T : Task_ID) is
begin
pragma Debug (Printk ("procedure Finalize_TCB called" & LF));
pragma Assert (T.Common.LL.Succ = To_Address (T));
if T.Common.LL.State = RT_TASK_DORMANT then
Known_Tasks (T.Known_Tasks_Index) := null;
T.Common.LL.Next := To_Address (Available_TCBs);
Available_TCBs := T;
Kfree (T.Common.LL.Stack_Bottom);
end if;
end Finalize_TCB;
procedure Exit_Task is
Flags : Integer;
begin
pragma Debug (Printk ("procedure Exit_Task called" & LF));
pragma Assert (Current_Task /= To_Task_ID (Idle_Task'Address));
pragma Assert (Current_Task /= Environment_Task_ID);
R_Save_Flags (Flags);
R_Cli;
Current_Task.Common.LL.State := RT_TASK_DORMANT;
Current_Task.Common.LL.Magic := 0;
Delete_R (Current_Task);
R_Restore_Flags (Flags);
Rt_Schedule;
end Exit_Task;
procedure Abort_Task (T : Task_ID) is
begin
pragma Debug (Printk ("procedure Abort_Task called" & LF));
null;
end Abort_Task;
function Check_Exit (Self_ID : Task_ID) return Boolean is
begin
pragma Debug (Printk ("function Check_Exit called" & LF));
return True;
end Check_Exit;
function Check_No_Locks (Self_ID : Task_ID) return Boolean is
begin
pragma Debug (Printk ("function Check_No_Locks called" & LF));
if Self_ID.Common.LL.Outer_Lock = null then
return True;
else
return False;
end if;
end Check_No_Locks;
function Environment_Task return Task_ID is
begin
return Environment_Task_ID;
end Environment_Task;
procedure Lock_RTS is
begin
Write_Lock (Single_RTS_Lock'Access, Global_Lock => True);
end Lock_RTS;
procedure Unlock_RTS is
begin
Unlock (Single_RTS_Lock'Access, Global_Lock => True);
end Unlock_RTS;
procedure Stack_Guard (T : Task_ID; On : Boolean) is
begin
null;
end Stack_Guard;
function Get_Thread_Id (T : Task_ID) return OSI.Thread_Id is
begin
return To_Address (T);
end Get_Thread_Id;
function Suspend_Task
(T : Task_ID;
Thread_Self : OSI.Thread_Id) return Boolean is
begin
return False;
end Suspend_Task;
function Resume_Task
(T : ST.Task_ID;
Thread_Self : OSI.Thread_Id) return Boolean is
begin
return False;
end Resume_Task;
function Init_Module return Integer is
procedure adainit;
pragma Import (C, adainit);
begin
adainit;
In_Elab_Code := False;
Set_Priority (Environment_Task_ID, Any_Priority'First);
return 0;
end Init_Module;
procedure Cleanup_Module is
procedure adafinal;
pragma Import (C, adafinal);
begin
adafinal;
end Cleanup_Module;
procedure Initialize (Environment_Task : Task_ID) is
begin
pragma Debug (Printk ("procedure Initialize called" & LF));
Environment_Task_ID := Environment_Task;
Available_TCBs := To_Task_ID (TCB_Array (1)'Address);
for J in TCB_Array'First + 1 .. TCB_Array'Last - 1 loop
TCB_Array (J).Common.LL.Next := TCB_Array (J + 1)'Address;
end loop;
TCB_Array (TCB_Array'Last).Common.LL.Next := System.Null_Address;
Idle_Task.Common.LL.Magic := RT_TASK_MAGIC;
Idle_Task.Common.LL.State := RT_TASK_READY;
Idle_Task.Common.Current_Priority := System.Any_Priority'First;
Idle_Task.Common.LL.Active_Priority := System.Any_Priority'First;
Idle_Task.Common.LL.Succ := Idle_Task'Address;
Idle_Task.Common.LL.Pred := Idle_Task'Address;
Environment_Task.Common.LL.Magic := RT_TASK_MAGIC;
Environment_Task.Common.LL.State := RT_TASK_READY;
Environment_Task.Common.Current_Priority := System.Any_Priority'First;
Environment_Task.Common.LL.Active_Priority := System.Any_Priority'First;
Environment_Task.Common.LL.Succ := To_Address (Environment_Task);
Environment_Task.Common.LL.Pred := To_Address (Environment_Task);
Timer_Queue.Common.LL.Succ := Timer_Queue'Address;
Timer_Queue.Common.LL.Pred := Timer_Queue'Address;
Timer_Queue.Common.LL.Resume_Time := Max_Sensible_Delay;
Current_Task := Environment_Task;
Rt_Free_Timer;
Rt_Request_Timer (Timer_Wrapper'Address);
Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
pragma Assert (not Single_Lock);
Enter_Task (Environment_Task);
end Initialize;
end System.Task_Primitives.Operations;