diff options
Diffstat (limited to 'translate/trans_analyzes.adb')
| -rw-r--r-- | translate/trans_analyzes.adb | 182 |
1 files changed, 0 insertions, 182 deletions
diff --git a/translate/trans_analyzes.adb b/translate/trans_analyzes.adb deleted file mode 100644 index 8147e93..0000000 --- a/translate/trans_analyzes.adb +++ /dev/null @@ -1,182 +0,0 @@ --- Analysis for translation. --- Copyright (C) 2009 Tristan Gingold --- --- GHDL 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, or (at your option) any later --- version. --- --- GHDL 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Iirs_Utils; use Iirs_Utils; -with Iirs_Walk; use Iirs_Walk; -with Disp_Vhdl; -with Ada.Text_IO; -with Errorout; - -package body Trans_Analyzes is - Driver_List : Iir_List; - - Has_After : Boolean; - function Extract_Driver_Target (Target : Iir) return Walk_Status - is - Base : Iir; - Prefix : Iir; - begin - Base := Get_Object_Prefix (Target); - -- Assigment to subprogram interface does not create a driver. - if Get_Kind (Base) = Iir_Kind_Interface_Signal_Declaration - and then - Get_Kind (Get_Parent (Base)) = Iir_Kind_Procedure_Declaration - then - return Walk_Continue; - end if; - - Prefix := Get_Longuest_Static_Prefix (Target); - Add_Element (Driver_List, Prefix); - if Has_After then - Set_After_Drivers_Flag (Base, True); - end if; - return Walk_Continue; - end Extract_Driver_Target; - - function Extract_Driver_Stmt (Stmt : Iir) return Walk_Status - is - Status : Walk_Status; - pragma Unreferenced (Status); - We : Iir; - begin - case Get_Kind (Stmt) is - when Iir_Kind_Signal_Assignment_Statement => - We := Get_Waveform_Chain (Stmt); - if We /= Null_Iir - and then Get_Chain (We) = Null_Iir - and then Get_Time (We) = Null_Iir - and then Get_Kind (Get_We_Value (We)) /= Iir_Kind_Null_Literal - then - Has_After := False; - else - Has_After := True; - end if; - Status := Walk_Assignment_Target - (Get_Target (Stmt), Extract_Driver_Target'Access); - when Iir_Kind_Procedure_Call_Statement => - declare - Call : constant Iir := Get_Procedure_Call (Stmt); - Assoc : Iir; - Formal : Iir; - Inter : Iir; - begin - -- Very pessimist. - Has_After := True; - - Assoc := Get_Parameter_Association_Chain (Call); - Inter := Get_Interface_Declaration_Chain - (Get_Implementation (Call)); - while Assoc /= Null_Iir loop - Formal := Get_Formal (Assoc); - if Formal = Null_Iir then - Formal := Inter; - Inter := Get_Chain (Inter); - else - Formal := Get_Association_Interface (Assoc); - end if; - if Get_Kind (Assoc) - = Iir_Kind_Association_Element_By_Expression - and then - Get_Kind (Formal) = Iir_Kind_Interface_Signal_Declaration - and then Get_Mode (Formal) /= Iir_In_Mode - then - Status := Extract_Driver_Target (Get_Actual (Assoc)); - end if; - Assoc := Get_Chain (Assoc); - end loop; - end; - when others => - null; - end case; - return Walk_Continue; - end Extract_Driver_Stmt; - - procedure Extract_Drivers_Sequential_Stmt_Chain (Chain : Iir) - is - Status : Walk_Status; - pragma Unreferenced (Status); - begin - Status := Walk_Sequential_Stmt_Chain (Chain, Extract_Driver_Stmt'Access); - end Extract_Drivers_Sequential_Stmt_Chain; - - procedure Extract_Drivers_Declaration_Chain (Chain : Iir) - is - Decl : Iir := Chain; - begin - while Decl /= Null_Iir loop - - -- Only procedures and impure functions may contain assignment. - if Get_Kind (Decl) = Iir_Kind_Procedure_Body - or else (Get_Kind (Decl) = Iir_Kind_Function_Body - and then - not Get_Pure_Flag (Get_Subprogram_Specification (Decl))) - then - Extract_Drivers_Declaration_Chain (Get_Declaration_Chain (Decl)); - Extract_Drivers_Sequential_Stmt_Chain - (Get_Sequential_Statement_Chain (Decl)); - end if; - - Decl := Get_Chain (Decl); - end loop; - end Extract_Drivers_Declaration_Chain; - - function Extract_Drivers (Proc : Iir) return Iir_List - is - begin - Driver_List := Create_Iir_List; - Extract_Drivers_Declaration_Chain (Get_Declaration_Chain (Proc)); - Extract_Drivers_Sequential_Stmt_Chain - (Get_Sequential_Statement_Chain (Proc)); - - return Driver_List; - end Extract_Drivers; - - procedure Free_Drivers_List (List : in out Iir_List) - is - El : Iir; - begin - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - Set_After_Drivers_Flag (Get_Object_Prefix (El), False); - end loop; - Destroy_Iir_List (List); - end Free_Drivers_List; - - procedure Dump_Drivers (Proc : Iir; List : Iir_List) - is - use Ada.Text_IO; - use Errorout; - El : Iir; - begin - Put_Line ("List of drivers for " & Disp_Node (Proc) & ":"); - Put_Line (" (declared at " & Disp_Location (Proc) & ")"); - for I in Natural loop - El := Get_Nth_Element (List, I); - exit when El = Null_Iir; - if Get_After_Drivers_Flag (Get_Object_Prefix (El)) then - Put ("* "); - else - Put (" "); - end if; - Disp_Vhdl.Disp_Vhdl (El); - New_Line; - end loop; - end Dump_Drivers; - -end Trans_Analyzes; |