------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 -- ----------------------------------------------------------------------------- -- -- -- -- ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ 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; package body Cache_Set is procedure Check_Cache (name : in Unbounded_String; number_of_block : in Natural; block_size : in Natural; associativity : in Natural; cache_replacement : in Cache_Replacement_Type; hit_time : in Double; miss_time : in Double; miss_rate : in Natural; cache_coherence_protocol : in Cache_Coherence_Protocol_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 number_of_block < 1 then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Number_Of_Block (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 1"))); end if; if (block_size < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Block_Size (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (associativity < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Associativity (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (hit_time < 0.0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Hit_Time (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (miss_time < 0.0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Miss_Time (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" >= 0"))); end if; if (hit_time < miss_time) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Hit_Time (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" < ") & Lb_Miss_Time (Current_Language))); end if; if (miss_rate > 100) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Cache (Current_Language) & " " & Name & " : " & Lb_Miss_Rate (Current_Language) & Lb_Must_Be (Current_Language) & To_Unbounded_String (" <= 100"))); 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; number_of_block : in Natural; block_size : in Natural; associativity : in Natural; cache_replacement : in Cache_Replacement_Type; hit_time : in Double; miss_time : in Double; miss_rate : in Natural; cache_coherence_protocol : in Cache_Coherence_Protocol_Type; cache_category : in Cache_Type) 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; begin check_initialize; Check_Cache(name, number_of_block, block_size, associativity, cache_replacement, hit_time, miss_time, miss_rate, cache_coherence_protocol, 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; 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; a_cache := new Generic_Cache; a_cache.name := name; a_cache.number_of_block := number_of_block; a_cache.block_size := block_size; a_cache.associativity := associativity; a_cache.cache_replacement := cache_replacement; a_cache.hit_time := hit_time; a_cache.miss_time := miss_time; a_cache.miss_rate := miss_rate; a_cache.cache_coherence_protocol := cache_coherence_protocol; a_cache.cache_category := new_cache_type; add (my_caches, a_cache); exception when 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; number_of_block : in Natural; block_size : in Natural; associativity : in Natural; cache_replacement : in Cache_Replacement_Type; hit_time : in Double; miss_time : in Double; miss_rate : in Natural; cache_coherence_protocol : in Cache_Coherence_Protocol_Type; cache_category : in Cache_Type) is a_cache : Generic_Cache_Ptr; begin Add_Cache(my_caches, a_cache, name, number_of_block, block_size, associativity, cache_replacement, hit_time, miss_time, miss_rate, cache_coherence_protocol, cache_category); end Add_Cache; procedure Update_Cache (my_caches : in out Caches_Set; name : in Unbounded_String; number_of_block : in Natural; block_size : in Natural; associativity : in Natural; cache_replacement : in Cache_Replacement_Type; hit_time : in Double; miss_time : in Double; miss_rate : in Natural; cache_coherence_protocol : in Cache_Coherence_Protocol_Type; cache_category : in Cache_Type) is the_cache : Generic_Cache_Ptr; begin the_cache := Search_Cache(my_caches,name); Check_cache(name, number_of_block, block_size, associativity, cache_replacement, hit_time, miss_time, miss_rate, cache_coherence_protocol, cache_category); Delete_Cache(my_caches,the_cache); Add_Cache(my_caches, name, number_of_block, block_size, associativity, cache_replacement, hit_time, miss_time, miss_rate, cache_coherence_protocol, cache_category); end Update_Cache; procedure Delete_Cache (my_caches : in out Caches_Set; a_cache : in out Generic_Cache_Ptr) is begin delete (my_caches, a_cache); end Delete_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_Cache(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 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; 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 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; 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;