------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2020, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR CNRS 6285, Universite 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: 3546 $ -- $Date: 2020-10-19 08:01:15 +0200 (lun. 19 oct. 2020) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Text_IO; use Ada.Text_IO; with systems; use systems; with dependencies; use dependencies; with task_dependencies; use task_dependencies; with task_dependencies; use task_dependencies.half_dep_set; with tasks; use tasks; with task_set; use task_set; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with debug; use debug; with sets; package body kl_partitioning is function computesCosts( nbParts: in Integer; nb_nodes: in Integer; costs: in out matrice; graph_sys: in out matrice; chromosome: in out chrom_array) return Integer is cut : Integer := 0; begin --BZERO for i in 1..nb_nodes loop for j in i+1 ..nb_nodes loop costs(i,chromosome(j)) := costs(i,chromosome(j)) + graph_sys(i,j); costs(j,chromosome(i)) := costs(i,chromosome(j)) + graph_sys(i,j); end loop; end loop; for i in 1..nb_nodes loop for k in 1..nbParts loop if (chromosome(i)/= k) then cut := cut + costs(i,k); end if; end loop; end loop; return cut/2; end computesCosts; function kl( nbParts: in Integer; nb_nodes: in Integer; costs: in out matrice; graph_sys: in out matrice; chromosome: in out chrom_array ) return Integer is cut, bestPair, bestCut, pair, a, b, tmp, gain, g : Integer:=0; locked : chrom_array; klstack: matrice; begin --random init for i in 1..nb_nodes loop chromosome(i):= i mod nbParts; end loop; cut:= computesCosts(nbParts, nb_nodes, costs, graph_sys, chromosome); put_debug("initial cut : " & cut'Img); while(true)loop bestCut := INFTY; --BZERO for i in 1..nb_nodes loop locked(i):=0; end loop; put_debug("cut at the begining of phase : " & cut'Img); for pair in 1..nb_nodes/2 loop --find best unlocked pair gain := -INFTY; for i in 1..nb_nodes-1 loop for j in i+1..nb_nodes loop if (locked(i)/=1) AND (locked(j)/=1)then g := costs(i, chromosome(j)) + costs(j, chromosome(i)) - costs(i,chromosome(i)) - costs(j,chromosome(j)) - 2* graph_sys(i,j); if g>gain then gain:=g; a:=i; b:=j; end if; end if; end loop; end loop; --swap the best pair, lock nodes, and compute new cut tmp := chromosome(a); chromosome(a):=chromosome(b); chromosome(b):=tmp; locked(a) := 1; locked(b) := 1; klstack(pair,1):=a ; -- first exchanged node klstack(pair,2):=b ; -- second exchanged node klstack(pair,3):=computesCosts(nbParts, nb_nodes, costs, graph_sys, chromosome) ; -- new cut value if (klstack(pair,3) < bestCut) then bestPair := pair; bestCut := klstack(pair,3); end if; end loop; put_debug("best pair " & bestPair'Img & " ->" & klstack(bestPair,1)'Img & " " & klstack(bestPair,2)'Img & " " & klstack(bestPair,3)'Img); if (bestCut < cut) then --we got a gain for pair in bestPair+1..nb_nodes/2 loop --invalidate last exchanges a:=klstack(bestPair,1); b:=klstack(bestPair,2); tmp := chromosome(a); chromosome(a):=chromosome(b); chromosome(b):=tmp; end loop; cut := computesCosts(nbParts, nb_nodes, costs, graph_sys, chromosome); -- = bestCut, we need to update Dval() else exit; end if; end loop; return cut; end kl; function genGraph( sys : in System; m : in out matrice; nbParts: in Integer; nb_nodes: in Integer) return Integer is my_dependencies : tasks_dependencies_ptr; dep_ptr : dependency_ptr; my_iterator : tasks_dependencies_iterator; e : integer :=0; begin my_dependencies := sys.dependencies; if is_empty( my_dependencies.Depends) then Put_Debug("No dependencies"); else reset_iterator (my_dependencies.depends, my_iterator); loop current_element (my_dependencies.depends, dep_ptr, my_iterator); if (dep_ptr.type_of_dependency = precedence_dependency) then m (Integer'value (To_String (dep_ptr.precedence_source.name)),Integer'value (To_String (dep_ptr.precedence_sink.name))) :=1; e:=e+1; elsif(dep_ptr.type_of_dependency = remote_procedure_call_dependency) then m (Integer'value(To_String (dep_ptr.remote_procedure_call_server.name)),Integer'value(To_String (dep_ptr.remote_procedure_call_client.name))) := 1; e:=e+1; exit when is_last_element (my_dependencies.depends, my_iterator); next_element (my_dependencies.depends, my_iterator); end if; end loop; end if ; return e; end genGraph; end kl_partitioning ;