------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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 primitive_xml_strings; use primitive_xml_strings; with Message_Set; use Message_Set; use Message_Set.Generic_Message_Set; with Buffer_Set; use Buffer_Set; use Buffer_Set.Generic_Buffer_Set; with Task_Set; use Task_Set; use Task_Set.Generic_Task_Set; with Resource_Set; use Resource_Set; use Resource_Set.Generic_Resource_Set; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with unbounded_strings; use unbounded_strings; with Framework_Config; use Framework_Config; with Simulations; use Simulations; with Simulations.extended; use Simulations.extended; with Text_IO; use Text_IO; with tables; with Ada.Finalization; with convert_strings; with convert_unbounded_strings; with objects; use objects; package Expressions is -- The data type does not match the expected type -- Type_Error : exception; -- Statement exception (such as unexpected statement) -- Statement_Error : exception; -- Exception raised when an error occurs -- on variable operations -- Variable_Error : exception; -- Syntax error detected -- Syntax_Error : exception; -- This exception is raised when a parametric file can not be read -- Parametric_File_Error : exception; -- This exception is raised wheh an exit statement is run -- Exit_Statement_Exception : exception; --------------------------------------------------------- -- Valid operator used to build expressions -- type Operator_Type is ( Plus_Type, Minus_Type, Divide_Type, Multiply_Type, Exponential_Type, Modulo_Type, Equal_Type, Not_Equal_Type, Equal_Less_Type, Equal_Greater_Type, Inferior_Type, Superior_Type, Logic_And_Type, Logic_Or_Type, Logic_Not_Type, Min_Operator_Type, Max_Operator_Type, Min_To_Index_Type, Max_To_Index_Type, Lcm_Type, Abs_Type, Get_Resource_Index_Type, Get_Task_Index_Type, Get_Message_Index_Type, Get_Buffer_Index_Type, Concatenate_Type); procedure To_Operator_Type is new convert_strings ( Operator_Type, Plus_Type); procedure To_Operator_Type is new convert_unbounded_strings ( Operator_Type, Plus_Type); package Operator_Type_Io is new Text_IO.Enumeration_IO (Operator_Type); use Operator_Type_Io; ----------------------------------------------------------- -- A predefinition of the variable type -- type Variable_Expression; type Variable_Expression_Ptr is access all Variable_Expression'Class; --------------------------------------------------------- -- Table to store the list of variables of -- a parametric scheduler. For each variable, -- the current simulation values are also stored -- type Variable_Record is record Variable : Variable_Expression_Ptr; Simulation : Simulation_Value_Ptr; end record; type Variable_Record_Ptr is access Variable_Record; procedure Put (V : in Variable_Record_Ptr); function XML_String (e : in Variable_Record_Ptr) return Unbounded_String; function XML_ref_String (e : in Variable_Record_Ptr) return Unbounded_String; package Variables_Type_Package is new tables ( Variable_Record_Ptr, Max_Variables, Put, XML_String, XML_ref_String); use Variables_Type_Package; subtype Variables_Range is Variables_Type_Package.table_range; subtype Variables_Table_Type is Variables_Type_Package.table; -- Looking for a variable in the variable table -- function Find_Variable (Var_Table : in Variables_Table_Type; S : in Unbounded_String; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Variables_Range; function Find_Variable (Var_Table : in Variables_Table_Type; S : in String; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Variables_Range; -- Check is a given variable is already defined in a -- variable table -- procedure Check_Variable_Declaration (Var_Table : in Variables_Table_Type; S : in Unbounded_String; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string); -- Load into the parametric simulator -- data from task, processor, message and buffer elements -- -- The number of object (tasks, resources, buffers) is initialized -- accordig to the correspondig processor (parameter processor_name) -- if processor_name is an empty string, all tasks/buffers/resources -- of all procesors are considered -- procedure Initialize_Parametric_Variables (Var_Table : in out Variables_Table_Type; My_Messages : in Messages_Set; My_Buffers : in Buffers_Set; My_Resources : in Resources_Set; My_Tasks : in Tasks_Set; Processor_Name : in Unbounded_String := empty_string); -- Add the parametric variable in a variable table -- procedure Create_Parametric_Variables (Variables_Table : in out Variables_Table_Type; My_Tasks : in Tasks_Set); --------------------------------------------------------- type Expressions_Type is ( Constant_Type, Variable_Type, Array_Variable_Type, Binary_Type, Unary_Type, Random_Type); procedure To_Expressions_Type is new convert_strings ( Expressions_Type, Constant_Type); procedure To_Expressions_Type is new convert_unbounded_strings ( Expressions_Type, Constant_Type); package Expressions_Type_io is new Text_IO.Enumeration_IO ( Expressions_Type); use Expressions_Type_io; type Generic_Expression is abstract new named_object with record Expression_Type : Expressions_Type; end record; type Generic_Expression_Ptr is access all Generic_Expression'Class; procedure Put (S : in Generic_Expression) is abstract; procedure Put (S : in Generic_Expression_Ptr) is abstract; function XML_String (obj : in Generic_Expression_Ptr) return Unbounded_String; function XML_String (obj : in Generic_Expression) return Unbounded_String; function XML_Ref_String (obj : in Generic_Expression_Ptr) return Unbounded_String; function XML_Ref_String (obj : in Generic_Expression) return Unbounded_String; procedure Put_Name (obj : in Generic_Expression_Ptr); function Get_Name (obj : in Generic_Expression) return Unbounded_String; function Get_Name (obj : in Generic_Expression_Ptr) return Unbounded_String; function To_Unbounded_String (C : Generic_Expression) return Unbounded_String is abstract; function Get_Type (C : Generic_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type is abstract; function Value_Of (C : in Generic_Expression; V : in Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is abstract; ------------------------------------------ type Constant_Expression is new Generic_Expression with record Value : Simulation_Value_Ptr; end record; type Constant_Expression_Ptr is access all Constant_Expression'Class; function XML_String (obj : in Constant_Expression_Ptr) return Unbounded_String; function XML_String (obj : in Constant_Expression) return Unbounded_String; function XML_Ref_String (obj : in Constant_Expression_Ptr) return Unbounded_String; function XML_Ref_String (obj : in Constant_Expression) return Unbounded_String; procedure Put (S : in Constant_Expression); procedure Put (S : in Constant_Expression_Ptr); procedure Put_Name (obj : in Constant_Expression_Ptr); function Get_Name (obj : in Constant_Expression) return Unbounded_String; function Get_Name (obj : in Constant_Expression_Ptr) return Unbounded_String; function To_Unbounded_String (C : Constant_Expression) return Unbounded_String; function Get_Type (C : Constant_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type; procedure Initialize (S : in out Constant_Expression); function Value_Of (C : in Constant_Expression; V : in Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr; ------------------------------------------ type Variable_Expression is new Generic_Expression with record -- Type of the variable (integer, boolean, ...) -- Variable_Type : Simulation_Type; end record; function XML_String (obj : in Variable_Expression_Ptr) return Unbounded_String; function XML_String (obj : in Variable_Expression) return Unbounded_String; function XML_Ref_String (obj : in Variable_Expression_Ptr) return Unbounded_String; function XML_Ref_String (obj : in Variable_Expression) return Unbounded_String; procedure Put (S : in Variable_Expression); procedure Put (S : in Variable_Expression_Ptr); procedure Put_Name (obj : in Variable_Expression_Ptr); function Get_Name (obj : in Variable_Expression) return Unbounded_String; function Get_Name (obj : in Variable_Expression_Ptr) return Unbounded_String; function To_Unbounded_String (C : Variable_Expression) return Unbounded_String; function Get_Type (C : Variable_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type; procedure Initialize (S : in out Variable_Expression); function Value_Of (C : in Variable_Expression; V : in Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr; ------------------------------------------ type Array_Variable_Expression is new Variable_Expression with record Array_Index : Generic_Expression_Ptr; end record; type Array_Variable_Expression_Ptr is access all Array_Variable_Expression' Class; function XML_String (obj : in Array_Variable_Expression_Ptr) return Unbounded_String; function XML_String (obj : in Array_Variable_Expression) return Unbounded_String; function XML_Ref_String (obj : in Array_Variable_Expression_Ptr) return Unbounded_String; function XML_Ref_String (obj : in Array_Variable_Expression) return Unbounded_String; procedure Put (S : in Array_Variable_Expression); procedure Put (S : in Array_Variable_Expression_Ptr); procedure Put_Name (obj : in Array_Variable_Expression_Ptr); function Get_Name (obj : in Array_Variable_Expression) return Unbounded_String; function Get_Name (obj : in Array_Variable_Expression_Ptr) return Unbounded_String; function To_Unbounded_String (C : Array_Variable_Expression) return Unbounded_String; procedure Initialize (S : in out Array_Variable_Expression); function Value_Of (C : in Array_Variable_Expression; V : in Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr; ------------------------------------------ type Binary_Expression is new Generic_Expression with record Ope : Operator_Type; Rvalue : Generic_Expression_Ptr; Lvalue : Generic_Expression_Ptr; end record; type Binary_Expression_Ptr is access all Binary_Expression'Class; function XML_String (obj : in Binary_Expression_Ptr) return Unbounded_String; function XML_String (obj : in Binary_Expression) return Unbounded_String; function XML_Ref_String (obj : in Binary_Expression_Ptr) return Unbounded_String; function XML_Ref_String (obj : in Binary_Expression) return Unbounded_String; procedure Put (S : in Binary_Expression); procedure Put (S : in Binary_Expression_Ptr); procedure Put_Name (obj : in Binary_Expression_Ptr); function Get_Name (obj : in Binary_Expression) return Unbounded_String; function Get_Name (obj : in Binary_Expression_Ptr) return Unbounded_String; function To_Unbounded_String (C : Binary_Expression) return Unbounded_String; function Get_Type (C : Binary_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type; procedure Initialize (S : in out Binary_Expression); function Value_Of (C : in Binary_Expression; V : in Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr; ------------------------------------------ type Unary_Expression is new Generic_Expression with record Ope : Operator_Type; Value : Generic_Expression_Ptr; end record; type Unary_Expression_Ptr is access all Unary_Expression'Class; function XML_String (obj : in unary_Expression_Ptr) return Unbounded_String; function XML_String (obj : in unary_Expression) return Unbounded_String; function XML_Ref_String (obj : in unary_Expression_Ptr) return Unbounded_String; function XML_Ref_String (obj : in unary_Expression) return Unbounded_String; procedure Put (S : in Unary_Expression); procedure Put (S : in Unary_Expression_Ptr); procedure Put_Name (obj : in Unary_Expression_Ptr); function Get_Name (obj : in Unary_Expression) return Unbounded_String; function Get_Name (obj : in Unary_Expression_Ptr) return Unbounded_String; function To_Unbounded_String (C : Unary_Expression) return Unbounded_String; function Get_Type (C : Unary_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type; procedure Initialize (S : in out Unary_Expression); function Value_Of (C : in Unary_Expression; V : in Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr; end Expressions;