------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 Caches; use Caches; with Objects; use Objects; with Objects.extended; use Objects.extended; with Text_IO; use Text_IO; with Translate; use Translate; with sets; with initialize_framework; use initialize_framework; with Caches; use Caches.Cache_Blocks_Table_Package; package body Cache_Set is ------------------------------------------------------ -- CACHE ------------------------------------------------------ procedure Check_Cache (name : in Unbounded_String; cache_size : in Natural; line_size : in Natural; associativity : in Natural; block_reload_time : in Natural; coherence_protocol : in Cache_Coherence_Protocol_Type; replacement_policy : in Cache_Replacement_Policy_Type; cache_category : in Cache_Type) is begin if (name = "") then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache_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_Cache (Current_Language) & Name & " : " & Lb_Cache_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if cache_size < 1 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Cache_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (line_size < 1) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Line_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (cache_size rem line_size /= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Line_Size (Current_Language) & Lb_Must_Be (Current_Language) & Lb_Divisible (Current_Language) & " " & Lb_Cache_Size (Current_Language) )); end if; if (associativity < 1) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Associativity (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & To_Unbounded_String ("0"))); end if; if (block_reload_time <= 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Miss_Time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & To_Unbounded_String ("0"))); end if; end Check_Cache; procedure Add_Cache (my_caches : in out Caches_Set; a_cache : in out Generic_Cache_Ptr; name : in Unbounded_String; cache_size : in Natural; line_size : in Natural; associativity : in Natural; block_reload_time : in Natural; coherence_protocol : in Cache_Coherence_Protocol_Type; replacement_policy : in Cache_Replacement_Policy_Type; cache_category : in Cache_Type; a_cache_blocks_table : in Cache_Blocks_Table := no_cache_blocks_table) is my_iterator : Caches_Iterator; new_cache_type : Cache_Type; new_data_cache : Data_Cache_Ptr; new_instruction_cache : Instruction_Cache_Ptr; new_data_instruction_cache : Data_Instruction_Cache_Ptr; number_of_block : Integer; a_cache_block : Cache_Block_Ptr; begin check_initialize; Check_Cache(name, cache_size, line_size, associativity, block_reload_time, coherence_protocol, replacement_policy, cache_category); if (get_number_of_elements (my_caches) > 0) then reset_iterator(my_caches,my_iterator); loop current_element(my_caches,a_cache,my_iterator); if(name = a_cache.name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Cache_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (my_caches,my_iterator); next_element (my_caches,my_iterator); end loop; end if; if (cache_category = Data_Cache_Type) then new_data_cache := new Data_Cache; new_cache_type := Data_Cache_Type; a_cache := Generic_Cache_Ptr(new_data_cache); else if (cache_category = Instruction_Cache_Type) then new_instruction_cache := new Instruction_Cache; new_cache_type := Instruction_Cache_Type; a_cache := Generic_Cache_Ptr(new_instruction_cache); else if (cache_category = Data_Instruction_Cache_Type) then new_data_instruction_cache := new Data_Instruction_Cache; new_cache_type := Data_Instruction_Cache_Type; a_cache := Generic_Cache_Ptr(new_data_instruction_cache); end if; end if; end if; number_of_block := cache_size/line_size; a_cache.name := name; a_cache.cache_size := cache_size; a_cache.line_size := line_size; a_cache.associativity := associativity; a_cache.replacement_policy := replacement_policy; a_cache.block_reload_time := block_reload_time; a_cache.coherence_protocol := coherence_protocol; if (a_cache_blocks_table.Nb_Entries > 0) then a_cache.cache_blocks := a_cache_blocks_table; else for i in 0..number_of_block-1 loop a_cache_block := new Cache_Block; a_cache_block.name := suppress_space(To_String(name & "_cb_" & i'Img)); a_cache_block.cache_block_number := Natural(i); Add(a_cache.cache_blocks,a_cache_block); end loop; end if; add (my_caches, a_cache); exception when Generic_Cache_Set.full_set => Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Caches (Current_Language))); end Add_Cache; procedure Add_Cache (my_caches : in out Caches_Set; name : in Unbounded_String; cache_size : in Natural; line_size : in Natural; associativity : in Natural; block_reload_time : in Natural; coherence_protocol : in Cache_Coherence_Protocol_Type; replacement_policy : in Cache_Replacement_Policy_Type; cache_category : in Cache_Type; a_cache_blocks_table : in Cache_Blocks_Table := no_cache_blocks_table) is a_cache : Generic_Cache_Ptr; begin Add_Cache(my_caches, a_cache, name, cache_size, line_size, associativity, block_reload_time, coherence_protocol, replacement_policy, cache_category, a_cache_blocks_table); end Add_Cache; procedure Update_Cache (my_caches : in out Caches_Set; name : in Unbounded_String; cache_size : in Natural; line_size : in Natural; associativity : in Natural; block_reload_time : in Natural; coherence_protocol : in Cache_Coherence_Protocol_Type; replacement_policy : in Cache_Replacement_Policy_Type; cache_category : in Cache_Type) is the_cache : Generic_Cache_Ptr; a_cache_blocks_tbl : Cache_Blocks_Table; begin Check_cache(name, cache_size, line_size, associativity, block_reload_time, coherence_protocol, replacement_policy, cache_category); the_cache := Search_Cache(my_caches,name); a_cache_blocks_tbl := the_cache.cache_blocks; Delete(my_caches,the_cache); Add_Cache(my_caches, name, cache_size, line_size, associativity, block_reload_time, coherence_protocol, replacement_policy, cache_category, a_cache_blocks_tbl); end Update_Cache; procedure Delete_Cache (my_caches : in out Caches_Set; name : in Unbounded_String) is the_cache : Generic_Cache_Ptr; begin the_cache := Search_Cache(my_caches,name); Delete(my_caches,the_cache); end Delete_Cache; function Search_Cache (my_caches : in Caches_Set; name : in Unbounded_String) return Generic_Cache_Ptr is my_iterator : Caches_Iterator; a_cache : Generic_Cache_Ptr; result : Generic_Cache_Ptr; found : Boolean := False; begin if not is_empty(my_caches) then reset_iterator(my_caches,my_iterator); loop current_element (my_caches, a_cache, my_iterator); if (a_cache.name = name) then found := True; result := a_cache; end if; exit when is_last_element (my_caches,my_iterator); next_element (my_caches,my_iterator); end loop; end if; if not Found then Raise_Exception (Cache_Not_Found'Identity, To_String (Lb_Cache_Name (Current_Language) & "=" & Name)); end if; return Result; end Search_Cache; function Search_Cache_by_id (my_caches : in Caches_Set; id : in Unbounded_String) return Generic_Cache_Ptr is my_iterator : Caches_Iterator; a_cache : Generic_Cache_Ptr; result : Generic_Cache_Ptr; found : Boolean := False; begin if not is_empty(my_caches) then reset_iterator(my_caches, my_iterator); loop current_element (my_caches, a_cache, my_iterator); if (a_cache.cheddar_private_id = id) then found := True; result := a_cache; end if; exit when is_last_element (my_caches,my_iterator); next_element (my_caches,my_iterator); end loop; end if; if not Found then Raise_Exception (cache_Not_Found'Identity, To_String (Lb_cache_id (Current_Language) & "=" & id)); end if; return Result; end Search_Cache_by_id; function Export_Aadl_Implementations (my_caches : in Caches_Set) return Unbounded_String is my_iterator : Caches_Iterator; a_cache : Generic_Cache_Ptr; result : Unbounded_String := empty_string; begin if not is_empty (my_caches) then reset_iterator (my_caches, my_iterator); loop current_element (my_caches, a_cache, my_iterator); Result := Result & To_Unbounded_String ("cache " & To_String (a_cache.name)) & unbounded_lf; Result := Result & To_Unbounded_String ("end " & To_String (a_cache.name) & ";") & unbounded_lf & unbounded_lf; Result := Result & To_Unbounded_String ("cache implementation " & To_String (a_cache.name) & ".Impl") & unbounded_lf; --TODO: Add more code here when understand more about the AADL implementation Result := Result & To_Unbounded_String ("end " & To_String (a_cache.name) & ".Impl;") & unbounded_lf & unbounded_lf; exit when is_last_element (my_caches, my_iterator); next_element (my_caches, my_iterator); end loop; end if; return Result; end Export_Aadl_Implementations; function Export_Aadl_Declarations (my_caches : in Caches_Set; number_of_ht : in Natural) return Unbounded_String is my_iterator : Caches_Iterator; a_cache : Generic_Cache_Ptr; result : Unbounded_String := empty_string; begin if not is_empty (my_caches) then reset_iterator (my_caches, my_iterator); loop current_element (my_caches, a_cache, my_iterator); for I in 1 .. number_of_ht loop result := result & ASCII.HT; end loop; result := result & To_Unbounded_String ("instancied_" & To_String (a_cache.name) & " : cache " & To_String (a_cache.name) & ".Impl;") & unbounded_lf; exit when is_last_element (my_caches, my_iterator); next_element (my_caches, my_iterator); end loop; end if; return Result; end Export_Aadl_Declarations; end Cache_Set;