------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Ada.Exceptions; use Ada.Exceptions; with CFG_Edges; use CFG_Edges; with CFG_Edges; use CFG_Edges.CFG_Edges_Table_Package; with Objects; use Objects; with Objects.extended; use Objects.extended; with Text_IO; use Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Integer_Arrays; use Integer_Arrays; with initialize_framework; use initialize_framework; with Translate; use Translate; with Tables; with sets; package body CFG_Edge_Set is ---------------------------------------------------- -- CHECK ---------------------------------------------------- procedure Check_CFG_Edge (name : in Unbounded_String; node : in Unbounded_String; next_node : in Unbounded_String) is begin if (name ="") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_CFG_Edge_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_CFG_Edge (Current_Language) & name & " : " & Lb_CFG_Edge_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if (node = "" OR next_node="") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_CFG_Node_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (node) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_CFG_Node (Current_Language) & node & " : " & Lb_CFG_Node_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if not Is_A_Valid_Identifier (next_node) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_CFG_Node (Current_Language) & next_node & " : " & Lb_CFG_Node_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; end Check_CFG_Edge; ---------------------------------------------------- -- ADD ---------------------------------------------------- procedure Add_CFG_Edge (my_cfg_edges : in out CFG_Edges_Set; a_cfg_edge : in out CFG_Edge_Ptr; name : in Unbounded_String; node : in Unbounded_String; next_node : in Unbounded_String) is my_iterator : CFG_Edges_Iterator; begin Check_Initialize; Check_CFG_Edge(name, node, next_node); a_cfg_edge := new CFG_Edge; a_cfg_edge.name := name; a_cfg_edge.node := node; a_cfg_edge.next_node := next_node; add(my_cfg_edges,a_cfg_edge); exception when full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_CFG_Edge (Current_Language))); end Add_CFG_Edge; procedure Add_CFG_Edge (my_cfg_edges : in out CFG_Edges_Set; name : in Unbounded_String; node : in Unbounded_String; next_node : in Unbounded_String) is a_cfg_edge : CFG_Edge_Ptr; begin Add_CFG_Edge(my_cfg_edges => my_cfg_edges, a_cfg_edge => a_cfg_edge, name => name, node => node, next_node => next_node); end Add_CFG_Edge; procedure Update_CFG_Edge (my_cfg_edges : in out CFG_Edges_Set; name : in Unbounded_String; node : in Unbounded_String; next_node : in Unbounded_String) is a_cfg_edge : CFG_Edge_Ptr; begin Check_CFG_Edge(name => name, node => node, next_node => next_node); a_cfg_edge := Search_CFG_Edge(my_cfg_edges => my_cfg_edges, name => name); Delete(my_cfg_edges,a_cfg_edge); Add_CFG_Edge(my_cfg_edges => my_cfg_edges, name => name, node => node, next_node => next_node); end Update_CFG_Edge; ------------------------------------------------------ -- SEARCH ------------------------------------------------------ function Search_CFG_Edge (my_cfg_edges : in CFG_Edges_Set; name : in Unbounded_String) return CFG_Edge_Ptr is my_iterator : CFG_Edges_Iterator; a_cfg_edge : CFG_Edge_Ptr; result : CFG_Edge_Ptr; found : Boolean := False; begin if not is_empty(my_cfg_edges) then reset_iterator(my_cfg_edges,my_iterator); loop current_element (my_cfg_edges, a_cfg_edge, my_iterator); if (a_cfg_edge.name = name) then found := True; result := a_cfg_edge; end if; exit when is_last_element (my_cfg_edges,my_iterator); next_element (my_cfg_edges,my_iterator); end loop; end if; if not Found then Raise_Exception (CFG_Edge_Not_Found'Identity, To_String (Lb_CFG_Edge_Name (Current_Language) & "=" & name)); end if; return Result; end Search_CFG_Edge; function Search_CFG_Edge_By_Id (my_cfg_edges : in CFG_Edges_Set; id : in Unbounded_String) return CFG_Edge_Ptr is my_iterator : CFG_Edges_Iterator; a_cfg_edge : CFG_Edge_Ptr; result : CFG_Edge_Ptr; found : Boolean := False; begin if not is_empty(my_cfg_edges) then reset_iterator(my_cfg_edges,my_iterator); loop current_element (my_cfg_edges, a_cfg_edge, my_iterator); if (a_cfg_edge.cheddar_private_id = id) then found := True; result := a_cfg_edge; end if; exit when is_last_element (my_cfg_edges,my_iterator); next_element (my_cfg_edges,my_iterator); end loop; end if; if not Found then Raise_Exception (CFG_Edge_Not_Found'Identity, To_String (Lb_CFG_Edge_Id (Current_Language) & "=" & id)); end if; return Result; end Search_CFG_Edge_By_Id; ------------------------------------------------------ -- SEARCH ------------------------------------------------------ procedure Delete_CFG_Edge (my_cfg_edges : in out CFG_Edges_Set; name : in Unbounded_String) is a_cfg_edge : CFG_Edge_Ptr; begin a_cfg_edge := Search_CFG_Edge(my_cfg_edges, name); delete (my_cfg_edges, a_cfg_edge); end Delete_CFG_Edge; end CFG_Edge_Set;