with Text_IO; use Text_IO; with Translate; use Translate; with unbounded_strings; use unbounded_strings; with Scheduler; use Scheduler; with Scheduling_Analysis; use Scheduling_Analysis; use Scheduling_Analysis.Double_Tasks_Parameters_Package; with Tasks; use Tasks; use Tasks.Generic_Task_List_Package; with Task_Set; use Task_Set; with Offsets; use Offsets; with Offsets.extended; use Offsets.extended; with Task_Dependencies; use Task_Dependencies; with Dependencies; use Dependencies; package body Feasibility_Test.Wort_Case_Response_Time is -- Compute the significant S for a i-j task pair -- function Audsley_Compute_S (Current_Group : in Generic_Task_Group_Ptr; Taski : in Generic_Task_Ptr; Taskj : in Generic_Task_Ptr; Q : in Natural ) return Double is S, kj, Tj, Oj, Jj, Oi, Ji : Double; begin Tj := Double (Transaction_Task_Group_Ptr (Current_Group).period); Oj := Double (Taskj.offsets.Entries(0).offset_value); Jj := Double (Periodic_Task_Ptr (Taskj).jitter); Oi := Double (Taski.offsets.Entries(0).offset_value); Ji := Double (Periodic_Task_Ptr (Taski).jitter); kj := Double'Ceiling((Jj + Oj - Oi - Ji) / Tj); S := (Double(Q) + kj) * Tj - Oj - Jj + Oi + Ji; return S; end; function Audsley_Compute_WiS_preemptive --Audsley's tasks are premptive (My_Task_Groups: in Task_Groups_Set; --all the task Current_Group : in Generic_Task_Group_Ptr; Current_Task : in Generic_Task_Ptr; --the task examine S : in Double) return Double is Iterator_Taskj, Iterator_Taskk : Generic_Task_Iterator; Iterator_Group : Task_Groups_Iterator; Taskj, Taskk : Generic_Task_Ptr; Transt : Generic_Task_Group_Ptr; WiS, Ci, Bi, ai, Ij, Ht, Max_WiS, Wt, Oi, Ji: Double; Oj, Jj, Tj, Cj, aj, Ok, Jk, Ck, Tk, Tmp_WiS : Double; begin Ci := Double(Current_Task.capacity); Bi := Double(Current_Task.blocking_time); ai := Double'Floor(S / Double(Transaction_Task_Group_Ptr (Current_Group).period)); Oi := Double(Current_Task.offsets.Entries(0).offset_value); Ji := Double(Periodic_Task_Ptr (Current_Task).jitter); WiS := Ci + ai * Ci + Bi; --put(" Initial WiS: "); --put(Double'Image(WiS)); --Compute Sum Ij -- reset_head_iterator(Current_Group.task_list, Iterator_Taskj); loop -- Selection of the task j -- current_element (Current_Group.task_list, Taskj, Iterator_Taskj); -- Only process task with higher priority -- if (Taskj.priority <= Current_Task.priority and Taskj /= Current_Task) then Oj := Double (Taskj.offsets.Entries(0).offset_value); Jj := Double (Periodic_Task_Ptr (Taskj).jitter); Tj := Double (Transaction_Task_Group_Ptr (Current_Group).period); Cj := Double (Taskj.capacity); aj := Double'Floor ((S - Oi - Ji + Oj + Jj) / Tj); Ij := Double'Ceiling ((WiS - S + Oi - Oj + Ji + aj * Tj) / Tj) * Cj; --put(" Taskj "); --put(Natural'Image(Natural(Taskj.priority))); --put(" aj "); --put(Double'Image(aj)); --put(" Ij "); --put(Double'Image(Ij)); WiS := WiS + Ij; end if; exit when is_tail_element(Current_Group.task_list, Iterator_Taskj); next_element (Current_Group.task_list, Iterator_Taskj); end loop; -- Compute Sum Ht -- Max_WiS := 0.0; reset_iterator(My_Task_Groups, Iterator_Group); loop -- Selection of a task group -- current_element(My_Task_Groups, Transt, Iterator_Group); -- Don't process the group task i belong to -- It is already taken care of with Ij if (Transt /= Current_Group) then reset_head_iterator(Transt.task_list, Iterator_Taskj); Ht := 0.0; Tmp_WiS := WiS; Max_WiS := WiS; --put_line(""); --put("Ht group "); --put(Natural'Image(Natural(Transaction_Task_Group_Ptr(Transt).period))); loop -- Selection of task j -- current_element(Transt.task_list, Taskj, Iterator_Taskj); -- Only process tasks with higher priority -- if (Taskj.priority <= Current_Task.priority and Taskj /= Current_Task) then Oj := Double (Taskj.offsets.Entries(0).offset_value); Jj := Double (Periodic_Task_Ptr (Taskj).jitter); Wt := Oj + Jj; --put_line(""); --put("Taskj "); --put(Natural'Image(Natural(Taskj.priority))); reset_head_iterator(Transt.task_list, Iterator_Taskk); loop -- Selection of task k -- current_element(Transt.task_list, Taskk, Iterator_Taskk); Ok := Double(Taskk.offsets.Entries(0).offset_value); Jk := Double(Periodic_Task_Ptr (Taskk).jitter); Ck := Double(Taskk.capacity); Tk := Double(Transaction_Task_Group_Ptr (Transt).period); --put("Taskk "); --put(Natural'Image(Natural(Taskk.priority))); if (Ok + Jk >= Wt) then --put(" ht1 "); Ht := Double'Ceiling((Tmp_WiS + Wt - Ok) / Tk) * Ck; else --put(" ht2 "); Ht := Double'Ceiling((Tmp_WiS + Wt - Ok - Tk) / Tk) * Ck; end if; Tmp_WiS := Tmp_WiS + Ht; --put("Tmp_WiS "); --put(Double'Image(Tmp_WiS)); exit when is_tail_element(Transt.task_list, Iterator_Taskk); next_element(Transt.task_list, Iterator_Taskk); end loop; if (Tmp_WiS > Max_WiS) then Max_WiS := Tmp_WiS; end if; end if; exit when is_tail_element(Transt.task_list, Iterator_Taskj); next_element(Transt.task_list, Iterator_Taskj); end loop; WiS := Max_WiS; --put("Final WiS "); --put(Double'Image(Max_WiS)); end if; exit when is_last_element(My_Task_Groups, Iterator_Group); next_element(My_Task_Groups, Iterator_Group); end loop; return WiS; end Audsley_Compute_WiS_preemptive; procedure Audsley_Compute_Offset_Response_Time (My_Task_Groups : in Task_Groups_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Response_Time : out Response_Time_Table) is Tmp : Generic_Task_Group; Iterator_Group : Task_Groups_Iterator; Groupi : Generic_Task_Group_Ptr; Iterator_Taski, Iterator_Taskj : Generic_Task_Iterator; Taski, Taskj : Generic_Task_Ptr; I : Response_Time_Range := 0; Ri, WiS, S, Ji, Ti : Double := 0.0; Q : Integer; Q_stop : Boolean := false; begin initialize (Response_Time); Current_Processor_Name := Processor_Name; -- Set priority according to the scheduler -- But there is no scheduler (bottom-up)? Assume the tasks already have -- priority assigned to it reset_iterator (My_Task_Groups, Iterator_Group); loop current_element (My_Task_Groups, Groupi, Iterator_Group); sort(Groupi.task_list, Decreasing_Priority'Access); exit when is_last_element (My_Task_Groups, Iterator_Group); next_element (My_Task_Groups, Iterator_Group); end loop; -- Bibliographical references -- Nothing for now -- compute response time for each tasks -- reset_iterator (My_Task_Groups, Iterator_Group); loop -- Selection of the current group -- current_element (My_Task_Groups, Groupi, Iterator_Group); reset_head_iterator (Groupi.task_list, Iterator_Taski); loop -- Selection of the current task (i) -- current_element (Groupi.task_list, Taski, Iterator_Taski); -- Initialize response time for task i -- Response_Time.entries (I).data := 0.0; Response_Time.entries (I).item := Taski; Response_Time.nb_entries := Response_Time.nb_entries + 1; -- Ji := Double (Periodic_Task_Ptr (Taski).jitter); Ti := Double (Transaction_Task_Group_Ptr (Groupi).period); --put_line(""); --put_line(""); --put("Task i: "); --put_line(Natural'Image(Natural(Taski.priority))); -- Find the maximum for Ri in [0..Q] -- Q := 0; loop Q_stop := true; --put("Q: "); --put_line(Natural'Image(Q)); -- Calculate the significant S -- reset_head_iterator(Groupi.task_list, Iterator_Taskj); loop -- Selection of task j -- current_element(Groupi.task_list, Taskj, Iterator_Taskj); -- only process tasks with higher priority if (Taskj.priority <= Taski.priority) then -- Compute response time -- S := Audsley_Compute_S(Groupi, Taski, Taskj, Q); --put_line(""); --put("Task "); --put(Natural'Image(Natural(Taskj.priority))); --put(" Significant S: "); --put(Double'Image(S)); WiS := Audsley_Compute_WiS_preemptive(My_Task_Groups, Groupi, Taski, S); Ri := WiS + Ji - S; --put(" WiS: "); --put(Double'Image(WiS)); --put(" Ri: "); --put_line(Double'Image(Ri)); if (Ri > Response_Time.entries(I).data) then Response_Time.entries(I).data := Ri; end if; if (Ri > Ti) then Q_stop := false; end if; end if; exit when is_tail_element(Groupi.task_list, Iterator_Taskj); next_element(Groupi.task_list, Iterator_Taskj); end loop; exit when Q_stop; Q := Q + 1; end loop; I := I + 1; exit when is_tail_element (Groupi.task_list, Iterator_Taski); next_element (Groupi.task_list, Iterator_Taski); end loop; exit when is_last_element (My_Task_Groups, Iterator_Group); next_element (My_Task_Groups, Iterator_Group); end loop; end Audsley_Compute_Offset_Response_Time; function Tindell_Compute_Viti (Groupi : in Generic_Task_Group_Ptr; Taski : in Generic_Task_Ptr; Taskj : in Generic_Task_Ptr) return Double is Oi, Oj, Ji, Jj, Tti, Viti : Double := 0.0; begin Tti := Double (Transaction_Task_Group_Ptr (Groupi).period); Oi := Double (Taski.offsets.Entries(0).offset_value); Ji := Double (Periodic_Task_Ptr(Taski).jitter); Oj := Double (Taskj.offsets.Entries(0).offset_value); Jj := Double (Periodic_Task_Ptr(Taskj).jitter); Viti := Double'Ceiling((Oj + Jj - Oi - Ji)/Tti); return Viti; end Tindell_Compute_Viti; function Tindell_Compute_Wiq_preemptive (My_Task_Groups : in Task_Groups_Set; Groupi : in Generic_Task_Group_Ptr; Taski : in Generic_Task_Ptr) return Double is Wiq : Double := 0.0; begin return Wiq; end Tindell_Compute_Wiq_preemptive; procedure Tindell_Compute_Offset_Response_Time --tractable (My_Task_Groups : in Task_Groups_Set; Processor_Name : in Unbounded_String; Msg : in out Unbounded_String; Response_Time : out Response_Time_Table) is Tmp : Generic_Task_Group; Iterator_Group : Task_Groups_Iterator; Groupi : Generic_Task_Group_Ptr; Iterator_Taski, Iterator_Taskj : Generic_Task_Iterator; Taski, Taskj : Generic_Task_Ptr; I : Response_Time_Range := 0; Ri, Wiq, Viti, Ji, Tti, Oi, Oj, Jj, Ei : Double := 0.0; Q : Integer; Q_stop : Boolean := false; begin initialize (Response_Time); Current_Processor_Name := Processor_Name; -- Set priority according to the scheduler -- But there is no scheduler (bottom-up)? Assume the tasks already have -- priority assigned to it reset_iterator (My_Task_Groups, Iterator_Group); loop current_element (My_Task_Groups, Groupi, Iterator_Group); sort(Groupi.task_list, Decreasing_Priority'Access); exit when is_last_element (My_Task_Groups, Iterator_Group); next_element (My_Task_Groups, Iterator_Group); end loop; -- Bibliographical references -- Nothing for now -- compute response time for each tasks -- reset_iterator (My_Task_Groups, Iterator_Group); loop -- Selection of the current group -- current_element (My_Task_Groups, Groupi, Iterator_Group); reset_head_iterator (Groupi.task_list, Iterator_Taski); loop -- Selection of the current task (i) -- current_element (Groupi.task_list, Taski, Iterator_Taski); -- Initialize response time for task i -- Response_Time.entries (I).data := 0.0; Response_Time.entries (I).item := Taski; Response_Time.nb_entries := Response_Time.nb_entries + 1; -- Ji := Double (Periodic_Task_Ptr (Taski).jitter); Oi := Double (Taski.offsets.Entries(0).offset_value); --Task model need to be amended to support property e (every) Ei := 1.0; Tti := Double (Transaction_Task_Group_Ptr (Groupi).period); --put_line(""); --put_line(""); --put("Task i: "); --put_line(Natural'Image(Natural(Taski.priority))); -- Tractable analysis: find the maximum for Ri in [0..Q] -- Q := 0; loop Q_stop := true; --put("Q: "); --put_line(Natural'Image(Q)); reset_head_iterator(Groupi.task_list, Iterator_Taskj); loop -- Selection of task j -- current_element(Groupi.task_list, Taskj, Iterator_Taskj); -- Compute response time -- Viti := Tindell_Compute_Viti(Groupi, Taski, Taskj); --put_line(""); --put("Task "); --put(Natural'Image(Natural(Taskj.priority))); --put(" Viti: "); --put(Double'Image(Viti)); Wiq := Tindell_Compute_Wiq_preemptive(My_Task_Groups, Groupi, Taski); Ri := Wiq + Oj + Ji - Tti * (Double(Q) * Ei + Viti) - Oi; --put(" Wiq: "); --put(Double'Image(Wiq)); --put(" Ri: "); --put_line(Double'Image(Ri)); if (Ri > Response_Time.entries(I).data) then Response_Time.entries(I).data := Ri; end if; -- see equation (20) - stop condition if (Ri > Tti * Ei + Ji) then Q_stop := false; end if; exit when is_tail_element(Groupi.task_list, Iterator_Taskj); next_element(Groupi.task_list, Iterator_Taskj); end loop; exit when Q_stop; Q := Q + 1; end loop; I := I + 1; exit when is_tail_element (Groupi.task_list, Iterator_Taski); next_element (Groupi.task_list, Iterator_Taski); end loop; exit when is_last_element (My_Task_Groups, Iterator_Group); next_element (My_Task_Groups, Iterator_Group); end loop; end Tindell_Compute_Offset_Response_Time; procedure WCDOPS_Plus (My_System : in out System; Response_Times : in out Response_Time_Table; Stop_On_Deadline_Missed : in Boolean := False) is -- Local exceptions -- Generic_WCDOPS_Plus_Exception : exception; -- Local functions -- function Max (x, y : Integer) return Integer is begin if x < y then return y; else return x; end if; end Max; function Min (x, y : Integer) return Integer is begin if x < y then return x; else return y; end if; end Min; function Modulus (x, y : Integer) return Integer is begin return x - Integer(Double'Floor(Double(x) / Double(y))) * y; end Modulus; function Ceil0 (x : Double) return Integer is begin if x < 0.0 then return 0; else return Integer(Double'Ceiling(x)); end if; end Ceil0; function get_Offset (tau : Generic_Task_Ptr) return Integer is New_Offset : Offset_Type_Ptr; use Offsets.Offsets_Table_Package; begin if tau.offsets.nb_entries > 0 then for I in 0 .. tau.offsets.nb_entries - 1 loop if tau.offsets.entries(I).activation = 0 then return tau.offsets.entries(I).offset_value; end if; end loop; end if; New_Offset := new Offset_Type; New_Offset.offset_value := 0; New_Offset.activation := 0; Add(tau.offsets, New_Offset.all); return 0; end get_Offset; function get_Global_Deadline (tau : Generic_Task_Ptr) return Integer is begin return tau.deadline + get_offset(tau); end get_Global_Deadline; procedure Init_Response_Times (Response_Times : out Response_Time_Table) is Gamma_iterator : Task_Groups_Iterator; Gamma : Generic_Task_Group_Ptr; tau_iterator : Generic_Task_Iterator; tau : Generic_Task_Ptr; i : Integer := 0; begin if not is_empty(My_System.Task_Groups) then Initialize(Response_Times); reset_iterator(My_System.Task_Groups, Gamma_iterator); loop current_element(My_System.Task_Groups, Gamma, Gamma_iterator); if not is_empty(Gamma.task_list) then reset_head_iterator(Gamma.task_list, tau_iterator); loop current_element(Gamma.task_list, tau, tau_iterator); Response_Times.entries(Response_Times.nb_entries).data := Double(get_Offset(tau) + tau.capacity); Response_Times.entries(Response_Times.nb_entries).item := tau; Response_Times.nb_entries := Response_Times.nb_entries + 1; exit when is_tail_element(Gamma.task_list, tau_iterator); next_element(Gamma.task_list, tau_iterator); end loop; end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_iterator); end loop; end if; end Init_Response_Times; procedure Set_Response (tau : Generic_Task_Ptr; time : Integer) is begin if Response_Times.nb_entries > 0 then for i in 0 .. Response_Times.nb_entries - 1 loop if Response_Times.entries(i).item.name = tau.name then Response_Times.entries(i).data := Double(time) + 0.0; return; end if; end loop; end if; end Set_Response; function get_Response (tau : Generic_Task_Ptr) return Integer is begin if Response_Times.nb_entries > 0 then for i in 0 .. Response_Times.nb_entries - 1 loop if Response_Times.entries(i).item.name = tau.name then return Integer(Response_Times.entries(i).data); end if; end loop; end if; raise Generic_WCDOPS_Plus_Exception; return 0; end get_Response; -- No multi-predecessor version; Otherwise should return a set of predecessors function Pred (tau_ij : Generic_Task_Ptr) return Generic_Task_Ptr is pred_ij : Generic_Task_Ptr; A_Task_Dependencies_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep : Dependency_Ptr; begin if not is_empty(My_System.Dependencies.Depends) then reset_iterator(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); loop current_element(My_System.Dependencies.Depends, A_Half_Dep, A_Task_Dependencies_Iterator); if A_Half_Dep.type_of_dependency = Precedence_Dependency then if A_Half_Dep.precedence_sink.name = tau_ij.name then pred_ij := A_Half_Dep.precedence_source; return pred_ij; end if; end if; exit when is_last_element(My_system.Dependencies.Depends, A_Task_Dependencies_Iterator); next_element(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); end loop; end if; return null; end Pred; function get_Root_Task (Gamma_i : Generic_Task_Group_Ptr) return Generic_Task_Ptr is tau_ij_iterator : Generic_Task_Iterator; tau_ij : Generic_Task_Ptr; pred_ij : Generic_Task_Ptr; begin if not is_empty(Gamma_i.task_list) then reset_head_iterator(Gamma_i.task_list, tau_ij_iterator); loop current_element(Gamma_i.task_list, tau_ij, tau_ij_iterator); pred_ij := pred(tau_ij); if pred_ij = null then return tau_ij; end if; exit when is_tail_element(Gamma_i.task_list, tau_ij_iterator); next_element(Gamma_i.task_list, tau_ij_iterator); end loop; end if; raise Generic_WCDOPS_Plus_Exception; -- Should never reach return null; end get_Root_Task; -- Returns true if tau_ip precedes tau_ij (not necessarily immediately) function Precedes (tau_ip : Generic_Task_Ptr; tau_ij : Generic_Task_Ptr) return Boolean is pred_ij : Generic_Task_Ptr; begin pred_ij := pred(tau_ij); if pred_ij = null then return false; elsif pred_ij.name = tau_ip.name then return true; else return Precedes(tau_ip, pred_ij); end if; end Precedes; function Succ (tau_ij : Generic_Task_Ptr) return Tasks_Set is Succ_ij : Tasks_Set; A_Task_Dependencies_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep : Dependency_Ptr; begin Initialize(Succ_ij); if not is_empty(My_System.Dependencies.Depends) then reset_iterator(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); loop current_element(My_System.Dependencies.Depends, A_Half_Dep, A_Task_Dependencies_Iterator); if A_Half_Dep.type_of_dependency = Precedence_Dependency then if A_Half_Dep.precedence_source.name = tau_ij.name then Add(Succ_ij, A_Half_Dep.precedence_sink); end if; end if; exit when is_last_element(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); next_element(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); end loop; end if; return Succ_ij; end Succ; -- Returns true if tau_ij in hpi(tau_ab) (tasks in Gamma_i of higher priority than tau_ab and on same cpu) function In_hpi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is begin if tau_ij = null then raise Generic_WCDOPS_Plus_Exception; end if; return tau_ij.priority >= tau_ab.priority and tau_ij.cpu_name = tau_ab.cpu_name; end In_hpi; -- Returns true if tau_ij in lpi(tau_ab) (tasks in Gamma_i of lower priority than tau_ab and on same cpu) function In_lpi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is begin if tau_ij = null then raise Generic_WCDOPS_Plus_Exception; end if; return tau_ij.priority < tau_ab.priority and tau_ij.cpu_name = tau_ab.cpu_name; end In_lpi; function Has_Pred_In_lpi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is pred_ij : Generic_Task_Ptr; begin pred_ij := pred(tau_ij); if pred_ij = null then return false; elsif In_lpi(pred_ij, tau_ab) then return true; else return Has_Pred_In_lpi(pred_ij, tau_ab); end if; end Has_Pred_In_lpi; -- Returns true if tau_ij in hpi(tau_ab) (tasks in Gamma_i of higher priority than tau_ab and on same cpu) function In_MPi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is begin if (not In_hpi(tau_ij, tau_ab)) or else (Has_Pred_In_lpi(tau_ij, tau_ab)) then return false; end if; return true; end In_MPi; -- Returns set of tasks in Gamma_i that are in hpi(tau_ab) but for which the predecessor is not in hpi(tau_ab) function XP (Gamma_i : Generic_Task_Group_Ptr; tau_ab : Generic_Task_Ptr) return Tasks_Set is XP_i : Tasks_Set; tau_if_iterator : Generic_Task_Iterator; tau_if : Generic_Task_Ptr; pred_if : Generic_Task_Ptr; begin -- For each task in Gamma_i, if task in hpi(tau_ab) and pred(task) not in hpi then add to XP_i Initialize(XP_i); if not is_empty(Gamma_i.task_list) then reset_head_iterator(Gamma_i.task_list, tau_if_iterator); loop current_element(Gamma_i.task_list, tau_if, tau_if_iterator); if In_hpi(tau_if, tau_ab) then pred_if := pred(tau_if); if pred_if = null or else not In_hpi(pred_if, tau_ab) then Add(XP_i, tau_if); end if; end if; exit when is_tail_element(Gamma_i.task_list, tau_if_iterator); next_element(Gamma_i.task_list, tau_if_iterator); end loop; end if; return XP_i; end XP; -- Returns the first task tau_if in tau_ij's segment accroding to tau_ab's priority and cpu -- Recursive function that does not work in multiple predecessors case (like Pred function) function First_Task_In_Hseg (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Generic_Task_Ptr is pred_ij : Generic_Task_Ptr; begin if not In_hpi(tau_ij, tau_ab) then raise Generic_WCDOPS_Plus_Exception; end if; pred_ij := pred(tau_ij); -- First condition should never be true if we add a ghost root task if pred_ij = null or else not In_hpi(pred_ij, tau_ab) then return tau_ij; else return First_Task_In_Hseg(pred_ij, tau_ab); end if; end First_Task_In_Hseg; function Get_First_Task_In_Hseg_N (Gamma_i : Generic_Task_Group_Ptr; tau_ab : Generic_Task_Ptr) return Generic_Task_Ptr is XP_i : Tasks_Set; tau_if_iterator : Tasks_Iterator; tau_if : Generic_Task_Ptr; H_seg_iN : Generic_Task_Ptr; O_if : Integer; J_if : Integer; Max_OJ : Integer := 0; begin -- Get XPi set (first tasks in their respective segment) and loop through to find the one with the greatest O + J -- If several have the same O + J, it doesn't matter because it's the "O + J" value that interest us in fact (after this function returns), not the task. XP_i := XP(Gamma_i, tau_ab); if not is_empty(XP_i) then reset_iterator(XP_i, tau_if_iterator); loop current_element(XP_i, tau_if, tau_if_iterator); if tau_if.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; O_if := get_Offset(tau_if); J_if := Periodic_Task_Ptr(tau_if).jitter; if O_if + J_if >= Max_OJ then H_seg_iN := tau_if; Max_OJ := O_if + J_if; end if; exit when is_last_element(XP_i, tau_if_iterator); next_element(XP_i, tau_if_iterator); end loop; end if; -- Free(XP_i, False); return H_seg_iN; end Get_First_Task_In_Hseg_N; function Same_Hsec (task1 : Generic_Task_Ptr; task2 : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is pred1 : Generic_Task_Ptr; pred2 : Generic_Task_Ptr; begin pred1 := pred(task1); while pred1 /= null and then not In_lpi(pred1, tau_ab) loop pred1 := pred(pred1); end loop; pred2 := pred(task2); while pred2 /= null and then not In_lpi(pred2, tau_ab) loop pred2 := pred(pred2); end loop; if pred1 /= null and pred2 /= null then if pred1.name = pred2.name then return true; end if; elsif pred1 = null and pred2 = null then return true; end if; return false; end Same_Hsec; function Same_Hseg (task1 : Generic_Task_Ptr; task2 : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is H_seg_task1 : Generic_Task_Ptr; H_seg_task2 : Generic_Task_Ptr; pred_H_seg_task1 : Generic_Task_Ptr; pred_H_seg_task2 : Generic_Task_Ptr; begin H_seg_task1 := First_Task_In_Hseg(task1, tau_ab); pred_H_seg_task1 := pred(H_seg_task1); H_seg_task2 := First_Task_In_Hseg(task2, tau_ab); pred_H_seg_task2 := pred(H_seg_task2); if pred_H_seg_task1 /= null and pred_H_seg_task2 /= null then return pred_H_seg_task1.name = pred_H_seg_task2.name; elsif pred_H_seg_task1 = null and pred_H_seg_task2 = null then return true; end if; return false; end Same_Hseg; -- Returns true if H_seg_ip precedes tau_ij function Seg_Precedes (tau_ip : Generic_Task_Ptr; tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is H_seg_ip : Generic_Task_Ptr; pred_H_seg_ip : Generic_Task_Ptr; begin H_seg_ip := First_Task_In_Hseg(tau_ip, tau_ab); pred_H_seg_ip := pred(H_seg_ip); return not Same_Hseg(tau_ip, tau_ij, tau_ab) and then (pred_H_seg_ip = null or else Precedes(pred_H_seg_ip, tau_ij)); end Seg_Precedes; -- varphi_ijk function varphi (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr) return Integer is T_i : Integer; O_ij : Integer; O_ik : Integer; J_ik : Integer; begin if tau_ij.task_type /= Periodic_Type or tau_ik.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; T_i := Periodic_Task_Ptr(tau_ik).period; O_ij := get_Offset(tau_ij); O_ik := get_Offset(tau_ik); J_ik := Periodic_Task_Ptr(tau_ik).jitter; return T_i + O_ij - Modulus(O_ik + J_ik, T_i); end varphi; function varphi_seg (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Integer is begin if not In_hpi(tau_ij, tau_ab) then raise Generic_WCDOPS_Plus_Exception; end if; return varphi(First_Task_In_Hseg(tau_ij, tau_ab), tau_ik); end varphi_seg; function p0 (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr) return Integer is varphi_ijk : Integer; J_ij : Integer; T_i : Integer; begin if tau_ij.task_type/= Periodic_Type or tau_ik.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; J_ij := Periodic_Task_Ptr(tau_ij).jitter; T_i := Periodic_Task_Ptr(tau_ik).period; varphi_ijk := varphi(tau_ij, tau_ik); return Integer( 1.0 - Double'Floor( Double(J_ij + varphi_ijk) / Double(T_i) ) ); end p0; -- p0 of first task in tau_ij's segment when tau_ik starts the BP function p0_seg (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Integer is begin return p0(First_Task_In_Hseg(tau_ij, tau_ab), tau_ik); end p0_seg; function TaskInterference (tau_ab : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr; tau_ij : Generic_Task_Ptr; w : Integer; p : Integer; tau_ac : Generic_Task_Ptr) return Integer is taskI : Integer := 0; p_seg_0ijk : Integer; p_seg_0ikk : Integer; varphi_seg_ijk : Integer; T_i : Integer; C_ij : Integer; H_seg_ik : Generic_Task_Ptr; H_seg_ij : Generic_Task_Ptr; H_seg_ab : Generic_Task_Ptr; H_seg_ac : Generic_Task_Ptr; pred_H_seg_ik : Generic_Task_Ptr; pred_H_seg_ij : Generic_Task_Ptr; pred_H_seg_ab : Generic_Task_Ptr; pred_H_seg_ac : Generic_Task_Ptr; begin if tau_ij.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; p_seg_0ijk := p0_seg(tau_ij, tau_ik, tau_ab); varphi_seg_ijk := varphi_seg(tau_ij, tau_ik, tau_ab);-- XP_a shouldn't be empty because at least tau_ab is in XP_a(tau_ab) T_i := Periodic_Task_Ptr(tau_ij).period; C_ij := tau_ij.capacity; if p >= p_seg_0ijk and w > varphi_seg_ijk + (p - 1) * T_i then taskI := C_ij; p_seg_0ikk := p0_seg(tau_ik, tau_ik, tau_ab); H_seg_ik := First_Task_In_Hseg(tau_ik, tau_ab); H_seg_ij := First_Task_In_Hseg(tau_ij, tau_ab); H_seg_ab := First_Task_In_Hseg(tau_ab, tau_ab); H_seg_ac := First_Task_In_Hseg(tau_ac, tau_ab); pred_H_seg_ik := pred(H_seg_ik); pred_H_seg_ij := pred(H_seg_ij); pred_H_seg_ab := pred(H_seg_ab); pred_H_seg_ac := pred(H_seg_ac); -- Note: Verifying H_segs are not null is important since tau_i0 ghost is added only to Gamma_a -- and this function is also called on Gamma_i transactions if (p >= p_seg_0ikk and then Seg_Precedes(tau_ik, tau_ij, tau_ab) and then not Same_Hsec(tau_ik, tau_ij, tau_ab)) -- Rule 1a or else (pred_H_seg_ik /= null and then In_lpi(pred_H_seg_ik, tau_ab) and then pred_H_seg_ij /= null and then In_lpi(pred_H_seg_ij, tau_ab) and then (p /= p_seg_0ikk or else not Same_Hseg(H_seg_ik, H_seg_ij, tau_ab))) -- Rule 2a or else (pred_H_seg_ab/= null and then In_lpi(pred_H_seg_ab, tau_ab) and then pred_H_seg_ij /= null and then In_lpi(pred_H_seg_ij, tau_ab)) -- Rule 3a or else (pred_H_seg_ac /= null and then In_lpi(pred_H_seg_ac, tau_ab) and then pred_H_seg_ij /= null and then In_lpi(pred_H_seg_ij, tau_ab)) then -- Rule 4a taskI := 0; end if; end if; return taskI; end TaskInterference; -- TODO: Comment this because it's different from Redell and a bit complicated. procedure Compute_SB_SectionI (tau_iB : in Generic_Task_Ptr; root : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; tau_ik : in Generic_Task_Ptr; w : in Integer; p : in Integer; tau_ac : in Generic_Task_Ptr; SB : out Tasks_Set; sectionI : in out Integer) is Succ_iB : Tasks_Set; tau_im_iterator : Tasks_Iterator; tau_im : Generic_Task_Ptr; H_seg_pred_im : Generic_Task_Ptr; pred_im : Generic_Task_Ptr; root_preceeds_a_Hseg : Boolean := false; begin Succ_iB := succ(tau_iB); if not is_empty(Succ_iB) then -- Check that tau_iB actually preceeds a segment reset_iterator(Succ_iB, tau_im_iterator); loop current_element(Succ_iB, tau_im, tau_im_iterator); if tau_iB.name /= root.name or else In_hpi(tau_im, tau_ab) then root_preceeds_a_Hseg := true; end if; exit when is_last_element(Succ_iB, tau_im_iterator) or else root_preceeds_a_Hseg; next_element(Succ_iB, tau_im_iterator); end loop; -- Update sectionI and add tasks to SB reset_iterator(Succ_iB, tau_im_iterator); loop current_element(Succ_iB, tau_im, tau_im_iterator); if In_hpi(tau_im, tau_ab) then sectionI := sectionI + TaskInterference(tau_ab, tau_ik, tau_im, w, p, tau_ac); Compute_SB_SectionI(tau_im, root, tau_ab, tau_ik, w, p, tau_ac, SB, sectionI); elsif In_lpi(tau_im, tau_ab) then Add(SB, tau_im); else -- Check if X succeeds root or root's segment (hpi tasks) pred_im := pred(tau_im); -- Succeeds root's segment? if In_hpi(pred_im, tau_ab) then H_seg_pred_im := First_Task_In_Hseg(pred_im, tau_ab); pred_im := pred(H_seg_pred_im); end if; if pred_im.name = root.name then Add(SB, tau_im); end if; -- The recursive algorithm continues on to a branch created with a X tau_im only if tau_iB preceeds a Hseg. -- Otherwise we don't want to add anything after the X tau_im to sectionI, nor any sub-branche starters to SB if root_preceeds_a_Hseg then Compute_SB_SectionI(tau_im, root, tau_ab, tau_ik, w, p, tau_ac, SB, sectionI); end if; end if; exit when is_last_element(Succ_iB, tau_im_iterator); next_element(Succ_iB, tau_im_iterator); end loop; end if; -- Free(Succ_iB, False); end Compute_SB_SectionI; procedure BranchInterference (tau_ab : in Generic_Task_Ptr; tau_ik : in Generic_Task_Ptr; tau_iB : in Generic_Task_Ptr; w : in Integer; p : in Integer; tau_ac : in Generic_Task_Ptr; branchI : in out Integer; branchDelta : in out Integer) is SB : Tasks_Set; sectionI : Integer := 0; tau_iS_iterator : Tasks_Iterator; tau_iS : Generic_Task_Ptr; bI : Integer := 0; bD : Integer := 0; subBranchesI : Integer := 0; subBDelta : Integer := 0; begin -- This differs a bit from the way Redell computes sectionI. -- We don't use a magical "S set" (i.e. H_im(tau_ab)), but a recursive algorithm. -- The recursive algorithm is more optimized for Cheddar ADL than computing H_im(tau_ab). Compute_SB_SectionI(tau_iB, tau_iB, tau_ab, tau_ik, w, p, tau_ac, SB, sectionI); if not is_empty(SB) then reset_iterator(SB, tau_iS_iterator); loop current_element(SB, tau_iS, tau_iS_iterator); BranchInterference(tau_ab, tau_ik, tau_iS, w, p, tau_ac, bI, bD); subBranchesI := subBranchesI + bI; subBDelta := max(subBDelta, bD); exit when is_last_element(SB, tau_iS_iterator); next_element(SB, tau_iS_iterator); end loop; end if; if In_lpi(tau_iB, tau_ab) then branchI := subBranchesI; branchDelta := max(sectionI - subBranchesI, subBDelta); else -- X, delta and ghost root cases branchI := max(sectionI, subBranchesI); branchDelta := max(subBranchesI + subBDelta - branchI, 0); end if; -- Free(SB, False); end BranchInterference; procedure TransactionInterference (tau_ab : in Generic_Task_Ptr; tau_ik : in Generic_Task_Ptr; w : in Integer; tau_ac : in Generic_Task_Ptr; transI_NoB : in out Integer; transI_B : in out Integer) is p_seg_0iNk : Integer; jobI : Integer := 0; jobDelta : Integer := 0; transDelta : Integer := 0; Gamma_i : Generic_Task_Group_Ptr; tau_i1 : Generic_Task_Ptr; tau_i0 : Generic_Task_Ptr; H_seg_iN : Generic_Task_Ptr; begin transI_B := 0; transI_NoB := 0; -- Add ghost root task: placed here for understanding. -- Can be moved to somewhere earlier for optimization (e.g. Max_WWB function) Gamma_i := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ik); tau_i1 := get_Root_Task(Gamma_i); tau_i0 := new Generic_Task; -- Scheduling_Task? tau_i0.name := to_unbounded_string("wcdops+_ghost_root"); tau_i0.cpu_name := to_unbounded_string("wcdops+_ghost_cpu"); tau_i0.priority := 0; --Add(My_System.Tasks, tau_i0); Add_One_Task_Dependency(My_System.Dependencies, tau_i0, tau_i1); -- Last segment of Gamma_i H_seg_iN := Get_First_Task_In_Hseg_N(Gamma_i, tau_ab); if H_seg_iN /= null then p_seg_0iNk := p0_seg(H_seg_iN, tau_ik, tau_ab); -- Compute transI_NoB, transDelta and transI_B for p in p_seg_0iNk .. 0 loop BranchInterference(tau_ab, tau_ik, tau_i0, w, p, tau_ac, jobI, jobDelta); transI_NoB := transI_NoB + jobI; transDelta := max(transDelta, jobDelta); end loop; transI_B := transI_NoB + transDelta; end if; -- Free tau_i0 Delete_One_Task_Dependency(My_System.Dependencies, tau_i0, tau_i1); Free(tau_i0); end TransactionInterference; function W_MP (tau_ik : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr; w : Integer) return Integer is Gamma_i : Generic_Task_Group_Ptr; tau_ij_iterator : Generic_Task_Iterator; tau_ij : Generic_Task_Ptr; C_ij : Integer; T_i : Integer; W_ik_p : Integer := 0; varphi_seg_ijk : Integer; begin Gamma_i := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ik); if not is_empty(Gamma_i.task_list) then reset_head_iterator(Gamma_i.task_list, tau_ij_iterator); loop current_element(Gamma_i.task_list, tau_ij, tau_ij_iterator); if In_MPi(tau_ij, tau_ab) then if tau_ij.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; C_ij := tau_ij.capacity; T_i := Periodic_Task_Ptr(tau_ij).period; varphi_seg_ijk := varphi_seg(tau_ij, tau_ik, tau_ab); -- Equation (19) W_ik_p := W_ik_p + Ceil0( Double(w - varphi_seg_ijk) / Double(T_i) ) * C_ij; end if; exit when is_tail_element(Gamma_i.task_list, tau_ij_iterator); next_element(Gamma_i.task_list, tau_ij_iterator); end loop; end if; return W_ik_p; end W_MP; -- [Wik(tau_ab, w, tau_ac), WBik(tau_ab, w, tau_ac)] => Equation (20) procedure WWB (tau_ik : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; tau_ac : in Generic_Task_Ptr; W_ik : out Integer; WB_ik : out Integer) is transI_NoB : Integer := 0; transI_B : Integer := 0; W_ik_p : Integer; -- W_ik for p > 0 begin TransactionInterference(tau_ab, tau_ik, w, tau_ac, transI_NoB, transI_B); W_ik_p := W_MP(tau_ik, tau_ab, w); -- Second part of Equation (20) W_ik := transI_NoB + W_ik_p; WB_ik := transI_B + W_ik_p; end WWB; -- [W_i*, WB_i*] => Equations (21) and (22) in one function procedure Max_WWB (Gamma_i : in Generic_Task_Group_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; tau_ac : in Generic_Task_Ptr; W_i : out Integer; WB_i : out Integer) is tau_ik_iterator : Tasks_Iterator; tau_ik : Generic_Task_Ptr; W_ik : Integer; WB_ik : Integer; XP_i : Tasks_Set; begin W_i := 0; WB_i := 0; XP_i := XP(Gamma_i, tau_ab); if not is_empty(XP_i) then reset_iterator(XP_i, tau_ik_iterator); loop current_element(XP_i, tau_ik, tau_ik_iterator); WWB(tau_ik, tau_ab, w, tau_ac, W_ik, WB_ik); W_i := max(W_i, W_ik); WB_i := max(WB_i, WB_ik); exit when is_last_element(XP_i, tau_ik_iterator); next_element(XP_i, tau_ik_iterator); end loop; end if; -- Free(XP_i, False); end Max_WWB; -- Busy period estimation function L (tau_ab : in Generic_Task_Ptr; tau_ac : in Generic_Task_Ptr) return Integer is L : Integer; L_w : Integer; C_ab : Integer; B_ab : Integer; W_L_ac : Integer; WB_L_ac : Integer; DW_L_ac : Integer; DW_i : Integer; Sum_Max_Wi : Integer := 0; Max_DW_i : Integer := 0; W_i : Integer; WB_i : Integer; Convergence : Boolean := False; Gamma_iterator : Task_Groups_Iterator; Gamma_i : Generic_Task_Group_Ptr; Gamma_a : Generic_Task_Group_Ptr; begin Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ab); C_ab := tau_ab.capacity; B_ab := tau_ab.blocking_time; L := C_ab + B_ab; loop -- Compute W_ac' and WB_ac' with equation (20) -- tau_ik tau_ab w tau_ac Wik WBik WWB(tau_ac, tau_ab, L, tau_ac, W_L_ac, WB_L_ac); DW_L_ac := WB_L_ac - W_L_ac; Sum_Max_Wi := 0; Max_DW_i := 0; reset_iterator(My_System.Task_Groups, Gamma_iterator); loop current_element(My_System.Task_Groups, Gamma_i, Gamma_iterator); if Gamma_i.name /= Gamma_a.name then W_i := 0; WB_i := 0; -- Equation (21) and (22) all in one function -- i tau_ab w tau_ac -> for reduction rules Max_WWB(Gamma_i, tau_ab, L, tau_ac, W_i, WB_i); -- Gives W_i := max(W_ik) and WB_i := max(WB_ik) for all tau_ik DW_i := WB_i - W_i; -- To compute term 3 and 4 of equation (34) Sum_Max_Wi := Sum_Max_Wi + W_i; -- W_i is summed for all Gamma_i Max_DW_i := max(Max_DW_i, DW_i); -- DW_i is compared for all Gamma_i end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_iterator); end loop; -- Equation (34) L_w := B_ab + W_L_ac + Sum_Max_Wi + max(DW_L_ac, Max_DW_i); If L = L_w then Convergence := true; end if; L := L_w; -- Warning: inifinity loop possible here, if no convergence. No convergence when CPU utilization > 100% -- TODO: Before starting the analysis, check that CPU utilization <= 100% exit when Convergence; end loop; return L; end L; function pL_seg (tau_ab : Generic_Task_Ptr; tau_ac : Generic_Task_Ptr) return Integer is varphi_seg_0abc : Integer; L_abc : Integer; T_a : Integer; begin if tau_ac.task_type/= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; L_abc := L(tau_ab, tau_ac); varphi_seg_0abc := varphi_seg(tau_ab, tau_ac, tau_ab); T_a := Periodic_Task_Ptr(tau_ac).period; if In_MPi(tau_ab, tau_ab) then return Ceil0( Double(L_abc - varphi_seg_0abc) / Double(T_a) ); end if; -- Note: Case where C < B and not same_h(A, B, C) is not needed because different segments is already handled in Redell (to verify). return 0; end pL_seg; function TaskInterference_Gamma_a (tau_ab : Generic_Task_Ptr; tau_ac : Generic_Task_Ptr; tau_aj : Generic_Task_Ptr; w : Integer; p : Integer; p_ab : Integer) return Integer is taskI : Integer := 0; p_seg_0ajc : Integer; p_seg_0acc : Integer; varphi_seg_ajc : Integer; T_a : Integer; C_aj : Integer; H_seg_ac : Generic_Task_Ptr; H_seg_aj : Generic_Task_Ptr; H_seg_ab : Generic_Task_Ptr; pred_H_seg_ac : Generic_Task_Ptr; pred_H_seg_aj : Generic_Task_Ptr; pred_H_seg_ab : Generic_Task_Ptr; begin if tau_aj.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; p_seg_0ajc := p0_seg(tau_aj, tau_ac, tau_ab); varphi_seg_ajc := varphi_seg(tau_aj, tau_ac, tau_ab); T_a := Periodic_Task_Ptr(tau_aj).period; C_aj := tau_aj.capacity; if p >= p_seg_0ajc and w > varphi_seg_ajc + (p - 1) * T_a then taskI := C_aj; p_seg_0acc := p0_seg(tau_ac, tau_ac, tau_ab); H_seg_ac := First_Task_In_Hseg(tau_ac, tau_ab); H_seg_aj := First_Task_In_Hseg(tau_aj, tau_ab); H_seg_ab := First_Task_In_Hseg(tau_ab, tau_ab); pred_H_seg_ac := pred(H_seg_ac); pred_H_seg_aj := pred(H_seg_aj); pred_H_seg_ab := pred(H_seg_ab); -- Note: a pred of a Hseg cannot be null -- beacuse First_Task_In_Hseg never returns null if we add a ghost root task. -- So condition "pred /= null" is not needed. if (p >= p_seg_0acc and then Seg_Precedes(tau_ac, tau_aj, tau_ab) and then not Same_Hsec(tau_ac, tau_aj, tau_ab)) -- Rule 1b or else (pred_H_seg_ac /= null and then In_lpi(pred_H_seg_ac, tau_ab) and then pred_H_seg_aj /= null and then In_lpi(pred_H_seg_aj, tau_ab) and then (p /= p_seg_0acc or else not Same_Hseg(H_seg_ac, H_seg_aj, tau_ab))) -- Rule 2b or else (pred_H_seg_ab /= null and then In_lpi(pred_H_seg_ab, tau_ab) and then pred_H_seg_aj /= null and then In_lpi(pred_H_seg_aj, tau_ab) and then (p /= p_ab or else not Same_Hseg(H_seg_ab, H_seg_aj, tau_ab))) -- Rule 3b or else (p <= p_ab and then Seg_Precedes(tau_aj, tau_ab, tau_ab) and then not Same_Hsec(tau_ab, tau_aj, tau_ab)) -- Rule 4b or else ( (p >= p_ab and then Precedes(tau_ab, tau_aj)) -- Rule 5b or else (p >= p_ab and then Seg_Precedes(tau_ab, tau_aj, tau_ab) and then not Same_Hsec(tau_ac, tau_ab, tau_ab)) or else (p > p_ab and tau_ab.name = tau_aj.name) ) then taskI := 0; end if; end if; return taskI; end TaskInterference_Gamma_a; procedure Compute_SB_SectionI_Gamma_a (tau_aBr : in Generic_Task_Ptr; root : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; tau_ac : in Generic_Task_Ptr; w : in Integer; p : in Integer; p_ab : in Integer; SB : out Tasks_Set; sectionI : in out Integer) is Succ_aBr : Tasks_Set; tau_am_iterator : Tasks_Iterator; tau_am : Generic_Task_Ptr; H_seg_pred_am : Generic_Task_Ptr; pred_am : Generic_Task_Ptr; root_preceeds_a_Hseg : Boolean; begin Succ_aBr := succ(tau_aBr); if not is_empty(Succ_aBr) then -- Check that tau_aBr actually preceeds a segment reset_iterator(Succ_aBr, tau_am_iterator); loop current_element(Succ_aBr, tau_am, tau_am_iterator); if tau_aBr.name /= root.name or else In_hpi(tau_am, tau_ab) then root_preceeds_a_Hseg := true; end if; exit when is_last_element(Succ_aBr, tau_am_iterator) or else root_preceeds_a_Hseg; next_element(Succ_aBr, tau_am_iterator); end loop; reset_iterator(Succ_aBr, tau_am_iterator); loop current_element(Succ_aBr, tau_am, tau_am_iterator); if In_hpi(tau_am, tau_ab) then sectionI := sectionI + TaskInterference_Gamma_a(tau_ab, tau_ac, tau_am, w, p, p_ab); Compute_SB_SectionI_Gamma_a(tau_am, root, tau_ab, tau_ac, w, p, p_ab, SB, sectionI); elsif In_lpi(tau_am, tau_ab) then Add(SB, tau_am); else -- Check if X succeeds root or root's segment (hpi tasks) pred_am := pred(tau_am); -- Succeeds root's segment? if In_hpi(pred_am, tau_ab) then H_seg_pred_am := First_Task_In_Hseg(pred_am, tau_ab); pred_am := pred(H_seg_pred_am); end if; if pred_am.name = root.name then Add(SB, tau_am); end if; if root_preceeds_a_Hseg then Compute_SB_SectionI_Gamma_a(tau_am, root, tau_ab, tau_ac, w, p, p_ab, SB, sectionI); end if; end if; exit when is_last_element(Succ_aBr, tau_am_iterator); next_element(Succ_aBr, tau_am_iterator); end loop; end if; -- Free(Succ_aBr, False); end Compute_SB_SectionI_Gamma_a; procedure BranchInterference_Gamma_a (tau_ab : in Generic_Task_Ptr; tau_ac : in Generic_Task_Ptr; tau_aBr : in Generic_Task_Ptr; w : in Integer; p : in Integer; p_ab : in Integer; branchI : in out Integer; branchDelta : in out Integer) is SB : Tasks_Set; sectionI : Integer := 0; tau_aS_iterator : Tasks_Iterator; tau_aS : Generic_Task_Ptr; bI : Integer := 0; bD : Integer := 0; subBranchesI : Integer := 0; subBDelta : Integer := 0; begin Compute_SB_SectionI_Gamma_a(tau_aBr, tau_aBr, tau_ab, tau_ac, w, p, p_ab, SB, sectionI); if not is_empty(SB) then reset_iterator(SB, tau_aS_iterator); loop current_element(SB, tau_aS, tau_aS_iterator); BranchInterference_Gamma_a(tau_ab, tau_ac, tau_aS, w, p, p_ab, bI, bD); subBranchesI := subBranchesI + bI; subBDelta := max(subBDelta, bD); exit when is_last_element(SB, tau_aS_iterator); next_element(SB, tau_aS_iterator); end loop; end if; if In_lpi(tau_aBr, tau_ab) then branchI := subBranchesI; branchDelta := max(sectionI - subBranchesI, subBDelta); else -- X, delta and ghost root cases branchI := max(sectionI, subBranchesI); branchDelta := max(subBranchesI + subBDelta - branchI, 0); end if; --Free(SB, False); end BranchInterference_Gamma_a; procedure TransactionInterference_Gamma_a (tau_ac : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; p_ab : in Integer; transI_NoB : in out Integer; transI_B : in out Integer) is p_seg_0aNk : Integer; jobI : Integer := 0; jobDelta : Integer := 0; transDelta : Integer := 0; Gamma_a : Generic_Task_Group_Ptr; tau_a1 : Generic_Task_Ptr; tau_a0 : Generic_Task_Ptr; H_seg_aN : Generic_Task_Ptr; begin transI_NoB := 0; transI_B := 0; -- Add ghost root task: placed here for understanding. -- Can be moved to somewhere earlier for optimization (e.g. Max_WWB function) Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ac); tau_a1 := get_Root_Task(Gamma_a); tau_a0 := new Generic_Task; -- Scheduling_Task? tau_a0.name := to_unbounded_string("wcdops+_ghost_root"); tau_a0.cpu_name := to_unbounded_string("wcdops+_ghost_cpu"); tau_a0.priority := 0; --Add(My_System.Tasks, tau_a0); Add_One_Task_Dependency(My_System.Dependencies, tau_a0, tau_a1); H_seg_aN := Get_First_Task_In_Hseg_N(Gamma_a, tau_ab); if H_seg_aN /= null then p_seg_0aNk := p0_seg(H_seg_aN, tau_ac, tau_ab); -- Compute transI_NoB, transDelta and transI_B for p in p_seg_0aNk .. 0 loop BranchInterference_Gamma_a(tau_ab, tau_ac, tau_a0, w, p, p_ab, jobI, jobDelta); transI_NoB := transI_NoB + jobI; transDelta := max(transDelta, jobDelta); end loop; transI_B := transI_NoB + transDelta; end if; -- Free tau_a0 Delete_One_Task_Dependency(My_System.Dependencies, tau_a0, tau_a1); Free(tau_a0); end TransactionInterference_Gamma_a; function W_MP_Gamma_a (tau_ac : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr; w : Integer; p_ab : Integer) return Integer is Gamma_a : Generic_Task_Group_Ptr; tau_aj_iterator : Generic_Task_Iterator; tau_aj : Generic_Task_Ptr; C_aj : Integer; T_a : Integer; varphi_seg_ajc : Integer; C_ab : Integer; W_ac_p_1 : Integer := 0; W_ac_p_2 : Integer := 0; W_ac_p : Integer := 0; begin Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ac); if not is_empty(Gamma_a.task_list) then reset_head_iterator(Gamma_a.task_list, tau_aj_iterator); loop current_element (Gamma_a.task_list, tau_aj, tau_aj_iterator); if In_MPi(tau_aj, tau_ab) then if tau_aj.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; C_aj := tau_aj.capacity; T_a := Periodic_Task_Ptr(tau_aj).period; varphi_seg_ajc := varphi_seg(tau_aj, tau_ac, tau_ab); if not Precedes(tau_ab, tau_aj) then -- Equation (26) W_ac_p_1 := W_ac_p_1 + Ceil0( Double(w - varphi_seg_ajc) / Double(T_a) ) * C_aj; else -- Equation (27) W_ac_p_2 := W_ac_p_2 + min(p_ab - 1, Ceil0( Double(w - varphi_seg_ajc) / Double(T_a) ) * C_aj); end if; end if; exit when is_tail_element(Gamma_a.task_list, tau_aj_iterator); next_element(Gamma_a.task_list, tau_aj_iterator); end loop; C_ab := tau_ab.capacity; W_ac_p := W_ac_p_1 + max(0, p_ab * C_ab + W_ac_p_2); end if; return W_ac_p; end W_MP_Gamma_a; -- [Wac(tau_ab, w, p_ab), WBac(tau_ab, w, p_ab)] => Equation (29) procedure WWB_Gamma_a (tau_ac : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; p_ab : Integer; W_ac : out Integer; WB_ac : out Integer) is transI_NoB : Integer := 0; transI_B : Integer := 0; W_ac_p : Integer; -- W_ac for p > 0 begin TransactionInterference_Gamma_a(tau_ac, tau_ab, w, p_ab, transI_NoB, transI_B); W_ac_p := W_MP_Gamma_a(tau_ac, tau_ab, w, p_ab); -- Second part of Equation (29) W_ac := transI_NoB + W_ac_p; WB_ac := transI_B + W_ac_p; end WWB_Gamma_a; function W (tau_ab : Generic_Task_Ptr; tau_ac : Generic_Task_Ptr; p_ab : Integer) return Integer is w : Integer; w_w : Integer; -- Smiley variable is not amused... C_ab : Integer; -- For initial w B_ab : Integer; -- 1st element W_ac : Integer; -- 2nd element p_0abc : Integer; W_i : Integer; WB_i : Integer; Sum_Max_Wi : Integer; -- 3rd element DW_i : Integer; -- To compute 2nd part of 4th element Max_DW_i : Integer := 0; -- 2nd part of 4th element WB_ac : Integer; -- To compute 1st part of 4th element DW_ac : Integer; -- 1st part of 4th element Gamma_iterator : Task_Groups_Iterator; Gamma_i : Generic_Task_Group_Ptr; Gamma_a : Generic_Task_Group_Ptr; Convergence : Boolean := False; begin Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ab); C_ab := tau_ab.capacity; B_ab := tau_ab.blocking_time; p_0abc := p0(tau_ab, tau_ac); -- Note: not p_seg_0abc but p_0abc w := (p_ab - p_0abc + 1) * C_ab + B_ab; loop -- Compute W_ac and DW_ac of Equation (32) and part 1 of Equation (31) WWB_Gamma_a(tau_ac, tau_ab, w, p_ab, W_ac, WB_ac); DW_ac := WB_ac - W_ac; -- Compute Equation (32)'s part 3 and Equation (31)'s part 2 Sum_Max_Wi := 0; Max_DW_i := 0; reset_iterator(My_System.Task_Groups, Gamma_iterator); loop current_element(My_System.Task_Groups, Gamma_i, Gamma_iterator); if Gamma_i.name /= Gamma_a.name then W_i := 0; WB_i := 0; -- Equation (21) and (22) all in one function -- i tau_ab w tau_ac -> for reduction rules Max_WWB(Gamma_i, tau_ab, w, tau_ac, W_i, WB_i); -- Gives W_i* := max(W_ik) and WB_i* := max(WB_ik) for all tau_ik DW_i := WB_i - W_i; Sum_Max_Wi := Sum_Max_Wi + W_i; -- W_i is summed for all Gamma_i Max_DW_i := max(Max_DW_i, DW_i); -- DW_i is compared for all Gamma_i end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_iterator); end loop; -- Equation (32) w_w := B_ab + W_ac + Sum_Max_Wi + max(DW_ac, Max_DW_i); If w = w_w then Convergence := true; end if; w := w_w; -- Warning: inifinity loop possible here, if no convergence. No convergence when CPU utilization > 100% -- TODO: Before starting the analysis, check that CPU utilization <= 100% exit when Convergence; end loop; return w; end W; procedure Estimate_Successors_Response_Time (tau_ij : in Generic_Task_ptr) is Succ_ij : Tasks_Set; succ_iterator : Tasks_Iterator; succ_task : Generic_Task_Ptr; R_tau_ij : Integer; R_succ : Integer; C_ij : Integer; begin Succ_ij := succ(tau_ij); if not is_empty(Succ_ij) then reset_iterator(Succ_ij, succ_iterator); loop current_element(Succ_ij, succ_task, succ_iterator); R_tau_ij := get_Response(tau_ij); R_succ := get_Response(succ_task); C_ij := tau_ij.capacity; if R_succ < R_tau_ij then Set_Response(succ_task, R_tau_ij + C_ij); end if; Estimate_Successors_Response_Time(succ_task); exit when is_last_element(Succ_ij, succ_iterator); next_element(Succ_ij, succ_iterator); end loop; end if; end Estimate_Successors_Response_Time; procedure Estimate_Predecessor_Response_Time (tau_ij : in Generic_Task_ptr) is pred_ij : Generic_Task_Ptr; R_tau_ij : Integer; R_pred_ij : Integer; C_ij : Integer; begin pred_ij := pred(tau_ij); if pred_ij /= null then R_tau_ij := get_Response(tau_ij); R_pred_ij := get_Response(pred_ij); C_ij := tau_ij.capacity; if R_tau_ij > R_pred_ij then Set_Response(pred_ij, R_tau_ij - C_ij); end if; Estimate_Predecessor_Response_Time(pred_ij); end if; end Estimate_Predecessor_Response_Time; -- MOD for delta: if tau_1 -> tau_2 -> tau_3 and tau_2 is delta, then... procedure Update_Successors_Jitter (tau_ij : in Generic_Task_Ptr) is Succ_ij : Tasks_Set; succ_iterator : Tasks_Iterator; succ_task : Generic_Task_Ptr; begin Succ_ij := succ(tau_ij); if not is_empty(Succ_ij) then reset_iterator(Succ_ij, succ_iterator); loop current_element(Succ_ij, succ_task, succ_iterator); if succ_task.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; Periodic_Task_Ptr(succ_task).jitter := max(get_offset(succ_task), get_response(tau_ij)) - get_offset(succ_task); Update_Successors_Jitter(succ_task); exit when is_last_element(Succ_ij, succ_iterator); next_element(Succ_ij, succ_iterator); end loop; end if; end Update_Successors_Jitter; -- Local variables -- Gamma_iterator : Task_Groups_Iterator; Gamma_a : Generic_Task_Group_Ptr; tau_ab_iterator : Generic_Task_Iterator; tau_ab : Generic_Task_Ptr; tau_ac_iterator : Tasks_Iterator; tau_ac : Generic_Task_Ptr; XP_a : Tasks_Set; R_w_ab : Integer; -- Worst response of tau_ab R_w_abc : Integer; -- Worst response among reponses that depend on a tau_ab starting the BP and the analyzed p_ab R_ab : Integer; -- To compare and store current and last response p_seg_0abc : Integer; p_seg_Labc : Integer; w_abc : Integer; varphi_abc : Integer; T_a : Integer; O_ab : Integer; Convergence : Boolean; begin --------------------------- -- PROCEDURE BEGINS HERE -- --------------------------- -- TODO a function to verify that the transaction is correct -- i.e. tree-shaped, offset values correct, no initial jitter... Init_Response_Times(Response_Times); loop -- Convergence loop Convergence := true; reset_iterator(My_System.Task_Groups, Gamma_iterator); loop -- Transactions loop current_element(My_System.Task_Groups, Gamma_a, Gamma_iterator); if not is_empty(Gamma_a.task_list) then reset_head_iterator(Gamma_a.task_list, tau_ab_iterator); loop -- Analyzed tasks loop (tau_ab) current_element(Gamma_a.task_list, tau_ab, tau_ab_iterator); -- MOD: if tau_ab != delta task then... R_ab := get_Response(tau_ab); R_w_ab := 0; XP_a := XP(Gamma_a, tau_ab); if not is_empty(XP_a) then -- Note: XP_a shouldn't be empty because at least tau_ab is in XP_a(tau_ab) reset_iterator(XP_a, tau_ac_iterator); loop -- BP starting tasks loop (tau_ac) current_element(XP_a, tau_ac, tau_ac_iterator); -- Compute p0 and pL for tau_ab's segment when tau_c starts the BP p_seg_0abc := p0_seg(tau_ab, tau_ac, tau_ab); p_seg_Labc := pL_seg(tau_ab, tau_ac); -- For all p_ab in p0 to pL, take max R_w_ab for p_ab in p_seg_0abc .. p_seg_Labc loop w_abc := w(tau_ab, tau_ac, p_ab); varphi_abc := varphi(tau_ab, tau_ac); T_a := Periodic_Task_Ptr(tau_ab).period; O_ab := get_Offset(tau_ab); R_w_abc := w_abc - varphi_abc - (p_ab - 1) * T_a + O_ab; -- Store maximum value of R_abc^w in R_ab^w if R_w_abc > R_w_ab then R_w_ab := R_w_abc; end if; -- Determine if R_w_abc is higher than deadline and stop if so if Stop_On_Deadline_Missed and R_w_ab > get_Global_Deadline(tau_ab) then raise Generic_WCDOPS_Plus_Exception; end if; end loop; exit when is_last_element(XP_a, tau_ac_iterator); next_element(XP_a, tau_ac_iterator); end loop; end if; --Free(XP_a, False); -- Update tau_ab's response time if R_w_ab > R_ab then R_ab := R_w_ab; Set_Response(tau_ab, R_ab); Convergence := false; end if; -- Estimate tau_ab's successors responses so they are not less than R_ab --Estimate_Successors_Response_Time(tau_ab); -- This gives wrong results and it wasn't mentioned in [Redell04] nor in [Palencia99] -- Estimate tau_ab's predecessor response because R_ab may be less than R_a{b-1} due to application of tau_ac in XP_a --Estimate_Predecessor_Response_Time(tau_ab); -- This gives wrong results and it wasn't mentioned in [Redell04] nor in [Palencia99] -- Jitter re-evaluation Update_Successors_Jitter(Get_Root_Task(Gamma_a)); exit when is_tail_element(Gamma_a.task_list, tau_ab_iterator); next_element(Gamma_a.task_list, tau_ab_iterator); end loop; end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_Iterator); end loop; -- Warning: inifinity loop possible here, if no convergence. No convergence when CPU utilization > 100% -- TODO: Before starting the analysis, check that CPU utilization <= 100% exit when Convergence; end loop; end WCDOPS_Plus; procedure WCDOPS_Plus_NIMP (My_System : in out System; Response_Times : in out Response_Time_Table; Stop_On_Deadline_Missed : in Boolean := False) is -- Local exceptions -- Generic_WCDOPS_Plus_Exception : exception; -- Global variables -- -- DELTA FORCED_IMMEDIATE_TASKS_SET : Tasks_Set; -- Local functions -- function Max (x, y : Integer) return Integer is begin if x < y then return y; else return x; end if; end Max; function Min (x, y : Integer) return Integer is begin if x < y then return x; else return y; end if; end Min; function Modulus (x, y : Integer) return Integer is begin return x - Integer(Double'Floor(Double(x) / Double(y))) * y; end Modulus; function Ceil0 (x : Double) return Integer is begin if x < 0.0 then return 0; else return Integer(Double'Ceiling(x)); end if; end Ceil0; function get_Offset (tau : Generic_Task_Ptr) return Integer is New_Offset : Offset_Type_Ptr; use Offsets.Offsets_Table_Package; begin if tau.offsets.nb_entries > 0 then for I in 0 .. tau.offsets.nb_entries - 1 loop if tau.offsets.entries(I).activation = 0 then return tau.offsets.entries(I).offset_value; end if; end loop; end if; New_Offset := new Offset_Type; New_Offset.offset_value := 0; New_Offset.activation := 0; Add(tau.offsets, New_Offset.all); return 0; end get_Offset; function get_Global_Deadline (tau : Generic_Task_Ptr) return Integer is begin return tau.deadline + get_offset(tau); end get_Global_Deadline; procedure Init_Response_Times (Response_Times : out Response_Time_Table) is Gamma_iterator : Task_Groups_Iterator; Gamma : Generic_Task_Group_Ptr; tau_iterator : Generic_Task_Iterator; tau : Generic_Task_Ptr; i : Integer := 0; begin if not is_empty(My_System.Task_Groups) then Initialize(Response_Times); reset_iterator(My_System.Task_Groups, Gamma_iterator); loop current_element(My_System.Task_Groups, Gamma, Gamma_iterator); if not is_empty(Gamma.task_list) then reset_head_iterator(Gamma.task_list, tau_iterator); loop current_element(Gamma.task_list, tau, tau_iterator); Response_Times.entries(Response_Times.nb_entries).data := Double(get_Offset(tau) + tau.capacity); Response_Times.entries(Response_Times.nb_entries).item := tau; Response_Times.nb_entries := Response_Times.nb_entries + 1; exit when is_tail_element(Gamma.task_list, tau_iterator); next_element(Gamma.task_list, tau_iterator); end loop; end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_iterator); end loop; end if; end Init_Response_Times; procedure Set_Response (tau : Generic_Task_Ptr; time : Integer) is begin if Response_Times.nb_entries > 0 then for i in 0 .. Response_Times.nb_entries - 1 loop if Response_Times.entries(i).item.name = tau.name then Response_Times.entries(i).data := Double(time) + 0.0; return; end if; end loop; end if; end Set_Response; function get_Response (tau : Generic_Task_Ptr) return Integer is begin if Response_Times.nb_entries > 0 then for i in 0 .. Response_Times.nb_entries - 1 loop if Response_Times.entries(i).item.name = tau.name then return Integer(Response_Times.entries(i).data); end if; end loop; end if; raise Generic_WCDOPS_Plus_Exception; return 0; end get_Response; -- DELTA procedures and functions in capital procedure FORCE_IMMEDIATE_TASK (tau : Generic_Task_Ptr) is tau_ij_iterator : Tasks_Iterator; tau_ij : Generic_Task_Ptr; begin if not is_empty(FORCED_IMMEDIATE_TASKS_SET) then reset_iterator(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); loop current_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij, tau_ij_iterator); if tau_ij.name = tau.name then return; end if; exit when is_last_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); next_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); end loop; end if; Add(FORCED_IMMEDIATE_TASKS_SET, tau); end FORCE_IMMEDIATE_TASK; procedure UNFORCE_IMMEDIATE_TASK (tau : Generic_Task_Ptr) is tau_ij_iterator : Tasks_Iterator; tau_ij : Generic_Task_Ptr; begin if not is_empty(FORCED_IMMEDIATE_TASKS_SET) then reset_iterator(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); loop current_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij, tau_ij_iterator); if tau_ij.name = tau.name then Delete(FORCED_IMMEDIATE_TASKS_SET, tau_ij, false); return; end if; exit when is_last_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); next_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); end loop; end if; end UNFORCE_IMMEDIATE_TASK; function IS_FORCED_IMMEDIATE_TASK (tau : Generic_Task_Ptr) return Boolean is tau_ij_iterator : Tasks_Iterator; tau_ij : Generic_Task_Ptr; begin if not is_empty(FORCED_IMMEDIATE_TASKS_SET) then reset_iterator(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); loop current_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij, tau_ij_iterator); if tau_ij.name = tau.name then return true; end if; exit when is_last_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); next_element(FORCED_IMMEDIATE_TASKS_SET, tau_ij_iterator); end loop; end if; return false; end IS_FORCED_IMMEDIATE_TASK; -- No multi-predecessor version; Otherwise should return a set of predecessors function Pred (tau_ij : Generic_Task_Ptr) return Generic_Task_Ptr is pred_ij : Generic_Task_Ptr; A_Task_Dependencies_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep : Dependency_Ptr; begin if not is_empty(My_System.Dependencies.Depends) then reset_iterator(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); loop current_element(My_System.Dependencies.Depends, A_Half_Dep, A_Task_Dependencies_Iterator); if A_Half_Dep.type_of_dependency = Precedence_Dependency then if A_Half_Dep.precedence_sink.name = tau_ij.name then pred_ij := A_Half_Dep.precedence_source; return pred_ij; end if; end if; exit when is_last_element(My_system.Dependencies.Depends, A_Task_Dependencies_Iterator); next_element(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); end loop; end if; return null; end Pred; function get_Root_Task (Gamma_i : Generic_Task_Group_Ptr) return Generic_Task_Ptr is tau_ij_iterator : Generic_Task_Iterator; tau_ij : Generic_Task_Ptr; pred_ij : Generic_Task_Ptr; begin if not is_empty(Gamma_i.task_list) then reset_head_iterator(Gamma_i.task_list, tau_ij_iterator); loop current_element(Gamma_i.task_list, tau_ij, tau_ij_iterator); pred_ij := pred(tau_ij); if pred_ij = null then return tau_ij; end if; exit when is_tail_element(Gamma_i.task_list, tau_ij_iterator); next_element(Gamma_i.task_list, tau_ij_iterator); end loop; end if; raise Generic_WCDOPS_Plus_Exception; -- Should never reach return null; end get_Root_Task; -- DELTA: New function function Is_Immediate (pred : Generic_Task_Ptr; succ : Generic_Task_Ptr) return Boolean is O_pred : Integer; C_pred : Integer; O_succ : Integer; begin -- DELTA: In case of non-immediate successors, we sometimes need to see what values are computed when their predecessor -- go over their offset, thus making them immediate successors. if IS_FORCED_IMMEDIATE_TASK(succ) then return true; end if; O_pred := get_Offset(pred); C_pred := pred.capacity; O_succ := get_Offset(succ); if O_succ > O_pred + C_pred then return false; end if; return true; end Is_Immediate; -- DELTA: New function function Is_Immediate_Successor (tau_ij : Generic_Task_Ptr) return Boolean is pred_ij : Generic_Task_Ptr; begin pred_ij := pred(tau_ij); if pred_ij /= null then return Is_Immediate(pred_ij, tau_ij); end if; return true; end Is_Immediate_Successor; -- Returns true if tau_ip precedes tau_ij (not necessarily immediately) function Precedes (tau_ip : Generic_Task_Ptr; tau_ij : Generic_Task_Ptr) return Boolean is pred_ij : Generic_Task_Ptr; begin pred_ij := pred(tau_ij); if pred_ij = null then return false; elsif pred_ij.name = tau_ip.name then return true; else return Precedes(tau_ip, pred_ij); end if; end Precedes; function Succ (tau_ij : Generic_Task_Ptr) return Tasks_Set is Succ_ij : Tasks_Set; A_Task_Dependencies_Iterator : Tasks_Dependencies_Iterator; A_Half_Dep : Dependency_Ptr; begin Initialize(Succ_ij); if not is_empty(My_System.Dependencies.Depends) then reset_iterator(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); loop current_element(My_System.Dependencies.Depends, A_Half_Dep, A_Task_Dependencies_Iterator); if A_Half_Dep.type_of_dependency = Precedence_Dependency then if A_Half_Dep.precedence_source.name = tau_ij.name then Add(Succ_ij, A_Half_Dep.precedence_sink); end if; end if; exit when is_last_element(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); next_element(My_System.Dependencies.Depends, A_Task_Dependencies_Iterator); end loop; end if; return Succ_ij; end Succ; -- Returns true if tau_ij in hpi(tau_ab) (tasks in Gamma_i of higher priority than tau_ab and on same cpu) function In_hpi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is begin if tau_ij = null then raise Generic_WCDOPS_Plus_Exception; end if; return tau_ij.priority >= tau_ab.priority and tau_ij.cpu_name = tau_ab.cpu_name; end In_hpi; -- Returns true if tau_ij in lpi(tau_ab) (tasks in Gamma_i of lower priority than tau_ab and on same cpu) function In_lpi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is begin if tau_ij = null then raise Generic_WCDOPS_Plus_Exception; end if; return tau_ij.priority < tau_ab.priority and tau_ij.cpu_name = tau_ab.cpu_name; end In_lpi; function Has_Pred_In_lpi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is pred_ij : Generic_Task_Ptr; begin pred_ij := pred(tau_ij); if pred_ij = null then return false; elsif In_lpi(pred_ij, tau_ab) then return true; else return Has_Pred_In_lpi(pred_ij, tau_ab); end if; end Has_Pred_In_lpi; -- Returns true if tau_ij in hpi(tau_ab) and does not have any predecessor (not only the immediate one) in lpi(tau_ab) function In_MPi (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is begin if (not In_hpi(tau_ij, tau_ab)) or else (Has_Pred_In_lpi(tau_ij, tau_ab)) then return false; end if; return true; end In_MPi; -- Returns set of tasks in Gamma_i that are in hpi(tau_ab) but for which the predecessor is not in hpi(tau_ab) function XP (Gamma_i : Generic_Task_Group_Ptr; tau_ab : Generic_Task_Ptr) return Tasks_Set is XP_i : Tasks_Set; tau_if_iterator : Generic_Task_Iterator; tau_if : Generic_Task_Ptr; pred_if : Generic_Task_Ptr; begin -- For each task in Gamma_i, if task in hpi(tau_ab) and pred(task) not in hpi then add to XP_i Initialize(XP_i); if not is_empty(Gamma_i.task_list) then reset_head_iterator(Gamma_i.task_list, tau_if_iterator); loop current_element(Gamma_i.task_list, tau_if, tau_if_iterator); if In_hpi(tau_if, tau_ab) then pred_if := pred(tau_if); -- DELTA: 'or else not Is_Immediate(pred_if, tau_if)' if pred_if = null or else not In_hpi(pred_if, tau_ab) or else not Is_Immediate(pred_if, tau_if) then Add(XP_i, tau_if); end if; end if; exit when is_tail_element(Gamma_i.task_list, tau_if_iterator); next_element(Gamma_i.task_list, tau_if_iterator); end loop; end if; return XP_i; end XP; -- Returns the first task tau_if in tau_ij's segment accroding to tau_ab's priority and cpu -- Recursive function that does not work in multiple predecessors case (like Pred function) function First_Task_In_Hseg (tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Generic_Task_Ptr is pred_ij : Generic_Task_Ptr; begin if not In_hpi(tau_ij, tau_ab) then raise Generic_WCDOPS_Plus_Exception; end if; pred_ij := pred(tau_ij); -- First condition should never be true if we add a ghost root task -- DELTA: 'or else not Is_Immediate(pred_ij, tau_ij)' if pred_ij = null or else not In_hpi(pred_ij, tau_ab) or else not Is_Immediate(pred_ij, tau_ij) then return tau_ij; else return First_Task_In_Hseg(pred_ij, tau_ab); end if; end First_Task_In_Hseg; function Get_First_Task_In_Hseg_N (Gamma_i : Generic_Task_Group_Ptr; tau_ab : Generic_Task_Ptr) return Generic_Task_Ptr is XP_i : Tasks_Set; tau_if_iterator : Tasks_Iterator; tau_if : Generic_Task_Ptr; H_seg_iN : Generic_Task_Ptr; O_if : Integer; J_if : Integer; Max_OJ : Integer := 0; begin -- Get XPi set (first tasks in their respective segment) and loop through to find the one with the greatest O + J -- If several have the same O + J, it doesn't matter because it's the "O + J" value that interest us in fact (after this function returns), not the task. XP_i := XP(Gamma_i, tau_ab); if not is_empty(XP_i) then reset_iterator(XP_i, tau_if_iterator); loop current_element(XP_i, tau_if, tau_if_iterator); if tau_if.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; O_if := get_Offset(tau_if); J_if := Periodic_Task_Ptr(tau_if).jitter; if O_if + J_if >= Max_OJ then H_seg_iN := tau_if; Max_OJ := O_if + J_if; end if; exit when is_last_element(XP_i, tau_if_iterator); next_element(XP_i, tau_if_iterator); end loop; end if; -- Free(XP_i, False); return H_seg_iN; end Get_First_Task_In_Hseg_N; function Same_Hsec (task1 : Generic_Task_Ptr; task2 : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is pred1 : Generic_Task_Ptr; pred2 : Generic_Task_Ptr; begin pred1 := pred(task1); while pred1 /= null and then not In_lpi(pred1, tau_ab) loop pred1 := pred(pred1); end loop; pred2 := pred(task2); while pred2 /= null and then not In_lpi(pred2, tau_ab) loop pred2 := pred(pred2); end loop; if pred1 /= null and pred2 /= null then if pred1.name = pred2.name then return true; end if; elsif pred1 = null and pred2 = null then return true; end if; return false; end Same_Hsec; function Same_Hseg (task1 : Generic_Task_Ptr; task2 : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is H_seg_task1 : Generic_Task_Ptr; H_seg_task2 : Generic_Task_Ptr; pred_H_seg_task1 : Generic_Task_Ptr; pred_H_seg_task2 : Generic_Task_Ptr; begin H_seg_task1 := First_Task_In_Hseg(task1, tau_ab); pred_H_seg_task1 := pred(H_seg_task1); H_seg_task2 := First_Task_In_Hseg(task2, tau_ab); pred_H_seg_task2 := pred(H_seg_task2); if pred_H_seg_task1 /= null and pred_H_seg_task2 /= null then -- DELTA: 'and Is_Immediate(pred_H_seg_task1, H_seg_task1) and Is_Immediate(pred_H_seg_task2, H_seg_task2)' return pred_H_seg_task1.name = pred_H_seg_task2.name and then Is_Immediate(pred_H_seg_task1, H_seg_task1) and then Is_Immediate(pred_H_seg_task2, H_seg_task2); elsif pred_H_seg_task1 = null and pred_H_seg_task2 = null then return true; end if; return false; end Same_Hseg; -- Returns true if H_seg_ip precedes tau_ij function Seg_Precedes (tau_ip : Generic_Task_Ptr; tau_ij : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Boolean is H_seg_ip : Generic_Task_Ptr; pred_H_seg_ip : Generic_Task_Ptr; begin H_seg_ip := First_Task_In_Hseg(tau_ip, tau_ab); pred_H_seg_ip := pred(H_seg_ip); -- DELTA: in case the pred is supposed to be a delta if not Is_Immediate(pred_H_seg_ip, H_seg_ip) then pred_H_seg_ip := H_seg_ip; end if; return not Same_Hseg(tau_ip, tau_ij, tau_ab) and then (pred_H_seg_ip = null or else Precedes(pred_H_seg_ip, tau_ij)); end Seg_Precedes; -- varphi_ijk function varphi (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr) return Integer is T_i : Integer; O_ij : Integer; O_ik : Integer; J_ik : Integer; begin if tau_ij.task_type /= Periodic_Type or tau_ik.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; T_i := Periodic_Task_Ptr(tau_ik).period; O_ij := get_Offset(tau_ij); O_ik := get_Offset(tau_ik); J_ik := Periodic_Task_Ptr(tau_ik).jitter; return T_i + O_ij - Modulus(O_ik + J_ik, T_i); end varphi; function varphi_seg (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Integer is begin if not In_hpi(tau_ij, tau_ab) then raise Generic_WCDOPS_Plus_Exception; end if; return varphi(First_Task_In_Hseg(tau_ij, tau_ab), tau_ik); end varphi_seg; function p0 (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr) return Integer is varphi_ijk : Integer; J_ij : Integer; T_i : Integer; begin if tau_ij.task_type/= Periodic_Type or tau_ik.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; J_ij := Periodic_Task_Ptr(tau_ij).jitter; T_i := Periodic_Task_Ptr(tau_ik).period; varphi_ijk := varphi(tau_ij, tau_ik); return Integer( 1.0 - Double'Floor( Double(J_ij + varphi_ijk) / Double(T_i) ) ); end p0; -- p0 of first task in tau_ij's segment when tau_ik starts the BP function p0_seg (tau_ij : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr) return Integer is begin return p0(First_Task_In_Hseg(tau_ij, tau_ab), tau_ik); end p0_seg; function TaskInterference (tau_ab : Generic_Task_Ptr; tau_ik : Generic_Task_Ptr; tau_ij : Generic_Task_Ptr; w : Integer; p : Integer; tau_ac : Generic_Task_Ptr) return Integer is taskI : Integer := 0; p_seg_0ijk : Integer; p_seg_0ikk : Integer; varphi_seg_ijk : Integer; T_i : Integer; C_ij : Integer; H_seg_ik : Generic_Task_Ptr; H_seg_ij : Generic_Task_Ptr; H_seg_ab : Generic_Task_Ptr; H_seg_ac : Generic_Task_Ptr; pred_H_seg_ik : Generic_Task_Ptr; pred_H_seg_ij : Generic_Task_Ptr; pred_H_seg_ab : Generic_Task_Ptr; pred_H_seg_ac : Generic_Task_Ptr; begin if tau_ij.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; p_seg_0ijk := p0_seg(tau_ij, tau_ik, tau_ab); varphi_seg_ijk := varphi_seg(tau_ij, tau_ik, tau_ab); T_i := Periodic_Task_Ptr(tau_ij).period; C_ij := tau_ij.capacity; if p >= p_seg_0ijk and w > varphi_seg_ijk + (p - 1) * T_i then taskI := C_ij; p_seg_0ikk := p0_seg(tau_ik, tau_ik, tau_ab); H_seg_ik := First_Task_In_Hseg(tau_ik, tau_ab); H_seg_ij := First_Task_In_Hseg(tau_ij, tau_ab); H_seg_ab := First_Task_In_Hseg(tau_ab, tau_ab); H_seg_ac := First_Task_In_Hseg(tau_ac, tau_ab); pred_H_seg_ik := pred(H_seg_ik); pred_H_seg_ij := pred(H_seg_ij); pred_H_seg_ab := pred(H_seg_ab); pred_H_seg_ac := pred(H_seg_ac); -- Note: Verifying H_segs are not null is important since tau_i0 ghost is added only to Gamma_a -- and this function is also called on Gamma_i transactions if (p >= p_seg_0ikk and then Seg_Precedes(tau_ik, tau_ij, tau_ab) and then not Same_Hsec(tau_ik, tau_ij, tau_ab)) -- Rule 1a or else (pred_H_seg_ik /= null and then In_lpi(pred_H_seg_ik, tau_ab) and then pred_H_seg_ij /= null and then In_lpi(pred_H_seg_ij, tau_ab) and then (p /= p_seg_0ikk or else not Same_Hseg(H_seg_ik, H_seg_ij, tau_ab))) -- Rule 2a or else (pred_H_seg_ab/= null and then In_lpi(pred_H_seg_ab, tau_ab) and then pred_H_seg_ij /= null and then In_lpi(pred_H_seg_ij, tau_ab)) -- Rule 3a or else (pred_H_seg_ac /= null and then In_lpi(pred_H_seg_ac, tau_ab) and then pred_H_seg_ij /= null and then In_lpi(pred_H_seg_ij, tau_ab)) -- Rule 4a or else (not Is_Immediate_Successor(tau_ik) and then p <= p_seg_0ikk and then Same_Hsec(tau_ij, tau_ik, tau_ab) and then Precedes(tau_ij, tau_ik)) then -- DELTA J: rule 5a: if tau_ij in same section as tau_ik and tau_ij precedes tau_ik and we are checking p <= p_seg_0ikk then burn it taskI := 0; end if; end if; return taskI; end TaskInterference; -- DELTA: New function procedure Compute_SB (root : in Generic_Task_Ptr; tau_im : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; SB : out Tasks_Set) is pred_im : Generic_Task_Ptr; H_seg_pred_im : Generic_Task_Ptr; begin pred_im := pred(tau_im); if In_hpi(pred_im, tau_ab) then H_seg_pred_im := First_Task_In_Hseg(pred_im, tau_ab); pred_im := pred(H_seg_pred_im); -- DELTA: If pred(H_seg_pred_im) is not immediate, then H_seg_pred_im's predecessor is actually an imaginary delta task, thus itself if not Is_Immediate(pred_im, H_seg_pred_im) then pred_im := H_seg_pred_im; end if; end if; if pred_im.name = root.name then Add(SB, tau_im); end if; end Compute_SB; -- TODO: Comment this because it's different from Redell and a bit complicated. procedure Compute_SB_SectionI (tau_iB : in Generic_Task_Ptr; root : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; tau_ik : in Generic_Task_Ptr; w : in Integer; p : in Integer; tau_ac : in Generic_Task_Ptr; SB : out Tasks_Set; sectionI : in out Integer) is Succ_iB : Tasks_Set; tau_im_iterator : Tasks_Iterator; tau_im : Generic_Task_Ptr; root_preceeds_a_Hseg : Boolean := false; -- DELTA J T_i : Integer; varphi_imk : Integer; varphi_iBk : Integer; r_iB : Integer; r_im : Integer; begin if tau_ik.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; Succ_iB := succ(tau_iB); if not is_empty(Succ_iB) then -- Check that tau_iB actually preceeds a segment reset_iterator(Succ_iB, tau_im_iterator); loop current_element(Succ_iB, tau_im, tau_im_iterator); -- DELTA: 'and then Is_Immediate(tau_iB, tau_im)' if (tau_iB.name /= root.name) or else (In_hpi(tau_im, tau_ab) and then Is_Immediate(tau_iB, tau_im)) then root_preceeds_a_Hseg := true; end if; exit when is_last_element(Succ_iB, tau_im_iterator) or else root_preceeds_a_Hseg; next_element(Succ_iB, tau_im_iterator); end loop; -- Update sectionI and add tasks to SB reset_iterator(Succ_iB, tau_im_iterator); loop current_element(Succ_iB, tau_im, tau_im_iterator); if In_hpi(tau_im, tau_ab) then -- DELTA J: If tau_im is not an immediate successor of tau_iB we check if it should be in the given condition if not Is_Immediate(tau_iB, tau_im) then T_i := Periodic_Task_Ptr(tau_im).period; varphi_imk := varphi(tau_im, tau_ik); varphi_iBk := varphi(tau_iB, tau_ik); r_im := varphi_imk + (p - 1) * T_i; -- tau_im release @ p r_iB := varphi_iBk + (p - 1) * T_i; -- tau_iB release @ p if r_im >= 0 then -- TODO: or else (r_im > 0 and r_iB + C_iB + something >= r_im) Compute_SB(root, tau_im, tau_ab, SB); end if; end if; -- DELTA: This condition is added because tau_im can be a non-immediate successor. -- See below (in X case) for explanation on usefulness of test. if root_preceeds_a_Hseg then sectionI := sectionI + TaskInterference(tau_ab, tau_ik, tau_im, w, p, tau_ac); Compute_SB_SectionI(tau_im, root, tau_ab, tau_ik, w, p, tau_ac, SB, sectionI); end if; elsif In_lpi(tau_im, tau_ab) then Add(SB, tau_im); else Compute_SB(root, tau_im, tau_ab, SB); -- The recursive algorithm continues on to a branch created with a X tau_im only if tau_iB preceeds a Hseg. -- Otherwise we don't want to add anything after the X tau_im to sectionI, nor any sub-branche starters to SB if root_preceeds_a_Hseg then Compute_SB_SectionI(tau_im, root, tau_ab, tau_ik, w, p, tau_ac, SB, sectionI); end if; end if; exit when is_last_element(Succ_iB, tau_im_iterator); next_element(Succ_iB, tau_im_iterator); end loop; end if; -- Free(Succ_iB, False); end Compute_SB_SectionI; procedure BranchInterference (tau_ab : in Generic_Task_Ptr; tau_ik : in Generic_Task_Ptr; tau_iB : in Generic_Task_Ptr; w : in Integer; p : in Integer; tau_ac : in Generic_Task_Ptr; branchI : in out Integer; branchDelta : in out Integer) is pred_iB : Generic_Task_Ptr; SB : Tasks_Set; sectionI : Integer := 0; tau_iS_iterator : Tasks_Iterator; tau_iS : Generic_Task_Ptr; bI : Integer := 0; bD : Integer := 0; subBranchesI : Integer := 0; subBDelta : Integer := 0; begin -- This differs a bit from the way Redell computes sectionI. -- We don't use a magical "S set" (i.e. H_im(tau_ab)), but a recursive algorithm. -- The recursive algorithm is more optimized for Cheddar ADL than computing H_im(tau_ab). Compute_SB_SectionI(tau_iB, tau_iB, tau_ab, tau_ik, w, p, tau_ac, SB, sectionI); -- DELTA: Since we add a hpi task in SB if it does not succeed immediately its predecessor in H_seg_iB, we can call BranchInterference on the former -- so it needs to contribute to the interference. if In_hpi(tau_iB, tau_ab) then sectionI := sectionI + TaskInterference(tau_ab, tau_ik, tau_iB, w, p, tau_ac); end if; if not is_empty(SB) then reset_iterator(SB, tau_iS_iterator); loop current_element(SB, tau_iS, tau_iS_iterator); BranchInterference(tau_ab, tau_ik, tau_iS, w, p, tau_ac, bI, bD); subBranchesI := subBranchesI + bI; subBDelta := max(subBDelta, bD); exit when is_last_element(SB, tau_iS_iterator); next_element(SB, tau_iS_iterator); end loop; end if; if In_lpi(tau_iB, tau_ab) then branchI := subBranchesI; branchDelta := max(sectionI - subBranchesI, subBDelta); -- DELTA: If tau_iB (in lpi) is not an immediate successor of pred_iB -- then only its branchDelta needs to be checked to see if it is lower than 0 -- since a delta task between pred_iB and tau_iB would return the same branchI, and only check -- if subBDelta is higher than 0, as explained below formally. pred_iB := pred(tau_iB); if pred_iB /= null and then not Is_Immediate(pred_iB, tau_iB) then -- branchI := max(sectionI, subBranchesI) := max(0, subBranchesI) := subBranchesI; -- branchDelta := max(subBranchesI + subBDelta - branchI, 0) := max(subBranchesI + subBDelta - subBranchesI, 0) := branchDelta := max(subBDelta, 0); end if; else -- X, hpi and ghost root cases branchI := max(sectionI, subBranchesI); branchDelta := max(subBranchesI + subBDelta - branchI, 0); -- DELTA: here we do not check if tau_iB is an immediate successor of pred_iB since even adding a delta between tau_iB and pred_iB -- would result in the same [branchI, branchDelta] returned by delta to pred_iB. end if; -- Free(SB, False); end BranchInterference; procedure TransactionInterference (tau_ab : in Generic_Task_Ptr; tau_ik : in Generic_Task_Ptr; w : in Integer; tau_ac : in Generic_Task_Ptr; transI_NoB : in out Integer; transI_B : in out Integer) is p_seg_0iNk : Integer; jobI : Integer := 0; jobDelta : Integer := 0; transDelta : Integer := 0; Gamma_i : Generic_Task_Group_Ptr; tau_i1 : Generic_Task_Ptr; tau_i0 : Generic_Task_Ptr; H_seg_iN : Generic_Task_Ptr; begin transI_B := 0; transI_NoB := 0; -- Add ghost root task: placed here for understanding. -- Can be moved to somewhere earlier for optimization (e.g. Max_WWB function) Gamma_i := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ik); tau_i1 := get_Root_Task(Gamma_i); tau_i0 := new Generic_Task; -- Scheduling_Task? tau_i0.name := to_unbounded_string("wcdops+_ghost_root"); tau_i0.cpu_name := to_unbounded_string("wcdops+_ghost_cpu"); tau_i0.priority := 0; --Add(My_System.Tasks, tau_i0); Add_One_Task_Dependency(My_System.Dependencies, tau_i0, tau_i1); -- Last segment of Gamma_i H_seg_iN := Get_First_Task_In_Hseg_N(Gamma_i, tau_ab); if H_seg_iN /= null then p_seg_0iNk := p0_seg(H_seg_iN, tau_ik, tau_ab); -- Compute transI_NoB, transDelta and transI_B for p in p_seg_0iNk .. 0 loop BranchInterference(tau_ab, tau_ik, tau_i0, w, p, tau_ac, jobI, jobDelta); transI_NoB := transI_NoB + jobI; transDelta := max(transDelta, jobDelta); end loop; transI_B := transI_NoB + transDelta; end if; -- Free tau_i0 Delete_One_Task_Dependency(My_System.Dependencies, tau_i0, tau_i1); Free(tau_i0); end TransactionInterference; function W_MP (tau_ik : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr; w : Integer) return Integer is Gamma_i : Generic_Task_Group_Ptr; tau_ij_iterator : Generic_Task_Iterator; tau_ij : Generic_Task_Ptr; C_ij : Integer; T_i : Integer; W_ik_p : Integer := 0; varphi_seg_ijk : Integer; begin Gamma_i := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ik); if not is_empty(Gamma_i.task_list) then reset_head_iterator(Gamma_i.task_list, tau_ij_iterator); loop current_element(Gamma_i.task_list, tau_ij, tau_ij_iterator); if In_MPi(tau_ij, tau_ab) then if tau_ij.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; C_ij := tau_ij.capacity; T_i := Periodic_Task_Ptr(tau_ij).period; varphi_seg_ijk := varphi_seg(tau_ij, tau_ik, tau_ab); -- Equation (19) -- TODO: Integer overflow bug W_ik_p := W_ik_p + Ceil0( Double(w - varphi_seg_ijk) / Double(T_i) ) * C_ij; end if; exit when is_tail_element(Gamma_i.task_list, tau_ij_iterator); next_element(Gamma_i.task_list, tau_ij_iterator); end loop; end if; return W_ik_p; end W_MP; -- [Wik(tau_ab, w, tau_ac), WBik(tau_ab, w, tau_ac)] => Equation (20) procedure WWB (tau_ik : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; tau_ac : in Generic_Task_Ptr; W_ik : out Integer; WB_ik : out Integer) is transI_NoB : Integer := 0; transI_B : Integer := 0; W_ik_p : Integer; -- W_ik for p > 0 begin TransactionInterference(tau_ab, tau_ik, w, tau_ac, transI_NoB, transI_B); W_ik_p := W_MP(tau_ik, tau_ab, w); -- Second part of Equation (20) W_ik := transI_NoB + W_ik_p; WB_ik := transI_B + W_ik_p; end WWB; -- [W_i*, WB_i*] => Equations (21) and (22) in one function procedure Max_WWB (Gamma_i : in Generic_Task_Group_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; tau_ac : in Generic_Task_Ptr; W_i : out Integer; WB_i : out Integer) is tau_ik_iterator : Tasks_Iterator; tau_ik : Generic_Task_Ptr; W_ik : Integer; WB_ik : Integer; XP_i : Tasks_Set; -- DELTA J J_ik : Integer; begin W_i := 0; WB_i := 0; XP_i := XP(Gamma_i, tau_ab); if not is_empty(XP_i) then reset_iterator(XP_i, tau_ik_iterator); loop current_element(XP_i, tau_ik, tau_ik_iterator); -- DELTA J: If tau_ik is not an immediate successor, then it does not jitter if it is chosen as a BP starting tau_ik -- We memorize its jitter and then set it to nil. -- We also need to modify its predecessors' jitter somehow... if not Is_Immediate_Successor(tau_ik) then J_ik := Periodic_Task_Ptr(tau_ik).jitter; Periodic_Task_Ptr(tau_ik).jitter := 0; --Modify_Predecessor_Jitters(tau_ik); end if; WWB(tau_ik, tau_ab, w, tau_ac, W_ik, WB_ik); W_i := max(W_i, W_ik); WB_i := max(WB_i, WB_ik); -- DELTA J: Set non-immediate tau_ik's jitter back (modified previously) if not Is_Immediate_Successor(tau_ik) then Periodic_Task_Ptr(tau_ik).jitter := J_ik; end if; exit when is_last_element(XP_i, tau_ik_iterator); next_element(XP_i, tau_ik_iterator); end loop; end if; -- Free(XP_i, False); end Max_WWB; -- Busy period estimation function L (tau_ab : in Generic_Task_Ptr; tau_ac : in Generic_Task_Ptr) return Integer is L : Integer; L_w : Integer; C_ab : Integer; B_ab : Integer; W_L_ac : Integer; WB_L_ac : Integer; DW_L_ac : Integer; DW_i : Integer; Sum_Max_Wi : Integer := 0; Max_DW_i : Integer := 0; W_i : Integer; WB_i : Integer; Convergence : Boolean := False; Gamma_iterator : Task_Groups_Iterator; Gamma_i : Generic_Task_Group_Ptr; Gamma_a : Generic_Task_Group_Ptr; begin Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ab); C_ab := tau_ab.capacity; B_ab := tau_ab.blocking_time; L := C_ab + B_ab; loop -- Compute W_ac' and WB_ac' with equation (20) -- tau_ik tau_ab w tau_ac Wik WBik WWB(tau_ac, tau_ab, L, tau_ac, W_L_ac, WB_L_ac); DW_L_ac := WB_L_ac - W_L_ac; Sum_Max_Wi := 0; Max_DW_i := 0; reset_iterator(My_System.Task_Groups, Gamma_iterator); loop current_element(My_System.Task_Groups, Gamma_i, Gamma_iterator); if Gamma_i.name /= Gamma_a.name then -- Equation (21) and (22) all in one function -- i tau_ab w tau_ac -> for reduction rules Max_WWB(Gamma_i, tau_ab, L, tau_ac, W_i, WB_i); -- Gives W_i := max(W_ik) and WB_i := max(WB_ik) for all tau_ik DW_i := WB_i - W_i; -- To compute term 3 and 4 of equation (34) Sum_Max_Wi := Sum_Max_Wi + W_i; -- W_i is summed for all Gamma_i Max_DW_i := max(Max_DW_i, DW_i); -- DW_i is compared for all Gamma_i end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_iterator); end loop; -- Equation (34) L_w := B_ab + W_L_ac + Sum_Max_Wi + max(DW_L_ac, Max_DW_i); If L = L_w then Convergence := true; end if; L := L_w; -- Warning: inifinity loop possible here, if no convergence. No convergence when CPU utilization > 100% -- TODO: Before starting the analysis, check that CPU utilization <= 100% exit when Convergence; end loop; return L; end L; function pL_seg (tau_ab : Generic_Task_Ptr; tau_ac : Generic_Task_Ptr) return Integer is varphi_seg_0abc : Integer; L_abc : Integer; T_a : Integer; begin if tau_ac.task_type/= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; L_abc := L(tau_ab, tau_ac); varphi_seg_0abc := varphi_seg(tau_ab, tau_ac, tau_ab); T_a := Periodic_Task_Ptr(tau_ac).period; if In_MPi(tau_ab, tau_ab) then return Ceil0( Double(L_abc - varphi_seg_0abc) / Double(T_a) ); end if; -- Note: Case where C < B and not same_h(A, B, C) is not needed because different segments is already handled in Redell (to verify). return 0; end pL_seg; function TaskInterference_Gamma_a (tau_ab : Generic_Task_Ptr; tau_ac : Generic_Task_Ptr; tau_aj : Generic_Task_Ptr; w : Integer; p : Integer; p_ab : Integer) return Integer is taskI : Integer := 0; p_seg_0ajc : Integer; p_seg_0acc : Integer; varphi_seg_ajc : Integer; T_a : Integer; C_aj : Integer; H_seg_ac : Generic_Task_Ptr; H_seg_aj : Generic_Task_Ptr; H_seg_ab : Generic_Task_Ptr; pred_H_seg_ac : Generic_Task_Ptr; pred_H_seg_aj : Generic_Task_Ptr; pred_H_seg_ab : Generic_Task_Ptr; begin if tau_aj.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; p_seg_0ajc := p0_seg(tau_aj, tau_ac, tau_ab); varphi_seg_ajc := varphi_seg(tau_aj, tau_ac, tau_ab); T_a := Periodic_Task_Ptr(tau_aj).period; C_aj := tau_aj.capacity; if p >= p_seg_0ajc and w > varphi_seg_ajc + (p - 1) * T_a then taskI := C_aj; p_seg_0acc := p0_seg(tau_ac, tau_ac, tau_ab); H_seg_ac := First_Task_In_Hseg(tau_ac, tau_ab); H_seg_aj := First_Task_In_Hseg(tau_aj, tau_ab); H_seg_ab := First_Task_In_Hseg(tau_ab, tau_ab); pred_H_seg_ac := pred(H_seg_ac); pred_H_seg_aj := pred(H_seg_aj); pred_H_seg_ab := pred(H_seg_ab); -- Note: a pred of a Hseg cannot be null -- beacuse First_Task_In_Hseg never returns null if we add a ghost root task. -- So condition "pred /= null" is not needed. if (p >= p_seg_0acc and then Seg_Precedes(tau_ac, tau_aj, tau_ab) and then not Same_Hsec(tau_ac, tau_aj, tau_ab)) -- Rule 1b or else (pred_H_seg_ac /= null and then In_lpi(pred_H_seg_ac, tau_ab) and then pred_H_seg_aj /= null and then In_lpi(pred_H_seg_aj, tau_ab) and then (p /= p_seg_0acc or else not Same_Hseg(H_seg_ac, H_seg_aj, tau_ab))) -- Rule 2b or else (pred_H_seg_ab /= null and then In_lpi(pred_H_seg_ab, tau_ab) and then pred_H_seg_aj /= null and then In_lpi(pred_H_seg_aj, tau_ab) and then (p /= p_ab or else not Same_Hseg(H_seg_ab, H_seg_aj, tau_ab))) -- Rule 3b or else (p <= p_ab and then Seg_Precedes(tau_aj, tau_ab, tau_ab) and then not Same_Hsec(tau_ab, tau_aj, tau_ab)) -- Rule 4b or else ( (p >= p_ab and then Precedes(tau_ab, tau_aj)) -- Rule 5b or else (p >= p_ab and then Seg_Precedes(tau_ab, tau_aj, tau_ab) and then not Same_Hsec(tau_ac, tau_ab, tau_ab)) or else (p > p_ab and tau_ab.name = tau_aj.name) ) or else (not Is_Immediate_Successor(tau_ac) and then p <= p_seg_0acc and then Same_Hsec(tau_aj, tau_ac, tau_ab) and then Precedes(tau_aj, tau_ac)) then -- DELTA J: Rule 6b (equivalent 5a) taskI := 0; end if; end if; return taskI; end TaskInterference_Gamma_a; procedure Compute_SB_SectionI_Gamma_a (tau_aBr : in Generic_Task_Ptr; root : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; tau_ac : in Generic_Task_Ptr; w : in Integer; p : in Integer; p_ab : in Integer; SB : out Tasks_Set; sectionI : in out Integer) is Succ_aBr : Tasks_Set; tau_am_iterator : Tasks_Iterator; tau_am : Generic_Task_Ptr; root_preceeds_a_Hseg : Boolean; -- DELTA J T_a : Integer; varphi_amc : Integer; varphi_aBrc : Integer; r_aBr : Integer; r_am : Integer; begin Succ_aBr := succ(tau_aBr); if not is_empty(Succ_aBr) then -- Check that tau_iB actually preceeds a segment reset_iterator(Succ_aBr, tau_am_iterator); loop current_element(Succ_aBr, tau_am, tau_am_iterator); if (tau_aBr.name /= root.name) or else (In_hpi(tau_am, tau_ab) and then Is_Immediate(tau_aBr, tau_am)) then root_preceeds_a_Hseg := true; end if; exit when is_last_element(Succ_aBr, tau_am_iterator) or else root_preceeds_a_Hseg; next_element(Succ_aBr, tau_am_iterator); end loop; reset_iterator(Succ_aBr, tau_am_iterator); loop current_element(Succ_aBr, tau_am, tau_am_iterator); if In_hpi(tau_am, tau_ab) then if not Is_Immediate(tau_aBr, tau_am) then -- DELTA J: If tau_im is not an immediate successor of tau_iB we check if it should be in the given condition if not Is_Immediate(tau_aBr, tau_am) then T_a := Periodic_Task_Ptr(tau_am).period; varphi_amc := varphi(tau_am, tau_ac); varphi_aBrc := varphi(tau_aBr, tau_ac); r_am := varphi_amc + (p - 1) * T_a; -- tau_am release @ p r_aBr := varphi_aBrc + (p - 1) * T_a; -- tau_Br release @ p if r_am >= 0 then -- TODO: or else (r_am > 0 and r_aBr + C_aBr + something >= r_am) Compute_SB(root, tau_am, tau_ab, SB); end if; end if; end if; if root_preceeds_a_Hseg then sectionI := sectionI + TaskInterference_Gamma_a(tau_ab, tau_ac, tau_am, w, p, p_ab); Compute_SB_SectionI_Gamma_a(tau_am, root, tau_ab, tau_ac, w, p, p_ab, SB, sectionI); end if; elsif In_lpi(tau_am, tau_ab) then Add(SB, tau_am); else Compute_SB(root, tau_am, tau_ab, SB); if root_preceeds_a_Hseg then Compute_SB_SectionI_Gamma_a(tau_am, root, tau_ab, tau_ac, w, p, p_ab, SB, sectionI); end if; end if; exit when is_last_element(Succ_aBr, tau_am_iterator); next_element(Succ_aBr, tau_am_iterator); end loop; end if; -- Free(Succ_aBr, False);p end Compute_SB_SectionI_Gamma_a; procedure BranchInterference_Gamma_a (tau_ab : in Generic_Task_Ptr; tau_ac : in Generic_Task_Ptr; tau_aBr : in Generic_Task_Ptr; w : in Integer; p : in Integer; p_ab : in Integer; branchI : in out Integer; branchDelta : in out Integer) is pred_aBr : Generic_Task_Ptr; SB : Tasks_Set; sectionI : Integer := 0; tau_aS_iterator : Tasks_Iterator; tau_aS : Generic_Task_Ptr; bI : Integer := 0; bD : Integer := 0; subBranchesI : Integer := 0; subBDelta : Integer := 0; begin Compute_SB_SectionI_Gamma_a(tau_aBr, tau_aBr, tau_ab, tau_ac, w, p, p_ab, SB, sectionI); if In_hpi(tau_aBr, tau_ab) then sectionI := sectionI + TaskInterference_Gamma_a(tau_ab, tau_ac, tau_aBr, w, p, p_ab); end if; if not is_empty(SB) then reset_iterator(SB, tau_aS_iterator); loop current_element(SB, tau_aS, tau_aS_iterator); -- if tau_aBr.name = "tau_11" and tau_aS.name = "tau_16" then -- put_line("fu"); -- end if; BranchInterference_Gamma_a(tau_ab, tau_ac, tau_aS, w, p, p_ab, bI, bD); subBranchesI := subBranchesI + bI; subBDelta := max(subBDelta, bD); exit when is_last_element(SB, tau_aS_iterator); next_element(SB, tau_aS_iterator); end loop; end if; if In_lpi(tau_aBr, tau_ab) then branchI := subBranchesI; branchDelta := max(sectionI - subBranchesI, subBDelta); pred_aBr := pred(tau_aBr); if pred_aBr /= null and then not Is_Immediate(pred_aBr, tau_aBr) then branchDelta := max(subBDelta, 0); end if; else -- X, delta and ghost root cases branchI := max(sectionI, subBranchesI); branchDelta := max(subBranchesI + subBDelta - branchI, 0); end if; --Free(SB, False); end BranchInterference_Gamma_a; procedure TransactionInterference_Gamma_a (tau_ac : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; p_ab : in Integer; transI_NoB : in out Integer; transI_B : in out Integer) is p_seg_0aNc : Integer; jobI : Integer := 0; jobDelta : Integer := 0; transDelta : Integer := 0; Gamma_a : Generic_Task_Group_Ptr; tau_a1 : Generic_Task_Ptr; tau_a0 : Generic_Task_Ptr; H_seg_aN : Generic_Task_Ptr; begin transI_NoB := 0; transI_B := 0; -- Add ghost root task: placed here for understanding. -- Can be moved to somewhere earlier for optimization (e.g. Max_WWB function) Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ac); tau_a1 := get_Root_Task(Gamma_a); tau_a0 := new Generic_Task; -- Scheduling_Task? tau_a0.name := to_unbounded_string("wcdops+_ghost_root"); tau_a0.cpu_name := to_unbounded_string("wcdops+_ghost_cpu"); tau_a0.priority := 0; --Add(My_System.Tasks, tau_a0); Add_One_Task_Dependency(My_System.Dependencies, tau_a0, tau_a1); H_seg_aN := Get_First_Task_In_Hseg_N(Gamma_a, tau_ab); if H_seg_aN /= null then p_seg_0aNc := p0_seg(H_seg_aN, tau_ac, tau_ab); -- Compute transI_NoB, transDelta and transI_B for p in p_seg_0aNc .. 0 loop BranchInterference_Gamma_a(tau_ab, tau_ac, tau_a0, w, p, p_ab, jobI, jobDelta); transI_NoB := transI_NoB + jobI; transDelta := max(transDelta, jobDelta); end loop; transI_B := transI_NoB + transDelta; end if; -- Free tau_a0 Delete_One_Task_Dependency(My_System.Dependencies, tau_a0, tau_a1); Free(tau_a0); end TransactionInterference_Gamma_a; function W_MP_Gamma_a (tau_ac : Generic_Task_Ptr; tau_ab : Generic_Task_Ptr; w : Integer; p_ab : Integer) return Integer is Gamma_a : Generic_Task_Group_Ptr; tau_aj_iterator : Generic_Task_Iterator; tau_aj : Generic_Task_Ptr; C_aj : Integer; T_a : Integer; varphi_seg_ajc : Integer; C_ab : Integer; W_ac_p_1 : Integer := 0; W_ac_p_2 : Integer := 0; W_ac_p : Integer := 0; begin Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ac); if not is_empty(Gamma_a.task_list) then reset_head_iterator(Gamma_a.task_list, tau_aj_iterator); loop current_element (Gamma_a.task_list, tau_aj, tau_aj_iterator); if In_MPi(tau_aj, tau_ab) then if tau_aj.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; C_aj := tau_aj.capacity; T_a := Periodic_Task_Ptr(tau_aj).period; varphi_seg_ajc := varphi_seg(tau_aj, tau_ac, tau_ab); if not Precedes(tau_ab, tau_aj) then -- Equation (26) W_ac_p_1 := W_ac_p_1 + Ceil0( Double(w - varphi_seg_ajc) / Double(T_a) ) * C_aj; else -- Equation (27) W_ac_p_2 := W_ac_p_2 + min(p_ab - 1, Ceil0( Double(w - varphi_seg_ajc) / Double(T_a) ) * C_aj); end if; end if; exit when is_tail_element(Gamma_a.task_list, tau_aj_iterator); next_element(Gamma_a.task_list, tau_aj_iterator); end loop; C_ab := tau_ab.capacity; W_ac_p := W_ac_p_1 + max(0, p_ab * C_ab + W_ac_p_2); end if; return W_ac_p; end W_MP_Gamma_a; -- [Wac(tau_ab, w, p_ab), WBac(tau_ab, w, p_ab)] => Equation (29) procedure WWB_Gamma_a (tau_ac : in Generic_Task_Ptr; tau_ab : in Generic_Task_Ptr; w : in Integer; p_ab : Integer; W_ac : out Integer; WB_ac : out Integer) is transI_NoB : Integer := 0; transI_B : Integer := 0; W_ac_p : Integer; -- W_ac for p > 0 begin TransactionInterference_Gamma_a(tau_ac, tau_ab, w, p_ab, transI_NoB, transI_B); W_ac_p := W_MP_Gamma_a(tau_ac, tau_ab, w, p_ab); -- Second part of Equation (29) W_ac := transI_NoB + W_ac_p; WB_ac := transI_B + W_ac_p; end WWB_Gamma_a; function W (tau_ab : Generic_Task_Ptr; tau_ac : Generic_Task_Ptr; p_ab : Integer) return Integer is w : Integer; w_w : Integer; -- Smiley variable is not amused... C_ab : Integer; -- For initial w B_ab : Integer; -- 1st element W_ac : Integer; -- 2nd element p_0abc : Integer; W_i : Integer; WB_i : Integer; Sum_Max_Wi : Integer; -- 3rd element DW_i : Integer; -- To compute 2nd part of 4th element Max_DW_i : Integer := 0; -- 2nd part of 4th element WB_ac : Integer; -- To compute 1st part of 4th element DW_ac : Integer; -- 1st part of 4th element Gamma_iterator : Task_Groups_Iterator; Gamma_i : Generic_Task_Group_Ptr; Gamma_a : Generic_Task_Group_Ptr; Convergence : Boolean := False; begin Gamma_a := Search_Task_Group_By_Task(My_System.Task_Groups, tau_ab); C_ab := tau_ab.capacity; B_ab := tau_ab.blocking_time; p_0abc := p0(tau_ab, tau_ac); -- Note: not p_seg_0abc but p_0abc w := (p_ab - p_0abc + 1) * C_ab + B_ab; loop -- Compute W_ac and DW_ac of Equation (32) and part 1 of Equation (31) WWB_Gamma_a(tau_ac, tau_ab, w, p_ab, W_ac, WB_ac); DW_ac := WB_ac - W_ac; -- Compute Equation (32)'s part 3 and Equation (31)'s part 2 Sum_Max_Wi := 0; Max_DW_i := 0; reset_iterator(My_System.Task_Groups, Gamma_iterator); loop current_element(My_System.Task_Groups, Gamma_i, Gamma_iterator); if Gamma_i.name /= Gamma_a.name then -- Equation (21) and (22) all in one function -- i tau_ab w tau_ac -> for reduction rules Max_WWB(Gamma_i, tau_ab, w, tau_ac, W_i, WB_i); -- Gives W_i* := max(W_ik) and WB_i* := max(WB_ik) for all tau_ik DW_i := WB_i - W_i; Sum_Max_Wi := Sum_Max_Wi + W_i; -- W_i is summed for all Gamma_i Max_DW_i := max(Max_DW_i, DW_i); -- DW_i is compared for all Gamma_i end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_iterator); end loop; -- Equation (32) w_w := B_ab + W_ac + Sum_Max_Wi + max(DW_ac, Max_DW_i); -- if tau_ab.name = "tau_110" then -- put_line(to_string(tau_ac.name) & " :: W_ac =" & W_ac'Img); -- put_line(to_string(tau_ac.name) & " :: DW_ac =" & DW_ac'Img); -- put_line(to_string(tau_ac.name) & " :: w_w =" & w_w'Img); -- put_line("***"); -- end if; If w = w_w then Convergence := true; end if; w := w_w; -- Warning: inifinity loop possible here, if no convergence. No convergence when CPU utilization > 100% -- TODO: Before starting the analysis, check that CPU utilization <= 100% exit when Convergence; end loop; return w; end W; procedure Estimate_Successors_Response_Time (tau_ij : in Generic_Task_ptr) is Succ_ij : Tasks_Set; succ_iterator : Tasks_Iterator; succ_task : Generic_Task_Ptr; R_tau_ij : Integer; R_succ : Integer; C_ij : Integer; begin Succ_ij := succ(tau_ij); if not is_empty(Succ_ij) then reset_iterator(Succ_ij, succ_iterator); loop current_element(Succ_ij, succ_task, succ_iterator); R_tau_ij := get_Response(tau_ij); R_succ := get_Response(succ_task); C_ij := tau_ij.capacity; if R_succ < R_tau_ij then Set_Response(succ_task, R_tau_ij + C_ij); end if; Estimate_Successors_Response_Time(succ_task); exit when is_last_element(Succ_ij, succ_iterator); next_element(Succ_ij, succ_iterator); end loop; end if; end Estimate_Successors_Response_Time; procedure Estimate_Predecessor_Response_Time (tau_ij : in Generic_Task_ptr) is pred_ij : Generic_Task_Ptr; R_tau_ij : Integer; R_pred_ij : Integer; C_ij : Integer; begin pred_ij := pred(tau_ij); if pred_ij /= null then R_tau_ij := get_Response(tau_ij); R_pred_ij := get_Response(pred_ij); C_ij := tau_ij.capacity; if R_tau_ij > R_pred_ij then Set_Response(pred_ij, R_tau_ij - C_ij); end if; Estimate_Predecessor_Response_Time(pred_ij); end if; end Estimate_Predecessor_Response_Time; -- MOD for delta: if tau_1 -> tau_2 -> tau_3 and tau_2 is delta, then... procedure Update_Successors_Jitter (tau_ij : in Generic_Task_Ptr) is Succ_ij : Tasks_Set; succ_iterator : Tasks_Iterator; succ_task : Generic_Task_Ptr; begin Succ_ij := succ(tau_ij); if not is_empty(Succ_ij) then reset_iterator(Succ_ij, succ_iterator); loop current_element(Succ_ij, succ_task, succ_iterator); if succ_task.task_type /= Periodic_Type then raise Generic_WCDOPS_Plus_Exception; end if; Periodic_Task_Ptr(succ_task).jitter := max(get_offset(succ_task), get_response(tau_ij)) - get_offset(succ_task); Update_Successors_Jitter(succ_task); exit when is_last_element(Succ_ij, succ_iterator); next_element(Succ_ij, succ_iterator); end loop; end if; end Update_Successors_Jitter; -- Local variables -- Gamma_iterator : Task_Groups_Iterator; Gamma_a : Generic_Task_Group_Ptr; tau_ab_iterator : Generic_Task_Iterator; tau_ab : Generic_Task_Ptr; tau_ac_iterator : Tasks_Iterator; tau_ac : Generic_Task_Ptr; XP_a : Tasks_Set; R_w_ab : Integer; -- Worst response of tau_ab R_w_abc : Integer; -- Worst response among reponses that depend on a tau_ab starting the BP and the analyzed p_ab R_ab : Integer; -- To compare and store current and last response p_seg_0abc : Integer; p_seg_Labc : Integer; w_abc : Integer; varphi_abc : Integer; T_a : Integer; O_ab : Integer; Convergence : Boolean; -- DELTA -- pred_ab : Generic_Task_Ptr; -- J_ab : Integer; -- w_abc_FI : Integer; -- w_abc_NI : Integer; -- R_w_abc_FI : Integer; -- R_w_abc_NI : Integer; -- DELTA J J_ac : Integer; -- TODO: Remove X : Integer := 0; begin --------------------------- -- PROCEDURE BEGINS HERE -- --------------------------- -- TODO a function to verify that the transaction is correct -- i.e. tree-shaped, offset values correct, no initial jitter... Init_Response_Times(Response_Times); Initialize(FORCED_IMMEDIATE_TASKS_SET); loop -- Convergence loop put_line("***** X = " & X'Img & " *****"); Convergence := true; reset_iterator(My_System.Task_Groups, Gamma_iterator); loop -- Transactions loop current_element(My_System.Task_Groups, Gamma_a, Gamma_iterator); if not is_empty(Gamma_a.task_list) then reset_head_iterator(Gamma_a.task_list, tau_ab_iterator); loop -- Analyzed tasks loop (tau_ab) current_element(Gamma_a.task_list, tau_ab, tau_ab_iterator); -- MOD: if tau_ab != delta task then... if tau_ab.name = "tau_11" then put_line("//// Analyzing tau_ab = " & to_string(tau_ab.name)); end if; R_ab := get_Response(tau_ab); R_w_ab := 0; XP_a := XP(Gamma_a, tau_ab); if not is_empty(XP_a) then -- Note: XP_a shouldn't be empty because at least tau_ab is in XP_a(tau_ab) reset_iterator(XP_a, tau_ac_iterator); loop -- BP starting tasks loop (tau_ac) current_element(XP_a, tau_ac, tau_ac_iterator); if tau_ab.name = "tau_11" then put_line(" tau_ac = " & to_string(tau_ac.name)); end if; -- DELTA J: If tau_ik is not an immediate successor, then it does not jitter if it is chosen as a BP starting tau_ik -- We memorize its jitter and then set it to nil. -- We also need to modify its predecessors' jitter somehow... if not Is_Immediate_Successor(tau_ac) then J_ac := Periodic_Task_Ptr(tau_ac).jitter; Periodic_Task_Ptr(tau_ac).jitter := 0; --Modify_Predecessor_Jitters(tau_ik); end if; -- Compute p0 and pL for tau_ab's segment when tau_c starts the BP p_seg_0abc := p0_seg(tau_ab, tau_ac, tau_ab); p_seg_Labc := pL_seg(tau_ab, tau_ac); if tau_ab.name = "tau_11" then put_line(" p_seg_0abc = " & p_seg_0abc'Img); put_line(" p_seg_Labc = " & p_seg_Labc'Img); end if; -- For all p_ab in p0 to pL, take max R_w_ab for p_ab in p_seg_0abc .. p_seg_Labc loop if tau_ab.name = "tau_11" then put_line(" @ p_ab = " & p_ab'Img); end if; -- if tau_ab.name = "tau_110" then -- put_line("p_ab =" & p_ab'Img); -- end if; -- DELTA: If tau_ab does not succeed immediately its predecessor, than we compute -- two values of w_abc: w_abc_FI where tau_ab jitters so it is immediate to its pred, i.e. it belongs to the pred's segment -- w_abc normal -- Then when we compute R_w_abc, we compute two values again: R_w_abc_FI where we use w_abc_FI -- and R_w_abc normal but we decrease this value by J_ab since it means the pred doesn't go over O_ab, so there is no jitter. -- pred_ab := pred(tau_ab); -- J_ab := Periodic_Task_Ptr(tau_ab).jitter; -- if pred_ab /= null and then not Is_Immediate(pred_ab, tau_ab) and then J_ab > 0 then -- put_line("-- tau_ac = " & to_string(tau_ac.name)); -- -- FORCE_IMMEDIATE_TASK(tau_ab); -- w_abc_FI := w(tau_ab, tau_ac, p_ab); -- UNFORCE_IMMEDIATE_TASK(tau_ab); -- w_abc_NI := w(tau_ab, tau_ac, p_ab); -- -- put_line("w_abc_NI = " & w_abc_NI'Img); -- put_line("w_abc_FI = " & w_abc_FI'Img); -- -- varphi_abc := varphi(tau_ab, tau_ac); -- T_a := Periodic_Task_Ptr(tau_ab).period; -- O_ab := get_Offset(tau_ab); -- -- --R_w_abc_FI := w_abc_FI - varphi_abc - (p_ab - 1) * T_a + O_ab; -- R_w_abc_FI := w_abc_FI - varphi_abc - (p_ab - 1) * T_a + O_ab; -- R_w_abc_NI := w_abc_NI - varphi_abc - (p_ab - 1) * T_a + O_ab - J_ab; -- DELTA: Note that we subtract J_ab here -- -- put_line("R_w_abc_FI = " & R_w_abc_FI'Img); -- put_line("R_w_abc_NI = " & R_w_abc_NI'Img); -- -- R_w_abc := max(R_w_abc_FI, R_w_abc_NI); -- else -- DELTA modifications stops here, the else is the normal case w_abc := w(tau_ab, tau_ac, p_ab); varphi_abc := varphi(tau_ab, tau_ac); T_a := Periodic_Task_Ptr(tau_ab).period; O_ab := get_Offset(tau_ab); R_w_abc := w_abc - varphi_abc - (p_ab - 1) * T_a + O_ab; if tau_ab.name = "tau_11" then put_line(" w_abc = " & w_abc'Img); put_line(" varphi_abc = " & varphi_abc'Img); put_line(" T_a = " & T_a'Img); put_line(" O_ab = " & O_ab'Img); put_line(" R_w_abc = " & R_w_abc'Img); end if; -- end if; -- if tau_ab.name = "tau_110" then -- put_line("w_abc =" & w_abc'Img); -- put_line("J_ac =" & Periodic_Task_Ptr(tau_ac).jitter'Img); -- put_line("varphi_abc =" & varphi_abc'Img); -- put_line("T_a =" & T_a'Img); -- put_line("O_ab =" & O_ab'Img); -- put_line("R_w_abc =" & R_w_abc'Img); -- end if; -- Store maximum value of R_abc^w in R_ab^w if R_w_abc > R_w_ab then R_w_ab := R_w_abc; end if; -- Determine if R_w_abc is higher than deadline and stop if so if Stop_On_Deadline_Missed and R_w_ab > get_Global_Deadline(tau_ab) then raise Generic_WCDOPS_Plus_Exception; end if; end loop; -- DELTA J: Set non-immediate tau_ik's jitter back (modified previously) if not Is_Immediate_Successor(tau_ac) then Periodic_Task_Ptr(tau_ac).jitter := J_ac; end if; exit when is_last_element(XP_a, tau_ac_iterator); next_element(XP_a, tau_ac_iterator); end loop; end if; --Free(XP_a, False); -- Update tau_ab's response time if R_w_ab > R_ab then R_ab := R_w_ab; Set_Response(tau_ab, R_ab); Convergence := false; end if; -- Estimate tau_ab's successors responses so they are not less than R_ab --Estimate_Successors_Response_Time(tau_ab); -- This gives wrong results and it wasn't mentioned in [Redell04] nor in [Palencia99] -- Estimate tau_ab's predecessor response because R_ab may be less than R_a{b-1} due to application of tau_ac in XP_a --Estimate_Predecessor_Response_Time(tau_ab); -- This gives wrong results and it wasn't mentioned in [Redell04] nor in [Palencia99] -- Jitter re-evaluation Update_Successors_Jitter(Get_Root_Task(Gamma_a)); -- if tau_ab.name = "tau_110" then -- put_line("*****"); -- end if; exit when is_tail_element(Gamma_a.task_list, tau_ab_iterator); next_element(Gamma_a.task_list, tau_ab_iterator); end loop; end if; exit when is_last_element(My_System.Task_Groups, Gamma_iterator); next_element(My_System.Task_Groups, Gamma_Iterator); end loop; -- Warning: inifinity loop possible here, if no convergence. No convergence when CPU utilization > 100% -- TODO: Before starting the analysis, check that CPU utilization <= 100% X := X + 1; exit when Convergence; end loop; end WCDOPS_Plus_NIMP; end Feasibility_Test.Wort_Case_Response_Time;