------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 6285, 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$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Unchecked_Deallocation; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; generic type element is private; type index is private; size : Natural := 100; first : Natural := 0; with procedure put (e : in element); with procedure initialize (e : out element); with procedure put (e : in index); with function to_string (e : in index) return Unbounded_String; with function xml_string (e : in element) return Unbounded_String; with function xml_ref_string (e : in element) return Unbounded_String; xml_tag : Unbounded_String := To_Unbounded_String ("index"); package indexed_tables is -- This exception is raised when adding a new item -- in the table will conduct to have Ada check bound exception -- indexed_table_full : exception; -- Do not change range 0..first+size -- intro first..first+size : it's a tips to -- avoid constraint error with nb_entries -- define by a table_range (and not a natural) -- type indexed_table_range is new Natural range 0 .. first + size; type indexed_table_range_ptr is access indexed_table_range; first_range : indexed_table_range := indexed_table_range (first); type item is record data : element; item : index; end record; type data_table is array (indexed_table_range) of item; type indexed_table is record nb_entries : indexed_table_range := 0; entries : data_table; end record; type indexed_table_ptr is access indexed_table; procedure put (a_item : in item); -- Produce XML for all elements of a list -- function xml_ref_string (obj : in indexed_table) return Unbounded_String; function xml_ref_string (obj : in indexed_table_ptr) return Unbounded_String; function xml_string (obj : in indexed_table) return Unbounded_String; function xml_string (obj : in indexed_table_ptr) return Unbounded_String; procedure put (a_table : in indexed_table); procedure put (a_table : in indexed_table_ptr); procedure initialize (a_table : out indexed_table); procedure delete (a_table : in out indexed_table; a_item : indexed_table_range); procedure add (a_table : in out indexed_table; a_index : index; a_element : element); procedure free is new Unchecked_Deallocation (indexed_table, indexed_table_ptr); pragma inline (add); pragma inline (delete); end indexed_tables;