diff options
Diffstat (limited to 'src/vhdl/translate/trans_analyzes.adb')
| -rw-r--r-- | src/vhdl/translate/trans_analyzes.adb | 182 |
1 files changed, 182 insertions, 0 deletions
diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb new file mode 100644 index 000000000..8147e93bd --- /dev/null +++ b/src/vhdl/translate/trans_analyzes.adb @@ -0,0 +1,182 @@ +-- 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; |