canon: change profile of Canon_Procedure_Call.

4 files changed, 27 insertions, 64 deletions

diff --git a/canon.adb b/canon.adb
index b93b69c1b..466ca1a93 100644
--- a/canon.adb
+++ b/canon.adb
@@ -48,9 +48,8 @@ package body Canon is
      (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir)
      return Iir;
 
-   function Canon_Association_Chain_And_Actuals
-     (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir)
-     return Iir;
+   --  Like Canon_Subprogram_Call, but recurse on actuals.
+   procedure Canon_Subprogram_Call_And_Actuals (Call : Iir);
 
    --  Canonicalize block configuration CONF.
    --  TOP is used to added dependences to the design unit which CONF
@@ -612,23 +611,10 @@ package body Canon is
             end if;
 
          when Iir_Kind_Function_Call =>
-            declare
-               Imp : Iir;
-               Assoc_Chain : Iir;
-            begin
-               Imp := Get_Implementation (Expr);
-               if Get_Kind (Imp) /= Iir_Kind_Implicit_Function_Declaration then
-                  Assoc_Chain := Canon_Association_Chain_And_Actuals
-                    (Get_Interface_Declaration_Chain (Imp),
-                     Get_Parameter_Association_Chain (Expr),
-                     Expr);
-                  Set_Parameter_Association_Chain (Expr, Assoc_Chain);
-               else
-                  -- FIXME:
-                  -- should canon concatenation.
-                  null;
-               end if;
-            end;
+            Canon_Subprogram_Call_And_Actuals (Expr);
+            -- FIXME:
+            -- should canon concatenation.
+
          when Iir_Kind_Type_Conversion
            | Iir_Kind_Qualified_Expression =>
             Canon_Expression (Get_Expression (Expr));
@@ -843,19 +829,7 @@ package body Canon is
       end loop;
    end Canon_Association_Chain_Actuals;
 
-   function Canon_Association_Chain_And_Actuals
-     (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir)
-     return Iir
-   is
-      Res : Iir;
-   begin
-      Res := Canon_Association_Chain
-        (Interface_Chain, Association_Chain, Loc);
-      Canon_Association_Chain_Actuals (Res);
-      return Res;
-   end Canon_Association_Chain_And_Actuals;
-
-   function Canon_Subprogram_Call (Call : Iir) return Iir
+   procedure Canon_Subprogram_Call (Call : Iir)
    is
       Imp : Iir;
       Assoc_Chain : Iir;
@@ -866,9 +840,14 @@ package body Canon is
       Assoc_Chain := Get_Parameter_Association_Chain (Call);
       Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call);
       Set_Parameter_Association_Chain (Call, Assoc_Chain);
-      return Assoc_Chain;
    end Canon_Subprogram_Call;
 
+   procedure Canon_Subprogram_Call_And_Actuals (Call : Iir) is
+   begin
+      Canon_Subprogram_Call (Call);
+      Canon_Association_Chain_Actuals (Get_Parameter_Association_Chain (Call));
+   end Canon_Subprogram_Call_And_Actuals;
+
    --  Create a default association list for INTERFACE_LIST.
    --  The default is a list of interfaces associated with open.
    function Canon_Default_Association_Chain (Interface_Chain : Iir)
@@ -938,17 +917,6 @@ package body Canon is
    --  Inner loop if any; used to canonicalize exit/next statement.
    Cur_Loop : Iir;
 
-   procedure Canon_Procedure_Call (Call : Iir_Procedure_Call)
-   is
-      Assoc_Chain : Iir;
-   begin
-      Assoc_Chain := Canon_Association_Chain_And_Actuals
-        (Get_Interface_Declaration_Chain (Get_Implementation (Call)),
-         Get_Parameter_Association_Chain (Call),
-         Call);
-      Set_Parameter_Association_Chain (Call, Assoc_Chain);
-   end Canon_Procedure_Call;
-
    procedure Canon_Sequential_Stmts (First : Iir)
    is
       Stmt: Iir;
@@ -1060,7 +1028,7 @@ package body Canon is
                end if;
 
             when Iir_Kind_Procedure_Call_Statement =>
-               Canon_Procedure_Call (Get_Procedure_Call (Stmt));
+               Canon_Subprogram_Call_And_Actuals (Get_Procedure_Call (Stmt));
 
             when Iir_Kind_Null_Statement =>
                null;
@@ -1249,9 +1217,6 @@ package body Canon is
          end case;
          Assoc := Get_Chain (Assoc);
       end loop;
-      if Get_Nbr_Elements (Sensitivity_List) = 0 then
-         Destroy_Iir_List (Sensitivity_List);
-      end if;
       if Is_Sensitized then
          Set_Sensitivity_List (Proc, Sensitivity_List);
       else
