------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real time scheduling analysis tool. -- This program provides services to automatically check performances -- of real time architectures. -- -- Copyright (C) 2002-2010, by Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- the LISyC Team, University of Western Britanny. -- -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- 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: 554 $ -- $Date: 2012-10-12 19:47:56 +0200 (Fri, 12 Oct 2012) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_IO; use Text_IO; package body indexed_tables is procedure initialize (a_table : out indexed_table) is begin a_table.nb_entries := 0; for i in indexed_table_range loop initialize (a_table.entries (i).data); end loop; end initialize; procedure put (a_item : in item) is begin put (a_item.item); Put ("/"); put (a_item.data); New_Line; end put; procedure put (a_table : in indexed_table_ptr) is begin put (a_table.all); end put; procedure put (a_table : in indexed_table) is begin Put_Line (" Nb entries : " & a_table.nb_entries'Img); for i in first_range .. first_range + a_table.nb_entries - 1 loop put (a_table.entries (i)); end loop; end put; procedure delete (a_table : in out indexed_table; a_item : indexed_table_range) is begin a_table.entries (a_item) := a_table.entries (a_table.nb_entries - 1); a_table.nb_entries := a_table.nb_entries - 1; end delete; -- Produce XML for all elements of a list -- function XML_ref_String(obj : in Indexed_Table_ptr; level : in natural := 0) return Unbounded_String is begin return xml_ref_string(obj.all, level); end xml_ref_string; function XML_String(obj : in Indexed_Table_ptr; level : in natural := 0) return Unbounded_String is begin return xml_string(obj.all, level); end xml_string; function xml_string (obj : in indexed_table; level : in Natural := 0) return Unbounded_String is result : Unbounded_String := To_Unbounded_String (""); begin for i in first_range .. first_range + obj.nb_entries - 1 loop result := result & to_unbounded_string(" ") & to_string(obj.entries(i).item) & to_unbounded_string(" "); result := result & xml_string (obj.entries (i).data); end loop; return result; end xml_string; function xml_ref_string (obj : in indexed_table; level : in Natural := 0) return Unbounded_String is result : Unbounded_String := To_Unbounded_String (""); begin for i in first_range .. first_range + obj.nb_entries - 1 loop result := result & xml_ref_string (obj.entries (i).data); end loop; return result; end xml_ref_string; procedure add (a_table : in out indexed_table; a_index : index; a_element : element) is begin if a_table.nb_entries > indexed_table_range'Last - 1 then raise indexed_table_full; end if; a_table.entries (a_table.nb_entries).item := a_index; a_table.entries (a_table.nb_entries).data := a_element; a_table.nb_entries := a_table.nb_entries + 1; end add; end indexed_tables;