------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- This source file was automatically generated by Platypus -- see http://dossen.univ-brest.fr/apl -- -- Any modification of this file will be lost. -- Please see the "platypus" directory instead : it contains the Cheddar's -- model and its meta-model. ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a free real time scheduling tool. -- This program provides services to automatically check temporal constraints -- of real time tasks. -- -- Copyright (C) 2002-2014 Frank Singhoff -- Cheddar is developed by the LAB-STICC Team, University of Brest -- -- 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 -- To post to this mailing list, you must be subscribed -- (see http//beru.univ-brest.fr/~singhoff/cheddar for details) -- ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_IO; use Text_IO; with unbounded_strings; use unbounded_strings; with CFG_Nodes; use CFG_Nodes; use CFG_Nodes.CFG_Nodes_Table_Package; with primitive_xml_strings; use primitive_xml_strings; package body dfg_nodes is -- --------= DFG_Variable =-------- procedure initialize (obj : in out dfg_variable) is begin Initialize (named_object (obj)); end initialize; function copy (obj : in dfg_variable) return dfg_variable_ptr is new_dfg_variable : dfg_variable_ptr; begin new_dfg_variable := new dfg_variable'(obj); return (new_dfg_variable); end copy; function copy (obj : in dfg_variable_ptr) return dfg_variable_ptr is begin return copy (obj.all); end copy; procedure put (obj : in dfg_variable) is begin Put (named_object (obj)); end put; procedure put (obj : in dfg_variable_ptr) is begin put (obj.all); end put; procedure put_name (obj : in dfg_variable_ptr) is begin Put (To_String (obj.name)); end put_name; function get_name (obj : in dfg_variable) return Unbounded_String is begin return obj.name; end get_name; function get_name (obj : in dfg_variable_ptr) return Unbounded_String is begin return obj.name; end get_name; function type_of (obj : in dfg_variable) return unbounded_string_list is list : unbounded_string_list; s : unbounded_string_ptr; begin initialize (list); s := new Unbounded_String; s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT"); add (list, s); s := new Unbounded_String; s.all := To_Unbounded_String ("OBJECTS.NAMED_OBJECT"); add (list, s); s := new Unbounded_String; s.all := To_Unbounded_String ("DFG_NODES.DFG_VARIABLE"); add (list, s); return list; end type_of; function type_of (obj : in dfg_variable_ptr) return unbounded_string_list is begin return type_of (obj.all); end type_of; procedure build_attributes_xml_string (obj : in dfg_variable; result : in out Unbounded_String) is begin Build_Attributes_XML_String (named_object (obj), result); end build_attributes_xml_string; function xml_string (obj : in dfg_variable) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in dfg_variable_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in dfg_variable) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); return (result); end xml_ref_string; function xml_ref_string (obj : in dfg_variable_ptr) return Unbounded_String is begin return xml_ref_string (obj.all); end xml_ref_string; -- --------= DFG_Statement =-------- procedure initialize (obj : in out dfg_statement) is begin Initialize (named_object (obj)); end initialize; function copy (obj : in dfg_statement) return dfg_statement_ptr is new_dfg_statement : dfg_statement_ptr; begin new_dfg_statement := new dfg_statement'(obj); return (new_dfg_statement); end copy; function copy (obj : in dfg_statement_ptr) return dfg_statement_ptr is begin return copy (obj.all); end copy; procedure put (obj : in dfg_statement) is begin Put (named_object (obj)); Put ("Defined_Variable: "); if obj.defined_variable /= null then put (obj.defined_variable.all); else Put ("null"); end if; Put ("; "); Put ("Used_Variables: "); put (obj.used_variables); Put ("; "); end put; procedure put (obj : in dfg_statement_ptr) is begin put (obj.all); end put; procedure put_name (obj : in dfg_statement_ptr) is begin Put (To_String (obj.name)); end put_name; function get_name (obj : in dfg_statement) return Unbounded_String is begin return obj.name; end get_name; function get_name (obj : in dfg_statement_ptr) return Unbounded_String is begin return obj.name; end get_name; function type_of (obj : in dfg_statement) return unbounded_string_list is list : unbounded_string_list; s : unbounded_string_ptr; begin initialize (list); s := new Unbounded_String; s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT"); add (list, s); s := new Unbounded_String; s.all := To_Unbounded_String ("OBJECTS.NAMED_OBJECT"); add (list, s); s := new Unbounded_String; s.all := To_Unbounded_String ("DFG_NODES.DFG_STATEMENT"); add (list, s); return list; end type_of; function type_of (obj : in dfg_statement_ptr) return unbounded_string_list is begin return type_of (obj.all); end type_of; procedure build_attributes_xml_string (obj : in dfg_statement; result : in out Unbounded_String) is begin Build_Attributes_XML_String (named_object (obj), result); result := result & To_Unbounded_String (""); if (xml_string (obj.used_variables) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.used_variables) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in dfg_statement) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in dfg_statement_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in dfg_statement) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); return (result); end xml_ref_string; function xml_ref_string (obj : in dfg_statement_ptr) return Unbounded_String is begin return xml_ref_string (obj.all); end xml_ref_string; -- --------= DFG_Cfg_Type =-------- procedure initialize (obj : out dfg_cfg_type) is begin obj.nb_blocks := 0; end initialize; procedure put (obj : in dfg_cfg_type) is begin Put ("Blocks: "); put (obj.blocks); Put ("; "); Put ("Nb_Blocks: "); standards_io.natural_io.Put (obj.nb_blocks); Put ("; "); end put; procedure put (obj : in dfg_cfg_type_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in dfg_cfg_type; result : in out Unbounded_String) is begin if (xml_string (obj.blocks) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.blocks) & To_Unbounded_String (""); end if; if (xml_string (obj.nb_blocks) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.nb_blocks) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in dfg_cfg_type) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in dfg_cfg_type_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in dfg_cfg_type) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in dfg_cfg_type) return dfg_cfg_type_ptr is new_dfg_cfg_type : dfg_cfg_type_ptr; begin new_dfg_cfg_type := new dfg_cfg_type'(obj); return (new_dfg_cfg_type); end copy; function copy (obj : in dfg_cfg_type_ptr) return dfg_cfg_type_ptr is begin return copy (obj.all); end copy; -- --------= DFG_Def_Use_Association =-------- procedure initialize (obj : out dfg_def_use_association) is begin null; end initialize; procedure put (obj : in dfg_def_use_association) is begin Put ("Def_Variable: "); if obj.def_variable /= null then put (obj.def_variable.all); else Put ("null"); end if; Put ("; "); Put ("Def_Statement: "); if obj.def_statement /= null then put (obj.def_statement.all); else Put ("null"); end if; Put ("; "); Put ("Use_Statement: "); if obj.use_statement /= null then put (obj.use_statement.all); else Put ("null"); end if; Put ("; "); end put; procedure put (obj : in dfg_def_use_association_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in dfg_def_use_association; result : in out Unbounded_String) is begin result := result & To_Unbounded_String (""); result := result & To_Unbounded_String (""); result := result & To_Unbounded_String (""); end build_attributes_xml_string; function xml_string (obj : in dfg_def_use_association) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in dfg_def_use_association_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in dfg_def_use_association) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in dfg_def_use_association) return dfg_def_use_association_ptr is new_dfg_def_use_association : dfg_def_use_association_ptr; begin new_dfg_def_use_association := new dfg_def_use_association'(obj); return (new_dfg_def_use_association); end copy; function copy (obj : in dfg_def_use_association_ptr) return dfg_def_use_association_ptr is begin return copy (obj.all); end copy; -- --------= DFG_Var_Association =-------- procedure initialize (obj : out dfg_var_association) is begin null; end initialize; procedure put (obj : in dfg_var_association) is begin Put ("Def_Variable: "); if obj.def_variable /= null then put (obj.def_variable.all); else Put ("null"); end if; Put ("; "); Put ("Statement: "); if obj.statement /= null then put (obj.statement.all); else Put ("null"); end if; Put ("; "); end put; procedure put (obj : in dfg_var_association_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in dfg_var_association; result : in out Unbounded_String) is begin result := result & To_Unbounded_String (""); result := result & To_Unbounded_String (""); end build_attributes_xml_string; function xml_string (obj : in dfg_var_association) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in dfg_var_association_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in dfg_var_association) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in dfg_var_association) return dfg_var_association_ptr is new_dfg_var_association : dfg_var_association_ptr; begin new_dfg_var_association := new dfg_var_association'(obj); return (new_dfg_var_association); end copy; function copy (obj : in dfg_var_association_ptr) return dfg_var_association_ptr is begin return copy (obj.all); end copy; -- --------= DFG_Def_Use_Info =-------- procedure initialize (obj : out dfg_def_use_info) is begin null; end initialize; procedure put (obj : in dfg_def_use_info) is begin Put ("Def_In: "); put (obj.def_in); Put ("; "); Put ("Def_Out: "); put (obj.def_out); Put ("; "); Put ("Use_Out: "); put (obj.use_out); Put ("; "); Put ("Def_Use_Asso: "); put (obj.def_use_asso); Put ("; "); end put; procedure put (obj : in dfg_def_use_info_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in dfg_def_use_info; result : in out Unbounded_String) is begin if (xml_string (obj.def_in) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.def_in) & To_Unbounded_String (""); end if; if (xml_string (obj.def_out) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.def_out) & To_Unbounded_String (""); end if; if (xml_string (obj.use_out) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.use_out) & To_Unbounded_String (""); end if; if (xml_string (obj.def_use_asso) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.def_use_asso) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in dfg_def_use_info) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in dfg_def_use_info_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in dfg_def_use_info) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in dfg_def_use_info) return dfg_def_use_info_ptr is new_dfg_def_use_info : dfg_def_use_info_ptr; begin new_dfg_def_use_info := new dfg_def_use_info'(obj); return (new_dfg_def_use_info); end copy; function copy (obj : in dfg_def_use_info_ptr) return dfg_def_use_info_ptr is begin return copy (obj.all); end copy; end dfg_nodes;