Translation: handle individual association in function call.

Factorize code.

Fix ticket 74.

5 files changed, 76 insertions, 120 deletions

diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index eb83036..4b89cec 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -23,6 +23,7 @@ with Evaluation; use Evaluation;
 with Canon;
 with Trans.Chap3;
 with Trans.Chap7;
+with Trans.Chap8;
 with Trans.Chap14;
 with Trans.Helpers2; use Trans.Helpers2;
 with Trans_Decls; use Trans_Decls;
@@ -1006,7 +1007,7 @@ package body Trans.Chap6 is
                   Assoc_Chain := Get_Parameter_Association_Chain (Name);
                   Obj := Get_Method_Object (Name);
                   return E2M
-                    (Chap7.Translate_Function_Call (Imp, Assoc_Chain, Obj),
+                    (Chap8.Translate_Subprogram_Call (Imp, Assoc_Chain, Obj),
                      Type_Info, Mode_Value);
                end if;
             end;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 25f044a..c226f52 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -681,97 +681,6 @@ package body Trans.Chap7 is
       end case;
    end Translate_Range_Length;
 
-   function Translate_Association (Assoc : Iir) return O_Enode
-   is
-      Formal      : constant Iir := Get_Formal (Assoc);
-      Formal_Base : constant Iir := Get_Association_Interface (Assoc);
-      Actual      : Iir;
-   begin
-      case Get_Kind (Assoc) is
-         when Iir_Kind_Association_Element_By_Expression =>
-            Actual := Get_Actual (Assoc);
-         when Iir_Kind_Association_Element_Open =>
-            Actual := Get_Default_Value (Formal);
-         when others =>
-            Error_Kind ("translate_association", Assoc);
-      end case;
-
-      case Get_Kind (Formal_Base) is
-         when Iir_Kind_Interface_Constant_Declaration
-            | Iir_Kind_Interface_File_Declaration =>
-            return Chap3.Maybe_Insert_Scalar_Check
-              (Translate_Expression (Actual, Get_Type (Formal)),
-               Actual, Get_Type (Formal));
-         when Iir_Kind_Interface_Signal_Declaration =>
-            return Translate_Implicit_Conv
-              (M2E (Chap6.Translate_Name (Actual)),
-               Get_Type (Actual),
-               Get_Type (Formal_Base),
-               Mode_Signal, Assoc);
-         when others =>
-            Error_Kind ("translate_association", Formal);
-      end case;
-   end Translate_Association;
-
-   function Translate_Function_Call (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
-                                    return O_Enode
-   is
-      Info   : constant Subprg_Info_Acc := Get_Info (Imp);
-      Constr : O_Assoc_List;
-      Assoc  : Iir;
-      Res    : Mnode;
-   begin
-      if Info.Use_Stack2 then
-         Create_Temp_Stack2_Mark;
-      end if;
-
-      if Info.Res_Interface /= O_Dnode_Null then
-         --  Composite result.
-         --  If we need to allocate, do it before starting the call!
-         declare
-            Res_Type : Iir;
-            Res_Info : Type_Info_Acc;
-         begin
-            Res_Type := Get_Return_Type (Imp);
-            Res_Info := Get_Info (Res_Type);
-            Res := Create_Temp (Res_Info);
-            if Res_Info.Type_Mode /= Type_Mode_Fat_Array then
-               Chap4.Allocate_Complex_Object (Res_Type, Alloc_Stack, Res);
-            end if;
-         end;
-      end if;
-
-      Start_Association (Constr, Info.Ortho_Func);
-
-      if Info.Res_Interface /= O_Dnode_Null then
-         --  Composite result.
-         New_Association (Constr, M2E (Res));
-      end if;
-
-      --  If the subprogram is a method, pass the protected object.
-      if Obj /= Null_Iir then
-         New_Association (Constr, M2E (Chap6.Translate_Name (Obj)));
-      else
-         Subprgs.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance);
-      end if;
-
-      Assoc := Assoc_Chain;
-      while Assoc /= Null_Iir loop
-         --  FIXME: evaluate expression before, because we
-         --  may allocate objects.
-         New_Association (Constr, Translate_Association (Assoc));
-         Assoc := Get_Chain (Assoc);
-      end loop;
-
-      if Info.Res_Interface /= O_Dnode_Null then
-         --  Composite result.
-         New_Procedure_Call (Constr);
-         return M2E (Res);
-      else
-         return New_Function_Call (Constr);
-      end if;
-   end Translate_Function_Call;
-
    function Translate_Operator_Function_Call
      (Imp : Iir; Left : Iir;  Right : Iir; Res_Type : Iir) return O_Enode
    is
@@ -801,7 +710,7 @@ package body Trans.Chap7 is
          Set_Chain (El_L, El_R);
       end if;
 
-      Res := Translate_Function_Call (Imp, El_L, Null_Iir);
+      Res := Chap8.Translate_Subprogram_Call (Imp, El_L, Null_Iir);
 
       Free_Iir (El_L);
       if Right /= Null_Iir then
@@ -3969,7 +3878,7 @@ package body Trans.Chap7 is
                else
                   Canon.Canon_Subprogram_Call (Expr);
                   Assoc_Chain := Get_Parameter_Association_Chain (Expr);
-                  Res := Translate_Function_Call
+                  Res := Chap8.Translate_Subprogram_Call
                     (Imp, Assoc_Chain, Get_Method_Object (Expr));
                   Expr_Type := Get_Return_Type (Imp);
                end if;
diff --git a/src/vhdl/translate/trans-chap7.ads b/src/vhdl/translate/trans-chap7.ads
index 5b3ff22..8aa9042 100644
--- a/src/vhdl/translate/trans-chap7.ads
+++ b/src/vhdl/translate/trans-chap7.ads
@@ -42,13 +42,6 @@ package Trans.Chap7 is
    function Translate_Expression (Expr : Iir; Rtype : Iir := Null_Iir)
                                      return O_Enode;
 
-   --  Translate call to function IMP.
-   --  ASSOC_CHAIN is the chain of a associations for this call.
-   --  OBJ, if not NULL_IIR is the protected object.
-   function Translate_Function_Call
-     (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
-         return O_Enode;
-
    --  Translate range and return an lvalue containing the range.
    --  The node returned can be used only one time.
    function Translate_Range (Arange : Iir; Range_Type : Iir) return O_Lnode;
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 6f406ba..16dc32b 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -1666,18 +1666,21 @@ package body Trans.Chap8 is
       end if;
    end Do_Conversion;
 
-   procedure Translate_Procedure_Call (Stmt : Iir_Procedure_Call)
+   function Translate_Subprogram_Call (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
+                                      return O_Enode
    is
+      Is_Procedure : constant Boolean :=
+        Get_Kind (Imp) = Iir_Kind_Procedure_Declaration;
+      Is_Function : constant Boolean := not Is_Procedure;
       type Mnode_Array is array (Natural range <>) of Mnode;
       type O_Enode_Array is array (Natural range <>) of O_Enode;
-      Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
       Nbr_Assoc : constant Natural :=
         Iir_Chains.Get_Chain_Length (Assoc_Chain);
       Params : Mnode_Array (0 .. Nbr_Assoc - 1);
       E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1);
-      Imp : constant Iir := Get_Implementation (Stmt);
       Info : constant Subprg_Info_Acc := Get_Info (Imp);
-      Res : O_Dnode;
+      Copy_Out : O_Dnode;
+      Res : Mnode;
       El : Iir;
       Pos : Natural;
       Constr : O_Assoc_List;
@@ -1699,14 +1702,32 @@ package body Trans.Chap8 is
       Out_Expr : Iir;
       Formal_Object_Kind : Object_Kind_Type;
       Bounds : Mnode;
-      Obj : Iir;
    begin
+      --  For functions returning an unconstrained object: save the mark.
+      if Is_Function and then Info.Use_Stack2 then
+         Create_Temp_Stack2_Mark;
+      end if;
+
+      if Is_Function and then Info.Res_Interface /= O_Dnode_Null then
+         --  Composite result.
+         --  If we need to allocate, do it before starting the call!
+         declare
+            Res_Type : constant Iir := Get_Return_Type (Imp);
+            Res_Info : constant Type_Info_Acc := Get_Info (Res_Type);
+         begin
+            Res := Create_Temp (Res_Info);
+            if Res_Info.Type_Mode /= Type_Mode_Fat_Array then
+               Chap4.Allocate_Complex_Object (Res_Type, Alloc_Stack, Res);
+            end if;
+         end;
+      end if;
+
       --  Create an in-out result record for in-out arguments passed by
       --  value.
-      if Info.Res_Record_Type /= O_Tnode_Null then
-         Res := Create_Temp (Info.Res_Record_Type);
+      if Is_Procedure and then Info.Res_Record_Type /= O_Tnode_Null then
+         Copy_Out := Create_Temp (Info.Res_Record_Type);
       else
-         Res := O_Dnode_Null;
+         Copy_Out := O_Dnode_Null;
       end if;
 
       --  Evaluate in-out parameters and parameters passed by ref, since
@@ -1780,7 +1801,7 @@ package body Trans.Chap8 is
             then
                --  Arguments may be assigned if there is an in conversion.
                Ptr := New_Selected_Element
-                 (New_Obj (Res), Formal_Info.Interface_Field);
+                 (New_Obj (Copy_Out), Formal_Info.Interface_Field);
                Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
                if In_Conv /= Null_Iir then
                   In_Expr := In_Conv;
@@ -1799,8 +1820,8 @@ package body Trans.Chap8 is
                when Iir_Kind_Interface_Constant_Declaration
                   | Iir_Kind_Interface_File_Declaration =>
                   --  No conversion here.
-                  E_Params (Pos) := Chap7.Translate_Expression
-                    (Act, Formal_Type);
+                  E_Params (Pos) :=
+                    Chap7.Translate_Expression (Act, Formal_Type);
                when Iir_Kind_Interface_Variable_Declaration
                   | Iir_Kind_Interface_Signal_Declaration =>
                   Param := Chap6.Translate_Name (Act);
@@ -1814,7 +1835,7 @@ package body Trans.Chap8 is
                      --  Implicit array conversion or subtype check.
                      E_Params (Pos) := Chap7.Translate_Implicit_Conv
                        (E_Params (Pos), Actual_Type, Formal_Type,
-                        Get_Object_Kind (Param), Stmt);
+                        Get_Object_Kind (Param), Act);
                   end if;
                when others =>
                   Error_Kind ("translate_procedure_call(2)", Formal);
@@ -1865,12 +1886,17 @@ package body Trans.Chap8 is
 
       --  Second stage:  really perform the call.
       Start_Association (Constr, Info.Ortho_Func);
-      if Res /= O_Dnode_Null then
-         New_Association (Constr,
-                          New_Address (New_Obj (Res), Info.Res_Record_Ptr));
+
+      if Is_Function and then Info.Res_Interface /= O_Dnode_Null then
+         --  Composite result.
+         New_Association (Constr, M2E (Res));
+      end if;
+
+      if Copy_Out /= O_Dnode_Null then
+         New_Association
+           (Constr, New_Address (New_Obj (Copy_Out), Info.Res_Record_Ptr));
       end if;
 
-      Obj := Get_Method_Object (Stmt);
       if Obj /= Null_Iir then
          New_Association (Constr, M2E (Chap6.Translate_Name (Obj)));
       else
@@ -1922,6 +1948,8 @@ package body Trans.Chap8 is
                         if In_Conv = Null_Iir then
                            Val := Chap7.Translate_Expression
                              (Act, Formal_Type);
+                           Val := Chap3.Maybe_Insert_Scalar_Check
+                             (Val, Act, Formal_Type);
                         else
                            Actual_Type := Get_Type (Act);
                            Val := Do_Conversion
@@ -1944,7 +1972,17 @@ package body Trans.Chap8 is
          Pos := Pos + 1;
       end loop;
 
-      New_Procedure_Call (Constr);
+      if Is_Procedure then
+         New_Procedure_Call (Constr);
+      else
+         if Info.Res_Interface /= O_Dnode_Null then
+            --  Composite result.
+            New_Procedure_Call (Constr);
+            return M2E (Res);
+         else
+            return New_Function_Call (Constr);
+         end if;
+      end if;
 
       --  Copy-out non-composite parameters.
       El := Assoc_Chain;
@@ -1968,7 +2006,7 @@ package body Trans.Chap8 is
                   Out_Expr := Out_Conv;
                end if;
                Ptr := New_Selected_Element
-                 (New_Obj (Res), Formal_Info.Interface_Field);
+                 (New_Obj (Copy_Out), Formal_Info.Interface_Field);
                Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
                Chap7.Translate_Assign (Params (Pos),
                                        Do_Conversion (Out_Conv, Formal,
@@ -1997,6 +2035,19 @@ package body Trans.Chap8 is
          El := Get_Chain (El);
          Pos := Pos + 1;
       end loop;
+
+      return O_Enode_Null;
+   end Translate_Subprogram_Call;
+
+   procedure Translate_Procedure_Call (Stmt : Iir_Procedure_Call)
+   is
+      Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
+      Imp : constant Iir := Get_Implementation (Stmt);
+      Obj : constant Iir := Get_Method_Object (Stmt);
+      Res : O_Enode;
+   begin
+      Res := Translate_Subprogram_Call (Imp, Assoc_Chain, Obj);
+      pragma Assert (Res = O_Enode_Null);
    end Translate_Procedure_Call;
 
    procedure Translate_Wait_Statement (Stmt : Iir)
diff --git a/src/vhdl/translate/trans-chap8.ads b/src/vhdl/translate/trans-chap8.ads
index b358d5b..27ddfe8 100644
--- a/src/vhdl/translate/trans-chap8.ads
+++ b/src/vhdl/translate/trans-chap8.ads
@@ -36,5 +36,7 @@ package Trans.Chap8 is
                                   Itype    : Iir);
 
    procedure Translate_Report (Stmt : Iir; Subprg : O_Dnode; Level : Iir);
-end Trans.Chap8;
 
+   function Translate_Subprogram_Call (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
+                                      return O_Enode;
+end Trans.Chap8;