------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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: 534 $ -- $Date: 2012-10-05 19:46:28 +0200 (Fri, 05 Oct 2012) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; with Ada.Exceptions; use Ada.Exceptions; with Ada.Numerics; use Ada.Numerics; with Translate; use Translate; with Time_Unit_Events; use Time_Unit_Events; with Qs_Tools; use Qs_Tools; with Ada.Numerics.Aux; use Ada.Numerics.Aux; with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; with Messages; use Messages; with Tasks; use Tasks; with Buffers; use Buffers; with Resources; use Resources; with Parameters; use Parameters; with Laws; use Laws; use Parameters.User_Defined_Parameters_Table_Package; with integer_util; package body Expressions is procedure Put_Name (obj : in Generic_Expression_Ptr) is begin null; end Put_Name; procedure Put_Name (obj : in Constant_Expression_Ptr) is begin null; end Put_Name; procedure Put_Name (obj : in Variable_Expression_Ptr) is begin null; end Put_Name; procedure Put_Name (obj : in Array_Variable_Expression_Ptr) is begin null; end Put_Name; procedure Put_Name (obj : in Binary_Expression_Ptr) is begin null; end Put_Name; procedure Put_Name (obj : in Unary_Expression_Ptr) is begin null; end Put_Name; function Get_Name (obj : in Generic_Expression) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Constant_Expression) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Variable_Expression) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Unary_Expression) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Binary_Expression) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Array_Variable_Expression) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Generic_Expression_Ptr) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Variable_Expression_Ptr) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Array_Variable_Expression_Ptr) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Unary_Expression_Ptr) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Constant_Expression_Ptr) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function Get_Name (obj : in Binary_Expression_Ptr) return Unbounded_String is begin return To_Unbounded_String (""); end Get_Name; function XML_String (e : in Variable_Record_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (e : in Variable_Record_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; procedure Put (V : in Variable_Record_Ptr) is begin Put (V.Variable); Put (V.Simulation); end Put; 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 is begin for I in 0 .. Var_Table.nb_entries - 1 loop if Var_Table.entries (I).Variable.Name = S then return I; end if; end loop; if (Line = 0) then Raise_Exception (Expressions.Syntax_Error'Identity, To_String (S & Lb_Comma & Lb_Undeclared_Identifier (Current_Language))); else Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & ", line " & Line'Img & To_String (Lb_Comma & S & Lb_Comma & Lb_Undeclared_Identifier (Current_Language))); end if; end Find_Variable; 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 is begin return Find_Variable (Var_Table, To_Unbounded_String (S), Line, File_Name); end Find_Variable; 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) is Dummy : constant Variables_Range := Find_Variable (Var_Table, S, Line, File_Name); begin null; end Check_Variable_Declaration; 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) is Var : Variables_Range; Index : Simulations_Range; A_Message : Generic_Message_Ptr; A_Message_Iterator : Messages_Iterator; A_Buffer : Buffer_Ptr; A_Buffer_Iterator : Buffers_Iterator; A_Task : Generic_Task_Ptr; A_Task_Iterator : Tasks_Iterator; A_Resource : Generic_Resource_Ptr; A_Resource_Iterator : Resources_Iterator; begin --------------------------------------------------------------- -- Set message variables --------------------------------------------------------------- -- "nb_messages" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("nb_messages")); Var_Table.entries (Var).Simulation.Integer_Value := Integer (get_number_of_elements (My_Messages)); if not is_empty (My_Messages) then reset_iterator (My_Messages, A_Message_Iterator); Index := 0; loop current_element (My_Messages, A_Message, A_Message_Iterator); -- "messages.name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Message.name; -- "messages.deadline" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.deadline")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Message.deadline); -- "messages.delay" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.delay")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Message.response_time); -- "messages.size" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.size")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Message.size); -- "messages.period" and "messages.jitter" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.period")); case A_Message.message_type is when Aperiodic_Type => Var_Table.entries (Var).Simulation.Integer_Table_Value ( Index) := 0; when others => Var_Table.entries (Var).Simulation.Integer_Table_Value ( Index) := Integer (Periodic_Message_Ptr (A_Message).period); end case; Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.jitter")); case A_Message.message_type is when Aperiodic_Type => Var_Table.entries (Var).Simulation.Integer_Table_Value ( Index) := 0; when others => Var_Table.entries (Var).Simulation.Integer_Table_Value ( Index) := Integer (Periodic_Message_Ptr (A_Message).jitter); end case; -- "messages.ready" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("messages.ready")); Var_Table.entries (Var).Simulation.Boolean_Table_Value (Index) := False; exit when is_last_element (My_Messages, A_Message_Iterator); next_element (My_Messages, A_Message_Iterator); Index := Index + 1; end loop; end if; --------------------------------------------------------------- -- Set buffer variables --------------------------------------------------------------- -- "nb_buffers" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("nb_buffers")); if Processor_Name = empty_string then Var_Table.entries (Var).Simulation.Integer_Value := Integer (get_number_of_elements (My_Buffers)); else Var_Table.entries (Var).Simulation.Integer_Value := Integer (Get_Number_Of_Buffer_From_Processor (My_Buffers, Processor_Name)); end if; if not is_empty (My_Buffers) then reset_iterator (My_Buffers, A_Buffer_Iterator); Index := 0; loop current_element (My_Buffers, A_Buffer, A_Buffer_Iterator); -- "buffers.processor_name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("buffers.processor_name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Buffer.cpu_name; -- "buffers.name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("buffers.name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Buffer.name; -- "buffers.max_size" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("buffers.max_size")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Buffer.size); exit when is_last_element (My_Buffers, A_Buffer_Iterator); next_element (My_Buffers, A_Buffer_Iterator); Index := Index + 1; end loop; end if; --------------------------------------------------------------- -- Set resource variables --------------------------------------------------------------- -- "nb_resources" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("nb_resources")); if Processor_Name = empty_string then Var_Table.entries (Var).Simulation.Integer_Value := Integer (get_number_of_elements (My_Resources)); else Var_Table.entries (Var).Simulation.Integer_Value := Integer (Get_Number_Of_Resource_From_Processor (My_Resources, Processor_Name)); end if; if not is_empty (My_Resources) then reset_iterator (My_Resources, A_Resource_Iterator); Index := 0; loop current_element (My_Resources, A_Resource, A_Resource_Iterator); -- "resources.name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("resources.name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Resource.name; -- "resources.initial_state" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("resources.initial_state")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := A_Resource.state; -- "resources.protocol" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("resources.protocol")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := To_Unbounded_String (A_Resource.protocol'Img); -- "resources.processor_name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("resources.processor_name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Resource.cpu_name; exit when is_last_element (My_Resources, A_Resource_Iterator); next_element (My_Resources, A_Resource_Iterator); Index := Index + 1; end loop; end if; --------------------------------------------------------------- -- Set task variables --------------------------------------------------------------- -- "nb_tasks" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("nb_tasks")); if Processor_Name = empty_string then Var_Table.entries (Var).Simulation.Integer_Value := Integer (get_number_of_elements (My_Tasks)); else Var_Table.entries (Var).Simulation.Integer_Value := Integer (Get_Number_Of_Task_From_Processor (My_Tasks, Processor_Name)); end if; reset_iterator (My_Tasks, A_Task_Iterator); Index := 0; loop current_element (My_Tasks, A_Task, A_Task_Iterator); -- "tasks.priority" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.priority")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Task.priority); -- "tasks.deadline" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.deadline")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Task.deadline); -- "tasks.start_time" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.start_time")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Task.start_time); -- "tasks.suspended" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.suspended")); Var_Table.entries (Var).Simulation.Boolean_Table_Value (Index) := False; -- "tasks.type" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.type")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := To_Unbounded_String (A_Task.task_type'Img); -- "tasks.processor_name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.processor_name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Task.cpu_name; -- "tasks.name" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.name")); Var_Table.entries (Var).Simulation.String_Table_Value (Index) := A_Task.name; -- "tasks.capacity" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.capacity")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Task.capacity); -- "tasks.blocking_time" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.blocking_time")); Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (A_Task.blocking_time); -- "tasks.period" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.period")); case A_Task.task_type is when Aperiodic_Type => Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := 0; when others => Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (Periodic_Task_Ptr (A_Task).period); end case; -- "tasks.jitter" -- Var := Find_Variable (Var_Table, To_Unbounded_String ("tasks.jitter")); case A_Task.task_type is when Aperiodic_Type => Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := 0; when others => Var_Table.entries (Var).Simulation.Integer_Table_Value (Index) := Integer (Periodic_Task_Ptr (A_Task).jitter); end case; -- user defined task's parameter : -- for I in 0 .. A_Task.parameters.nb_entries - 1 loop -- Find the user defined variable -- and set its value -- for J in 0 .. Var_Table.nb_entries - 1 loop if Var_Table.entries (J).Variable.Name = To_Unbounded_String ("tasks.") & A_Task.parameters.entries (I).name then -- Now, set the value -- if A_Task.parameters.entries (I).discriminant = Boolean_Parameter then Var_Table.entries (J).Simulation.Boolean_Table_Value ( Index) := Boolean (A_Task.parameters.entries (I).boolean_value); end if; if A_Task.parameters.entries (I).discriminant = Integer_Parameter then Var_Table.entries (J).Simulation.Integer_Table_Value ( Index) := Integer (A_Task.parameters.entries (I).integer_value); end if; if A_Task.parameters.entries (I).discriminant = Double_Parameter then Var_Table.entries (J).Simulation.Double_Table_Value ( Index) := Double (A_Task.parameters.entries (I).double_value); end if; if A_Task.parameters.entries (I).discriminant = String_Parameter then Var_Table.entries (J).Simulation.String_Table_Value ( Index) := A_Task.parameters.entries (I).string_value; end if; end if; end loop; end loop; exit when is_last_element (My_Tasks, A_Task_Iterator); next_element (My_Tasks, A_Task_Iterator); Index := Index + 1; end loop; end Initialize_Parametric_Variables; procedure Create_Parametric_Variables (Variables_Table : in out Variables_Table_Type; My_Tasks : in Tasks_Set) is New_Var : Variable_Record_Ptr; New_Expr_Array : Array_Variable_Expression_Ptr; New_Expr_Variable : Variable_Expression_Ptr; Do_Insert : Boolean; A_Task : Generic_Task_Ptr; Iterator : Tasks_Iterator; begin initialize (Variables_Table); ------------------------------------------------------ -- common variables ------------------------------------------------------ -- "previously_elected" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("previously_elected"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_tasks" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_tasks"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_processors" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_processors"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_messages" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_messages"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_buffers" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_buffers"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_resources" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_resources"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_address_spaces" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_address_spaces"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "nb_time_units" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("nb_time_units"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "simulation_time" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("simulation_time"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "simulation_length" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("simulation_length"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); ------------------------------------------------------ -- Buffer variables ------------------------------------------------------ -- "buffers.name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("buffers.name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "buffers.max_size" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("buffers.max_size"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "buffers.processor_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("buffers.processor_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "buffers.users.time" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("buffers.users.time"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "buffers.users.size" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("buffers.users.size"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "buffers.users.task_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("buffers.users.task_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); ------------------------------------------------------ -- Message variables ------------------------------------------------------ -- "messages.jitter" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("messages.jitter"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.delay" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("messages.delay"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("messages.name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.deadline" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("messages.deadline"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.period" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("messages.period"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.ready" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Boolean; New_Expr_Variable.Name := To_Unbounded_String ("messages.ready"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.size" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("messages.size"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.users.time" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("messages.users.time"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.users.type" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("messages.users.type"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "messages.users.task_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("messages.users.task_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); ------------------------------------------------------ -- Event variables ------------------------------------------------------ -- "events.time" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Integer; New_Expr_Variable.Name := To_Unbounded_String ("events.time"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "events.processor_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_String; New_Expr_Variable.Name := To_Unbounded_String ("events.processor_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "events.type" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_String; New_Expr_Variable.Name := To_Unbounded_String ("events.type"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "events.task_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_String; New_Expr_Variable.Name := To_Unbounded_String ("events.task_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "events.buffer_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_String; New_Expr_Variable.Name := To_Unbounded_String ("events.buffer_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "events.resource_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_String; New_Expr_Variable.Name := To_Unbounded_String ("events.resource_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "events.message_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_String; New_Expr_Variable.Name := To_Unbounded_String ("events.message_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); ------------------------------------------------------ -- Resource variables ------------------------------------------------------ -- "resources.initial_state" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("resources.initial_state"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.processor_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("resources.processor_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.protocol" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("resources.protocol"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("resources.name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.current_state" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("resources.current_state"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.users.task_name" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_String; New_Expr_Variable.Name := To_Unbounded_String ("resources.users.task_name"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.users.start_time" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("resources.users.start_time"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); -- "resources.users.end_time" -- New_Var := new Variable_Record; New_Expr_Variable := new Array_Variable_Expression; New_Expr_Variable.Variable_Type := Simulation_Array_Integer; New_Expr_Variable.Name := To_Unbounded_String ("resources.users.end_time"); New_Var.Variable := New_Expr_Variable; add (Variables_Table, New_Var); ------------------------------------------------------ -- Task variables ------------------------------------------------------ -- "tasks.priority" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.priority"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.deadline" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.deadline"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.start_time" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.start_time"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.capacity" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.capacity"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.rest_of_capacity" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.rest_of_capacity"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.used_capacity" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.used_capacity"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.activation_number" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.activation_number"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.wakeup_time" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.wakeup_time"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.used_cpu" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.used_cpu"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.period" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.period"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.ready" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Boolean; New_Expr_Array.Name := To_Unbounded_String ("tasks.ready"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.suspended" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Boolean; New_Expr_Array.Name := To_Unbounded_String ("tasks.suspended"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.type" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_String; New_Expr_Array.Name := To_Unbounded_String ("tasks.type"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.processor_name" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_String; New_Expr_Array.Name := To_Unbounded_String ("tasks.processor_name"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.blocking_time" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.blocking_time"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.name" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_String; New_Expr_Array.Name := To_Unbounded_String ("tasks.name"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- "tasks.jitter" -- New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; New_Expr_Array.Variable_Type := Simulation_Array_Integer; New_Expr_Array.Name := To_Unbounded_String ("tasks.jitter"); New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); -- Task's user defined parameters -- -- Find user defined parameters : scan all task -- Variables and add them -- if not is_empty (My_Tasks) then reset_iterator (My_Tasks, Iterator); loop current_element (My_Tasks, A_Task, Iterator); for I in 0 .. A_Task.parameters.nb_entries - 1 loop -- Is the Variable already exists ? -- Do_Insert := True; for J in 0 .. Variables_Table.nb_entries - 1 loop if Variables_Table.entries (J).Variable.Name = To_Unbounded_String ("tasks.") & A_Task.parameters.entries (I).name then Do_Insert := False; end if; end loop; if Do_Insert then New_Var := new Variable_Record; New_Expr_Array := new Array_Variable_Expression; if A_Task.parameters.entries (I).discriminant = Integer_Parameter then New_Expr_Array.Variable_Type := Simulation_Array_Integer; end if; if A_Task.parameters.entries (I).discriminant = Double_Parameter then New_Expr_Array.Variable_Type := Simulation_Array_Double; end if; if A_Task.parameters.entries (I).discriminant = Boolean_Parameter then New_Expr_Array.Variable_Type := Simulation_Array_Boolean; end if; if A_Task.parameters.entries (I).discriminant = String_Parameter then New_Expr_Array.Variable_Type := Simulation_Array_String; end if; New_Expr_Array.Name := To_Unbounded_String ("tasks.") & A_Task.parameters.entries (I).name; New_Var.Variable := Variable_Expression_Ptr (New_Expr_Array); add (Variables_Table, New_Var); end if; end loop; exit when is_last_element (My_Tasks, Iterator); next_element (My_Tasks, Iterator); end loop; end if; --------------------------------------------------------------- -- Initialize simulation data : provide initial values for -- all variables --------------------------------------------------------------- -- Allocate simulation data -- for I in 0 .. Variables_Table.nb_entries - 1 loop Variables_Table.entries (I).Simulation := new Simulation_Value (Variable_Expression_Ptr (Variables_Table.entries (I).Variable). Variable_Type); end loop; end Create_Parametric_Variables; -------------------------------------------------- procedure Put (S : in Constant_Expression) is begin Put (To_Unbounded_String (S)); end Put; procedure Put (S : in Constant_Expression_Ptr) is begin Put (To_Unbounded_String (S.all)); end Put; procedure Put (S : in Variable_Expression) is begin Put (S.Name); Put ("/"); Put (S.Variable_Type'Img); end Put; procedure Put (S : in Variable_Expression_Ptr) is begin Put (S.all); end Put; procedure Put (S : in Array_Variable_Expression) is begin Put (S.Name); Put ("/"); Put (S.Variable_Type'Img); if (S.Array_Index /= null) then Put (S.Array_Index.all); end if; end Put; procedure Put (S : in Array_Variable_Expression_Ptr) is begin Put (S.all); end Put; procedure Put (S : in Binary_Expression) is begin if (S.Lvalue /= null) then Put (S.Lvalue.all); end if; Put (S.Ope); if (S.Rvalue /= null) then Put (S.Rvalue.all); end if; end Put; procedure Put (S : in Binary_Expression_Ptr) is begin Put (S.all); end Put; procedure Put (S : in Unary_Expression) is begin Put (To_Unbounded_String (S)); end Put; procedure Put (S : in Unary_Expression_Ptr) is begin Put (To_Unbounded_String (S.all)); end Put; -------------------------------------------------- function XML_String (obj : in generic_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_String (obj : in generic_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (obj : in generic_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_ref_String (obj : in generic_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_String (obj : in constant_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_String (obj : in constant_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (obj : in constant_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_ref_String (obj : in constant_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_String (obj : in unary_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_String (obj : in unary_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (obj : in unary_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_ref_String (obj : in unary_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_String (obj : in binary_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_String (obj : in binary_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (obj : in binary_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_ref_String (obj : in binary_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_String (obj : in Variable_Expression; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_String (obj : in Variable_Expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (obj : in Variable_Expression; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_ref_String (obj : in Variable_Expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_String (obj : in Array_Variable_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_String (obj : in Array_Variable_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_string_error; return to_unbounded_string(""); end XML_String; function XML_ref_String (obj : in Array_Variable_expression; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; function XML_ref_String (obj : in Array_Variable_expression_Ptr; level : in Natural := 0) return Unbounded_String is begin raise xml_ref_string_error; return to_unbounded_string(""); end XML_ref_String; ------------------------------------------------------ procedure Initialize (S : in out Constant_Expression) is begin S.Expression_Type := Constant_Type; end Initialize; procedure Initialize (S : in out Variable_Expression) is begin S.Expression_Type := Variable_Type; end Initialize; procedure Initialize (S : in out Array_Variable_Expression) is begin S.Expression_Type := Array_Variable_Type; end Initialize; procedure Initialize (S : in out Binary_Expression) is begin S.Expression_Type := Binary_Type; end Initialize; procedure Initialize (S : in out Unary_Expression) is begin S.Expression_Type := Unary_Type; end Initialize; --------------------------------------------------------------- function To_Unbounded_String (C : Constant_Expression) return Unbounded_String is begin return To_Unbounded_String (C.Value); end To_Unbounded_String; function To_Unbounded_String (C : Variable_Expression) return Unbounded_String is begin return C.Name; end To_Unbounded_String; function To_Unbounded_String (C : Array_Variable_Expression) return Unbounded_String is begin return C.Name; end To_Unbounded_String; function To_Unbounded_String (C : Binary_Expression) return Unbounded_String is Result : Unbounded_String := empty_string; begin case C.Ope is when Minus_Type => Result := Result & "-("; when Plus_Type => Result := Result & "+("; when Multiply_Type => Result := Result & "*("; when Divide_Type => Result := Result & "/("; when Equal_Type => Result := Result & "=("; when Not_Equal_Type => Result := Result & "/=("; when Equal_Less_Type => Result := Result & "<=("; when Equal_Greater_Type => Result := Result & ">=("; when Inferior_Type => Result := Result & "<("; when Superior_Type => Result := Result & ">("; when Logic_And_Type => Result := Result & "and("; when Logic_Or_Type => Result := Result & "or("; when Max_Operator_Type => Result := Result & "max("; when Min_Operator_Type => Result := Result & "min("; when Lcm_Type => Result := Result & "lcm("; when Concatenate_Type => Result := Result & "&("; when Exponential_Type => Result := Result & "**("; when Modulo_Type => null; when Logic_Not_Type => null; when Min_To_Index_Type => null; when Max_To_Index_Type => null; when Abs_Type => null; when Get_Resource_Index_Type => null; when Get_Task_Index_Type => null; when Get_Message_Index_Type => null; when Get_Buffer_Index_Type => null; end case; Result := Result & To_Unbounded_String (C.Lvalue.all); Result := Result & ","; Result := Result & To_Unbounded_String (C.Rvalue.all); Result := Result & ")"; return Result; end To_Unbounded_String; function To_Unbounded_String (C : Unary_Expression) return Unbounded_String is Result : Unbounded_String := empty_string; begin case C.Ope is when Minus_Type => null; when Plus_Type => null; when Multiply_Type => null; when Divide_Type => null; when Equal_Type => null; when Not_Equal_Type => null; when Equal_Less_Type => null; when Equal_Greater_Type => null; when Inferior_Type => null; when Superior_Type => null; when Logic_And_Type => null; when Logic_Or_Type => null; when Max_Operator_Type => null; when Min_Operator_Type => null; when Concatenate_Type => null; when Exponential_Type => null; when Lcm_Type => null; when Modulo_Type => Result := Result & "mod("; when Logic_Not_Type => Result := Result & "not("; when Min_To_Index_Type => Result := Result & "min_to_index("; when Max_To_Index_Type => Result := Result & "max_to_index("; when Abs_Type => Result := Result & "abs("; when Get_Resource_Index_Type => Result := Result & "get_resource_index("; when Get_Task_Index_Type => Result := Result & "get_task_index("; when Get_Message_Index_Type => Result := Result & "get_message_index("; when Get_Buffer_Index_Type => Result := Result & "get_buffer_index("; end case; Result := Result & To_Unbounded_String (C.Value.all); Result := Result & ")"; return Result; end To_Unbounded_String; --------------------------------------------------------------- function Get_Type (C : Constant_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type is begin return C.Value.Ptype; end Get_Type; function Get_Type (C : Variable_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type is begin return C.Variable_Type; end Get_Type; function Get_Type (C : Binary_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type is A : constant Simulation_Type := Get_Type (C.Rvalue.all); B : constant Simulation_Type := Get_Type (C.Lvalue.all); begin if not has_compatible_type (A, B) then Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (A'Img) & Lb_Comma & To_Unbounded_String (B'Img))); end if; return A; end Get_Type; function Get_Type (C : Unary_Expression; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Type is begin -- For Get_Task_Index, Get_Buffer_Index ... -- the return value of the operation has a different type than its --argument -- if (C.Ope = Get_Resource_Index_Type) or (C.Ope = Get_Task_Index_Type) or (C.Ope = Get_Message_Index_Type) or (C.Ope = Get_Buffer_Index_Type) then return (Simulation_Integer); else return Get_Type (C.Value.all); end if; end Get_Type; ------------------------------------------------------------------------- function Apply_Random_Operator (Seed : in Generator; Parameters : in Random_Law_Parameters_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer; function Apply_Operator (Lvalue : Integer; Rvalue : Integer; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer; function Apply_Operator (Lvalue : Double; Rvalue : Double; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Double; function Apply_Operator (Lvalue : Double; Rvalue : Double; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean; function Apply_Operator (Lvalue : Unbounded_String; Rvalue : Unbounded_String; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Unbounded_String; function Apply_Operator (Lvalue : Unbounded_String; Rvalue : Unbounded_String; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean; function Apply_Operator (Lvalue : Integer; Rvalue : Integer; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean; function Apply_Operator (Lvalue : Boolean; Rvalue : Boolean; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean; function Compute_Binary_Value (Lvalue : Simulation_Value_Ptr; Rvalue : Simulation_Value_Ptr; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr; function Apply_Operator (Value : Boolean; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean; function Apply_Operator (Value : Integer; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer; function Apply_Operator (Value : Double; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Double; function Apply_Operator (Value : Unbounded_String; V : Variables_Table_Type; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer; function Apply_Random_Operator (Seed : in Generator; Parameters : in Random_Law_Parameters_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer is Temp : Double := 0.0; Temp2 : Double := 0.0; Value : Integer; W : Double := 1.0; Convergence : Boolean := False; begin case Parameters.Law is when Exponential_Law_Type => Value := Integer (Get_Exponential_Time (Double (Parameters.Parameter1), Seed)); when Uniform_Law_Type => Temp := Double (Parameters.Parameter2 - Parameters.Parameter1); Value := Integer (Double (Parameters.Parameter1) + Double (Random (Seed)) * Temp); when Laplace_Gauss_Law_Type => while (Convergence = False) loop Temp := Double (Random (Seed)) * 2.0 - 1.0; Temp2 := Double (Random (Seed)) * 2.0 - 1.0; W := Temp ** 2 + Temp2 ** 2; if (W < 1.0) then Convergence := True; end if; end loop; W := Sqrt (-2.0 * Log (W) * Double (Parameters.Parameter2) / W); Value := Integer (Temp * W + Double (Parameters.Parameter1)); end case; return Value; end Apply_Random_Operator; function Apply_Operator (Lvalue : Integer; Rvalue : Integer; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer is begin if Ope = Min_Operator_Type then if Lvalue < Rvalue then return Lvalue; else return Rvalue; end if; end if; if Ope = Max_Operator_Type then if Lvalue > Rvalue then return Lvalue; else return Rvalue; end if; end if; if Ope = Lcm_Type then return integer_util.lcm (Lvalue, Rvalue); end if; if Ope = Plus_Type then return Lvalue + Rvalue; end if; if Ope = Minus_Type then return Lvalue - Rvalue; end if; if Ope = Multiply_Type then return Lvalue * Rvalue; end if; if Ope = Divide_Type then return Lvalue / Rvalue; end if; if Ope = Modulo_Type then return Lvalue mod Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Lvalue'Img) & Lb_Comma & To_Unbounded_String (Rvalue'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); -- Arithmetic exception : return 0 in any cases -- to avoid stopping the application -- exception when others => return 0; end Apply_Operator; function Apply_Operator (Lvalue : Double; Rvalue : Double; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Double is begin if Ope = Min_Operator_Type then if Lvalue < Rvalue then return Lvalue; else return Rvalue; end if; end if; if Ope = Max_Operator_Type then if Lvalue > Rvalue then return Lvalue; else return Rvalue; end if; end if; if Ope = Lcm_Type then return Double (integer_util.lcm (Integer (Lvalue), Integer (Rvalue))); end if; if Ope = Plus_Type then return Lvalue + Rvalue; end if; if Ope = Minus_Type then return Lvalue - Rvalue; end if; if Ope = Multiply_Type then return Lvalue * Rvalue; end if; if Ope = Divide_Type then return Lvalue / Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Lvalue'Img) & Lb_Comma & To_Unbounded_String (Rvalue'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); -- Arithmetic exception : return 0 in any cases -- to avoid stopping the application -- exception when others => return 0.0; end Apply_Operator; function Apply_Operator (Lvalue : Double; Rvalue : Double; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean is begin if Ope = Equal_Type then return Lvalue = Rvalue; end if; if Ope = Not_Equal_Type then return Lvalue /= Rvalue; end if; if Ope = Equal_Less_Type then return Lvalue <= Rvalue; end if; if Ope = Equal_Greater_Type then return Lvalue >= Rvalue; end if; if Ope = Inferior_Type then return Lvalue < Rvalue; end if; if Ope = Superior_Type then return Lvalue > Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Lvalue'Img) & Lb_Comma & To_Unbounded_String (Rvalue'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Lvalue : Unbounded_String; Rvalue : Unbounded_String; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Unbounded_String is begin if Ope = Concatenate_Type then return Lvalue & Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & Lvalue & Lb_Comma & Rvalue & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Lvalue : Unbounded_String; Rvalue : Unbounded_String; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean is begin if Ope = Equal_Type then return Lvalue = Rvalue; end if; if Ope = Not_Equal_Type then return Lvalue /= Rvalue; end if; if Ope = Equal_Less_Type then return Lvalue <= Rvalue; end if; if Ope = Equal_Greater_Type then return Lvalue >= Rvalue; end if; if Ope = Inferior_Type then return Lvalue < Rvalue; end if; if Ope = Superior_Type then return Lvalue > Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & Lvalue & Lb_Comma & Rvalue & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Lvalue : Integer; Rvalue : Integer; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean is begin if Ope = Equal_Type then return Lvalue = Rvalue; end if; if Ope = Not_Equal_Type then return Lvalue /= Rvalue; end if; if Ope = Equal_Less_Type then return Lvalue <= Rvalue; end if; if Ope = Equal_Greater_Type then return Lvalue >= Rvalue; end if; if Ope = Inferior_Type then return Lvalue < Rvalue; end if; if Ope = Superior_Type then return Lvalue > Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Lvalue'Img) & Lb_Comma & To_Unbounded_String (Rvalue'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Lvalue : Boolean; Rvalue : Boolean; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean is begin if Ope = Equal_Type then return Lvalue = Rvalue; end if; if Ope = Not_Equal_Type then return Lvalue /= Rvalue; end if; if Ope = Equal_Less_Type then return Lvalue <= Rvalue; end if; if Ope = Equal_Greater_Type then return Lvalue >= Rvalue; end if; if Ope = Inferior_Type then return Lvalue < Rvalue; end if; if Ope = Superior_Type then return Lvalue > Rvalue; end if; if Ope = Logic_And_Type then return Lvalue and Rvalue; end if; if Ope = Logic_Or_Type then return Lvalue or Rvalue; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Lvalue'Img) & Lb_Comma & To_Unbounded_String (Rvalue'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Compute_Binary_Value (Lvalue : Simulation_Value_Ptr; Rvalue : Simulation_Value_Ptr; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is Res : Simulation_Value_Ptr; begin case Lvalue.Ptype is -- Nothing to compute in the cases of random type -- because value_of functions already do the job -- by returning integer values -- when Simulation_Random => null; when Simulation_Array_Random => null; when Simulation_Integer | Simulation_clock => if (Rvalue.Ptype = Simulation_Integer) or (Rvalue.Ptype = Simulation_clock) then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Boolean); Res.Boolean_Value := Apply_Operator (Lvalue.Integer_Value, Rvalue.Integer_Value, Ope, Line, File_Name); else Res := new Simulation_Value (Simulation_Integer); Res.Integer_Value := Apply_Operator (Lvalue.Integer_Value, Rvalue.Integer_Value, Ope, Line, File_Name); end if; else if (Rvalue.Ptype = Simulation_Array_Integer) or (Rvalue.Ptype = Simulation_array_clock) then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Array_Boolean); else Res := new Simulation_Value (Simulation_Array_Integer); end if; for I in Simulations_Range loop if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.Integer_Table_Value (I) := Apply_Operator (Lvalue.Integer_Value, Rvalue.Integer_Table_Value (I), Ope, Line, File_Name); end if; end loop; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); else Res := new Simulation_Value (Simulation_Time_Unit_Array_Integer); end if; for I in Time_Unit_Range loop if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.Integer_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Integer_Value, Rvalue.Integer_Time_Unit_Table_Value (I), Ope, Line, File_Name); end if; end loop; end if; end if; when Simulation_String => if Rvalue.Ptype = Simulation_String then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Boolean); Res.Boolean_Value := Apply_Operator (Lvalue.String_Value, Rvalue.String_Value, Ope, Line, File_Name); else Res := new Simulation_Value (Simulation_String); Res.String_Value := Apply_Operator (Lvalue.String_Value, Rvalue.String_Value, Ope, Line, File_Name); end if; else if Rvalue.Ptype = Simulation_Array_String then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Array_Boolean); else Res := new Simulation_Value (Simulation_Array_String); end if; for I in Simulations_Range loop if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.String_Table_Value (I) := Apply_Operator (Lvalue.String_Value, Rvalue.String_Table_Value (I), Ope, Line, File_Name); end if; end loop; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); else Res := new Simulation_Value (Simulation_Time_Unit_Array_String); end if; for I in Time_Unit_Range loop if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.String_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.String_Value, Rvalue.String_Time_Unit_Table_Value (I), Ope, Line, File_Name); end if; end loop; end if; end if; when Simulation_Double => if Rvalue.Ptype = Simulation_Double then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Boolean); Res.Boolean_Value := Apply_Operator (Lvalue.Double_Value, Rvalue.Double_Value, Ope, Line, File_Name); else Res := new Simulation_Value (Simulation_Double); Res.Double_Value := Apply_Operator (Lvalue.Double_Value, Rvalue.Double_Value, Ope, Line, File_Name); end if; else if Rvalue.Ptype = Simulation_Array_Double then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Array_Boolean); else Res := new Simulation_Value (Simulation_Array_Double); end if; for I in Simulations_Range loop if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.Double_Table_Value (I) := Apply_Operator (Lvalue.Double_Value, Rvalue.Double_Table_Value (I), Ope, Line, File_Name); end if; end loop; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); else Res := new Simulation_Value (Simulation_Time_Unit_Array_Double); end if; for I in Time_Unit_Range loop if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.Double_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Double_Value, Rvalue.Double_Time_Unit_Table_Value (I), Ope, Line, File_Name); end if; end loop; end if; end if; when Simulation_Boolean => if Rvalue.Ptype = Simulation_Boolean then Res := new Simulation_Value (Simulation_Boolean); Res.Boolean_Value := Apply_Operator (Lvalue.Boolean_Value, Rvalue.Boolean_Value, Ope, Line, File_Name); else if Rvalue.Ptype = Simulation_Array_Boolean then Res := new Simulation_Value (Simulation_Array_Boolean); for I in Simulations_Range loop Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); end loop; else Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); for I in Time_Unit_Range loop Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Value, Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); end loop; end if; end if; when Simulation_Array_Integer | Simulation_array_clock => if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Array_Boolean); else Res := new Simulation_Value (Simulation_Array_Integer); end if; for I in Simulations_Range loop if (Rvalue.Ptype = Simulation_array_clock) or (Rvalue.Ptype = Simulation_Array_Integer) then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.Integer_Table_Value (I) := Apply_Operator (Lvalue.Integer_Table_Value (I), Rvalue.Integer_Table_Value (I), Ope, Line, File_Name); end if; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); else Res.Integer_Table_Value (I) := Apply_Operator (Lvalue.Integer_Table_Value (I), Rvalue.Integer_Value, Ope, Line, File_Name); end if; end if; end loop; when Simulation_Array_Double => if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Array_Boolean); else Res := new Simulation_Value (Simulation_Array_Double); end if; for I in Simulations_Range loop if Rvalue.Ptype = Simulation_Array_Double then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.Double_Table_Value (I) := Apply_Operator (Lvalue.Double_Table_Value (I), Rvalue.Double_Table_Value (I), Ope, Line, File_Name); end if; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); else Res.Double_Table_Value (I) := Apply_Operator (Lvalue.Double_Table_Value (I), Rvalue.Double_Value, Ope, Line, File_Name); end if; end if; end loop; when Simulation_Array_String => if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Array_Boolean); else Res := new Simulation_Value (Simulation_Array_String); end if; for I in Simulations_Range loop if Rvalue.Ptype = Simulation_Array_String then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.String_Table_Value (I) := Apply_Operator (Lvalue.String_Table_Value (I), Rvalue.String_Table_Value (I), Ope, Line, File_Name); end if; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); else Res.String_Table_Value (I) := Apply_Operator (Lvalue.String_Table_Value (I), Rvalue.String_Value, Ope, Line, File_Name); end if; end if; end loop; when Simulation_Array_Boolean => Res := new Simulation_Value (Simulation_Array_Boolean); for I in Simulations_Range loop if Rvalue.Ptype = Simulation_Array_Boolean then Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Table_Value (I), Ope, Line, File_Name); else Res.Boolean_Table_Value (I) := Apply_Operator (Lvalue.Boolean_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); end if; end loop; when Simulation_Time_Unit_Array_Integer => if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); else Res := new Simulation_Value (Simulation_Time_Unit_Array_Integer); end if; for I in Time_Unit_Range loop if Rvalue.Ptype = Simulation_Time_Unit_Array_Integer then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.Integer_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Integer_Time_Unit_Table_Value (I), Rvalue.Integer_Time_Unit_Table_Value (I), Ope, Line, File_Name); end if; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); else Res.Integer_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Integer_Time_Unit_Table_Value (I), Rvalue.Integer_Value, Ope, Line, File_Name); end if; end if; end loop; when Simulation_Time_Unit_Array_Double => if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); else Res := new Simulation_Value (Simulation_Time_Unit_Array_Double); end if; for I in Time_Unit_Range loop if Rvalue.Ptype = Simulation_Time_Unit_Array_Double then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.Double_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Double_Time_Unit_Table_Value (I), Rvalue.Double_Time_Unit_Table_Value (I), Ope, Line, File_Name); end if; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); else Res.Double_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.Double_Time_Unit_Table_Value (I), Rvalue.Double_Value, Ope, Line, File_Name); end if; end if; end loop; when Simulation_Time_Unit_Array_Boolean => Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); for I in Time_Unit_Range loop if Rvalue.Ptype = Simulation_Time_Unit_Array_Boolean then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); end if; end loop; when Simulation_Time_Unit_Array_String => if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); else Res := new Simulation_Value (Simulation_Time_Unit_Array_String); end if; for I in Time_Unit_Range loop if Rvalue.Ptype = Simulation_Time_Unit_Array_String then if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.boolean_Time_Unit_Table_Value (I), Ope, Line, File_Name); else Res.String_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.String_Time_Unit_Table_Value (I), Rvalue.String_Time_Unit_Table_Value (I), Ope, Line, File_Name); end if; else if (Ope = Equal_Type) or (Ope = Not_Equal_Type) or (Ope = Equal_Less_Type) or (Ope = Equal_Greater_Type) or (Ope = Inferior_Type) or (Ope = Superior_Type) then Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.boolean_Time_Unit_Table_Value (I), Rvalue.Boolean_Value, Ope, Line, File_Name); else Res.String_Time_Unit_Table_Value (I) := Apply_Operator (Lvalue.String_Time_Unit_Table_Value (I), Rvalue.String_Value, Ope, Line, File_Name); end if; end if; end loop; end case; return Res; end Compute_Binary_Value; function Apply_Operator (Value : Boolean; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Boolean is begin if Ope = Logic_Not_Type then return not Value; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Value'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Value : Integer; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer is begin if Ope = Abs_Type then return abs Value; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Value'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Value : Double; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Double is begin if Ope = Abs_Type then return abs Value; end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Value'Img) & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; function Apply_Operator (Value : Unbounded_String; V : Variables_Table_Type; Ope : Operator_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Integer is Var : Variables_Range; begin if Ope = Get_Task_Index_Type then Var := Find_Variable (V, To_Unbounded_String ("tasks.name")); for I in String_Table'Range loop if V.entries (Var).Simulation.String_Table_Value (I) = Value then return Integer (I); end if; end loop; Raise_Exception (Statement_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Task_Not_Found (Current_Language) & Lb_Colon & Value & Lb_Comma & To_Unbounded_String (Ope'Img))); end if; if Ope = Get_Buffer_Index_Type then Var := Find_Variable (V, To_Unbounded_String ("buffers.name")); for I in String_Table'Range loop if V.entries (Var).Simulation.String_Table_Value (I) = Value then return Integer (I); end if; end loop; Raise_Exception (Statement_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Buffer_Not_Found (Current_Language) & Lb_Colon & Value & Lb_Comma & To_Unbounded_String (Ope'Img))); end if; if Ope = Get_Message_Index_Type then Var := Find_Variable (V, To_Unbounded_String ("messages.name")); for I in String_Table'Range loop if V.entries (Var).Simulation.String_Table_Value (I) = Value then return Integer (I); end if; end loop; Raise_Exception (Statement_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Message_Not_Found (Current_Language) & Lb_Colon & Value & Lb_Comma & To_Unbounded_String (Ope'Img))); end if; if Ope = Get_Resource_Index_Type then Var := Find_Variable (V, To_Unbounded_String ("resources.name")); for I in String_Table'Range loop if V.entries (Var).Simulation.String_Table_Value (I) = Value then return Integer (I); end if; end loop; Raise_Exception (Statement_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Resource_Not_Found (Current_Language) & Lb_Colon & Value & Lb_Comma & To_Unbounded_String (Ope'Img))); end if; Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & Value & Lb_Comma & To_Unbounded_String (Ope'Img))); end Apply_Operator; --------------------------------------------------------- function Value_Of (C : Binary_Expression; V : Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is Res, Lvalue, Rvalue : Simulation_Value_Ptr; begin Lvalue := Value_Of (C.Lvalue.all, V, Line, File_Name); Rvalue := Value_Of (C.Rvalue.all, V, Line, File_Name); -- First case : it's a logical expression : the two values -- have to have the same type and the same size -- -- Second case : the expression is an arithmetic statement. In -- this case, we are less strict : some expression can be composed -- of data with different types (types are then compatible) -- -- Last case : type are not compatible, it's an error ! -- -- First case : it's a logical expression : the two values -- have to have the same type and the same size -- if (Rvalue.Ptype /= Lvalue.Ptype) and ((C.Ope = Equal_Type) or (C.Ope = Not_Equal_Type) or (C.Ope = Equal_Less_Type) or (C.Ope = Equal_Greater_Type) or (C.Ope = Logic_And_Type) or (C.Ope = Logic_Or_Type) or (C.Ope = Logic_Not_Type) or (C.Ope = Inferior_Type) or (C.Ope = Superior_Type)) then Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (C.Lvalue.all) & Lb_Comma & To_Unbounded_String (C.Rvalue.all))); end if; -- Second case : the expression is an arithmetic statement. In -- this case, we are less strict : some expression can be composed -- of data with different types (types are then compatible) -- if ((Rvalue.Ptype = Lvalue.Ptype) or ((Lvalue.Ptype = Simulation_Array_Integer) and (Rvalue.Ptype = Simulation_Integer)) or ((Lvalue.Ptype = Simulation_array_clock) and (Rvalue.Ptype = Simulation_clock)) or ((Lvalue.Ptype = Simulation_array_clock) and (Rvalue.Ptype = Simulation_Integer)) or ((Lvalue.Ptype = Simulation_Array_Double) and (Rvalue.Ptype = Simulation_Double)) or ((Lvalue.Ptype = Simulation_Array_Boolean) and (Rvalue.Ptype = Simulation_Boolean)) or ((Lvalue.Ptype = Simulation_Array_String) and (Rvalue.Ptype = Simulation_String)) or ((Lvalue.Ptype = Simulation_Integer) and (Rvalue.Ptype = Simulation_clock)) or ((Lvalue.Ptype = Simulation_clock) and (Rvalue.Ptype = Simulation_Integer)) or ((Lvalue.Ptype = Simulation_Integer) and (Rvalue.Ptype = Simulation_Array_Integer)) or ((Lvalue.Ptype = Simulation_clock) and (Rvalue.Ptype = Simulation_array_clock)) or ((Lvalue.Ptype = Simulation_clock) and (Rvalue.Ptype = Simulation_Array_Integer)) or ((Lvalue.Ptype = Simulation_Double) and (Rvalue.Ptype = Simulation_Array_Double)) or ((Lvalue.Ptype = Simulation_String) and (Rvalue.Ptype = Simulation_Array_String)) or ((Lvalue.Ptype = Simulation_Boolean) and (Rvalue.Ptype = Simulation_Array_Boolean)) or ((Lvalue.Ptype = Simulation_Time_Unit_Array_Integer) and (Rvalue.Ptype = Simulation_Integer)) or ((Lvalue.Ptype = Simulation_Time_Unit_Array_Double) and (Rvalue.Ptype = Simulation_Double)) or ((Lvalue.Ptype = Simulation_Time_Unit_Array_Boolean) and (Rvalue.Ptype = Simulation_Boolean)) or ((Lvalue.Ptype = Simulation_Time_Unit_Array_String) and (Rvalue.Ptype = Simulation_String)) or ((Lvalue.Ptype = Simulation_Integer) and (Rvalue.Ptype = Simulation_Time_Unit_Array_Integer)) or ((Lvalue.Ptype = Simulation_Double) and (Rvalue.Ptype = Simulation_Time_Unit_Array_Double)) or ((Lvalue.Ptype = Simulation_String) and (Rvalue.Ptype = Simulation_Time_Unit_Array_String)) or ((Lvalue.Ptype = Simulation_Boolean) and (Rvalue.Ptype = Simulation_Time_Unit_Array_Boolean))) then Res := Compute_Binary_Value (Lvalue, Rvalue, C.Ope); else -- Last case : type are not compatible, it's an error ! -- Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (C.Lvalue.all) & Lb_Comma & To_Unbounded_String (C.Rvalue.all))); end if; Free (Lvalue); Free (Rvalue); return Res; end Value_Of; function Value_Of (C : Unary_Expression; V : Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is Res, Value : Simulation_Value_Ptr; begin Value := Value_Of (C.Value.all, V, Line, File_Name); if (Value.Ptype = Simulation_Array_String) or (Value.Ptype = Simulation_Time_Unit_Array_String) then Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & Value.Ptype'Img & Lb_Comma & To_Unbounded_String (C.Ope'Img))); end if; if (C.Ope = Max_To_Index_Type) or (C.Ope = Min_To_Index_Type) then return Value; end if; -- Apply operator from an unary expression -- case Value.Ptype is when Simulation_String => Res := new Simulation_Value (Simulation_Integer); Res.Integer_Value := Apply_Operator (Value.String_Value, V, C.Ope, Line, File_Name); when Simulation_Array_String => null; when Simulation_Time_Unit_Array_String => null; -- Nothing to compute in the cases of random type -- because value_of functions already do the job -- by returing integer values -- when Simulation_Random => null; when Simulation_Array_Random => null; when Simulation_Time_Unit_Array_Integer => Res := new Simulation_Value (Simulation_Time_Unit_Array_Integer); for I in Time_Unit_Range loop Res.Integer_Time_Unit_Table_Value (I) := Apply_Operator (Value.Integer_Time_Unit_Table_Value (I), C.Ope, Line, File_Name); end loop; when Simulation_Array_Integer | Simulation_array_clock => Res := new Simulation_Value (Simulation_Array_Integer); for I in Simulations_Range loop Res.Integer_Table_Value (I) := Apply_Operator (Value.Integer_Table_Value (I), C.Ope, Line, File_Name); end loop; when Simulation_Integer | Simulation_clock => Res := new Simulation_Value (Simulation_Integer); Res.Integer_Value := Apply_Operator (Value.Integer_Value, C.Ope, Line, File_Name); when Simulation_Time_Unit_Array_Double => Res := new Simulation_Value (Simulation_Time_Unit_Array_Double); for I in Time_Unit_Range loop Res.Double_Time_Unit_Table_Value (I) := Apply_Operator (Value.Double_Time_Unit_Table_Value (I), C.Ope, Line, File_Name); end loop; when Simulation_Array_Double => Res := new Simulation_Value (Simulation_Array_Double); for I in Simulations_Range loop Res.Double_Table_Value (I) := Apply_Operator (Value.Double_Table_Value (I), C.Ope, Line, File_Name); end loop; when Simulation_Double => Res := new Simulation_Value (Simulation_Double); Res.Double_Value := Apply_Operator (Value.Double_Value, C.Ope, Line, File_Name); when Simulation_Time_Unit_Array_Boolean => Res := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); for I in Time_Unit_Range loop Res.boolean_Time_Unit_Table_Value (I) := Apply_Operator (Value.boolean_Time_Unit_Table_Value (I), C.Ope, Line, File_Name); end loop; when Simulation_Array_Boolean => Res := new Simulation_Value (Simulation_Array_Boolean); for I in Simulations_Range loop Res.Boolean_Table_Value (I) := Apply_Operator (Value.Boolean_Table_Value (I), C.Ope, Line, File_Name); end loop; when Simulation_Boolean => Res := new Simulation_Value (Simulation_Boolean); Res.Boolean_Value := Apply_Operator (Value.Boolean_Value, C.Ope, Line, File_Name); end case; return Res; end Value_Of; function Value_Of (C : Constant_Expression; V : Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is begin return Copy (C.Value); end Value_Of; function Value_Of (C : Variable_Expression; V : Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is New_Val : Simulation_Value_Ptr; Seed : Generator; begin for I in 0 .. V.nb_entries - 1 loop if V.entries (I).Variable.Name = C.Name then if (V.entries (I).Simulation.Ptype = Simulation_Random) then Reset (Seed, V.entries (I).Simulation.Random_Value); New_Val := new Simulation_Value (Simulation_Integer); New_Val.Integer_Value := Apply_Random_Operator (Seed, V.entries (I).Simulation.Random_Law_Parameters, Line, File_Name); Save (Seed, V.entries (I).Simulation.Random_Value); return New_Val; else return Copy (V.entries (I).Simulation); end if; end if; end loop; Raise_Exception (Variable_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Undeclared_Identifier (Current_Language) & Lb_Colon & C.Name)); end Value_Of; function Value_Of (C : Array_Variable_Expression; V : Variables_Table_Type; Line : in Natural := 0; File_Name : in Unbounded_String := empty_string) return Simulation_Value_Ptr is New_Val : Simulation_Value_Ptr; Index : Simulation_Value_Ptr; Seed : Generator; begin for I in 0 .. V.nb_entries - 1 loop if V.entries (I).Variable.Name = C.Name then -- Two cases : return the all task array table or -- if an index is provided, return -- a scalar data -- if (C.Array_Index /= null) -- indexed expression : return scalar data -- then Index := Value_Of (C.Array_Index.all, V, Line, File_Name); if Index.Ptype /= Simulation_Integer then Raise_Exception (Type_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Index_Error (Current_Language) & Lb_Colon & C.Name)); end if; if (C.Variable_Type = Simulation_array_clock or C.Variable_Type = Simulation_Array_Integer) then New_Val := new Simulation_Value (Simulation_Integer); New_Val.Integer_Value := V.entries (I).Simulation.Integer_Table_Value ( Simulations_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Array_Random then Reset (Seed, V.entries (I).Simulation.Random_Table_Value ( Simulations_Range (Index.Integer_Value))); New_Val := new Simulation_Value (Simulation_Integer); New_Val.Integer_Value := Apply_Random_Operator (Seed, V.entries (I).Simulation.Random_Table_Law_Parameters, Line, File_Name); Save (Seed, V.entries (I).Simulation.Random_Table_Value ( Simulations_Range (Index.Integer_Value))); end if; if C.Variable_Type = Simulation_Array_Double then New_Val := new Simulation_Value (Simulation_Double); New_Val.Double_Value := V.entries (I).Simulation.Double_Table_Value ( Simulations_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Array_Boolean then New_Val := new Simulation_Value (Simulation_Boolean); New_Val.Boolean_Value := V.entries (I).Simulation.Boolean_Table_Value ( Simulations_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Array_String then New_Val := new Simulation_Value (Simulation_String); New_Val.String_Value := V.entries (I).Simulation.String_Table_Value ( Simulations_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Time_Unit_Array_Integer then New_Val := new Simulation_Value (Simulation_Integer); New_Val.Integer_Value := V.entries (I).Simulation.Integer_Time_Unit_Table_Value ( Time_Unit_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Time_Unit_Array_Double then New_Val := new Simulation_Value (Simulation_Double); New_Val.Double_Value := V.entries (I).Simulation.Double_Time_Unit_Table_Value ( Time_Unit_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Time_Unit_Array_Boolean then New_Val := new Simulation_Value (Simulation_Boolean); New_Val.Boolean_Value := V.entries (I).Simulation.boolean_Time_Unit_Table_Value ( Time_Unit_Range (Index.Integer_Value)); end if; if C.Variable_Type = Simulation_Time_Unit_Array_String then New_Val := new Simulation_Value (Simulation_String); New_Val.String_Value := V.entries (I).Simulation.String_Time_Unit_Table_Value ( Time_Unit_Range (Index.Integer_Value)); end if; Free (Index); return New_Val; else -- Array tables. -- if C.Variable_Type = Simulation_Array_Random then New_Val := new Simulation_Value (Simulation_Array_Integer); for J in Simulations_Range loop Reset (Seed, V.entries (I).Simulation.Random_Table_Value (J)); New_Val.Integer_Table_Value (J) := Apply_Random_Operator (Seed, V.entries (I).Simulation. Random_Table_Law_Parameters, Line, File_Name); Save (Seed, V.entries (I).Simulation.Random_Table_Value (J)); end loop; end if; if (C.Variable_Type = Simulation_Array_Integer or C.Variable_Type = Simulation_array_clock) then New_Val := new Simulation_Value (Simulation_Array_Integer); New_Val.Integer_Table_Value := V.entries (I).Simulation.Integer_Table_Value; end if; if C.Variable_Type = Simulation_Array_Double then New_Val := new Simulation_Value (Simulation_Array_Double); New_Val.Double_Table_Value := V.entries (I).Simulation.Double_Table_Value; end if; if C.Variable_Type = Simulation_Array_Boolean then New_Val := new Simulation_Value (Simulation_Array_Boolean); New_Val.Boolean_Table_Value := V.entries (I).Simulation.Boolean_Table_Value; end if; if C.Variable_Type = Simulation_Array_String then New_Val := new Simulation_Value (Simulation_Array_String); New_Val.String_Table_Value := V.entries (I).Simulation.String_Table_Value; end if; if C.Variable_Type = Simulation_Time_Unit_Array_Integer then New_Val := new Simulation_Value (Simulation_Time_Unit_Array_Integer); New_Val.Integer_Time_Unit_Table_Value := V.entries (I).Simulation.Integer_Time_Unit_Table_Value; end if; if C.Variable_Type = Simulation_Time_Unit_Array_Double then New_Val := new Simulation_Value (Simulation_Time_Unit_Array_Double); New_Val.Double_Time_Unit_Table_Value := V.entries (I).Simulation.Double_Time_Unit_Table_Value; end if; if C.Variable_Type = Simulation_Time_Unit_Array_Boolean then New_Val := new Simulation_Value (Simulation_Time_Unit_Array_Boolean); New_Val.boolean_Time_Unit_Table_Value := V.entries (I).Simulation.boolean_Time_Unit_Table_Value; end if; if C.Variable_Type = Simulation_Time_Unit_Array_String then New_Val := new Simulation_Value (Simulation_Time_Unit_Array_String); New_Val.String_Time_Unit_Table_Value := V.entries (I).Simulation.String_Time_Unit_Table_Value; end if; return New_Val; end if; end if; end loop; Raise_Exception (Variable_Error'Identity, "line " & Line'Img & ", file " & To_String (File_Name) & To_String (Lb_Comma) & To_String (Lb_Undeclared_Identifier (Current_Language) & Lb_Colon & C.Name)); end Value_Of; end Expressions;