-- ============================================================================ -- >>>>>>>>>>>>>>>>>>>>>>>>>> ADA COMPILATION UNIT <<<<<<<<<<<<<<<<<<<<<<<<<<<< -- ============================================================================ -- -- NAME: Control_Flow_Scan -- -- BODY -- -- AUTHOR: Pilar Montes -- General Research Corporation -- -- CHANGE -- -- MM-DD-YY | Initials | Description -- --------------------------------------------------------------------------- -- 04-14-94 PNM Incorporated C. Hobin's suggestions resulting -- from his code walkthrough. -- 04-17-94 CWH Changed Node_Label_Set and Label_Node_Set to have -- pointers as their item types. Fixed Scan_Goto_Statement -- to handle the case where the name in a goto is a -- a selected component (seems odd, but it's legal!) -- 05-03-94 PNM Added extensive garbage collection. -- =========================================================================== -- =========================================================================== with Asis; with Control_Flow_Defs; with Msg_Log; with Set_Simple_Sequential_Unbounded_Managed_Iterator; with Stack_Sequential_Unbounded_Managed_Iterator; with Unchecked_Deallocation; package body Control_Flow_Scan is -- The approach used to build a control flow view is based on the -- Unit Flow Structure described in Bieman, "A Standard Representation of -- Imperative Language Programs of Data Collection and Software -- Measures Specification", The Journal of Systems and Software -- 8, 13-37 (1988). The paper considers the analysis of control flow -- in Pascal programs; we extended the analysis for Ada. The major -- difference in our approach is that we construct a separate graph node -- for each Ada statement, whereas Bieman constructs one node per basic -- block. Cuid : constant String := "Control_Flow_Scan"; package Asis_D renames Asis.Declarations; package Asis_E renames Asis.Elements; package Asis_X renames Asis.Expressions; package Asis_S renames Asis.Statements; package Asis_Td renames Asis.Type_Definitions; package Cf_Graph renames Control_Flow_Defs.Control_Graph; ---------------------------------------------------------------------------- -- Incomplete Type and Access Type Declarations ---------------------------------------------------------------------------- type Dangling_Node_Type; type Dangling_Node_Type_Ptr is access Dangling_Node_Type; type Label_Node_Type; type Label_Node_Type_Ptr is access Label_Node_Type; type Node_Label_Type; type Node_Label_Type_Ptr is access Node_Label_Type; type Loop_Node_Type; type Loop_Node_Type_Ptr is access Loop_Node_Type; type Choice_Type; type Choice_Type_Ptr is access Choice_Type; type Exception_Handler_Type; type Exception_Handler_Type_Ptr is access Exception_Handler_Type; type Block_Type; type Block_Type_Ptr is access Block_Type; ---------------------------------------------------------------------------- -- TYPE DECLARATIONS AND GENERIC PACKAGE INSTANTIATIONS ---------------------------------------------------------------------------- type Dangling_Node_Type is record Node : Cf_Graph.Vertex; Edge_Info : Control_Flow_Defs.Edge_Type; end record; -- A "dangling node" is a node whose successor in the graph is not -- currently known. When the successor node is discovered, an -- edge is created with the dangling node as the source and the -- successor node as the destination. -- -- This type associates a dangling node with information that -- will be stored on the edge. package Node_Set is new Set_Simple_Sequential_Unbounded_Managed_Iterator (Item => Dangling_Node_Type); type Node_Set_Ptr is access Node_Set.Set; package Node_Set_Stack is new Stack_Sequential_Unbounded_Managed_Iterator (Item => Node_Set_Ptr); procedure Free is new Unchecked_Deallocation (Node_Set.Set, Node_Set_Ptr); ------------------------------------------------------------------------ type Label_Node_Type is record Label : Asis.Entity_Name_Definition; Corresponding_Node : Cf_Graph.Vertex; end record; package Label_Node_Set is new Set_Simple_Sequential_Unbounded_Managed_Iterator (Item => Label_Node_Type_Ptr); procedure Free is new Unchecked_Deallocation (Label_Node_Type, Label_Node_Type_Ptr); ------------------------------------------------------------------------ type Node_Label_Type is record Go_From_Node : Cf_Graph.Vertex; Go_To_Label : Asis.Entity_Name_Definition; end record; package Node_Label_Set is new Set_Simple_Sequential_Unbounded_Managed_Iterator (Item => Node_Label_Type_Ptr); procedure Free is new Unchecked_Deallocation (Node_Label_Type, Node_Label_Type_Ptr); ------------------------------------------------------------------------ type Loop_Node_Type is record Loop_Stmt : Asis.Statement; Loop_Node : Cf_Graph.Vertex; Exit_Node_Set : Node_Set.Set; end record; package Loop_Node_Stack is new Stack_Sequential_Unbounded_Managed_Iterator (Item => Loop_Node_Type_Ptr); procedure Free is new Unchecked_Deallocation (Loop_Node_Type, Loop_Node_Type_Ptr); ------------------------------------------------------------------------ type Choice_Type is record Name_Def : Asis.Entity_Name_Definition; end record; package Choice_Set is new Set_Simple_Sequential_Unbounded_Managed_Iterator (Item => Choice_Type_Ptr); type Choice_Set_Ptr is access Choice_Set.Set; procedure Free is new Unchecked_Deallocation (Choice_Type, Choice_Type_Ptr); ------------------------------------------------------------------------ type Exception_Handler_Type is record Node : Cf_Graph.Vertex; Has_Others_Choice : Boolean; Choices : Choice_Set.Set; end record; package Exception_Handler_Set is new Set_Simple_Sequential_Unbounded_Managed_Iterator (Item => Exception_Handler_Type_Ptr); procedure Free is new Unchecked_Deallocation (Exception_Handler_Type, Exception_Handler_Type_Ptr); ------------------------------------------------------------------------ type Block_Type is record Block_Stmt : Asis.Statement; Block_Node : Cf_Graph.Vertex; Handlers : Exception_Handler_Set.Set; Current_Handler : Exception_Handler_Type_Ptr; end record; package Block_Stack is new Stack_Sequential_Unbounded_Managed_Iterator (Item => Block_Type_Ptr); procedure Free is new Unchecked_Deallocation (Block_Type, Block_Type_Ptr); --------------------------------------------------------------------------- -- GLOBAL VARIABLES --------------------------------------------------------------------------- The_View : Cf_Defs.Control_Flow_View; Dangling_Node_Stack : Node_Set_Stack.Stack; The_Return_Stack : Node_Set_Stack.Stack; The_Terminal_Node : Cf_Graph.Vertex; The_Block_Stack : Block_Stack.Stack; Current_Loop_Stack : Loop_Node_Stack.Stack; Label_Maps : Label_Node_Set.Set; Forward_Label_Ref : Node_Label_Set.Set; -- forward references ------------------------------------------------------------------------ -- LOCAL SUBPROGRAM DECLARATIONS ------------------------------------------------------------------------ procedure Clear_Globals; procedure Free_Globals; procedure Free_Node_Set (The_Set : in out Node_Set_Ptr); procedure Pop_Free (The_Stack : in out Node_Set_Stack.Stack); procedure Pop_Free (The_Stack : in out Loop_Node_Stack.Stack); procedure Pop_Free (The_Stack : in out Block_Stack.Stack); procedure Create_Edges_From_Dangling_Nodes (In_Node_Set : in Node_Set.Set; To_The_Node : in Cf_Graph.Vertex); procedure Merge_Dangling_Sets; function Base_Exception_Name_Definition (Exception_Expression : in Asis.Expression) return Asis.Entity_Name_Definition; procedure Create_Raise_Edge (From_Raise_Statement : in out Cf_Graph.Vertex; Raised_Exception : in Asis.Entity_Name_Definition); ------------------------------------------------------------------------ procedure Scan_Label_List (List : in Asis.Entity_Name_Definition_List; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Label (The_Label : in Asis.Entity_Name_Definition; The_New_Node : in Cf_Graph.Vertex); ------------------------------------------------------------------------ procedure Scan_Statement_List (List : in Asis.Statement_List); procedure Scan_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex); ------------------------------------------------------------------------ -- A separate scan procedure is declared for each kind of statement -- element. procedure Scan_Abort_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Accept_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Assignment_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Block_Statement (Block_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Case_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Code_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Delay_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Entry_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Exit_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Goto_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex); procedure Scan_If_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex); procedure Scan_Loop_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Null_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Procedure_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Raise_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex); procedure Scan_Return_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Selective_Wait_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Conditional_Entry_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); procedure Scan_Timed_Entry_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex); ------------------------------------------------------------------------ procedure Scan_Exception_Handler (Asis_Handler : in Asis.Exception_Handler); procedure Scan_Exception_Handler_List (List : in Asis.Exception_Handler_List); procedure Scan_Handler_Statement_List (List : in Asis.Statement_List; The_First_Node : out Cf_Graph.Vertex); procedure Scan_Handler_Choice_List (List : in Asis.Element_List; The_Handler : in out Exception_Handler_Type_Ptr); procedure Scan_Handler_Choice (A_Choice : in Asis.Choice; The_Handler : in out Exception_Handler_Type_Ptr); ------------------------------------------------------------------------ procedure Scan_If_Statement_Arm (Arm : in Asis.If_Statement_Arm; If_Node : in out Cf_Graph.Vertex); procedure Scan_If_Statement_Arm_List (List : in Asis.If_Statement_Arm_List; If_Node : in out Cf_Graph.Vertex); ------------------------------------------------------------------------ procedure Scan_Case_Statement_Alternative (Case_Alternative : in Asis.Case_Statement_Alternative; Case_Node : in Cf_Graph.Vertex); procedure Scan_Case_Statement_Alternative_List (List : in Asis.Case_Statement_Alternative_List; Case_Node : in Cf_Graph.Vertex); ------------------------------------------------------------------------ procedure Scan_Select_Statement_Arm (Arm : in Asis.Select_Statement_Arm; Select_Node : in out Cf_Graph.Vertex); procedure Scan_Select_Statement_Arm_List (List : in Asis.Select_Statement_Arm_List; Select_Node : in out Cf_Graph.Vertex); ------------------------------------------------------------------------ -- LOCAL SUBPROGRAM BODIES ------------------------------------------------------------------------ --| +-------------------------------------------------------------------------+ --| | CLEAR_GLOBALS (local) | --| +-------------------------------------------------------------------------+ --| Clears global variables used to build the control graph view. procedure Clear_Globals is begin Block_Stack.Clear (The_Stack => The_Block_Stack); Node_Set_Stack.Clear (The_Stack => Dangling_Node_Stack); Node_Set_Stack.Clear (The_Stack => The_Return_Stack); Loop_Node_Stack.Clear (The_Stack => Current_Loop_Stack); Label_Node_Set.Clear (The_Set => Label_Maps); Node_Label_Set.Clear (The_Set => Forward_Label_Ref); end Clear_Globals; --| +-------------------------------------------------------------------------+ --| | FREE_GLOBALS (local) | --| +-------------------------------------------------------------------------+ --| Garbage collection done at end of creating the control flow graph view. --| Free memory and clear out global variables. procedure Free_Globals is Iterator1 : Label_Node_Set.Iterator; Iterator2 : Node_Label_Set.Iterator; The_Label_Node : Label_Node_Type_Ptr; The_Node_Label : Node_Label_Type_Ptr; begin Label_Node_Set.Initialize (The_Iterator => Iterator1, With_The_Set => Label_Maps); while not Label_Node_Set.Is_Done (Iterator1) loop The_Label_Node := Label_Node_Set.Value_Of (Iterator1); Free (The_Label_Node); Label_Node_Set.Get_Next (Iterator1); end loop; Node_Label_Set.Initialize (The_Iterator => Iterator2, With_The_Set => Forward_Label_Ref); while not Node_Label_Set.Is_Done (Iterator2) loop The_Node_Label := Node_Label_Set.Value_Of (Iterator2); Free (The_Node_Label); Node_Label_Set.Get_Next (Iterator2); end loop; Clear_Globals; end Free_Globals; --| +-------------------------------------------------------------------------+ --| | POP_FREE (local) | --| +-------------------------------------------------------------------------+ procedure Free_Node_Set (The_Set : in out Node_Set_Ptr) is begin Node_Set.Clear (The_Set.all); Free (The_Set); end Free_Node_Set; --| +-------------------------------------------------------------------------+ --| | POP_FREE (local) | --| +-------------------------------------------------------------------------+ procedure Pop_Free (The_Stack : in out Node_Set_Stack.Stack) is The_Set : Node_Set_Ptr; begin The_Set := Node_Set_Stack.Top_Of (The_Stack => The_Stack); Free_Node_Set (The_Set => The_Set); Node_Set_Stack.Pop (The_Stack => The_Stack); end Pop_Free; --| +-------------------------------------------------------------------------+ --| | POP_FREE (local) | --| +-------------------------------------------------------------------------+ procedure Pop_Free (The_Stack : in out Loop_Node_Stack.Stack) is Loop_Node : Loop_Node_Type_Ptr; begin Loop_Node := Loop_Node_Stack.Top_Of (The_Stack => The_Stack); Node_Set.Clear (Loop_Node.Exit_Node_Set); Free (Loop_Node); Loop_Node_Stack.Pop (The_Stack); end Pop_Free; --| +-------------------------------------------------------------------------+ --| | POP_FREE (local) | --| +-------------------------------------------------------------------------+ -- Free and pop a block_type object from a block stack. The block contians -- a set of handlers, and each handler has a set of choices; memory for -- these objects are also freed. procedure Pop_Free (The_Stack : in out Block_Stack.Stack) is The_Block : Block_Type_Ptr; Iterator1 : Exception_Handler_Set.Iterator; Iterator2 : Choice_Set.Iterator; The_Handler : Exception_Handler_Type_Ptr; The_Choice : Choice_Type_Ptr; begin The_Block := Block_Stack.Top_Of (The_Stack => The_Stack); Exception_Handler_Set.Initialize (The_Iterator => Iterator1, With_The_Set => The_Block.Handlers); while not Exception_Handler_Set.Is_Done (Iterator1) loop The_Handler := Exception_Handler_Set.Value_Of (Iterator1); Choice_Set.Initialize (The_Iterator => Iterator2, With_The_Set => The_Handler.Choices); while not Choice_Set.Is_Done (Iterator2) loop The_Choice := Choice_Set.Value_Of (Iterator2); Choice_Set.Remove (The_Item => The_Choice, From_The_Set => The_Handler.Choices); Free (The_Choice); Choice_Set.Get_Next (Iterator2); end loop; Exception_Handler_Set.Remove (The_Item => The_Handler, From_The_Set => The_Block.Handlers); Free (The_Handler); Exception_Handler_Set.Get_Next (Iterator1); end loop; Block_Stack.Pop (The_Stack => The_Stack); end Pop_Free; --| +-------------------------------------------------------------------------+ --| | CREATE_EDGES_FROM_DANGLING_NODES (local) | --| +-------------------------------------------------------------------------+ procedure Create_Edges_From_Dangling_Nodes (In_Node_Set : in Node_Set.Set; To_The_Node : in Cf_Graph.Vertex) is Puid : constant String := "Create_Edges_From_Dangling_Nodes"; The_Iterator : Node_Set.Iterator; Dangling_Node : Dangling_Node_Type; The_Edge : Cf_Defs.Edge_Type_Ptr; The_Arc : Cf_Graph.Arc; begin -- For each node in the set, create an edge (arc) on the -- control graph. Node_Set.Initialize (The_Iterator => The_Iterator, With_The_Set => In_Node_Set); while not Node_Set.Is_Done (The_Iterator) loop Dangling_Node := Node_Set.Value_Of (The_Iterator); The_Edge := new Cf_Defs.Edge_Type'(Dangling_Node.Edge_Info); Cf_Graph.Create (The_Arc => The_Arc, With_The_Attribute => The_Edge, From_The_Vertex => Dangling_Node.Node, To_The_Vertex => To_The_Node, In_The_Graph => The_View.Graph); Node_Set.Get_Next (The_Iterator); end loop; end Create_Edges_From_Dangling_Nodes; --| +-------------------------------------------------------------------------+ --| | MERGE_DANGLING_SETS (local) | --| +-------------------------------------------------------------------------+ --| Merge (to the union of) the top two sets in the Dangling_Node_Stack. procedure Merge_Dangling_Sets is The_Xset : Node_Set_Ptr; The_Yset : Node_Set_Ptr; The_Set : Node_Set_Ptr; begin The_Xset := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); Node_Set_Stack.Pop (The_Stack => Dangling_Node_Stack); The_Yset := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); Node_Set_Stack.Pop (The_Stack => Dangling_Node_Stack); The_Set := new Node_Set.Set; Node_Set.Union (Of_The_Set => The_Xset.all, And_The_Set => The_Yset.all, To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Garbage collection Free_Node_Set (The_Set => The_Xset); Free_Node_Set (The_Set => The_Yset); end Merge_Dangling_Sets; --| +-------------------------------------------------------------------------+ --| | BASE_EXCEPTION_NAME_DEFINITION (local) | --| +-------------------------------------------------------------------------+ function Base_Exception_Name_Definition (Exception_Expression : in Asis.Expression) return Asis.Entity_Name_Definition is -- Given an exception name occuring in a raise statement or an exception -- handler choice, returns the Entity_Name_Definition element of -- the exception. If a renamed exception is referenced, -- renames are unwound and the Entity_Name_Definition of the -- base exception is located. Puid : constant String := "Base_Exception_Name_Definition"; Simple_Name : Asis.Expression; Exception_Declaration : Asis.Declaration; Rename_Expression : Asis.Expression; begin case Asis_X.Kind (Exception_Expression) is -- The expression is either a simple_name or a -- selected_component. when Asis_X.A_Simple_Name => Simple_Name := Exception_Expression; when Asis_X.A_Selected_Component => -- Get the selector (a simple_name). Simple_Name := Asis_X.Selector (Exception_Expression); when others => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Unexpected Expression kind encountered for exception name"); end case; Exception_Declaration := Asis_X.Name_Declaration (Simple_Name); if Asis_D."=" (Asis_D.Kind (Exception_Declaration), Asis_D.An_Exception_Rename_Declaration) then Rename_Expression := Asis_D.Renamed_Base_Entity (Exception_Declaration); case Asis_X.Kind (Rename_Expression) is -- The expression is either a simple_name or a -- selected_component. when Asis_X.A_Simple_Name => Simple_Name := Rename_Expression; when Asis_X.A_Selected_Component => -- Get the selector (a simple_name). Simple_Name := Asis_X.Selector (Rename_Expression); when others => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Unexpected Expression kind encountered for" & " renamed exception name"); end case; end if; return Asis_X.Name_Definition (Simple_Name); end Base_Exception_Name_Definition; --| +-------------------------------------------------------------------------+ --| | CREATE_RAISE_EDGE (local) | --| +-------------------------------------------------------------------------+ procedure Create_Raise_Edge (From_Raise_Statement : in out Cf_Graph.Vertex; Raised_Exception : in Asis.Entity_Name_Definition) is -- Applies the rules of LRM 11.4.1 to determine the destination node -- of the created edge. If the raised exception is handled by -- an exception handler associated with the program unit body, or with -- a block statement nested in the body, then the first statement -- in that handler becomes the destination node of the edge; -- otherwise, the destination node is the terminal node of the -- CFG. The latter case represents the situations where the exception -- is propagated by a subprogram or package body, or where a task body -- becomes completed (LRM 11.4.1, cases (a), (c), and (d)). -- -- The global variable The_Block_Stack is used by this procedure. Each -- item on the stack constitutes a frame (LRM 11.2). The stack is -- searched from the top down, and the handlers in each frame, if any, are -- examined to find a matching exception choice or a "when others" handler. -- If a matching exception or a "when others" is found, then edge is created -- with the first statement of the handler as the destination node. If -- the search of all frames in the stack fails, then the edge is created -- with the terminal node as the destination node. -- -- The search of a given frame is influenced by whether execution in that -- frame is currently in the frame's sequence of statements or in one of the -- frame's handlers. If a frame's execution is currently in a handler, -- then the frame is skipped and the search continues with the next frame -- on the stack (LRM 11.4.1(10)). -- -- The rules for exceptions raised within accept statements (LRM 11.5(4)) -- have no effect on this algorithm, as we are not concerned here with -- the raising of exceptions in a different thread of control. Stack_Iterator : Block_Stack.Iterator; The_Block : Block_Type_Ptr; Handler_Iterator : Exception_Handler_Set.Iterator; The_Handler : Exception_Handler_Type_Ptr; Others_Handler : Exception_Handler_Type_Ptr; Choice_Iterator : Choice_Set.Iterator; The_Choice : Choice_Type_Ptr; procedure Make_The_Edge (Destination_Vertex : in Cf_Graph.Vertex; Handled : in Boolean) is The_Arc : Cf_Graph.Arc; The_Edge : Cf_Defs.Edge_Type_Ptr; begin The_Edge := new Cf_Defs.Edge_Type; if Handled then The_Edge.Kind := Cf_Defs.Handled_Raise; else The_Edge.Kind := Cf_Defs.Propagated_Raise; end if; The_Edge.Element := Raised_Exception; Cf_Graph.Create (The_Arc => The_Arc, With_The_Attribute => The_Edge, From_The_Vertex => From_Raise_Statement, To_The_Vertex => Destination_Vertex, In_The_Graph => The_View.Graph); end Make_The_Edge; begin -- Search the block stack from the top down. Block_Stack.Initialize (The_Iterator => Stack_Iterator, With_The_Stack => The_Block_Stack); Iterate_Over_Block_Stack: while not Block_Stack.Is_Done (Stack_Iterator) loop The_Block := Block_Stack.Value_Of (Stack_Iterator); -- If execution of the current frame is within an exception handler, -- we skip it, since the the raised exception causes the -- frame to be abandoned immediately. if The_Block.Current_Handler = null then -- The frame's current handler is null, meaning execution is in the -- frame's sequence of statements. Thus, we search the -- frame's handlers for a matching exception. Exception_Handler_Set.Initialize (The_Iterator => Handler_Iterator, With_The_Set => The_Block.Handlers); Others_Handler := null; Iterate_Over_Handlers: while not Exception_Handler_Set.Is_Done (Handler_Iterator) loop The_Handler := Exception_Handler_Set.Value_Of (Handler_Iterator); if The_Handler.Has_Others_Choice then -- Hold onto the "when others" handler until we -- have searched each of the remaining handlers -- in the set. Others_Handler := The_Handler; else -- Search the handler's choices for a matching -- exception name. Choice_Set.Initialize (The_Iterator => Choice_Iterator, With_The_Set => The_Handler.Choices); Iterate_Over_Choices: while not Choice_Set.Is_Done (Choice_Iterator) loop The_Choice := Choice_Set.Value_Of (Choice_Iterator); if Asis_E.Is_Equal (The_Choice.Name_Def, Raised_Exception) then -- Match found. Create new edge and -- record the exception name definition -- element on it. Make_The_Edge (Destination_Vertex => The_Handler.Node, Handled => True); return; end if; Choice_Set.Get_Next (Choice_Iterator); end loop Iterate_Over_Choices; end if; Exception_Handler_Set.Get_Next (Handler_Iterator); end loop Iterate_Over_Handlers; if Others_Handler /= null then -- No match was found in any of the handlers that name exceptions, -- but a "when others" handler was present in the handler set. -- A "when others" handler matches all exceptions, so create a -- new edge and record the exception name definition on it. Make_The_Edge (Destination_Vertex => Others_Handler.Node, Handled => True); return; end if; end if; -- The_Block.Current_Handler = null Block_Stack.Get_Next (Stack_Iterator); end loop Iterate_Over_Block_Stack; -- No matching handler was found for the raised exception. Add an edge to the -- terminal node. Make_The_Edge (Destination_Vertex => The_Terminal_Node, Handled => False); end Create_Raise_Edge; --| +-------------------------------------------------------------------------+ --| | SCAN_LABEL_LIST (local) | --| +-------------------------------------------------------------------------+ --| A statement may have a list of labels assoicated with it. --| Scan the list of labels. procedure Scan_Label_List (List : in Asis.Entity_Name_Definition_List; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Label_List"; begin for I in List'Range loop Scan_Label (List (I), The_New_Node); end loop; end Scan_Label_List; --| +-------------------------------------------------------------------------+ --| | SCAN_LABEL (local) | --| +-------------------------------------------------------------------------+ --| Adds a node to the Label_Maps set and resolves any forward references to this --| label. procedure Scan_Label (The_Label : in Asis.Entity_Name_Definition; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Label"; The_Set : Label_Node_Set.Set; The_Label_Node : Label_Node_Type_Ptr; The_Node_Label : Node_Label_Type_Ptr; The_Iterator : Node_Label_Set.Iterator; The_Edge : Cf_Defs.Edge_Type_Ptr; The_Arc : Cf_Graph.Arc; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). -- Add a node to the Label_Maps set. The_Label_Node := new Label_Node_Type; The_Label_Node.Label := The_Label; The_Label_Node.Corresponding_Node := The_New_Node; Label_Node_Set.Add (The_Item => The_Label_Node, To_The_Set => Label_Maps); -- Find Forward Label Reference set nodes, whose Go_To_Label is equal -- to the statement label. Then, add the an edge (arc) to the control -- graph and remove the Node_Label_Type from the Forward_Label_Ref set. Node_Label_Set.Initialize (The_Iterator => The_Iterator, With_The_Set => Forward_Label_Ref); while not Node_Label_Set.Is_Done (The_Iterator) loop The_Node_Label := Node_Label_Set.Value_Of (The_Iterator); if Asis_E.Is_Equal (The_Node_Label.Go_To_Label, The_Label) then The_Edge := new Cf_Defs.Edge_Type; The_Edge.Kind := Cf_Defs.Continuation; The_Edge.Element := Asis.Nil_Element; Cf_Graph.Create (The_Arc => The_Arc, With_The_Attribute => The_Edge, From_The_Vertex => The_Node_Label.Go_From_Node, To_The_Vertex => The_New_Node, In_The_Graph => The_View.Graph); Node_Label_Set.Remove (The_Item => The_Node_Label, From_The_Set => Forward_Label_Ref); end if; Node_Label_Set.Get_Next (The_Iterator); end loop; end Scan_Label; --| +-------------------------------------------------------------------------+ --| | SCAN_STATEMENT_LIST (local) | --| +-------------------------------------------------------------------------+ --| Scan the sequence of statements. procedure Scan_Statement_List (List : in Asis.Statement_List) is Puid : constant String := "Scan_Statement_List"; The_New_Node : Cf_Graph.Vertex; begin for I in List'Range loop case Asis_E.Element_Kind (List (I)) is when Asis_E.A_Statement => Scan_Statement (List (I), The_New_Node); when others => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Unexpected element kind when expecting a statement"); end case; end loop; end Scan_Statement_List; --| +-------------------------------------------------------------------------+ --| | SCAN_STATEMENT (local) | --| +-------------------------------------------------------------------------+ --| Adds a node (The_New_Node) to the Control Flow Graph, by calling Hook_Up_New_Node. --| Processes statement labels. Based on the statement kind, a procedure is called --| to process the procedure. --| NOTE: The first thing done when a statement is encountered is to add a new node --| to the Control Flow Graph. Typically there is a node per statement -- though --| there are a few exceptions. procedure Scan_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_Statement"; The_New_Item : Cf_Defs.Item_Type_Ptr; The_Set : Node_Set_Ptr; begin if Asis_E.Is_Nil (A_Statement) then return; end if; -- Create a new graph node for the statement. The_New_Item := new Cf_Defs.Item_Type; The_New_Item.Element := A_Statement; The_New_Item.Kind := Cf_Defs.Statement; -- NOTE: The item Element and Kind will be changed if -- if A_Statement is An_If_Statement. Cf_Graph.Add (The_Vertex => The_New_Node, With_The_Item => The_New_Item, To_The_Graph => The_View.Graph); -- Create a graph edge from each node in the set on top of the -- Dangling_Node_Stack to The_New_Node. The_Set := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); Create_Edges_From_Dangling_Nodes (In_Node_Set => The_Set.all, To_The_Node => The_New_Node); Pop_Free (The_Stack => Dangling_Node_Stack); -- Pop set from stack and free the memory. -- Add the The_New_Node (as a set of one node) to the Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Continuation, Asis.Nil_Element)), To_The_Set => The_Set.all); -- NOTE: The edge info may be changed when the statement is scanned. Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Check if the statement is labeled. if Asis_S.Is_Labeled (A_Statement) then Scan_Label_List (Asis_S.Label_Names (A_Statement), The_New_Node); end if; case Asis_S.Kind (A_Statement) is when Asis_S.A_Null_Statement => Scan_Null_Statement (A_Statement, The_New_Node); when Asis_S.An_Assignment_Statement => Scan_Assignment_Statement (A_Statement, The_New_Node); when Asis_S.A_Procedure_Call_Statement => Scan_Procedure_Call_Statement (A_Statement, The_New_Node); when Asis_S.An_Exit_Statement => Scan_Exit_Statement (A_Statement, The_New_Node); when Asis_S.A_Return_Statement => Scan_Return_Statement (A_Statement, The_New_Node); when Asis_S.A_Goto_Statement => Scan_Goto_Statement (A_Statement, The_New_Node); when Asis_S.An_Entry_Call_Statement => Scan_Entry_Call_Statement (A_Statement, The_New_Node); when Asis_S.A_Delay_Statement => Scan_Delay_Statement (A_Statement, The_New_Node); when Asis_S.An_Abort_Statement => Scan_Abort_Statement (A_Statement, The_New_Node); when Asis_S.A_Raise_Statement => Scan_Raise_Statement (A_Statement, The_New_Node); when Asis_S.A_Code_Statement => Scan_Code_Statement (A_Statement, The_New_Node); when Asis_S.An_If_Statement => Scan_If_Statement (A_Statement, The_New_Node); when Asis_S.A_Case_Statement => Scan_Case_Statement (A_Statement, The_New_Node); when Asis_S.A_Loop_Statement => Scan_Loop_Statement (A_Statement, The_New_Node); when Asis_S.A_Block_Statement => Scan_Block_Statement (A_Statement, The_New_Node); when Asis_S.An_Accept_Statement => Scan_Accept_Statement (A_Statement, The_New_Node); when Asis_S.A_Selective_Wait_Statement => Scan_Selective_Wait_Statement (A_Statement, The_New_Node); when Asis_S.A_Conditional_Entry_Call_Statement => Scan_Conditional_Entry_Call_Statement (A_Statement, The_New_Node); when Asis_S.A_Timed_Entry_Call_Statement => Scan_Timed_Entry_Call_Statement (A_Statement, The_New_Node); when Asis_S.Not_A_Statement => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Statement of kind Not_A_Statement encountered"); end case; end Scan_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_ABORT_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Abort_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Abort_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Abort_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_ACCEPT_STATEMENT (local) | --| +-------------------------------------------------------------------------+ --| Process the accept sequence of statements. procedure Scan_Accept_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Accept_Statement"; List : constant Asis.Statement_List := Asis_S.Accept_Body_Statements (A_Statement); The_Set : Node_Set_Ptr; The_Return_Set : Node_Set_Ptr; The_New_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). --| TRAVERSAL : Scan sequence of statements, if any. if not Asis_E.Is_Nil (List) then -- Change the edge kind of the accept statement's dangling node. Pop_Free (The_Stack => Dangling_Node_Stack); The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Accept_Body_Start, Asis.Nil_Element)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Add an empty set on the top of The_Return_Stack. This is used to -- track return statements inside an accept block. The_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => The_Return_Stack); Scan_Statement_List (List); -- Add return nodes inside the accept block to the -- Dangling_Node_Stack. The top set on the stack is replaced with -- one that includes the return nodes. The_Set := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); Node_Set_Stack.Pop (The_Stack => Dangling_Node_Stack); The_Return_Set := Node_Set_Stack.Top_Of (The_Stack => The_Return_Stack); Node_Set_Stack.Pop (The_Stack => The_Return_Stack); The_New_Set := new Node_Set.Set; Node_Set.Union (Of_The_Set => The_Set.all, And_The_Set => The_Return_Set.all, To_The_Set => The_New_Set.all); Node_Set_Stack.Push (The_Item => The_New_Set, On_The_Stack => Dangling_Node_Stack); -- Garbage collection. Free_Node_Set (The_Set => The_Set); Free_Node_Set (The_Set => The_Return_Set); end if; end Scan_Accept_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_ASSIGNMENT_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Assignment_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Assignment_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Assignment_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_BLOCK_STATEMENT (local) | --| +-------------------------------------------------------------------------+ --| Add a member onto The_Block_Stack. Process the exception handlers for the block. --| Process the sequence of statements. procedure Scan_Block_Statement (Block_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Block_Statement"; The_Exception_Handlers : constant Asis.Exception_Handler_List := Asis_S.Block_Exception_Handlers (Block_Statement); The_Block : Block_Type_Ptr; The_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). -- Pop the block statement off the Dangling_Node_Stack while processing -- exception handlers. Pop_Free (The_Stack => Dangling_Node_Stack); -- Initialize the top set in the Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Put the block onto the The_Block_Stack. The_Block := new Block_Type; The_Block.Block_Stmt := Block_Statement; The_Block.Block_Node := The_New_Node; Block_Stack.Push (The_Item => The_Block, On_The_Stack => The_Block_Stack); -- Build the control flow structure for the exception handlers. -- The handlers are done prior to the body statements, so that -- handler information is available for 'raise' statement resolution. --| TRAVERSAL : Scan the block handlers, if any. if not Asis_E.Is_Nil (The_Exception_Handlers) then Scan_Exception_Handler_List (The_Exception_Handlers); end if; --| CONTROL FLOW GRAPH PROCESSING -- Add Block Statement to Dangling_Node_Stack The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Block_Body_Start, Asis.Nil_Element)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Set field used in determining exeception propagation. The_Block.Current_Handler := null; --| TRAVERSAL : Scan the block sequence of statements. Scan_Statement_List (Asis_S.Block_Body_Statements (Block_Statement)); --| CONTROL FLOW GRAPH PROCESSING -- Merge the top two sets in the Dangling_Node_Stack. Merge_Dangling_Sets; -- The Block processing has completed, pop The_Block_Stack. Pop_Free (The_Stack => The_Block_Stack); end Scan_Block_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_CASE_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Case_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Case_Statement"; Case_Node : Cf_Graph.Vertex; The_Node_Set : Node_Set_Ptr; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). -- Pop the new node from the Dangling_Node_Stack. It will be added while -- each alternative is processed. Pop_Free (The_Stack => Dangling_Node_Stack); -- Push an empty set on the dangling node stack. After the statement is -- scanned this set will contain the dangling nodes of the case -- alternatives. The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); Case_Node := The_New_Node; --| TRAVERSAL : Scan the case alternatives Scan_Case_Statement_Alternative_List (Asis_S.Case_Statement_Alternatives (A_Statement), Case_Node); end Scan_Case_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_CODE_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Code_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Code_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Code_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_DELAY_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Delay_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Delay_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Delay_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_ENTRY_CALL_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Entry_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Entry_Call_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Entry_Call_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_EXIT_STATEMENT (local) | --| +-------------------------------------------------------------------------+ --| procedure Scan_Exit_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Exit_Statement"; Condition : Asis.Expression; The_Loop_Exp : Asis.Expression; The_Loop_Name : constant Asis.Expression := Asis_S.Exit_Loop_Name (A_Statement); The_Iterator : Loop_Node_Stack.Iterator; The_Node : Loop_Node_Type_Ptr; The_Loop_Node : Loop_Node_Type_Ptr; The_Loop_Statement : Asis.Statement; The_Node_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). if Asis_E.Is_Nil (The_Loop_Name) then -- Exit from the current loop. The_Loop_Node := Loop_Node_Stack.Top_Of (The_Stack => Current_Loop_Stack); else -- Search for the loop exited in the Current_Loop_Stack. The_Loop_Statement := Asis_S.Loop_Exited (Statement => A_Statement); Loop_Node_Stack.Initialize (The_Iterator => The_Iterator, With_The_Stack => Current_Loop_Stack); while not Loop_Node_Stack.Is_Done (The_Iterator) loop The_Node := Loop_Node_Stack.Value_Of (The_Iterator); if Asis_E.Is_Equal (The_Loop_Statement, The_Node.Loop_Stmt) then The_Loop_Node := The_Node; exit; end if; Loop_Node_Stack.Get_Next (The_Iterator); end loop; end if; -- For a conditional exit: -- * The dangling node in the Exit_Node_Set has an edge kind -- of Condition_True. -- * The dangling node on top of the dangling node stack has an -- edge kind of Condition_False. -- -- For an unconditional exit: -- * The dangling node in the Exit_Node_Set has an edge kind -- of Continuation. -- * The dangling node set on top of the dangling node stack is -- cleared. if Asis_E.Is_Nil (Asis_S.Exit_Condition (A_Statement)) then Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Continuation, Asis.Nil_Element)), To_The_Set => The_Loop_Node.Exit_Node_Set); Pop_Free (The_Stack => Dangling_Node_Stack); The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); else Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Condition_True, Asis.Nil_Element)), To_The_Set => The_Loop_Node.Exit_Node_Set); Pop_Free (The_Stack => Dangling_Node_Stack); The_Node_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Condition_False, Asis.Nil_Element)), To_The_Set => The_Node_Set.all); Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); end if; end Scan_Exit_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_GOTO_STATEMENT (local) | --| +-------------------------------------------------------------------------+ --| procedure Scan_Goto_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_Goto_Statement"; Label_Expression : Asis.Expression; The_Label : Asis.Entity_Name_Definition; The_Iterator : Label_Node_Set.Iterator; -- Used to scan the Label_Maps set. The_Label_Node : Label_Node_Type_Ptr; -- Label_Maps member node. The_Edge : Cf_Defs.Edge_Type_Ptr; The_Arc : Cf_Graph.Arc; Found_Label : Boolean := False; The_Node_Label : Node_Label_Type_Ptr; -- Forward_Label_Ref member node. The_Node_Set : Node_Set_Ptr; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). --| CONTROL FLOW GRAPH PROCESSING -- Get the name definition of the referenced label. NOTE: the -- label reference can be a selected component! Label_Expression := Asis_S.Goto_Label (A_Statement); case Asis_X.Kind (Label_Expression) is when Asis_X.A_Simple_Name => The_Label := Asis_X.Name_Definition (Label_Expression); when Asis_X.A_Selected_Component => The_Label := Asis_X.Name_Definition (Asis_X.Selector (Label_Expression)); when others => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Unexpected expression kind encountered for label name"); end case; -- Determine whether the referenced label is in the Label_Maps -- set. If one is found then set the edge to that labelled node. Label_Node_Set.Initialize (The_Iterator => The_Iterator, With_The_Set => Label_Maps); while not Label_Node_Set.Is_Done (The_Iterator) loop The_Label_Node := Label_Node_Set.Value_Of (The_Iterator); if Asis_E.Is_Equal (The_Label_Node.Label, The_Label) then The_Edge := new Cf_Defs.Edge_Type; The_Edge.Kind := Cf_Defs.Continuation; The_Edge.Element := Asis.Nil_Element; Cf_Graph.Create (The_Arc => The_Arc, With_The_Attribute => The_Edge, From_The_Vertex => The_New_Node, To_The_Vertex => The_Label_Node. Corresponding_Node, In_The_Graph => The_View.Graph); Found_Label := True; exit; end if; Label_Node_Set.Get_Next (The_Iterator); end loop; -- No label match, then add a node to the Forward_Label_Ref set. if not Found_Label then The_Node_Label := new Node_Label_Type; The_Node_Label.Go_From_Node := The_New_Node; The_Node_Label.Go_To_Label := The_Label; Node_Label_Set.Add (The_Item => The_Node_Label, To_The_Set => Forward_Label_Ref); end if; -- Update the Dangling_Node_Stack; set the top set to empty. Pop_Free (The_Stack => Dangling_Node_Stack); The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); end Scan_Goto_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_IF_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_If_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_If_Statement"; If_Node : Cf_Graph.Vertex; The_Node_Set : Node_Set_Ptr; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). -- Pop the new node from the Dangling_Node_Stack. It will be added -- back when the first if statement arm is scanned. Pop_Free (The_Stack => Dangling_Node_Stack); -- Push an empty set on the dangling node stack. After the statement is -- scanned this set will contain the dangling nodes of the if statement arms. The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); If_Node := The_New_Node; --| TRAVERSAL : Scan the if statement arms. Scan_If_Statement_Arm_List (Asis_S.If_Statement_Arms (A_Statement), If_Node); end Scan_If_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_LOOP_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Loop_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Loop_Statement"; The_Set : Node_Set_Ptr; The_New_Set : Node_Set_Ptr; The_Iterator : Node_Set.Iterator; The_Edge : Cf_Defs.Edge_Type_Ptr; The_Arc : Cf_Graph.Arc; The_Node : Cf_Graph.Vertex; The_From_Node : Cf_Graph.Vertex; The_Loop_Node : Loop_Node_Type_Ptr; The_Loop_Kind : constant Asis_S.Loop_Kinds := Asis_S.Loop_Kind (A_Statement); Conditional_Loop : Boolean; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on the Control -- Graph (The_View.Graph) by the calling procedure (SCAN_STATEMENT). -- Put the New_Node and the loop statement into the Current_Loop_Stack; -- which contains the loops currently being scanned. This approach -- will account for nested loops. The_Loop_Node := new Loop_Node_Type; The_Loop_Node.Loop_Stmt := A_Statement; The_Loop_Node.Loop_Node := The_New_Node; Loop_Node_Stack.Push (The_Item => The_Loop_Node, On_The_Stack => Current_Loop_Stack); if Asis_S."=" (The_Loop_Kind, Asis_S.A_While_Loop) or Asis_S."=" (The_Loop_Kind, Asis_S.A_For_Loop) then Conditional_Loop := True; Pop_Free (The_Stack => Dangling_Node_Stack); The_New_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Condition_True, Asis.Nil_Element)), To_The_Set => The_New_Set.all); Node_Set_Stack.Push (The_Item => The_New_Set, On_The_Stack => Dangling_Node_Stack); else Conditional_Loop := False; end if; -- TRAVERSAL : Scan sequence of statements Scan_Statement_List (Asis_S.Loop_Statements (A_Statement)); --| CONTROL FLOW GRAPH PROCESSING -- Get The_Node from the Current_Loop_Stack. The_Loop_Node := Loop_Node_Stack.Top_Of (The_Stack => Current_Loop_Stack); The_Node := The_Loop_Node.Loop_Node; -- Get the top node set from the Dangling_Node_Stack. The_Set := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); -- For each node in the top set of the Dangling_Node_Stack (The_Set), -- create an edge (arc) to The_Node (the loop node) on the control -- graph. Create_Edges_From_Dangling_Nodes (In_Node_Set => The_Set.all, To_The_Node => The_Node); -- Update the Dangling_Node_Stack. Pop_Free (The_Stack => Dangling_Node_Stack); The_Set := new Node_Set.Set; -- Determine if The_Node (the loop node) should go on the Dangling_ -- Node_Stack. Also, set the edge tag for the next statement. if Conditional_Loop then -- Since this is a conditional loop, add the node to The_Set -- and set the edge tag to Condition_False. Node_Set.Add (The_Item => (Node => The_Node, Edge_Info => (Cf_Defs.Condition_False, Asis.Nil_Element)), To_The_Set => The_Set.all); else null; -- A simple loop does not exit from the loop statement. Therefore, -- there is no need to add a The_Node to the Dangling_Node_Stack. end if; -- Add nodes in The_Loop_Node.Exit_Node_Set to the Dangling_Node_ -- Stack set. These exits from the loop will be hooked onto the -- next statement. The_New_Set := new Node_Set.Set; Node_Set.Union (Of_The_Set => The_Set.all, And_The_Set => The_Loop_Node.Exit_Node_Set, To_The_Set => The_New_Set.all); Node_Set_Stack.Push (The_Item => The_New_Set, On_The_Stack => Dangling_Node_Stack); -- We are done with this loop (The_Loop_Node). Update the -- Current_Loop_Stack. Pop_Free (The_Stack => Current_Loop_Stack); -- Garbage collection. Free_Node_Set (The_Set => The_Set); end Scan_Loop_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_NULL_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Null_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Null_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Null_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_PROCEDURE_CALL_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Procedure_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Procedure_Call_Statement"; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). null; end Scan_Procedure_Call_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_RAISE_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Raise_Statement (A_Statement : in Asis.Statement; The_New_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_Raise_Statement"; Raised_Exception_Exp : Asis.Expression; Stack_Iterator : Block_Stack.Iterator; The_Handler : Exception_Handler_Type_Ptr; The_Choice : Choice_Type_Ptr; Choice_Iterator : Choice_Set.Iterator; The_Node_Set : Node_Set_Ptr; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). -- A Raise statement is an unconditional branch, hence there are no -- dangling nodes resulting from this statement. Pop_Free (The_Stack => Dangling_Node_Stack); The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); Raised_Exception_Exp := Asis_S.Raised_Exception (A_Statement); if not Asis_E.Is_Nil (Raised_Exception_Exp) then -- Located the name definition of the raised exception, then -- create the edge by searching the block stack for a matching -- handler. Create_Raise_Edge (From_Raise_Statement => The_New_Node, Raised_Exception => Base_Exception_Name_Definition (Raised_Exception_Exp)); else -- A raise statement without a name can only occur within a handler. -- (Note, however, that a handler may contain block statements, and -- a name-less raise may occur in the sequence of statements of such -- a block statement!) -- Find the innermost enclosing block whose execution is currently -- within an exception handler. (This will be the block on top -- of the stack unless there are blocks within the handler.) -- Get the handler. Block_Stack.Initialize (The_Iterator => Stack_Iterator, With_The_Stack => The_Block_Stack); while not Block_Stack.Is_Done (Stack_Iterator) loop The_Handler := Block_Stack.Value_Of (Stack_Iterator). Current_Handler; exit when The_Handler /= null; -- Assert : for some block on the stack, Current_Handler /= null Block_Stack.Get_Next (Stack_Iterator); end loop; if The_Handler.Has_Others_Choice then -- The set of exceptions that can be handled by a "when others" -- handler is dynamic, hence the flow of control out of an -- unnamed raise is also dynamic. No edge is created (the node -- is left dangling). null; else -- The unnamed raise statement can re-raise any of the exceptions -- named by the handler. -- -- For each exception choice, get the exception named -- by the choice, then create an edge by searching the block -- stack for a matching handler. -- -- If the handler has multiple choices, there will be multiple -- edges originating at the raise node. Because each edge -- is labelled with the name definition of the corresponding -- exception, the CFG user will be able determine which edge -- to follow for a given exception. Choice_Set.Initialize (The_Iterator => Choice_Iterator, With_The_Set => The_Handler.Choices); while not Choice_Set.Is_Done (Choice_Iterator) loop The_Choice := Choice_Set.Value_Of (Choice_Iterator); Create_Raise_Edge (From_Raise_Statement => The_New_Node, Raised_Exception => The_Choice.Name_Def); Choice_Set.Get_Next (Choice_Iterator); end loop; end if; end if; end Scan_Raise_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_RETURN_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Return_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Return_Statement"; The_Node_Set : Node_Set_Ptr; The_Return_Set : Node_Set_Ptr; begin -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). --| CONTROL FLOW GRAPH PROCESSING -- No statement will follow the return statement. Update the -- Dangling_Node_Stack. Pop_Free (The_Stack => Dangling_Node_Stack); The_Node_Set := new Node_Set.Set; Node_Set.Clear (The_Node_Set.all); Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); -- Add The_New_Node to the top set in The_Return_Stack. The_Return_Set := Node_Set_Stack.Top_Of (The_Stack => The_Return_Stack); Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Continuation, Asis.Nil_Element)), To_The_Set => The_Return_Set.all); end Scan_Return_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_SELECTIVE_WAIT_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Selective_Wait_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Selective_Wait_Statement"; Select_Node : Cf_Graph.Vertex; The_Node_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). Select_Node := The_New_Node; -- Pop the new node from the Dangling_Node_Stack. It will be added while -- each arm is processed. Pop_Free (The_Stack => Dangling_Node_Stack); -- Push an empty set on the dangling node stack. After the statement is -- scanned this set will contain the dangling nodes of the select arms. The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); --| TRAVERSAL : Scan selective wait arms Scan_Select_Statement_Arm_List (Asis_S.Select_Statement_Arms (A_Statement), Select_Node); end Scan_Selective_Wait_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_CONDITIONAL_ENTRY_CALL_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Conditional_Entry_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Conditional_Entry_Call_Statement"; Select_Node : Cf_Graph.Vertex; The_Node_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). Select_Node := The_New_Node; -- Pop the new node from the Dangling_Node_Stack. It will be added while -- each arm is processed. Pop_Free (The_Stack => Dangling_Node_Stack); -- Push an empty set on the dangling node stack. After the statement is -- scanned this set will contain the dangling nodes of the select arms. The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); --| TRAVERSAL : Scan arms Scan_Select_Statement_Arm_List (Asis_S.Select_Statement_Arms (A_Statement), Select_Node); end Scan_Conditional_Entry_Call_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_TIMED_ENTRY_CALL_STATEMENT (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Timed_Entry_Call_Statement (A_Statement : in Asis.Statement; The_New_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Timed_Entry_Call_Statement"; Select_Node : Cf_Graph.Vertex; The_Node_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- NOTE: A new node (The_New_Node) was put on The_View.Graph -- by the calling procedure (SCAN_STATEMENT). Select_Node := The_New_Node; -- Pop the new node from the Dangling_Node_Stack. It will be added while -- each arm is processed. Pop_Free (The_Stack => Dangling_Node_Stack); -- Push an empty set on the dangling node stack. After the statement is -- scanned this set will contain the dangling nodes of the select arms. The_Node_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Node_Set, On_The_Stack => Dangling_Node_Stack); --| TRAVERSAL : Scan arms Scan_Select_Statement_Arm_List (Asis_S.Select_Statement_Arms (A_Statement), Select_Node); end Scan_Timed_Entry_Call_Statement; --| +-------------------------------------------------------------------------+ --| | SCAN_EXCEPTION_HANDLER (local) | --| +-------------------------------------------------------------------------+ --| Add the exception handler to The_View and The_Block_Stack. Traverse the handler --| choices and the sequence of statements. procedure Scan_Exception_Handler (Asis_Handler : in Asis.Exception_Handler) is Puid : constant String := "Scan_Exception_Handler"; The_View_Handler : Cf_Defs.Handler_Type_Ptr; The_Block : Block_Type_Ptr; The_Handler : Exception_Handler_Type_Ptr; The_First_Node : Cf_Graph.Vertex; The_Set : Node_Set.Set; The_Item : Cf_Defs.Item_Type_Ptr; begin -- Each handler has it own control flow. -- Add a handler (The_View_Handler) to The_View The_View_Handler := new Cf_Defs.Handler_Type; The_View_Handler.Handler := Asis_Handler; Cf_Defs.Handler_Set.Add (The_Item => The_View_Handler, To_The_Set => The_View.Handlers); -- Add a handler (The_Handler) to The_Block. The_Block := Block_Stack.Top_Of (The_Stack => The_Block_Stack); The_Handler := new Exception_Handler_Type; Exception_Handler_Set.Add (The_Item => The_Handler, To_The_Set => The_Block.Handlers); -- Set field used in determining exeception propagation. The_Block.Current_Handler := The_Handler; --| TRAVERSAL : Scan the handler choices. Build The_Handler --| choices stack. Scan_Handler_Choice_List (Asis_S.Exception_Choices (Asis_Handler), The_Handler); --| TRAVERSAL : Scan the handler statements. declare The_Handler_List : constant Asis.Statement_List := Asis_S.Handler_Statements (Asis_Handler); begin Scan_Handler_Statement_List (The_Handler_List, The_First_Node); -- Put the first statement node onto in The_View_Handler (component -- of The_View) and The_Handler (component of The_Block). The_View_Handler.Node := The_First_Node; The_Handler.Node := The_First_Node; end; -- Merge the top two sets in the Dangling_Node_Stack. Merge_Dangling_Sets; end Scan_Exception_Handler; --| +-------------------------------------------------------------------------+ --| | SCAN_EXCEPTION_HANDLER_LIST (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Exception_Handler_List (List : in Asis.Exception_Handler_List) is Puid : constant String := "Scan_Exception_Handler_List"; begin for I in List'Range loop Scan_Exception_Handler (List (I)); end loop; end Scan_Exception_Handler_List; --| +-------------------------------------------------------------------------+ --| | SCAN_HANDLER_STATEMENT_LIST (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Handler_Statement_List (List : in Asis.Statement_List; The_First_Node : out Cf_Graph.Vertex) is Puid : constant String := "Scan_Statement_List"; The_New_Node : Cf_Graph.Vertex; The_Set : Node_Set_Ptr; begin -- Initialize the top set in the Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Process the statement in the exception handler. for I in List'Range loop case Asis_E.Element_Kind (List (I)) is when Asis_E.A_Statement => Scan_Statement (List (I), The_New_Node); if Asis.Numerics.Operations."=" (I, List'First) then The_First_Node := The_New_Node; end if; when others => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Unexpected element kind "); end case; end loop; end Scan_Handler_Statement_List; --| +-------------------------------------------------------------------------+ --| | SCAN_HANDLER_CHOICE_LIST (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Handler_Choice_List (List : in Asis.Element_List; The_Handler : in out Exception_Handler_Type_Ptr) is Puid : constant String := "Scan_Handler_Choice_List"; begin for I in List'Range loop Scan_Handler_Choice (List (I), The_Handler); end loop; end Scan_Handler_Choice_List; --| +-------------------------------------------------------------------------+ --| | SCAN_HANDLER_CHOICE (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Handler_Choice (A_Choice : in Asis.Choice; The_Handler : in out Exception_Handler_Type_Ptr) is Puid : constant String := "Scan_Handler_Choice"; Choice_Exp : Asis.Expression; Choice : Choice_Type_Ptr; Exception_Name_Definition : Asis.Entity_Name_Definition; begin case Asis_Td.Choice_Kind (A_Choice) is when Asis_Td.An_Exception_Name | Asis_Td.A_Simple_Expression => -- Get the Entity_Name_Definition for the exception named in the choice. -- If the exception name is a rename, unwind all renames and get -- the Entity_Name_Definition of the base exception. if Asis_Td."=" (Asis_Td.Choice_Kind (A_Choice), Asis_Td.An_Exception_Name) then Choice_Exp := Asis_Td.Choice_Name (A_Choice); else Choice_Exp := Asis_Td.Choice_Simple_Expression (A_Choice); end if; Exception_Name_Definition := Base_Exception_Name_Definition (Choice_Exp); -- Add a new choice to The_Handler choice set, Choice := new Choice_Type; Choice.Name_Def := Exception_Name_Definition; Choice_Set.Add (The_Item => Choice, To_The_Set => The_Handler.Choices); The_Handler.Has_Others_Choice := False; when Asis_Td.An_Others_Choice => The_Handler.Has_Others_Choice := True; when Asis_Td.A_Discrete_Range | Asis_Td.A_Simple_Name => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Unexpected Choice kind encountered"); when Asis_Td.Not_A_Choice => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Choice of kind Not_A_Choice encountered"); end case; end Scan_Handler_Choice; --| +-------------------------------------------------------------------------+ --| | SCAN_IF_STATEMENT_ARM (local) | --| +-------------------------------------------------------------------------+ procedure Scan_If_Statement_Arm (Arm : in Asis.If_Statement_Arm; If_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_If_Statement_Arm"; The_New_Item : Cf_Defs.Item_Type_Ptr; The_New_Node : Cf_Graph.Vertex; The_Set : Node_Set_Ptr; Arm_Kind : constant Asis_S.If_Statement_Arm_Kinds := Asis_S.If_Statement_Arm_Kind (Arm); begin if Asis_S."=" (Arm_Kind, Asis_S.An_If_Arm) then -- The If_Node currently references the ASIS If_Statement -- element. Change the If_Node so that it references -- the first If_Statement_Arm element of the If_Statement. The_New_Item := Cf_Graph.Item_Of (The_Vertex => If_Node); The_New_Item.Element := Arm; The_New_Item.Kind := Cf_Defs.If_Statement_Arm; -- The statements on this arm are executed if the -- condition expression is true; push the If_Node on -- the dangling node stack and label the edge -- Condition_True. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => If_Node, Edge_Info => (Cf_Defs.Condition_True, Asis.Nil_Element)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); elsif Asis_S."=" (Arm_Kind, Asis_S.An_Elsif_Arm) then -- Processing of An_Elsif_Arm exploits the following -- equivalence: -- -- if then -- -- elsif then -- -- end if; -- -- is equivalent to -- -- if then O <-- current If_Node -- T / \ F -- else / \ -- if then O <-- new node -- T / \ F -- end if; / \ -- end if; -- -- An_Elsif_Arm is treated as an 'else' followed by a nested 'if'. -- The resulting graph structure is depicted above. A new node -- is created for the nested 'if', and an edge with kind -- Condition_False is created between the current If_Node and -- the new node. The new node then becomes the current If_Node -- and is pushed on the dangling node stack. -- -- If an If_Statement has multiple Elsif_Arms, the above structure -- is repeated: a new node is created for each Elsif and that -- node becomes the Condition_False "child" of the previous -- Elsif node. -- Create a new node for the elsif arm. The_New_Item := new Cf_Defs.Item_Type; The_New_Item.Element := Arm; The_New_Item.Kind := Cf_Defs.If_Statement_Arm; Cf_Graph.Add (The_Vertex => The_New_Node, With_The_Item => The_New_Item, To_The_Graph => The_View.Graph); -- Create a Condition_False edge from If_Node to The_New_Node. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => If_Node, Edge_Info => (Cf_Defs.Condition_False, Element => Asis.Nil_Element)), To_The_Set => The_Set.all); Create_Edges_From_Dangling_Nodes (In_Node_Set => The_Set.all, To_The_Node => The_New_Node); -- The statements on this arm are executed if the -- condition expression is true; push The_New_Node on -- the dangling node stack and set the edge kind to -- Condition_True. Node_Set.Clear (The_Set.all); Node_Set.Add (The_Item => (Node => The_New_Node, Edge_Info => (Cf_Defs.Condition_True, Asis.Nil_Element)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); If_Node := The_New_Node; elsif Asis_S."=" (Arm_Kind, Asis_S.An_Else_Arm) then -- The statements on this arm are executed if the -- condition expression of the current If_Node is false; -- push the If_Node on the dangling node stack with -- edge kind Condition_False. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => If_Node, Edge_Info => (Cf_Defs.Condition_False, Asis.Nil_Element)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); else null; -- Should never get here. end if; --| TRAVERSAL : Scan the arm statements. Scan_Statement_List (Asis_S.Arm_Statements (Arm)); -- Merge the dangling nodes of this arm with the dangling nodes -- of all previously considered arms. Merge_Dangling_Sets; end Scan_If_Statement_Arm; --| +-------------------------------------------------------------------------+ --| | SCAN_IF_STATEMENT_ARM_LIST (local) | --| +-------------------------------------------------------------------------+ procedure Scan_If_Statement_Arm_List (List : in Asis.If_Statement_Arm_List; If_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_If_Statement_Arm_List"; Last_Arm_Kind : Asis_S.If_Statement_Arm_Kinds; The_Set : Node_Set_Ptr; begin for I in List'Range loop Scan_If_Statement_Arm (List (I), If_Node); end loop; Last_Arm_Kind := Asis_S.If_Statement_Arm_Kind (List (List'Last)); if Asis_S."/=" (Last_Arm_Kind, Asis_S.An_Else_Arm) then -- If_Statement has an implicit else; add the If_Node to the -- set on top of the dangling node stack. (This set contains -- the union of the dangling nodes from the if statement arms.) The_Set := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); Node_Set.Add (The_Item => (Node => If_Node, Edge_Info => (Cf_Defs.Condition_False, Asis.Nil_Element)), To_The_Set => The_Set.all); end if; end Scan_If_Statement_Arm_List; --| +-------------------------------------------------------------------------+ --| | SCAN_CASE_STATEMENT_ALTERNATIVE (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Case_Statement_Alternative (Case_Alternative : in Asis.Case_Statement_Alternative; Case_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Case_Statement_Alternative"; The_Set : Node_Set_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- Add Case_Node to Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => Case_Node, Edge_Info => (Cf_Defs.Case_Alt, Case_Alternative)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); --| TRAVERSAL : Scan the alternative statements. Scan_Statement_List (Asis_S.Case_Statement_Alternative_Statements (Case_Alternative)); --| CONTROL FLOW GRAPH PROCESSING -- Merge the dangling nodes of this alternative with the dangling -- of all previously considered alternatives. -- Update the Dangling_Node_Stack. Merge_Dangling_Sets; end Scan_Case_Statement_Alternative; --| +-------------------------------------------------------------------------+ --| | SCAN_CASE_STATEMENT_ALTERNATIVE_LIST (local) | --| +-------------------------------------------------------------------------+ procedure Scan_Case_Statement_Alternative_List (List : in Asis.Case_Statement_Alternative_List; Case_Node : in Cf_Graph.Vertex) is Puid : constant String := "Scan_Case_Statement_Alternative_List"; begin for I in List'Range loop Scan_Case_Statement_Alternative (List (I), Case_Node); end loop; end Scan_Case_Statement_Alternative_List; --| +-------------------------------------------------------------------------+ --| | SCAN_SELECT_STATEMENT_ARM (local) | --| +-------------------------------------------------------------------------+ --| Determine what kind of select arm this is. Process the sequence of --| statements. procedure Scan_Select_Statement_Arm (Arm : in Asis.Select_Statement_Arm; Select_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_Select_Statement_Arm"; The_Set : Node_Set_Ptr; Select_Alt : Asis.Select_Alternative; The_Arc : Cf_Graph.Arc; The_Edge : Cf_Defs.Edge_Type_Ptr; begin --| CONTROL FLOW GRAPH PROCESSING -- Add Select_Node to Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => Select_Node, Edge_Info => (Cf_Defs.Select_Arm, Arm)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); case Asis_S.Select_Statement_Arm_Kind (Arm) is when Asis_S.A_Selective_Wait_Select_Arm | Asis_S.A_Selective_Wait_Or_Arm => Select_Alt := Asis_S.Arm_Select_Alternative (Arm); case Asis_S.Select_Alternative_Kind (Select_Alt) is when Asis_S.An_Accept_Alternative => --| TRAVERSAL : Scan the alternative statements. Scan_Statement_List (Asis_S.Select_Alternative_Statements (Select_Alt)); when Asis_S.A_Delay_Alternative => --| TRAVERSAL : Scan the alternative statements. Scan_Statement_List (Asis_S.Select_Alternative_Statements (Select_Alt)); when Asis_S.A_Terminate_Alternative => -- Make an edge to the terminal node. The_Edge := new Cf_Defs.Edge_Type; The_Edge.Kind := Cf_Defs.Select_Arm; The_Edge.Element := Arm; Cf_Graph.Create (The_Arc => The_Arc, With_The_Attribute => The_Edge, From_The_Vertex => Select_Node, To_The_Vertex => The_Terminal_Node, In_The_Graph => The_View.Graph); -- Clear the node set on top of the stack. Pop_Free (The_Stack => Dangling_Node_Stack); Node_Set_Stack.Push (new Node_Set.Set, On_The_Stack => Dangling_Node_Stack); when Asis_S.Not_A_Select_Alternative => null; -- Should never get here. end case; when Asis_S.A_Conditional_Entry_Call_Select_Arm | Asis_S.A_Timed_Entry_Call_Select_Arm => --| TRAVERSAL : Scan the statements. Scan_Statement_List (Asis_S.Entry_Call_Statements (Arm)); when Asis_S.A_Timed_Entry_Call_Or_Arm => --| TRAVERSAL : Scan the statements. Scan_Statement_List (Asis_S.Timed_Entry_Call_Or_Statements (Arm)); when Asis_S.A_Selective_Wait_Else_Arm | Asis_S.A_Conditional_Entry_Call_Else_Arm => --| TRAVERSAL : Scan the statements. Scan_Statement_List (Asis_S.Else_Statements (Arm)); when Asis_S.Not_A_Select_Statement_Arm => null; -- Should never get here. end case; --| CONTROL FLOW GRAPH PROCESSING -- Update the Dangling_Node_Stack. -- Merge the dangling nodes of this arm with the dangling nodes -- of all previously considered arms. Merge_Dangling_Sets; end Scan_Select_Statement_Arm; --| +-------------------------------------------------------------------------+ --| | SCAN_SELECT_STATEMENT_ARM_LIST (local) | --| +-------------------------------------------------------------------------+ --| Scan the select alternatives. procedure Scan_Select_Statement_Arm_List (List : in Asis.Select_Statement_Arm_List; Select_Node : in out Cf_Graph.Vertex) is Puid : constant String := "Scan_Select_Statement_Arm_List"; begin for I in List'Range loop --| TRAVERSAL : Scan an arm Scan_Select_Statement_Arm (List (I), Select_Node); end loop; end Scan_Select_Statement_Arm_List; ------------------------------------------------------------------------ -- EXPORTED SUBPROGRAM BODIES ------------------------------------------------------------------------ --| +-------------------------------------------------------------------------+ --| | BUILD_CONTROL_FLOW_VIEW (exported) | --| +-------------------------------------------------------------------------+ --| function Build_Control_Flow_View (Body_Decl : in Asis.Declaration) return Cf_Defs.Control_Flow_View is Puid : constant String := "Build_Control_Flow_View"; Body_Statement : Asis.Statement; The_Set : Node_Set_Ptr; The_New_Set : Node_Set_Ptr; The_Return_Set : Node_Set_Ptr; The_Iterator : Node_Set.Iterator; The_Edge : Cf_Defs.Edge_Type_Ptr; The_New_Item : Cf_Defs.Item_Type_Ptr; The_Item : Cf_Defs.Item_Type_Ptr; The_Start_Node : Cf_Graph.Vertex; The_Arc : Cf_Graph.Arc; The_Node : Dangling_Node_Type; The_Block : Block_Type_Ptr; begin -- Clear the global stacks and sets used to build the control flow view. Clear_Globals; -- Initialize the top set in the Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); case Asis_D.Kind (Body_Decl) is when Asis_D.A_Function_Body_Declaration | Asis_D.A_Procedure_Body_Declaration => Body_Statement := Asis_D.Subprogram_Body_Block (Declaration => Body_Decl); when Asis_D.A_Package_Body_Declaration => Body_Statement := Asis_D.Package_Body_Block (Declaration => Body_Decl); when Asis_D.A_Task_Body_Declaration => Body_Statement := Asis_D.Task_Body_Block (Declaration => Body_Decl); when Asis_D.A_Function_Body_Stub | Asis_D.A_Procedure_Body_Stub | Asis_D.A_Package_Body_Stub | Asis_D.A_Task_Body_Stub => Msg_Log.Put_Msg_Debug (Cuid, Puid, "This is a body stub, there is no control flow."); return null; when others => Msg_Log.Put_Msg_Debug (Cuid, Puid, "Invalid Body_Decl passed."); return null; end case; --| CONTROL FLOW GRAPH PROCESSING -- Create the control flow view. The_View := new Cf_Defs.View_Type; The_View.Body_Decl := Body_Decl; -- Create the start node. Add it to The_View.Graph. The_New_Item := new Cf_Defs.Item_Type; The_New_Item.Element := Body_Statement; The_New_Item.Kind := Cf_Defs.Start; Cf_Graph.Add (The_Vertex => The_Start_Node, With_The_Item => The_New_Item, To_The_Graph => The_View.Graph); The_View.Start := The_Start_Node; --| CONTROL FLOW GRAPH PROCESSING -- Add the terminal node to the control graph (The_View.Graph). The_New_Item := new Cf_Defs.Item_Type; The_New_Item.Element := Body_Statement; The_New_Item.Kind := Cf_Defs.Terminal; Cf_Graph.Add (The_Vertex => The_Terminal_Node, With_The_Item => The_New_Item, To_The_Graph => The_View.Graph); The_View.Terminal := The_Terminal_Node; -- Put the block onto the The_Block_Stack. The_Block := new Block_Type; The_Block.Block_Stmt := Body_Statement; The_Block.Block_Node := The_Start_Node; Block_Stack.Push (The_Item => The_Block, On_The_Stack => The_Block_Stack); -- Add an empty set on the top of The_Return_Stack. This is used to -- track return statements. The_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => The_Return_Stack); -- Initialize the top set in the Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Build the control flow structure for the exception handlers. -- The handlers are done prior to the body statements, so that -- handler information is available for 'raise' statement resolution. --| TRAVERSAL : Scan the block handlers, if any. declare Exception_Handlers : constant Asis.Exception_Handler_List := Asis_S.Block_Exception_Handlers (Body_Statement); begin if not Asis_E.Is_Nil (Exception_Handlers) then Scan_Exception_Handler_List (Exception_Handlers); end if; end; --| CONTROL FLOW GRAPH PROCESSING -- Add the start Node (as a set of one) to the Dangling_Node_Stack. The_Set := new Node_Set.Set; Node_Set.Add (The_Item => (Node => The_Start_Node, Edge_Info => (Cf_Defs.Prog_Unit_Start, Asis.Nil_Element)), To_The_Set => The_Set.all); Node_Set_Stack.Push (The_Item => The_Set, On_The_Stack => Dangling_Node_Stack); -- Set variable indicating that there is no current handler. This is -- used to resolve exception propagation in the Scan_Raise_Statement -- procedure. The_Block.Current_Handler := null; --| TRAVERSAL : Scan the block sequence of statements. Scan_Statement_List (Asis_S.Block_Body_Statements (Body_Statement)); --| CONTROL FLOW GRAPH PROCESSING -- Performed at the end of a program unit body block. Combine node -- sets to connect to the terminal node: top two sets in the -- Dangling_Node_Stack, and the top set in The_Return_Stack. -- Merge the top two sets in the Dangling_Node_Stack. Merge_Dangling_Sets; -- Get the top node set in the Dangling_Node_Stack. The_Set := Node_Set_Stack.Top_Of (The_Stack => Dangling_Node_Stack); Node_Set_Stack.Pop (The_Stack => Dangling_Node_Stack); The_Return_Set := Node_Set_Stack.Top_Of (The_Stack => The_Return_Stack); Node_Set_Stack.Pop (The_Stack => The_Return_Stack); The_New_Set := new Node_Set.Set; Node_Set.Union (Of_The_Set => The_Set.all, And_The_Set => The_Return_Set.all, To_The_Set => The_New_Set.all); -- For each node in The_New_Set create an edge (arc) to the -- terminal node on the control graph. Create_Edges_From_Dangling_Nodes (In_Node_Set => The_New_Set.all, To_The_Node => The_Terminal_Node); -- Garbage collection. Free_Node_Set (The_Set => The_Set); Free_Node_Set (The_Set => The_Return_Set); Pop_Free (The_Stack => The_Block_Stack); Free_Globals; return The_View; end Build_Control_Flow_View; end Control_Flow_Scan;