analysis for translate

1 files changed, 163 insertions, 0 deletions

diff --git a/translate/trans_analyzes.adb b/translate/trans_analyzes.adb
new file mode 100644
index 000000000..a6d5619d9
--- /dev/null
+++ b/translate/trans_analyzes.adb
@@ -0,0 +1,163 @@
+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_Signal_Interface_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;
+      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 : Iir;
+               Assoc : Iir;
+               Formal : Iir;
+               Inter : Iir;
+            begin
+               --  Very pessimist.
+               Has_After := True;
+
+               Call := Get_Procedure_Call (Stmt);
+               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_Base_Name (Formal);
+                  end if;
+                  if Get_Kind (Assoc)
+                    = Iir_Kind_Association_Element_By_Expression
+                    and then
+                    Get_Kind (Formal) = Iir_Kind_Signal_Interface_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;
+   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
+                    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_Base_Name (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_Base_Name (El)) then
+            Put ("*  ");
+         else
+            Put ("   ");
+         end if;
+         Disp_Vhdl.Disp_Vhdl (El);
+         New_Line;
+      end loop;
+   end Dump_Drivers;
+
+end Trans_Analyzes;