---------------------------------------------------- ---------------------------- ------------------------------------------------------------------------------ -- 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: 297 $ -- $Date: 2010-11-23 13:39:03 +0100 (mar. 23 nov. 2010) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_IO; use Text_IO; with unbounded_strings; use unbounded_strings; with Ada.Exceptions; use Ada.Exceptions; with GNAT.Current_Exception; use GNAT.Current_Exception; with Translate; use Translate; with Time_Unit_Events; use Time_Unit_Events; with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; with Sections; use Sections; use Sections.Sections_Type_io; with Simulations; use Simulations; with Simulations.extended; use Simulations.extended; with Statements.extended; use Statements.extended; with Laws; use Laws; package body Interpreter.extended is procedure Put (S : in Section_Table) is begin for I in Sections_Type'Range loop if S (I) /= null then Put (" Section : "); Put (I); New_Line; Recursive_Put (S (I)); New_Line; New_Line; end if; end loop; end Put; function Find_Set (Var : in Sets_Table_Type; S : in Unbounded_String) return Sets_Range is begin for I in 0 .. Var.nb_entries - 1 loop if Var.entries (I).set_id = S then return I; end if; end loop; Raise_Exception (Expressions.Syntax_Error'Identity, To_String (S & Lb_Comma & Lb_Undeclared_Identifier (Current_Language))); return 0; end Find_Set; procedure Check_Set_Declaration (Var : in Sets_Table_Type; S : in Unbounded_String) is Dummy : constant Sets_Range := Find_Set (Var, S); begin null; end Check_Set_Declaration; -------------------------------------------------------------- procedure If_Dispatch (Current : in If_Statement_Ptr; Current_Section : in Sections_Type; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String; Next : in out Generic_Statement_Ptr) is Simu_Ptr : Simulation_Value_Ptr; begin Simu_Ptr := Value_Of (Current.bool_expression.all, Variables_Table, Current.line_number, Current.file_name); if Simu_Ptr.Ptype /= Simulation_Boolean then Raise_Exception (Type_Error'Identity, "If statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Uncompatible_Type_Error (Current_Language))); end if; if Simu_Ptr.Boolean_Value then Dispatch (Current.then_statement, Current_Section, processor_name, Variables_Table, Msg); else Dispatch (Current.else_statement, Current_Section, processor_name, Variables_Table, Msg); end if; Free (Simu_Ptr); Next := Current.next_statement; exception when Constraint_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Storage_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Program_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); end If_Dispatch; procedure Random_Initialize_Dispatch (Current : in Random_Initialize_Statement_Ptr; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String; Next : in out Generic_Statement_Ptr) is Var : Variables_Range; Val1, Val2 : Simulation_Value_Ptr; Seed : Generator; begin Var := Find_Variable (Variables_Table, Current.lvalue, Current.line_number, Current.file_name); case Current.law is when Uniform_Law_Type | Laplace_Gauss_Law_Type => Val1 := Value_Of (Current.parameter1.all, Variables_Table, Current.line_number, Current.file_name); Val2 := Value_Of (Current.parameter2.all, Variables_Table, Current.line_number, Current.file_name); when Exponential_Law_Type => Val1 := Value_Of (Current.parameter1.all, Variables_Table, Current.line_number, Current.file_name); Val2 := new Simulation_Value (Simulation_Integer); end case; if Val1.Ptype /= Simulation_Integer then Raise_Exception (Type_Error'Identity, "Random statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Uncompatible_Type_Error (Current_Language))); end if; if Val2.Ptype /= Simulation_Integer then Raise_Exception (Type_Error'Identity, "Random statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Uncompatible_Type_Error (Current_Language))); end if; -- Store random law parameters in simulation data -- and initialize seed -- if (Variables_Table.entries (Var).Simulation.Ptype = Simulation_Array_Random) then for I in Simulations_Range loop Reset (Seed); Save (Seed, Variables_Table.entries (Var).Simulation.Random_Table_Value (I)) ; end loop; Variables_Table.entries (Var).Simulation.Random_Table_Law_Parameters. Law := Current.law; Variables_Table.entries (Var).Simulation.Random_Table_Law_Parameters. Parameter1 := Val1.Integer_Value; Variables_Table.entries (Var).Simulation.Random_Table_Law_Parameters. Parameter2 := Val2.Integer_Value; else Reset (Seed); Save (Seed, Variables_Table.entries (Var).Simulation.Random_Value); Variables_Table.entries (Var).Simulation.Random_Law_Parameters.Law := Current.law; Variables_Table.entries (Var).Simulation.Random_Law_Parameters. Parameter1 := Val1.Integer_Value; Variables_Table.entries (Var).Simulation.Random_Law_Parameters. Parameter2 := Val2.Integer_Value; end if; Free (Val1); Free (Val2); Next := Current.next_statement; exception when Constraint_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Storage_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Program_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); end Random_Initialize_Dispatch; procedure Assign_Dispatch (Current : in Assign_Statement_Ptr; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String; Next : in out Generic_Statement_Ptr) is Left_Var : Variables_Range; Fully_Indexed : Boolean := False; Val, Index : Simulation_Value_Ptr; Left_Type : Simulation_Type := Get_Type (Current.lvalue.all); Right_Type : Simulation_Type := Get_Type (Current.rvalue.all); begin -- First of all : chack that types of left and rigth value are --compatibles -- if not has_compatible_type (Left_Type, Right_Type) then Raise_Exception (Type_Error'Identity, "Assignement statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Uncompatible_Type_Error (Current_Language) & Lb_Colon & To_Unbounded_String (Left_Type'Img) & Lb_Comma & To_Unbounded_String (Right_Type'Img))); end if; if Current.lvalue.Expression_Type = Array_Variable_Type then if Array_Variable_Expression_Ptr (Current.lvalue).Array_Index /= null then Fully_Indexed := True; end if; end if; -- Assignement from a scalar to another scalar -- if not Fully_Indexed then Left_Var := Find_Variable (Variables_Table, Variable_Expression_Ptr (Current.lvalue).Name, Current.line_number, Current.file_name); Val := Value_Of (Current.rvalue.all, Variables_Table, Current.line_number, Current.file_name); -- We can not initialize the left part when its type is -- scalar and when the right part type is vectorial -- The only exception is when the operator is a min_to_index -- or a max_to_index operator -- if ((Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Integer) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_clock) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Boolean) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Random) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_String) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Double)) and ((Val.Ptype = Simulation_Array_Boolean) or (Val.Ptype = Simulation_Array_Integer) or (Val.Ptype = Simulation_array_clock) or (Val.Ptype = Simulation_Array_Double) or (Val.Ptype = Simulation_Array_String) or (Val.Ptype = Simulation_Array_Random)) then Raise_Exception (Type_Error'Identity, "Assignement statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Variable_Size (Current_Language))); end if; if ((Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Integer) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Boolean) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_String) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Double)) and ((Val.Ptype = Simulation_Time_Unit_Array_Double) or (Val.Ptype = Simulation_Time_Unit_Array_Double) or (Val.Ptype = Simulation_Time_Unit_Array_String) or (Val.Ptype = Simulation_Time_Unit_Array_Integer)) then Raise_Exception (Type_Error'Identity, "Assignement statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Variable_Size (Current_Language))); end if; -- Start to compute expression evaluation -- if ((Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Integer) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_array_clock)) and ((Val.Ptype = Simulation_Integer) or (Val.Ptype = Simulation_clock)) then for I in Simulations_Range loop Variables_Table.entries (Left_Var).Simulation. Integer_Table_Value (I) := Val.Integer_Value; end loop; else if (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Time_Unit_Array_Integer) and (Val.Ptype = Simulation_Integer) then for I in Time_Unit_Range loop Variables_Table.entries (Left_Var).Simulation. Integer_Time_Unit_Table_Value (I) := Val.Integer_Value; end loop; else if (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Time_Unit_Array_Double) and (Val.Ptype = Simulation_Double) then for I in Time_Unit_Range loop Variables_Table.entries (Left_Var).Simulation. Double_Time_Unit_Table_Value (I) := Val.Double_Value; end loop; else if (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Time_Unit_Array_Boolean) and (Val.Ptype = Simulation_Boolean) then for I in Time_Unit_Range loop Variables_Table.entries (Left_Var).Simulation. boolean_Time_Unit_Table_Value (I) := Val.Boolean_Value; end loop; else if (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Time_Unit_Array_String) and (Val.Ptype = Simulation_String) then for I in Time_Unit_Range loop Variables_Table.entries (Left_Var).Simulation. String_Time_Unit_Table_Value (I) := Val.String_Value; end loop; else if (Variables_Table.entries (Left_Var).Simulation. Ptype = Simulation_Array_Boolean) and (Val.Ptype = Simulation_Boolean) then for I in Simulations_Range loop Variables_Table.entries (Left_Var).Simulation. Boolean_Table_Value (I) := Val.Boolean_Value; end loop; else if (Variables_Table.entries (Left_Var).Simulation. Ptype = Simulation_Array_Double) and (Val.Ptype = Simulation_Double) then for I in Simulations_Range loop Variables_Table.entries (Left_Var).Simulation. Double_Table_Value (I) := Val.Double_Value; end loop; else if (Variables_Table.entries (Left_Var). Simulation.Ptype = Simulation_Array_String) and (Val.Ptype = Simulation_String) then for I in Simulations_Range loop Variables_Table.entries (Left_Var). Simulation.String_Table_Value (I) := Val.String_Value; end loop; else Variables_Table.entries (Left_Var).Simulation := Value_Of (Current.rvalue.all, Variables_Table, Current.line_number, Current.file_name); end if; end if; end if; end if; end if; end if; end if; end if; Free (Val); else -- Indexed affectation : the left side AND the right side are indexed -- Index := Value_Of (Array_Variable_Expression_Ptr (Current.lvalue).Array_Index.all, Variables_Table, Current.line_number, Current.file_name); if Index.Ptype /= Simulation_Integer then Raise_Exception (Type_Error'Identity, "Assignement statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Index_Error (Current_Language))); end if; Left_Var := Find_Variable (Variables_Table, Variable_Expression_Ptr (Current.lvalue).Name, Current.line_number, Current.file_name); Val := Value_Of (Current.rvalue.all, Variables_Table, Current.line_number, Current.file_name); if (Val.Ptype /= Simulation_Integer) and (Val.Ptype /= Simulation_Boolean) and (Val.Ptype /= Simulation_Double) and (Val.Ptype /= Simulation_clock) and (Val.Ptype /= Simulation_String) then Raise_Exception (Type_Error'Identity, "Assignement statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & ", rvalue " & To_String (Lb_Uncompatible_Type_Error (Current_Language))); end if; if ((Val.Ptype = Simulation_Integer) or (Val.Ptype = Simulation_clock)) and ((Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Integer) or (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_array_clock)) then Variables_Table.entries (Left_Var).Simulation.Integer_Table_Value ( Simulations_Range (Index.Integer_Value)) := Val.Integer_Value; else if ((Val.Ptype = Simulation_Double) and (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Double)) then Variables_Table.entries (Left_Var).Simulation. Double_Table_Value (Simulations_Range (Index.Integer_Value)) := Val.Double_Value; else if ((Val.Ptype = Simulation_Boolean) and (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_Boolean)) then Variables_Table.entries (Left_Var).Simulation. Boolean_Table_Value (Simulations_Range ( Index.Integer_Value)) := Val.Boolean_Value; else if ((Val.Ptype = Simulation_String) and (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Array_String)) then Variables_Table.entries (Left_Var).Simulation. String_Table_Value (Simulations_Range ( Index.Integer_Value)) := Val.String_Value; else if ((Val.Ptype = Simulation_Integer) and (Variables_Table.entries (Left_Var).Simulation.Ptype = Simulation_Time_Unit_Array_Integer)) then Variables_Table.entries (Left_Var).Simulation. Integer_Time_Unit_Table_Value (Time_Unit_Range ( Index.Integer_Value)) := Val.Integer_Value; else if ((Val.Ptype = Simulation_Double) and (Variables_Table.entries (Left_Var).Simulation. Ptype = Simulation_Time_Unit_Array_Double)) then Variables_Table.entries (Left_Var).Simulation. Double_Time_Unit_Table_Value (Time_Unit_Range ( Index.Integer_Value)) := Val.Double_Value; else if ((Val.Ptype = Simulation_Boolean) and (Variables_Table.entries (Left_Var).Simulation. Ptype = Simulation_Time_Unit_Array_Boolean)) then Variables_Table.entries (Left_Var).Simulation. boolean_Time_Unit_Table_Value (Time_Unit_Range( Index.Integer_Value)) := Val.Boolean_Value; else if ((Val.Ptype = Simulation_String) and (Variables_Table.entries (Left_Var). Simulation.Ptype = Simulation_Time_Unit_Array_String)) then Variables_Table.entries (Left_Var).Simulation. String_Time_Unit_Table_Value ( Time_Unit_Range (Index.Integer_Value)) := Val.String_Value; else Raise_Exception (Type_Error'Identity, "Assignement statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Uncompatible_Type_Error ( Current_Language))); end if; end if; end if; end if; end if; end if; end if; end if; Free (Index); Free (Val); end if; Next := Current.next_statement; exception when Constraint_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Storage_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Program_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); end Assign_Dispatch; procedure Put_Dispatch (Current : in Put_Statement_Ptr; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String; Next : in out Generic_Statement_Ptr) is Expr_Simu_Ptr : Simulation_Value_Ptr; From_Simu_Ptr : Simulation_Value_Ptr; To_Simu_Ptr : Simulation_Value_Ptr; begin if (Current.put_from /= null) then From_Simu_Ptr := Value_Of (Current.put_from.all, Variables_Table, Current.line_number, Current.file_name); end if; if (Current.put_to /= null) then To_Simu_Ptr := Value_Of (Current.put_to.all, Variables_Table, Current.line_number, Current.file_name); end if; Expr_Simu_Ptr := Value_Of (Current.expression_to_be_displayed.all, Variables_Table, Current.line_number, Current.file_name); if (Current.put_to /= null) then if (To_Simu_Ptr.Ptype /= Simulation_Integer) or (From_Simu_Ptr.Ptype /= Simulation_Integer) then Raise_Exception (Type_Error'Identity, "Put parameter should be an integer, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & To_String (Lb_Comma & Lb_Uncompatible_Type_Error (Current_Language))); end if; end if; Msg := Msg & To_Unbounded_String ("- Line " & Current.line_number'Img & ", "); if (Current.put_to /= null) and (Current.put_from /= null) then Msg := Msg & To_Unbounded_String (Expr_Simu_Ptr, From_Simu_Ptr.Integer_Value, To_Simu_Ptr.Integer_Value) & unbounded_lf; Free (From_Simu_Ptr); Free (To_Simu_Ptr); else if ((Expr_Simu_Ptr.Ptype = Simulation_Time_Unit_Array_Boolean) or (Expr_Simu_Ptr.Ptype = Simulation_Time_Unit_Array_Integer) or (Expr_Simu_Ptr.Ptype = Simulation_Time_Unit_Array_Double) or (Expr_Simu_Ptr.Ptype = Simulation_Time_Unit_Array_String)) then Msg := Msg & To_Unbounded_String (Current.expression_to_be_displayed.all) & "=" & To_Unbounded_String (Expr_Simu_Ptr, Integer (Time_Unit_Range'First), Integer (Time_Unit_Range'Last)) & unbounded_lf; else if ((Expr_Simu_Ptr.Ptype = Simulation_Array_Boolean) or (Expr_Simu_Ptr.Ptype = Simulation_Array_Integer) or (Expr_Simu_Ptr.Ptype = Simulation_array_clock) or (Expr_Simu_Ptr.Ptype = Simulation_Array_String) or (Expr_Simu_Ptr.Ptype = Simulation_Array_Double)) then Msg := Msg & To_Unbounded_String (Expr_Simu_Ptr, Integer (Simulations_Range'First), Integer (Simulations_Range'Last)) & unbounded_lf; else Msg := Msg & To_Unbounded_String (Expr_Simu_Ptr) & unbounded_lf; end if; end if; end if; Free (Expr_Simu_Ptr); Next := Current.next_statement; exception when Constraint_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Storage_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Program_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); end Put_Dispatch; procedure While_Dispatch (Current : in While_Statement_Ptr; Current_Section : in Sections_Type; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String; Next : in out Generic_Statement_Ptr) is Simu_Ptr : Simulation_Value_Ptr; begin -- Let's run included statements : -- do a loop iteration -- loop Simu_Ptr := Value_Of (Current.condition.all, Variables_Table, Current.line_number, Current.file_name); if Simu_Ptr.Ptype /= Simulation_Boolean then Raise_Exception (Type_Error'Identity, "while statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & ", " & To_String (Lb_Uncompatible_Type_Error (Current_Language))); end if; exit when Simu_Ptr.Boolean_Value = False; Dispatch (Current.included_statement, Current_Section, processor_name, Variables_Table, Msg); end loop; Free (Simu_Ptr); Next := Generic_Statement_Ptr (Current.next_statement); exception when Constraint_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Storage_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Program_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); end While_Dispatch; procedure For_Dispatch (Current : in For_Statement_Ptr; Current_Section : in Sections_Type; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String; Next : in out Generic_Statement_Ptr) is Var : Variables_Range; Var_Loop_Index : Variables_Range; begin -- Test is the expression included in the for -- statement is a variable ... raise a exception -- in the other cases -- if Current.for_index.Expression_Type = Variable_Type then if Variable_Expression_Ptr (Current.for_index).Variable_Type /= Simulation_Integer then Raise_Exception (Type_Error'Identity, "for statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & ", for expression have to be an integer variable"); end if; else Raise_Exception (Type_Error'Identity, "for statement, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & ", for expression have to be an integer variable"); end if; -- Let's run included statements : -- do a loop iteration -- case Current.for_type is when Task_Table_Type => Var_Loop_Index := Find_Variable (Variables_Table, "nb_tasks", Current.line_number, Current.file_name); when Processor_Table_Type => Var_Loop_Index := Find_Variable (Variables_Table, "nb_processors", Current.line_number, Current.file_name); when Buffer_Table_Type => Var_Loop_Index := Find_Variable (Variables_Table, "nb_buffers", Current.line_number, Current.file_name); when Time_Unit_Table_Type => Var_Loop_Index := Find_Variable (Variables_Table, "nb_time_units", Current.line_number, Current.file_name); when Resource_Table_Type => Var_Loop_Index := Find_Variable (Variables_Table, "nb_resources", Current.line_number, Current.file_name); when Message_Table_Type => Var_Loop_Index := Find_Variable (Variables_Table, "nb_messages", Current.line_number, Current.file_name); end case; for I in 0 .. Natural (Variables_Table.entries (Var_Loop_Index).Simulation. Integer_Value - 1) loop Var := Find_Variable (Variables_Table, Variable_Expression_Ptr (Current.for_index).Name, Current.line_number, Current.file_name); Variables_Table.entries (Var).Simulation.Integer_Value := Integer (I); Dispatch (Current.included_statement, Current_Section, processor_name, Variables_Table, Msg); end loop; Next := Generic_Statement_Ptr (Current.next_statement); exception when Constraint_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Storage_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); when Program_Error => Raise_Exception (Statement_Error'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; Exception raised :" & Exception_Name & ":" & Exception_Message); end For_Dispatch; procedure Dispatch (Current : in Generic_Statement_Ptr; Current_Section : in Sections_Type; processor_name : in Unbounded_String; Variables_Table : in out Variables_Table_Type; Msg : in out Unbounded_String) is Next : Generic_Statement_Ptr; My_Current : Generic_Statement_Ptr := Current; begin if My_Current /= null then loop -- Run the associated statement -- case My_Current.statement_type is when Exit_Statement_Type => Raise_Exception (Exit_Statement_Exception'Identity, "line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & " ; simulation stopped by exit statement."); when Put_Statement_Type => Put_Dispatch (Put_Statement_Ptr (My_Current), processor_name, Variables_Table, Msg, Next); when Nop_Statement_Type => Next := My_Current.next_statement; when If_Statement_Type => If_Dispatch (If_Statement_Ptr (My_Current), Current_Section, processor_name, Variables_Table, Msg, Next); when Random_Initialize_Statement_Type => Random_Initialize_Dispatch (Random_Initialize_Statement_Ptr (My_Current), processor_name, Variables_Table, Msg, Next); when Assign_Statement_Type | Clock_Statement_Type => Assign_Dispatch (Assign_Statement_Ptr (My_Current), processor_name, Variables_Table, Msg, Next); when For_Statement_Type => For_Dispatch (For_Statement_Ptr (My_Current), Current_Section, processor_name, Variables_Table, Msg, Next); when Return_Statement_Type => -- Check if a return statement is called -- if (Return_Statement_Ptr (My_Current).return_value /= null) and (Current_Section /= Election_Type) then Raise_Exception (Type_Error'Identity, Current_Section'Img & " section, line " & Current.line_number'Img & ", processor " & To_String (processor_name) & ", file " & To_String (Current.file_name) & ", invalid return value from return statement"); end if; exit; when While_Statement_Type => While_Dispatch (While_Statement_Ptr (My_Current), Current_Section, processor_name, Variables_Table, Msg, Next); when Set_Statement_Type => null; when Subprogram_Statement_Type => null; when Subprogram_Call_Statement_Type => null; end case; -- Last statement ? -- exit when Next = null; My_Current := Next; end loop; end if; end Dispatch; end Interpreter.extended;