with Ada.text_IO; use Ada.text_IO; with Ada.Integer_text_IO; use Ada.Integer_text_IO; with Ada.Float_Text_IO; use Ada.Float_Text_IO; with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; with Ada.Strings; use Ada.Strings; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Numerics.Float_Random ; use Ada.Numerics.Float_Random ; with unbounded_strings; use unbounded_strings; with Tasks; use Tasks; with Task_Set; use Task_Set; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Unbounded_Strings; use Unbounded_Strings; with convert_unbounded_strings; use unbounded_strings.unbounded_string_list_package; with feasibility_test.feasibility_interval; use feasibility_test.feasibility_interval; with Core_Units; use Core_Units; use Core_Units.Core_Units_Table_Package; with Scheduler_Interface; use Scheduler_Interface; with Address_Spaces; use Address_Spaces; with Address_Space_Set; use Address_Space_Set; with Processors; use Processors; with Processor_Set; use Processor_Set; with processor_interface; use processor_interface; with Call_Framework; use Call_Framework; with Call_Framework_Interface; use Call_Framework_Interface; use Call_Framework_Interface.Framework_Response_Package; use Call_Framework_Interface.Framework_Request_Package; with Call_Scheduling_Framework; use Call_Scheduling_Framework; with Pipe_Commands; use Pipe_Commands; with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO; with Ada.Directories; use Ada.Directories; with GNAT.OS_Lib; use GNAT.OS_Lib; package body Paes_For_Clustering is ------------------------- -- init_for_clustering -- ------------------------- procedure init_for_clustering is a_core : core_unit_ptr; begin -- initialise c with values from 1 to genes -- we suppose each function is assigned to a task. for i in 1..genes loop c.chrom(i) := i; end loop; -- Initialize the system "sys" Call_Framework.initialize (False); Initialize(A_System => sys); Add_Address_Space(sys.address_spaces, to_unbounded_string("addr1"), to_unbounded_string("processor1"), 0, 0, 0, 0); Add_core_unit(My_core_units => sys.core_units, A_core_unit => a_core, Name => to_unbounded_string("core1"), Is_Preemptive => preemptive, Quantum => 0, speed => 1.0, capacity => 0, period => 0, Priority => Task_priority, File_Name => to_unbounded_string(""), A_Scheduler => The_scheduler); Add_Processor(My_Processors => sys.processors, Name => to_unbounded_string("processor1"), A_Network => to_unbounded_string("a_network"), a_Core => a_core); -- Initialise the float generator reset(G); end init_for_clustering; ----------------------------- -- evaluate_for_clustering -- ----------------------------- procedure evaluate_for_clustering (s : in out solution) is begin s.obj(1) := Float (Nb_preemption_of_the_candidate_sol); if Second_fitness_function ="sum_lax" then s.obj(2) := Float (Hyperperiod_of_Initial_Taskset - Sum_laxities_of_the_candidate_sol); else s.obj(2) := Float (Hyperperiod_of_Initial_Taskset - Min_laxities_of_the_candidate_sol); end if; end evaluate_for_clustering; --------------------------- -- Mutate_for_clustering -- --------------------------- procedure mutate_for_clustering (s : in out solution) is random_task, fn : integer; A_Task_set, New_Task_set : Tasks_Set; Nb_tasks, New_nb_tasks : integer; period_fn, period_j : natural; harmonic_tasks : chrom_type; tmp_mod, k, j, counter : integer; is_harmonic, exist : boolean; Sol_is_mutated : boolean; A_sol : solution; Nb_harmonic_tasks : integer; FileStream : stream; command : unbounded_String; F : Ada.Text_IO.File_Type; line : unbounded_String; Buffer : unbounded_String; begin sol_is_mutated := false; --reset(G); -- Initialise the float generator -- I think, we should add a counter, if this counter reach a threashold -- and it failed to generate a mutated solution then we stop counter := 1; while (not sol_is_mutated) and (counter <= 100) loop Put_line ("................................................................"); Put_line ("The " & counter'img & " attempt of the mutation procedure "); Put_line ("................................................................"); A_sol := s; A_Task_set := Appling_clustering_rules (A_sol); Nb_tasks := Number_of_tasks (A_sol); fn := 0; -- choose randomly an index of a function between 1 and genes while (fn > genes) or (fn < 1) loop fn := integer (float(genes) * random(G)); end loop; Put_Line ("The randomly chosen function is : " & fn'img); -- determine the set of harmonic tasks with the choosen function fn K := 0; period_fn := Get (My_Tasks => Initial_tasks_set, Task_Name => Suppress_Space (To_Unbounded_String ("Task" & fn'Img)), Param_Name => Period); for j in 1 .. Nb_tasks loop period_j := Get (My_Tasks => A_Task_set, Task_Name => Suppress_Space (To_Unbounded_String ("Task" & j'Img)), Param_Name => Period); if period_fn > period_j then tmp_mod := period_fn mod period_j; else tmp_mod := period_j mod period_fn; end if; if tmp_mod = 0 then Put_Line ("period_fn = " & period_fn'Img & " period_j = " & period_j'Img); k := k + 1; harmonic_tasks (k) := j; Put_Line ("harmonic_tasks (" & k'Img & ") = " & j'Img); end if; end loop; nb_harmonic_tasks := k; -- if the set of tasks which are harmonic with "fn" is not empty -- else i.e the function fn is not harmonic with any task, only its own task -- then we repeat the procedure with another function chosen randomly if nb_harmonic_tasks /= 0 then -- choose randomly a task random_task over tasks in the set harmonic_tasks -- (including tau_j = chrom[fn]); is_harmonic := false; while (not is_harmonic) loop random_task := 0; -- generate a random number of task comprised between 1 and nb_tasks while (random_task > nb_tasks) or (random_task < 1) loop random_task := integer (float(nb_tasks) * random(G)); end loop; Put_Line ("nb_tasks =" & nb_tasks'img & " and The task chosen randomly is :" & random_task'img); Put ("The harmonic tasks with " & fn'Img & " are: "); for j in 1 .. nb_harmonic_tasks loop Put (" " & harmonic_tasks (j)'Img); end loop; New_Line; -- verify if random_task is among the set of harmonic tasks j := 1; exist := false; while (not exist) and (j <= nb_harmonic_tasks) loop if random_task = harmonic_tasks (j) then exist := true; end if; j := j + 1; end loop; if exist then is_harmonic := true; end if; end loop; if (random_task /= A_sol.chrom(fn)) then -- if the function "fn" is not intially in -- the task "random_task" the "fn" is moved -- to the task "random_task" A_sol.chrom(fn) := random_task; sol_is_mutated := true; elsif (not is_isolated (fn, A_sol)) then -- if coincidentally the function "fn" is intially in the task "random_task" -- then if the function "fn" is not initially isolated, we create a new task -- in which we isolate it -- else i.e the function "fn" is alone then we repeat the procedure with another function -- chosen randomly A_sol.chrom(fn) := nb_tasks + 1; sol_is_mutated := true; end if; end if; if sol_is_mutated then New_Line; Put_Line ("The mutated solution is : "); print_genome(A_sol); New_Line; -- normalize the mutate solution normalize(A_sol); New_Line; Put_Line ("After normalization the candidate solution is : "); print_genome(A_sol); New_Line; ---------------------------------------------------------------------------------------- -- After generating a mutate solution, we shoud verify : -- 1) If the new solution is consistent or not i.e two non-harmonic functions -- which are grouped alone in the same task. -- 2) If it was a consistent solution then we should verify its schedulability -- by calling the Cheddar tool to simulate the scheduling of the candidate task set -- Else, we must regenerate a new candidate solution ----------------------------------------------------------------------------------------- If Is_sol_consistent (A_sol) then Put_Line (" The candidate solution is consistent and then we check the schedulability"); -- check the schedulability New_Task_set := Appling_clustering_rules (A_sol); New_nb_tasks := Number_of_tasks (A_sol); Sys.Tasks := New_Task_set; Build_xml_model (New_Task_set, "candidate_solution.xmlv3"); -- command := To_Unbounded_String("../../../../../../../call_cheddar_d " command := To_Unbounded_String("/media/DATA/These_Rahma/CHEDDAR/trunk/src/call_cheddar_d " & Hyperperiod_of_Initial_Taskset'img & " candidate_solution.xmlv3"); FileStream := execute(To_string(command), read_file); loop begin Buffer := read_next(FileStream); exception when Pipe_Commands.End_of_file => exit; end; end loop; close(FileStream); Open(F, Ada.Text_IO.In_File,"Output.txt"); line := To_Unbounded_String(get_line(F)); line := Unbounded_Slice(line,1,3); if line = "sch" then put_line("**The candidate task set is schedulable**"); sol_is_mutated := true; s := A_sol; line := To_Unbounded_String(get_line(F)); line := Unbounded_Slice(line, index(line,"=") + 3, length(line)); Nb_preemption_of_the_candidate_sol := integer'Value(to_string(Unbounded_Slice(line,1,length(line)))); put_line("Nb_preemptions = " & Nb_preemption_of_the_candidate_sol'Img); line := To_Unbounded_String(get_line(F)); line := Unbounded_Slice(line, index(line,"=") + 3, length(line)); Sum_laxities_of_the_candidate_sol := integer'Value (to_string(Unbounded_Slice(line,1,length(line)))); put_line("sum_lax = " & Sum_laxities_of_the_candidate_sol'Img); line := To_Unbounded_String(get_line(F)); line := Unbounded_Slice(line, index(line,"=") + 3, length(line)); Min_laxities_of_the_candidate_sol := integer'Value (to_string(Unbounded_Slice(line,1,length(line)))); put_line("Min_lax = " & Min_laxities_of_the_candidate_sol'Img); else put_line("**The candidate task set is NOT schedulable**"); sol_is_mutated := false; counter := counter + 1; end if; Close(F); else Put_Line (" The candidate solution is NOt consistent and then " & " we should regenerate another candidate solution"); sol_is_mutated := false; counter := counter + 1; end if; end if; end loop; if counter > 100 then New_Line; New_Line; put_line("Exit the program, there is no schedulable candidate solution !"); New_Line; New_Line; OS_Exit (0); end if; end mutate_for_clustering; ----------------- -- is_isolated -- ----------------- function is_isolated(t : integer; s : solution) return boolean is result : boolean := true; i : integer := 1; begin while (result and i <= genes) loop if (s.chrom(i) = s.chrom(t)) and then (t /= i) then result := false; end if; i := i + 1; end loop; return result; end is_isolated; --------------- -- Normalize -- --------------- procedure normalize(s : in out solution) is nb_tasks : integer := 1; -- the vector var is used to know if a gene is normalised or not yet var : chrom_Type; begin -- initialization of the vector var. for i in 1..genes loop var(i) := 0; end loop; ------------------------------------------------------------ -- if var(i) = 0 ==> s.chrom(i) is not yet normalised -- if var(i) = 1 ==> s.chrom(i) is normalised ------------------------------------------------------------ for i in 1..genes loop if (var(i) = 0) then for j in i+1..genes loop if (s.chrom(j) = s.chrom(i)) and then (var(j) = 0) then var(j) := 1; -- if s.chrom(i) is not normalised then all s.chrom(j) (which egal s.all.chrom(i)) -- are not normalised if (s.chrom(i) /= nb_tasks) then s.chrom(j) := nb_tasks; end if; end if; end loop; -- we normalize s.chrom(i) if (s.chrom(i) /= nb_tasks) then s.chrom(i) := nb_tasks; end if; var(i) := 1; nb_tasks := nb_tasks + 1; end if; end loop; end normalize; end Paes_For_Clustering;