diff --git a/canon.ads b/canon.ads
index 5f7a62082..ca11ae723 100644
--- a/canon.ads
+++ b/canon.ads
@@ -49,8 +49,7 @@ package Canon is
      return Iir_Design_Unit;
 
    --  Canonicalize a subprogram call.
-   --  Return the new association chain.
-   function Canon_Subprogram_Call (Call : Iir) return Iir;
+   procedure Canon_Subprogram_Call (Call : Iir);
 
    -- Compute the sensivity list of EXPR and add it to SENSIVITY_LIST.
    -- If IS_TARGET is true, the longuest static prefix of the signal name
diff --git a/translate/ghdldrv/ghdlsimul.adb b/translate/ghdldrv/ghdlsimul.adb
index 9cc36717e..0e8f29660 100644
--- a/translate/ghdldrv/ghdlsimul.adb
+++ b/translate/ghdldrv/ghdlsimul.adb
@@ -67,6 +67,7 @@ package body Ghdlsimul is
       Annotations.Annotate (Std_Package.Std_Standard_Unit);
 
       Canon.Canon_Flag_Add_Labels := True;
+      Canon.Canon_Flag_Sequentials_Stmts := True;
    end Compile_Init;
 
    procedure Compile_Elab
diff --git a/translate/translation.adb b/translate/translation.adb
index d8d1cc504..50e047c11 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -6209,8 +6209,7 @@ package body Translation is
          Info.Type_Mode := Type_Mode_File;
       end Translate_File_Type;
 
-      function Get_File_Signature_Length (Def : Iir) return Natural
-      is
+      function Get_File_Signature_Length (Def : Iir) return Natural is
       begin
          case Get_Kind (Def) is
             when Iir_Kinds_Scalar_Type_Definition =>
@@ -6282,17 +6281,16 @@ package body Translation is
 
       procedure Create_File_Type_Var (Def : Iir_File_Type_Definition)
       is
-         Type_Name : Iir;
+         Type_Name : constant Iir := Get_Type_Mark (Def);
          Info : Type_Info_Acc;
       begin
-         Type_Name := Get_Type_Mark (Def);
          if Get_Kind (Type_Name) in Iir_Kinds_Scalar_Type_Definition then
             return;
          end if;
          declare
             Len : constant Natural := Get_File_Signature_Length (Type_Name);
             Sig : String (1 .. Len + 2);
-            Off : Natural := 1;
+            Off : Natural := Sig'First;
          begin
             Get_File_Signature (Type_Name, Sig, Off);
             Sig (Len + 1) := '.';
@@ -13662,7 +13660,8 @@ package body Translation is
                      --  FIXME : to be done
                      raise Internal_Error;
                   else
-                     Assoc_Chain := Canon.Canon_Subprogram_Call (Name);
+                     Canon.Canon_Subprogram_Call (Name);
+                     Assoc_Chain := Get_Parameter_Association_Chain (Name);
                      Obj := Get_Method_Object (Name);
                      return E2M
                        (Chap7.Translate_Function_Call (Imp, Assoc_Chain, Obj),
@@ -16733,7 +16732,8 @@ package body Translation is
                           (Imp, Left, Right, Res_Type, Expr);
                      end;
                   else
-                     Assoc_Chain := Canon.Canon_Subprogram_Call (Expr);
+                     Canon.Canon_Subprogram_Call (Expr);
+                     Assoc_Chain := Get_Parameter_Association_Chain (Expr);
                      Res := Translate_Function_Call
                        (Imp, Assoc_Chain, Get_Method_Object (Expr));
                      Expr_Type := Get_Return_Type (Imp);
@@ -20323,8 +20323,8 @@ package body Translation is
            Iir_Chains.Get_Chain_Length (Assoc_Chain);
          Params : Mnode_Array (0 .. Nbr_Assoc - 1);
          E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1);
-         Imp : Iir;
-         Info : Subprg_Info_Acc;
+         Imp : constant Iir := Get_Implementation (Stmt);
+         Info : constant Subprg_Info_Acc := Get_Info (Imp);
          Res : O_Dnode;
          El : Iir;
          Pos : Natural;
@@ -20346,9 +20346,6 @@ package body Translation is
          Bounds : O_Enode;
          Obj : Iir;
       begin
-         Imp := Get_Implementation (Stmt);
-         Info := Get_Info (Imp);
-
          --  Create an in-out result record for in-out arguments passed by
          --  value.
          if Info.Res_Record_Type /= O_Tnode_Null then
@@ -21564,7 +21561,8 @@ package body Translation is
                   Imp : Iir;
                begin
                   Call := Get_Procedure_Call (Stmt);
-                  Assocs := Canon.Canon_Subprogram_Call (Call);
+                  Canon.Canon_Subprogram_Call (Call);
+                  Assocs := Get_Parameter_Association_Chain (Call);
                   Imp := Get_Implementation (Call);
                   if Get_Kind (Imp) = Iir_Kind_Implicit_Procedure_Declaration
                   then