------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR CNRS 6285, Universite de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ------------------------------------------------------------------------------ -- Last update : -- $Rev$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_IO;use Text_IO; with Framework_Config; use Framework_Config; with Scheduler_Lex; use Scheduler_Lex; with scheduler_dfa; use scheduler_dfa; with Scheduler_Goto; use Scheduler_Goto; with Scheduler_Tokens; use Scheduler_Tokens; with Scheduler_Shift_Reduce; use Scheduler_Shift_Reduce; with Ada.Numerics.Aux; use Ada.Numerics.Aux; with Translate; use Translate; with unbounded_strings; use unbounded_strings; with Ada.Exceptions; use Ada.Exceptions; with Simulations; use Simulations; with Simulations.extended; use Simulations.extended; with Parameters; use Parameters; use Parameters.User_Defined_Parameters_Table_Package; with Task_Set; use Task_Set; use Task_Set.Generic_Task_Set; with Statements; use Statements; with Sections; use Sections; with Laws; use Laws; with Automaton; use Automaton; with Automaton.extended; use Automaton.extended; use Automaton.State_Lists_Package; use Automaton.Transition_Lists_Package; package body Parser is -- These variables store statements of inner blocks of code -- Else_Inner_Statement_Ptr : array (0 .. Max_Block_Level) of Generic_Statement_Ptr; Else_Inner_Statement_Index : Natural := 0; Then_Inner_Statement_Ptr : array (0 .. Max_Block_Level) of Generic_Statement_Ptr; Then_Inner_Statement_Index : Natural := 0; Loop_Inner_Statement_Ptr : array (0 .. Max_Block_Level) of Generic_Statement_Ptr; Loop_Inner_Statement_Index : Natural := 0; -- Variables needed to parse a "if" or a "for" statement -- New_If : If_Statement_Ptr; New_for : For_Statement_Ptr; New_While : While_Statement_Ptr; -- File name that we are currently treating -- File_Name : Unbounded_String; procedure Yyerror (S : String) is begin Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " token """ & To_String (To_Unbounded_String (YYText) & """" & Lb_Comma & " line" & Positive'Image (Lines) & Lb_Comma & To_Unbounded_String (S))); end Yyerror; -- This variables stores the data related -- to the section we currently parse -- Current_Section_Type : Sections_Type; Current_Statement_Pointer : Generic_Statement_Ptr := null; Current_Synchronization_Section : Synchronization_Section_Ptr := null; Current_Computation_Section : Computation_Section_Ptr; Current_Section_Name : Unbounded_String; procedure First_File (A_File_Name : in Unbounded_String) is begin Else_Inner_Statement_Index := 0; Then_Inner_Statement_Index := 0; Loop_Inner_Statement_Index := 0; Initialize (Sets_Table); initialize (Root_Statement_Pointer); Scheduler_Lex.Lines := 1; File_Name := A_File_Name; end First_File; procedure Next_File (A_File_Name : in Unbounded_String) is begin Scheduler_Lex.Lines := 1; File_Name := A_File_Name; end Next_File; procedure Yyparse is -- Rename User Defined Packages to Internal Names. package yy_goto_tables renames Scheduler_Goto; package yy_shift_reduce_tables renames Scheduler_Shift_Reduce; package yy_tokens renames Scheduler_Tokens; use yy_tokens, yy_goto_tables, yy_shift_reduce_tables; procedure yyerrok; procedure yyclearin; package yy is -- the size of the value and state stacks stack_size : constant Natural := 300; -- subtype rule is natural; subtype parse_state is Natural; -- subtype nonterminal is integer; -- encryption constants default : constant := -1; first_shift_entry : constant := 0; accept_code : constant := -3001; error_code : constant := -3000; -- stack data used by the parser tos : Natural := 0; value_stack : array (0 .. stack_size) of yy_tokens.Yystype; state_stack : array (0 .. stack_size) of parse_state; -- current input symbol and action the parser is on action : Integer; rule_id : Rule; input_symbol : yy_tokens.Token; -- error recovery flag error_flag : Natural := 0; -- indicates 3 - (number of valid shifts after an error occurs) look_ahead : Boolean := True; index : Integer; -- Is Debugging option on or off DEBUG : constant Boolean := False; end yy; function goto_state (state : yy.parse_state; sym : Nonterminal) return yy.parse_state; function parse_action (state : yy.parse_state; t : yy_tokens.Token) return Integer; pragma Inline (goto_state, parse_action); function goto_state (state : yy.parse_state; sym : Nonterminal) return yy.parse_state is index : Integer; begin index := GOTO_OFFSET (state); while Integer (Goto_Matrix (index).Nonterm) /= sym loop index := index + 1; end loop; return Integer (Goto_Matrix (index).Newstate); end goto_state; function parse_action (state : yy.parse_state; t : yy_tokens.Token) return Integer is index : Integer; tok_pos : Integer; default : constant Integer := -1; begin tok_pos := yy_tokens.Token'Pos (t); index := SHIFT_REDUCE_OFFSET (state); while Integer (Shift_Reduce_Matrix (index).T) /= tok_pos and then Integer (Shift_Reduce_Matrix (index).T) /= default loop index := index + 1; end loop; return Integer (Shift_Reduce_Matrix (index).Act); end parse_action; -- error recovery stuff procedure handle_error is temp_action : Integer; begin if yy.error_flag = 3 then -- no shift yet, clobber input. if yy.DEBUG then Text_IO.Put_Line ("Ayacc.YYParse: Error Recovery Clobbers " & yy_tokens.Token'Image (yy.input_symbol)); end if; if yy.input_symbol = yy_tokens.End_Of_Input then -- don't --discard, if yy.DEBUG then Text_IO.Put_Line ("Ayacc.YYParse: Can't discard END_OF_INPUT, quiting..."); end if; raise yy_tokens.Syntax_Error; end if; yy.look_ahead := True; -- get next token return; -- and try again... end if; if yy.error_flag = 0 then -- brand new error Yyerror ("Syntax Error"); end if; yy.error_flag := 3; -- find state on stack where error is a valid shift -- if yy.DEBUG then Text_IO.Put_Line ("Ayacc.YYParse: Looking for state with error as valid shift"); end if; loop if yy.DEBUG then Text_IO.Put_Line ("Ayacc.YYParse: Examining State " & yy.parse_state'Image (yy.state_stack (yy.tos))); end if; temp_action := parse_action (yy.state_stack (yy.tos), Error); if temp_action >= yy.first_shift_entry then if yy.tos = yy.stack_size then Text_IO.Put_Line (" Stack size exceeded on state_stack"); raise yy_tokens.Syntax_Error; end if; yy.tos := yy.tos + 1; yy.state_stack (yy.tos) := temp_action; exit; end if; Decrement_Stack_Pointer : begin yy.tos := yy.tos - 1; exception when Constraint_Error => yy.tos := 0; end Decrement_Stack_Pointer; if yy.tos = 0 then if yy.DEBUG then Text_IO.Put_Line( "Ayacc.YYParse: Error recovery popped entire stack, aborting..."); end if; raise yy_tokens.Syntax_Error; end if; end loop; if yy.DEBUG then Text_IO.Put_Line ("Ayacc.YYParse: Shifted error token in state " & yy.parse_state'Image (yy.state_stack (yy.tos))); end if; end handle_error; -- print debugging information for a shift operation procedure shift_debug (state_id : yy.parse_state; lexeme : yy_tokens.Token) is begin Text_IO.Put_Line ("Ayacc.YYParse: Shift " & yy.parse_state'Image (state_id) & " on input symbol " & yy_tokens.Token'Image (lexeme)); end shift_debug; -- print debugging information for a reduce operation procedure reduce_debug (rule_id : Rule; state_id : yy.parse_state) is begin Text_IO.Put_Line ("Ayacc.YYParse: Reduce by rule " & Rule'Image (rule_id) & " goto state " & yy.parse_state'Image (state_id)); end reduce_debug; -- make the parser believe that 3 valid shifts have occured. -- used for error recovery. procedure yyerrok is begin yy.error_flag := 0; end yyerrok; -- called to clear input symbol that caused an error. procedure yyclearin is begin -- yy.input_symbol := yylex; yy.look_ahead := True; end yyclearin; begin -- initialize by pushing state 0 and getting the first input symbol yy.state_stack (yy.tos) := 0; loop yy.index := SHIFT_REDUCE_OFFSET (yy.state_stack (yy.tos)); if Integer (Shift_Reduce_Matrix (yy.index).T) = yy.default then yy.action := Integer (Shift_Reduce_Matrix (yy.index).Act); else if yy.look_ahead then yy.look_ahead := False; yy.input_symbol := Yylex; end if; yy.action := parse_action (yy.state_stack (yy.tos), yy.input_symbol); end if; if yy.action >= yy.first_shift_entry then -- SHIFT if yy.DEBUG then shift_debug (yy.action, yy.input_symbol); end if; -- Enter new state if yy.tos = yy.stack_size then Text_IO.Put_Line (" Stack size exceeded on state_stack"); raise yy_tokens.Syntax_Error; end if; yy.tos := yy.tos + 1; yy.state_stack (yy.tos) := yy.action; yy.value_stack (yy.tos) := YYLVal; if yy.error_flag > 0 then -- indicate a valid shift yy.error_flag := yy.error_flag - 1; end if; -- Advance lookahead yy.look_ahead := True; elsif yy.action = yy.error_code then -- ERROR handle_error; elsif yy.action = yy.accept_code then if yy.DEBUG then Text_IO.Put_Line ("Ayacc.YYParse: Accepting Grammar..."); end if; exit; else -- Reduce Action -- Convert action into a rule yy.rule_id := -1 * yy.action; -- Execute User Action -- user_action(yy.rule_id); case yy.rule_id is when 14 => --#line 99 Current_Section_Type := Check_Resource_Type; Current_Statement_Pointer := null; when 15 => --#line 104 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 16 => --#line 111 Current_Section_Type := Release_Resource_Type; Current_Statement_Pointer := null; when 17 => --#line 116 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 18 => --#line 123 Current_Section_Type := Allocate_Resource_Type; Current_Statement_Pointer := null; when 19 => --#line 128 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 20 => --#line 135 Current_Section_Type := Start_Type; Current_Statement_Pointer := null; when 21 => --#line 140 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 22 => --#line 147 Current_Section_Type := Gather_Event_Analyzer_Type; Current_Statement_Pointer := null; when 23 => --#line 152 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 24 => --#line 159 Current_Section_Type := Display_Event_Analyzer_Type; Current_Statement_Pointer := null; when 25 => --#line 164 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 26 => --#line 171 Current_Section_Type := Activation_Type; Current_Statement_Pointer := null; when 27 => --#line 176 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 28 => --#line 183 Current_Section_Type := Election_Type; Current_Statement_Pointer := null; when 29 => --#line 188 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 30 => --#line 195 Current_Section_Type := Priority_Type; Current_Statement_Pointer := null; when 31 => --#line 200 if Current_Computation_Section /= null then Current_Computation_Section.name := Current_Section_Name; end if; when 32 => --#line 208 Current_Section_Type := Automaton_Type; Current_Synchronization_Section := null; when 33 => --#line 213 if Current_Synchronization_Section /= null then Current_Synchronization_Section.name := Current_Section_Name; end if; when 34 => --#line 222 Current_Section_Name := yy.value_stack (yy.tos).String_Value; when 35 => --#line 226 Current_Section_Name := empty_string; when 36 => --#line 233 if yy.value_stack (yy.tos).State /= null then if (Current_Synchronization_Section = null) then Current_Synchronization_Section := new Synchronization_Section; Current_Synchronization_Section.file_name := File_Name; Current_Synchronization_Section.section_type := Current_Section_Type; add (Root_Statement_Pointer, Generic_Section_Ptr (Current_Synchronization_Section)); end if; add (Current_Synchronization_Section.state_list, yy.value_stack (yy.tos).State); end if; when 38 => --#line 250 if yy.value_stack (yy.tos).Transition /= null then add (Current_Synchronization_Section.transition_list, yy.value_stack (yy.tos).Transition); end if; when 40 => --#line 260 declare New_State : State_Ptr; begin New_State := new State; New_State.name := yy.value_stack (yy.tos - 3).String_Value; New_State.is_initial := True; YYVal.State := New_State; end; when 41 => --#line 271 declare New_State : State_Ptr; begin New_State := new State; New_State.name := yy.value_stack (yy.tos - 3).String_Value; New_State.is_initial := False; YYVal.State := New_State; end; when 42 => --#line 283 YYVal.Expression := yy.value_stack (yy.tos).Expression; when 43 => --#line 287 YYVal.Expression := null; when 44 => --#line 293 YYVal.Statement := yy.value_stack (yy.tos).Statement; when 45 => --#line 297 YYVal.Statement := null; when 46 => --#line 304 declare New_Sync : Synchronization_Ptr; begin New_Sync := new Synchronization; New_Sync.name := yy.value_stack (yy.tos - 1).String_Value; New_Sync.synchronization_type := Receive; YYVal.Synchronization := New_Sync; end; when 47 => --#line 315 declare New_Sync : Synchronization_Ptr; begin New_Sync := new Synchronization; New_Sync.name := yy.value_stack (yy.tos - 1).String_Value; New_Sync.synchronization_type := Send; YYVal.Synchronization := New_Sync; end; when 48 => --#line 326 YYVal.Synchronization := null; when 49 => --#line 332 declare New_Transition : Transition_Ptr; begin New_Transition := new Transition; New_Transition.name := yy.value_stack (yy.tos - 11).String_Value & To_Unbounded_String ("==>") & yy.value_stack (yy.tos - 1).String_Value; begin New_Transition.from_state := Search_state (Current_Synchronization_Section.state_list, yy.value_stack (yy.tos - 11).String_Value); exception when state_not_found => Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "State " & yy.value_stack (yy.tos - 11).String_Value & " not found")); end; begin New_Transition.to_state := Search_state (Current_Synchronization_Section.state_list, yy.value_stack (yy.tos - 1).String_Value); exception when state_not_found => Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "State " & yy.value_stack (yy.tos - 1).String_Value & " not found")); end; New_Transition.guards := yy.value_stack (yy.tos - 8).Expression; New_Transition.clocks := yy.value_stack (yy.tos - 6).Statement; New_Transition.synchronization := yy.value_stack (yy.tos - 4).Synchronization; YYVal.Transition := New_Transition; end; when 50 => --#line 365 begin if yy.value_stack (yy.tos).Statement /= null then if (Current_Statement_Pointer = null) then Current_Statement_Pointer := yy.value_stack (yy.tos).Statement; Current_Computation_Section := new Computation_Section; Current_Computation_Section.file_name := File_Name; Current_Computation_Section.section_type := Current_Section_Type; Current_Computation_Section.first_statement := yy.value_stack (yy.tos).Statement; add (Root_Statement_Pointer, Generic_Section_Ptr (Current_Computation_Section)); else Current_Statement_Pointer.next_statement := yy.value_stack (yy.tos).Statement; Current_Statement_Pointer := yy.value_stack (yy.tos).Statement; end if; end if; end; when 52 => --#line 387 YYVal.Statement := yy.value_stack (yy.tos - 2).Statement; when 53 => --#line 391 YYVal.Statement := null; when 54 => --#line 397 yy.value_stack (yy.tos - 1).Statement.next_statement := yy.value_stack (yy.tos).Statement; YYVal.Statement := yy.value_stack (yy.tos - 1).Statement; when 55 => --#line 402 YYVal.Statement := yy.value_stack (yy.tos).Statement; when 56 => --#line 406 YYVal.Statement := null; when 57 => --#line 411 yy.value_stack (yy.tos - 1).Statement.next_statement := yy.value_stack (yy.tos).Statement; YYVal.Statement := yy.value_stack (yy.tos - 1).Statement; when 58 => --#line 416 YYVal.Statement := yy.value_stack (yy.tos).Statement; when 59 => --#line 420 YYVal.Statement := null; when 60 => --#line 428 declare New_Put : Put_Statement_Ptr; begin -- Firstly, the Put_Parameter -- if ((yy.value_stack (yy.tos - 3).Expression /= null) and (yy.value_stack (yy.tos - 2).Expression = null)) or ((yy.value_stack (yy.tos - 3).Expression = null) and (yy.value_stack (yy.tos - 2).Expression /= null)) then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "0 or 2 parameters should be given")); end if; New_Put := new Put_Statement; New_Put.expression_to_be_displayed := yy.value_stack (yy.tos - 4).Expression; New_Put.put_from := yy.value_stack (yy.tos - 3).Expression; New_Put.put_to := yy.value_stack (yy.tos - 2).Expression; New_Put.line_number := Scheduler_Lex.Lines; New_Put.file_name := File_Name; YYVal.Statement := Generic_Statement_Ptr (New_Put); end; when 61 => --#line 453 declare New_Assign : Assign_Statement_Ptr; New_Var : Variable_Record_Ptr; New_Array_Expr : Array_Variable_Expression_Ptr; New_Var_Expr : Variable_Expression_Ptr; begin -- Is the Variable already exists ? -- for I in 0 .. Variables_Table.Nb_Entries - 1 loop if (Variables_Table.Entries (I).Variable.name = yy.value_stack (yy.tos - 4).String_Value) then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & yy.value_stack (yy.tos - 4).String_Value & Lb_Comma & Lb_Identifier_Already_Declared ( Current_Language))); end if; end loop; -- Create the Variable (Array or not) -- New_Var := new Variable_Record; if (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Array_Double) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Array_Integer) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Array_Boolean) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_array_clock) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Array_String) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Array_Random) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Time_Unit_Array_Double) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Time_Unit_Array_Integer) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Time_Unit_Array_Boolean) or (yy.value_stack (yy.tos - 2).Variable_Type_Value = Simulation_Time_Unit_Array_String) then New_Array_Expr := new Array_Variable_Expression; New_Array_Expr.Variable_Type := yy.value_stack (yy.tos - 2).Variable_Type_Value; New_Array_Expr.name := yy.value_stack (yy.tos - 4).String_Value; New_Var.Variable := Variable_Expression_Ptr (New_Array_Expr); else New_Var_Expr := new Variable_Expression; New_Var_Expr.Variable_Type := yy.value_stack (yy.tos - 2).Variable_Type_Value; New_Var_Expr.name := yy.value_stack (yy.tos - 4).String_Value; New_Var.Variable := New_Var_Expr; end if; Add (Variables_Table, New_Var); -- Create simulation data -- Variables_Table.Entries (Variables_Table.Nb_Entries - 1). Simulation := new Simulation_Value (Variable_Expression_Ptr ( Variables_Table.Entries (Variables_Table.Nb_Entries - 1). Variable).Variable_Type); -- If Assignement is not null, we should register -- a new Assignement -- if yy.value_stack (yy.tos - 1).Expression /= null then New_Assign := new Assign_Statement; New_Assign.lvalue := Generic_Expression_Ptr (New_Var_Expr); New_Assign.rvalue := yy.value_stack (yy.tos - 1).Expression; New_Assign.line_number := Scheduler_Lex.Lines; New_Assign.file_name := File_Name; YYVal.Statement := Generic_Statement_Ptr (New_Assign); else YYVal.Statement := null; end if; end; when 62 => --#line 532 declare New_Clock : Clock_Statement_Ptr; begin New_Clock := new Clock_Statement; New_Clock.line_number := Scheduler_Lex.Lines; New_Clock.file_name := File_Name; New_Clock.lvalue := yy.value_stack (yy.tos - 1).Expression; YYVal.Statement := Generic_Statement_Ptr (New_Clock); end; when 63 => --#line 546 declare New_Assign : Assign_Statement_Ptr; begin New_Assign := new Assign_Statement; New_Assign.line_number := Scheduler_Lex.Lines; New_Assign.file_name := File_Name; New_Assign.lvalue := yy.value_stack (yy.tos - 3).Expression; New_Assign.rvalue := yy.value_stack (yy.tos - 1).Expression; YYVal.Statement := Generic_Statement_Ptr (New_Assign); end; when 64 => --#line 562 New_If := new If_Statement; New_If.line_number := Scheduler_Lex.Lines; New_If.file_name := File_Name; New_If.bool_expression := yy.value_stack (yy.tos - 3).Expression; New_If.then_statement := yy.value_stack (yy.tos - 1).Statement; New_If.else_statement := yy.value_stack (yy.tos).Statement; YYVal.Statement := Generic_Statement_Ptr (New_If); when 65 => --#line 575 declare New_Return : Return_Statement_Ptr; begin New_Return := new Return_Statement; New_Return.return_value := yy.value_stack (yy.tos).Expression; New_Return.line_number := Scheduler_Lex.Lines; New_Return.file_name := File_Name; YYVal.Statement := Generic_Statement_Ptr (New_Return); end; when 66 => --#line 591 declare New_Exit : Exit_Statement_Ptr; begin New_Exit := new Exit_Statement; New_Exit.line_number := Scheduler_Lex.Lines; New_Exit.file_name := File_Name; YYVal.Statement := Generic_Statement_Ptr (New_Exit); end; when 67 => --#line 605 New_for := new For_Statement; New_for.for_type := yy.value_stack (yy.tos - 4).Table_Type_Value; New_for.for_index := Variable_Expression_Ptr ( yy.value_stack (yy.tos - 6).Expression); New_for.line_number := Scheduler_Lex.Lines; New_for.file_name := File_Name; New_for.included_statement := yy.value_stack (yy.tos - 2).Statement; YYVal.Statement := Generic_Statement_Ptr (New_for); when 68 => --#line 618 New_While := new While_Statement; New_While.condition := yy.value_stack (yy.tos - 4).Expression; New_While.line_number := Scheduler_Lex.Lines; New_While.file_name := File_Name; New_While.included_statement := yy.value_stack (yy.tos - 2).Statement; YYVal.Statement := Generic_Statement_Ptr (New_While); when 69 => --#line 631 declare New_Random : Random_Initialize_Statement_Ptr; begin New_Random := new Random_Initialize_Statement; New_Random.line_number := Scheduler_Lex.Lines; New_Random.file_name := File_Name; New_Random.lvalue := yy.value_stack (yy.tos - 4).String_Value; New_Random.law := Exponential_Law_Type; New_Random.parameter1 := yy.value_stack (yy.tos - 2).Expression; YYVal.Statement := Generic_Statement_Ptr (New_Random); end; when 70 => --#line 648 declare New_Random : Random_Initialize_Statement_Ptr; begin New_Random := new Random_Initialize_Statement; New_Random.line_number := Scheduler_Lex.Lines; New_Random.file_name := File_Name; New_Random.lvalue := yy.value_stack (yy.tos - 6).String_Value; New_Random.law := Laplace_Gauss_Law_Type; New_Random.parameter1 := yy.value_stack (yy.tos - 4).Expression; New_Random.parameter2 := yy.value_stack (yy.tos - 2).Expression; YYVal.Statement := Generic_Statement_Ptr (New_Random); end; when 71 => --#line 665 declare New_Random : Random_Initialize_Statement_Ptr; begin New_Random := new Random_Initialize_Statement; New_Random.line_number := Scheduler_Lex.Lines; New_Random.file_name := File_Name; New_Random.lvalue := yy.value_stack (yy.tos - 6).String_Value; New_Random.law := Uniform_Law_Type; New_Random.parameter1 := yy.value_stack (yy.tos - 4).Expression; New_Random.parameter2 := yy.value_stack (yy.tos - 2).Expression; YYVal.Statement := Generic_Statement_Ptr (New_Random); end; when 72 => --#line 682 declare New_Set : Set_Statement_Ptr; begin -- Is the Variable already exists ? -- for I in 0 .. Sets_Table.Nb_Entries - 1 loop if (Sets_Table.Entries (I).set_id = yy.value_stack (yy.tos - 2).String_Value) then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & yy.value_stack (yy.tos - 2).String_Value & Lb_Comma & Lb_Identifier_Already_Declared ( Current_Language))); end if; end loop; New_Set := new Set_Statement; New_Set.set_value := yy.value_stack (yy.tos - 1).Expression; New_Set.set_id := yy.value_stack (yy.tos - 2).String_Value; New_Set.line_number := Scheduler_Lex.Lines; New_Set.file_name := File_Name; Add (Sets_Table, New_Set); YYVal.Statement := Generic_Statement_Ptr (New_Set); end; when 73 => --#line 713 YYVal.Expression := yy.value_stack (yy.tos).Expression; when 74 => --#line 717 YYVal.Expression := null; when 75 => --#line 725 YYVal.Expression := yy.value_stack (yy.tos - 1).Expression; when 76 => --#line 729 YYVal.Expression := null; when 77 => --#line 737 YYVal.Variable_Type_Value := Simulation_Double; when 78 => --#line 741 if yy.value_stack (yy.tos - 3).Table_Type_Value = Time_Unit_Table_Type then YYVal.Variable_Type_Value := Simulation_Time_Unit_Array_Double; else YYVal.Variable_Type_Value := Simulation_Array_Double; end if; when 79 => --#line 750 YYVal.Variable_Type_Value := Simulation_Integer; when 80 => --#line 754 if yy.value_stack (yy.tos - 3).Table_Type_Value = Time_Unit_Table_Type then YYVal.Variable_Type_Value := Simulation_Time_Unit_Array_Integer; else YYVal.Variable_Type_Value := Simulation_Array_Integer; end if; when 81 => --#line 763 YYVal.Variable_Type_Value := Simulation_clock; when 82 => --#line 767 if yy.value_stack (yy.tos - 3).Table_Type_Value = Time_Unit_Table_Type then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "can not define a Time_Unit array of Clock type.")); else YYVal.Variable_Type_Value := Simulation_array_clock; end if; when 83 => --#line 778 YYVal.Variable_Type_Value := Simulation_Random; when 84 => --#line 782 if yy.value_stack (yy.tos - 3).Table_Type_Value = Time_Unit_Table_Type then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "can not define a Time_Unit array of Random type.")); else YYVal.Variable_Type_Value := Simulation_array_clock; end if; when 85 => --#line 793 YYVal.Variable_Type_Value := Simulation_Boolean; when 86 => --#line 797 if yy.value_stack (yy.tos - 3).Table_Type_Value = Time_Unit_Table_Type then YYVal.Variable_Type_Value := Simulation_Time_Unit_Array_Boolean; else YYVal.Variable_Type_Value := Simulation_Array_Boolean; end if; when 87 => --#line 806 if yy.value_stack (yy.tos - 3).Table_Type_Value = Time_Unit_Table_Type then YYVal.Variable_Type_Value := Simulation_Time_Unit_Array_String; else YYVal.Variable_Type_Value := Simulation_Array_String; end if; when 88 => --#line 815 YYVal.Variable_Type_Value := Simulation_String; when 89 => --#line 823 YYVal.Table_Type_Value := Task_Table_Type; when 90 => --#line 827 YYVal.Table_Type_Value := Buffer_Table_Type; when 91 => --#line 831 YYVal.Table_Type_Value := Message_Table_Type; when 92 => --#line 835 YYVal.Table_Type_Value := Time_Unit_Table_Type; when 93 => --#line 839 YYVal.Table_Type_Value := Processor_Table_Type; when 94 => --#line 843 YYVal.Table_Type_Value := Resource_Table_Type; when 95 => --#line 851 YYVal.Expression := yy.value_stack (yy.tos).Expression; when 96 => --#line 855 YYVal.Expression := null; when 97 => --#line 862 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Logic_And_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 98 => --#line 875 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Modulo_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 99 => --#line 888 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Inferior_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 100 => --#line 901 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Superior_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 101 => --#line 914 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Equal_Less_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 102 => --#line 927 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Equal_Greater_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 103 => --#line 940 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Not_Equal_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 104 => --#line 953 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Equal_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 105 => --#line 966 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Logic_Or_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 106 => --#line 979 declare New_Expr : Unary_Expression_Ptr; begin New_Expr := new Unary_Expression; New_Expr.Ope := Logic_Not_Type; New_Expr.Value := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 107 => --#line 991 YYVal.Expression := yy.value_stack (yy.tos - 1).Expression; when 108 => --#line 996 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value'(Simulation_Boolean, True); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 109 => --#line 1007 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value'(Simulation_Boolean, False); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 110 => --#line 1018 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Plus_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 111 => --#line 1031 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Minus_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 112 => --#line 1044 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Multiply_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 113 => --#line 1057 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Divide_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 114 => --#line 1070 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Lcm_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 5).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos - 3).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 115 => --#line 1083 declare New_Expr : Unary_Expression_Ptr; begin New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Abs_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 116 => --#line 1096 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Concatenate_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 5).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos - 3).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 117 => --#line 1109 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Max_Operator_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 3).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos - 1).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 118 => --#line 1122 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Min_Operator_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 3).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos - 1).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 119 => --#line 1135 declare New_Expr : Binary_Expression_Ptr; begin New_Expr := new Binary_Expression; New_Expr.Ope := Exponential_Type; New_Expr.Lvalue := yy.value_stack (yy.tos - 2).Expression; New_Expr.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 120 => --#line 1148 declare New_Expr1 : Binary_Expression_Ptr; New_Expr2 : Constant_Expression_Ptr; begin New_Expr2 := new Constant_Expression; if Get_Type (yy.value_stack (yy.tos).Expression.all) = Simulation_Double then New_Expr2.Value := new Simulation_Value'(Simulation_Double, -1.0); else New_Expr2.Value := new Simulation_Value'(Simulation_Integer, -1); end if; New_Expr1 := new Binary_Expression; New_Expr1.Ope := Multiply_Type; New_Expr1.Lvalue := Generic_Expression_Ptr (New_Expr2); New_Expr1.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr1); end; when 121 => --#line 1172 declare New_Expr1 : Binary_Expression_Ptr; New_Expr2 : Constant_Expression_Ptr; begin New_Expr2 := new Constant_Expression; if Get_Type (yy.value_stack (yy.tos).Expression.all) = Simulation_Double then New_Expr2.Value := new Simulation_Value'(Simulation_Double, 1.0); else New_Expr2.Value := new Simulation_Value'(Simulation_Integer, 1); end if; New_Expr1 := new Binary_Expression; New_Expr1.Ope := Multiply_Type; New_Expr1.Lvalue := Generic_Expression_Ptr (New_Expr2); New_Expr1.Rvalue := yy.value_stack (yy.tos).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr1); end; when 122 => --#line 1196 declare New_Expr : Unary_Expression_Ptr; begin if (Current_Section_Type /= Election_Type) then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "min_to_index and max_to_index operators can only be used in election_section." )); end if; New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Max_To_Index_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 123 => --#line 1216 declare New_Expr : Unary_Expression_Ptr; begin if (Current_Section_Type /= Election_Type) then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & "min_to_index and max_to_index operators can only be used in election_section." )); end if; New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Min_To_Index_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 124 => --#line 1236 declare New_Expr : Unary_Expression_Ptr; begin New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Get_Task_Index_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 125 => --#line 1248 declare New_Expr : Unary_Expression_Ptr; begin New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Get_Resource_Index_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 126 => --#line 1260 declare New_Expr : Unary_Expression_Ptr; begin New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Get_Buffer_Index_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 127 => --#line 1272 declare New_Expr : Unary_Expression_Ptr; begin New_Expr := new Unary_Expression; New_Expr.Value := yy.value_stack (yy.tos - 1).Expression; New_Expr.Ope := Get_Message_Index_Type; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 128 => --#line 1284 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value'(Simulation_Double, Double'Last); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 129 => --#line 1294 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value'(Simulation_Double, Double'First); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 130 => --#line 1304 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value'(Simulation_Integer, Integer'Last); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 131 => --#line 1314 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value'(Simulation_Integer, Integer'First); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 132 => --#line 1324 declare New_Expr : Array_Variable_Expression_Ptr; begin -- Find the type of the $1 Variable -- YYVal.Expression := Generic_Expression_Ptr ( Variables_Table.Entries (Find_Variable (Variables_Table, yy.value_stack (yy.tos - 3). String_Value, Scheduler_Lex.Lines, File_Name)).Variable); New_Expr := new Array_Variable_Expression; New_Expr.Variable_Type := Variable_Expression_Ptr (YYVal.Expression).Variable_Type; New_Expr.name := yy.value_stack (yy.tos - 3).String_Value; New_Expr.Array_Index := yy.value_stack (yy.tos - 1).Expression; YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 133 => --#line 1341 -- Find the type of the Variable before -- instanciation -- YYVal.Expression := Generic_Expression_Ptr ( Variables_Table.Entries (Find_Variable (Variables_Table, yy.value_stack (yy.tos). String_Value, Scheduler_Lex.Lines, File_Name)).Variable); when 134 => --#line 1349 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value' (Simulation_String, yy.value_stack (yy.tos).String_Value); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 135 => --#line 1359 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value' (Simulation_Double, yy.value_stack (yy.tos).Double_Value); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 136 => --#line 1370 declare New_Expr : Constant_Expression_Ptr; begin New_Expr := new Constant_Expression; New_Expr.Value := new Simulation_Value' (Simulation_Integer, yy.value_stack (yy.tos).Integer_Value); YYVal.Expression := Generic_Expression_Ptr (New_Expr); end; when 137 => --#line 1385 YYVal.String_Value := To_Unbounded_String (scheduler_dfa.YYText); when 138 => --#line 1391 declare Ok : Boolean; begin to_double (To_Unbounded_String (scheduler_dfa.YYText), YYVal.Double_Value, Ok); if not Ok then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & To_Unbounded_String (scheduler_dfa.YYText) & Lb_Comma & Lb_Double_Conversion_Error (Current_Language))); end if; end; when 139 => --#line 1407 declare Tmp : Unbounded_String; begin Tmp := To_Unbounded_String (scheduler_dfa.YYText); Tmp := To_Unbounded_String (Slice (Tmp, 2, Length (Tmp) - 1)); YYVal.String_Value := Tmp; end; when 140 => --#line 1418 declare Ok : Boolean; begin to_integer (To_Unbounded_String (scheduler_dfa.YYText), YYVal.Integer_Value, Ok); if not Ok then Raise_Exception (Expressions.Syntax_Error'Identity, "file " & To_String (File_Name) & " line " & Scheduler_Lex.Lines'Img & To_String (Lb_Comma & To_Unbounded_String (scheduler_dfa.YYText) & Lb_Comma & Lb_Integer_Conversion_Error (Current_Language))); end if; end; when others => null; end case; -- Pop RHS states and goto next state yy.tos := yy.tos - Rule_Length (yy.rule_id) + 1; if yy.tos > yy.stack_size then Text_IO.Put_Line (" Stack size exceeded on state_stack"); raise yy_tokens.Syntax_Error; end if; yy.state_stack (yy.tos) := goto_state (yy.state_stack (yy.tos - 1), Get_LHS_Rule (yy.rule_id)); yy.value_stack (yy.tos) := YYVal; if yy.DEBUG then reduce_debug (yy.rule_id, goto_state (yy.state_stack (yy.tos - 1), Get_LHS_Rule (yy.rule_id))); end if; end if; end loop; end Yyparse; end Parser;