------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2016, Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285 laboratory, Université de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ------------------------------------------------------------------------------ -- Last update : -- $Rev: 1249 $ -- $Date: 2014-08-28 07:02:15 +0200 (Fri, 28 Aug 2014) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ 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 priority_assignment.rm; use priority_assignment.rm; with priority_assignment.dm; use priority_assignment.dm; with systems; use systems; with debug; use debug; package body Scheduler.Fixed_Priority is function Build_Tcb (My_Scheduler : in Fixed_Priority_Scheduler; A_Task : Generic_Task_Ptr) return Tcb_Ptr is A_Tcb : Fixed_Priority_Tcb_Ptr; begin A_Tcb := new Fixed_Priority_Tcb; Initialize (Tcb (A_Tcb.all), A_Task); Initialize (A_Tcb.all); return Tcb_Ptr (A_Tcb); end Build_Tcb; procedure Initialize (A_Tcb : in out Fixed_Priority_Tcb) is begin A_Tcb.Current_Priority := A_Tcb.Tsk.priority; end Initialize; procedure Do_Election (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Msg : in out Unbounded_String; Current_Time : in Natural; Processor_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; My_Dependencies : in Tasks_Dependencies_Ptr; With_Offsets : in Boolean; With_Precedencies : in Boolean; With_Resources : in Boolean; With_jitters : in Boolean; With_minimize_preemption : in Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table; Elected : in out Tasks_Range; No_Task : in out Boolean) is Highiest_Priority : Natural := Natural'First; I : Tasks_Range := 0; begin -- For each task, call "check_resources" to -- take care of priority modification (PCP and PIP) -- loop if (Si.Tcbs (I).Tsk.cpu_name = Processor_Name) and ((Address_Space_Name = To_Unbounded_String ("")) or (Address_Space_Name = Si.Tcbs (I).Tsk.address_space_name)) then if (Si.Tcbs (I).Wake_Up_Time <= Current_Time) and (Si.Tcbs (I).Rest_Of_Capacity /= 0) then Check_jitter(Si.Tcbs (I), Current_Time, Si.Tcbs(I).is_jitter_ready ); if (With_jitters = False) or (Si.Tcbs (I).is_jitter_ready)then if (With_Offsets = False) or Check_Offset (Si.Tcbs (I), Current_Time) then if (With_Precedencies = False) or Check_Precedencies(Si, My_Dependencies, Current_Time, Si.Tcbs (I))then if With_Resources then Check_Resource (My_Scheduler, Si, Result, Current_Time, Si.Tcbs (I), Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Is_Resource_Ready, Event_To_Generate); end if; end if; end if; end if; end if; end if; I := I + 1; exit when Si.Tcbs (I) = null; end loop; -- We can compute scheduling since priorities are ok -- I := 0; loop if not Si.Tcbs (i).already_run_at_current_time then if (Si.Tcbs (I).Tsk.cpu_name = Processor_Name) and ((Address_Space_Name = To_Unbounded_String ("")) or (Address_Space_Name = Si.Tcbs (I).Tsk.address_space_name)) then if Check_Core_Assignment(my_scheduler, Si.Tcbs (I)) then if (Si.Tcbs (I).Wake_Up_Time <= Current_Time) and (Natural ( Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Current_Priority) > Highiest_Priority) and (Si.Tcbs (I).Rest_Of_Capacity /= 0) then if (With_jitters = False) or (Si.Tcbs (I).is_jitter_ready) then if (With_Offsets = False) or Check_Offset (Si.Tcbs (I), Current_Time) then if (With_Precedencies = False) or Check_Precedencies (Si, My_Dependencies, Current_Time, Si.Tcbs (I)) then if (With_Resources = False) or Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Is_Resource_Ready then Highiest_Priority := Natural ( Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)). Current_Priority); Elected := I; end if; end if; end if; end if; end if; end if; end if; end if; I := I + 1; exit when Si.Tcbs (I) = null; end loop; if Highiest_Priority = Natural'First then No_Task := True; else No_Task := False; end if; end Do_Election; procedure Compute_Ceiling_Of_Resources (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; Address_space_Name : in Unbounded_String; My_Tasks : in out Tasks_Set; My_Resources : in out Resources_Set) is begin -- Private scheduler data -- My_Scheduler.Used_Resource := False; -- Set priority ceiling of resources : only for PCP and IPCP resources and -- only if Automatic_Assignment is requested -- for K in 0 .. Si.Number_Of_Resources - 1 loop if (Si.Shared_Resources (K).Shared.protocol = Priority_Ceiling_Protocol) or (Si.Shared_Resources (K).Shared.protocol = Immediate_Priority_Ceiling_Protocol) then if si.shared_resources(k).shared.priority_assignment = manual_assignment then Fixed_Priority_Resource_Ptr (Si.Shared_Resources (K)). Priority_Ceiling := si.shared_resources(k).shared.Priority; else Fixed_Priority_Resource_Ptr (Si.Shared_Resources (K)). Priority_Ceiling := Priority_Range'First; for I in 0 .. Si.Shared_Resources (K).Shared.critical_sections.nb_entries - 1 loop for J in 0 .. Si.Number_Of_Tasks - 1 loop if Si.Shared_Resources (K).Shared.critical_sections.entries (I). item = Si.Tcbs (J).Tsk.name then Fixed_Priority_Resource_Ptr (Si.Shared_Resources (K) ).Priority_Ceiling := Priority_Range'Max (Fixed_Priority_Tcb_Ptr (Si.Tcbs (J)). Current_Priority, Fixed_Priority_Resource_Ptr ( Si.Shared_Resources (K)).Priority_Ceiling); end if; end loop; end loop; end if; end if; end loop; end Compute_Ceiling_Of_Resources; procedure Specific_Scheduler_Initialization (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Processor_Name : in Unbounded_String; address_space_name : in Unbounded_String; My_Tasks : in out Tasks_Set; my_schedulers : in Scheduler_table; My_Resources : in out Resources_Set; My_Buffers : in out Buffers_Set; My_Messages : in Messages_Set; Msg : in out Unbounded_String) is begin -- Set priority according to the scheduler -- if (My_Scheduler.parameters.scheduler_type = Deadline_Monotonic_Protocol) then Set_Priority_According_To_Dm (My_Tasks); else if (My_Scheduler.parameters.scheduler_type = Rate_Monotonic_Protocol) then Set_Priority_According_To_Rm (My_Tasks); end if; end if; for I in 0 .. Si.Number_Of_Tasks - 1 loop if (Si.Tcbs (I).Tsk.cpu_name = Processor_Name) and ((address_space_name = To_Unbounded_String ("")) or (address_space_name = Si.Tcbs (I).Tsk.address_space_name)) then Fixed_Priority_Tcb_Ptr (Si.Tcbs (I)).Current_Priority := Si.Tcbs (I).Tsk.priority; end if; end loop; -- Set priority ceiling of resources (only to PCP resource -- Compute_Ceiling_Of_Resources (My_Scheduler, Si, Processor_Name, address_space_name, My_Tasks, My_Resources); end Specific_Scheduler_Initialization; procedure Release_Resource (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; ipcp_priority : priority_range; begin if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task hold resources -- and then release them -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_end) and (Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).item = A_Tcb.Tsk.name) then Si.Shared_Resources (Index1).Shared.state := Si.Shared_Resources (Index1).Shared.state + 1; for I in 0 .. Si.Shared_Resources (Index1).Nb_Allocated - 1 loop if Si.Shared_Resources (Index1).Allocated_By (I) = A_Tcb.Tsk.name then Si.Shared_Resources (Index1).Allocated_By (I) := Si.Shared_Resources (Index1).Allocated_By ( Si.Shared_Resources (Index1).Nb_Allocated - 1); Si.Shared_Resources (Index1).Nb_Allocated := Si.Shared_Resources (Index1).Nb_Allocated - 1; if Event_To_Generate (Release_Resource) then A_Item := new Time_Unit_Event (Release_Resource); A_Item.release_resource := Si.Shared_Resources (Index1).Shared; A_Item.release_task := A_Tcb.Tsk; add (Result.all, Current_Time, a_item); end if; exit; end if; end loop; -- If PIP or PCP is used, releasing a shared resource -- should restore initial priority level of the -- task -- if (Si.Shared_Resources (Index1).Shared.protocol = Priority_Inheritance_Protocol) or (Si.Shared_Resources (Index1).Shared.protocol = Priority_Ceiling_Protocol) then Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (A_Tcb), A_Tcb.Tsk.priority); end if; -- When releasing an IPCP resource, task priority should be -- decreased to resource priority ceiling of all currently allocated resource -- if (Si.Shared_Resources (index1).Shared.protocol = Immediate_Priority_Ceiling_Protocol) then -- Compute priority : max (static priority, ceiling priority of all -- allocated resource) -- ipcp_priority:=Fixed_Priority_Tcb_Ptr(A_Tcb).tsk.Priority; for Index3 in 0 .. Si.Number_Of_Resources - 1 loop if Si.Shared_Resources (Index3).Nb_Allocated > 0 then for Index4 in 0 .. Si.Shared_Resources (Index3).Nb_Allocated - 1 loop if (Si.Shared_Resources (Index3).Allocated_By (Index4) = A_Tcb.Tsk.name) and (Fixed_Priority_Resource_Ptr ( Si.Shared_Resources (Index3)). Priority_Ceiling > ipcp_priority) then ipcp_priority:= Fixed_Priority_Resource_Ptr(Si.Shared_Resources(Index3)).Priority_Ceiling; end if; end loop; end if; end loop; -- Set priority -- Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (A_Tcb), ipcp_priority); end if; end if; end loop; end loop; end if; end Release_Resource; procedure Allocate_Resource (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : Tcb_Ptr; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; A_Item : Time_Unit_Event_Ptr; begin if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.capacity - A_Tcb.Rest_Of_Capacity + 1; for Index1 in 0 .. Si.Number_Of_Resources - 1 loop -- For each resource, check if the task request the resource -- and if the resource is free -- otherwise, block the task -- for Index2 in 0 .. Si.Shared_Resources (Index1).Shared.critical_sections.nb_entries - 1 loop if (Current_Capacity = Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).data.task_begin) and (Si.Shared_Resources (Index1).Shared.critical_sections.entries ( Index2).item = A_Tcb.Tsk.name) then Si.Shared_Resources (Index1).Shared.state := Si.Shared_Resources (Index1).Shared.state - 1; Si.Shared_Resources (Index1).Allocated_By ( Si.Shared_Resources (Index1).Nb_Allocated) := A_Tcb.Tsk.name; Si.Shared_Resources (Index1).Nb_Allocated := Si.Shared_Resources (Index1).Nb_Allocated + 1; if Event_To_Generate (Allocate_Resource) then A_Item := new Time_Unit_Event (Allocate_Resource); A_Item.allocate_resource := Si.Shared_Resources (Index1).Shared; A_Item.allocate_task := A_Tcb.Tsk; add (Result.all, Current_Time, a_item); end if; end if; end loop; end loop; end if; end Allocate_Resource; procedure Check_Resource (My_Scheduler : in out Fixed_Priority_Scheduler; Si : in out Scheduling_Information; Result : in out Scheduling_Sequence_Ptr; Current_Time : in Natural; A_Tcb : in Tcb_Ptr; Is_Ready : out Boolean; Event_To_Generate : in Time_Unit_Event_Type_Boolean_Table) is Current_Capacity : Natural := 0; ipcp_priority : priority_range; begin -- By default, the task is allowed to run -- Is_Ready := True; if (Si.Number_Of_Resources > 0) then Current_Capacity := A_Tcb.Tsk.capacity - A_Tcb.Rest_Of_Capacity + 1; for Resource_Index in 0 .. Si.Number_Of_Resources - 1 loop for Index2 in 0 .. Si.Shared_Resources (Resource_Index).Shared.critical_sections.nb_entries - 1 loop -- For each resource, check if the task requests the resource -- i.e. that the task is starting a critical section -- if (Current_Capacity = Si.Shared_Resources (Resource_Index).Shared.critical_sections.entries ( Index2).data.task_begin) and (Si.Shared_Resources (Resource_Index).Shared.critical_sections.entries ( Index2).item = A_Tcb.Tsk.name) then -- PCP blocking : the requesting task must have a priority -- strickly higher than the ceiling priority of -- all previously allocated resources (allocated by other -- tasks than the requesting task) -- if (Si.Shared_Resources (Resource_Index).Shared.protocol = Priority_Ceiling_Protocol) then -- Scan already allocated resources to check if the -- requiring task -- has a highier priority than ALL allocated resource -- ceiling value : block the task in the other case -- for Index3 in 0 .. Si.Number_Of_Resources - 1 loop if Si.Shared_Resources (Index3).Nb_Allocated > 0 then for Index4 in 0 .. Si.Shared_Resources (Index3).Nb_Allocated - 1 loop if (Si.Shared_Resources (Index3).Allocated_By ( Index4) /= A_Tcb.Tsk.name) and (Fixed_Priority_Resource_Ptr ( Si.Shared_Resources (Index3)). Priority_Ceiling >= Fixed_Priority_Tcb_Ptr (A_Tcb). Current_Priority) then Is_Ready := False; end if; end loop; end if; end loop; end if; -- Check that the task is available : i.e. the semaphore related -- to the resource is free -- if (Si.Shared_Resources (Resource_Index).Shared.state = 0) then Is_Ready := False; end if; -- The requesting task is blocked, for PIP and PCP -- we must change the priority level of a task -- that holds the resource (priority inheritance) -- if (Is_Ready = False) then if (Si.Shared_Resources (Resource_Index).Shared.protocol = Priority_Inheritance_Protocol) or (Si.Shared_Resources (Resource_Index).Shared.protocol = Priority_Ceiling_Protocol) then for I in 0 .. Si.Shared_Resources (Resource_Index).Nb_Allocated - 1 loop for J in 0 .. Si.Number_Of_Tasks - 1 loop if Si.Shared_Resources (Resource_Index).Allocated_By (I) = Si.Tcbs (J).Tsk.name then Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (Si.Tcbs (J)), Priority_Range'Max (Fixed_Priority_Tcb_Ptr (A_Tcb). Current_Priority, Fixed_Priority_Tcb_Ptr (Si.Tcbs (J)). Current_Priority)); end if; end loop; end loop; end if; end if; -- If the task is blocked due to a resource, we store this data -- in its Tcb -- if Is_Ready = False then put_debug(to_string(a_tcb.tsk.name) & " is waiting for " & to_string(Si.Shared_Resources (resource_index).Shared.name) ); a_tcb.wait_for_a_resource:=Si.Shared_Resources (resource_index).Shared; end if; -- when allocating an IPCP resource, task priority should be -- raised to resource priority ceiling -- if is_ready and (Si.Shared_Resources (Resource_Index).Shared.protocol = Immediate_Priority_Ceiling_Protocol) then ipcp_priority:=Fixed_Priority_Tcb_Ptr(A_Tcb).Current_Priority; ipcp_priority:=priority_range'max(ipcp_priority, Fixed_Priority_Resource_Ptr(Si.Shared_Resources(resource_index)).Priority_Ceiling); -- Set priority -- Change_Current_Priority (My_Scheduler, Fixed_Priority_Tcb_Ptr (A_Tcb), ipcp_priority); end if; end if; end loop; end loop; end if; end Check_Resource; function Build_Resource (My_Scheduler : in Fixed_Priority_Scheduler; A_Resource : Generic_Resource_Ptr) return Shared_Resource_Ptr is New_A_Resource : Fixed_Priority_Resource_Ptr; begin New_A_Resource := new Fixed_Priority_Resource; New_A_Resource.Shared := A_Resource; -- Set priority ceiling of the resource -- New_A_Resource.Priority_Ceiling := Low_Priority; return Shared_Resource_Ptr (New_A_Resource); end Build_Resource; procedure Change_Current_Priority (My_Scheduler : in out Fixed_Priority_Scheduler'Class; A_Tcb : in Fixed_Priority_Tcb_Ptr; New_Priority : Priority_Range) is begin Dispatched_Change_Current_Priority (My_Scheduler, A_Tcb, New_Priority); end Change_Current_Priority; procedure Dispatched_Change_Current_Priority (My_Scheduler : in out Fixed_Priority_Scheduler; A_Tcb : in Fixed_Priority_Tcb_Ptr; New_Priority : Priority_Range) is begin A_Tcb.Current_Priority := New_Priority; end Dispatched_Change_Current_Priority; function Produce_Running_Task_Event (My_Scheduler : in Fixed_Priority_Scheduler; A_Task : in Tcb_Ptr) return Time_Unit_Event_Ptr is A_Item : Time_Unit_Event_Ptr; Cache_State : Unbounded_String := empty_string; begin A_Item := new Time_Unit_Event (Running_Task); A_Item.running_task := A_Task.Tsk; A_Item.running_core := My_Scheduler.corresponding_core_unit.name; A_Item.current_priority := Fixed_Priority_Tcb_Ptr (A_Task).Current_Priority; A_Item.CRPD := A_Task.CRPD_capacity; for i in 0..A_Task.UCBs_In_Cache.Size-1 loop Append(Cache_State,To_Unbounded_String(" " & A_Task.UCBs_In_Cache.Elements(i)'Img)); end loop; A_Item.cache_state := Cache_State; return A_Item; end Produce_Running_Task_Event; function Export_Xml_Event_Running_Task (My_Scheduler : in Fixed_Priority_Scheduler; An_Event : in Time_Unit_Event_Ptr) return Unbounded_String is Result : Unbounded_String := empty_string; begin Result := " " & An_Event.running_task.name & " " & Priority_Range'Image (An_Event.current_priority) & " " & An_Event.running_core & " "; return Result; end Export_Xml_Event_Running_Task; end Scheduler.Fixed_Priority;