Translation: separate subprogram translation spec and body.

8 files changed, 126 insertions, 81 deletions

diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 68f4acd57..93534f028 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -163,7 +163,8 @@ package body Trans.Chap1 is
 
       if Global_Storage = O_Storage_External then
          --  Entity declaration subprograms.
-         Chap4.Translate_Declaration_Chain_Subprograms (Entity);
+         Chap4.Translate_Declaration_Chain_Subprograms
+           (Entity, Subprg_Translate_Spec_And_Body);
       else
          --  Entity declaration and process subprograms.
          Chap9.Translate_Block_Subprograms (Entity, Entity);
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 83bc97b31..df3298347 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -528,7 +528,8 @@ package body Trans.Chap2 is
          Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field
            (Prev_Subprg_Instances, Upframe_Field);
 
-         Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
+         Chap4.Translate_Declaration_Chain_Subprograms
+           (Subprg, Subprg_Translate_Spec_And_Body);
 
          --  Link to previous frame
          Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field
@@ -556,7 +557,8 @@ package body Trans.Chap2 is
       if not Has_Suspend and not Has_Nested then
          Chap4.Translate_Declaration_Chain (Subprg);
          Rtis.Generate_Subprogram_Body (Subprg);
-         Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
+         Chap4.Translate_Declaration_Chain_Subprograms
+           (Subprg, Subprg_Translate_Spec_And_Body);
       else
          New_Var_Decl (Frame_Ptr, Get_Identifier ("FRAMEPTR"),
                        O_Storage_Local, Frame_Ptr_Type);
@@ -827,7 +829,8 @@ package body Trans.Chap2 is
       if not Is_Nested then
          --  For nested package, this will be translated when translating
          --  subprograms.
-         Chap4.Translate_Declaration_Chain_Subprograms (Decl);
+         Chap4.Translate_Declaration_Chain_Subprograms
+           (Decl, Subprg_Translate_Spec_And_Body);
       end if;
 
       --  Declare elaborator for the body.
@@ -963,7 +966,8 @@ package body Trans.Chap2 is
       if not Is_Nested then
          --  Translate subprograms.  For nested package, this has to be called
          --  when translating subprograms.
-         Chap4.Translate_Declaration_Chain_Subprograms (Bod);
+         Chap4.Translate_Declaration_Chain_Subprograms
+           (Bod, Subprg_Translate_Spec_And_Body);
       end if;
 
       if Is_Spec_Decl and then Is_Uninstantiated_Package (Spec) then
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 0cfaecd71..39c170d2d 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -1543,7 +1543,7 @@ package body Trans.Chap3 is
       Pop_Identifier_Prefix (Mark);
    end Translate_Protected_Type;
 
-   procedure Translate_Protected_Type_Subprograms
+   procedure Translate_Protected_Type_Subprograms_Spec
      (Def : Iir_Protected_Type_Declaration)
    is
       Info                 : constant Type_Info_Acc := Get_Info (Def);
@@ -1595,7 +1595,7 @@ package body Trans.Chap3 is
       Subprgs.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance);
 
       Pop_Identifier_Prefix (Mark);
-   end Translate_Protected_Type_Subprograms;
+   end Translate_Protected_Type_Subprograms_Spec;
 
    procedure Translate_Protected_Type_Body (Bod : Iir)
    is
@@ -1618,7 +1618,6 @@ package body Trans.Chap3 is
       Chap4.Translate_Declaration_Chain (Bod);
 
       Pop_Instance_Factory (Info.B.Prot_Scope'Unrestricted_Access);
-      -- Info.Ortho_Type (Mode_Value) := Get_Scope_Type (Info.B.Prot_Scope);
 
       Pop_Identifier_Prefix (Mark);
    end Translate_Protected_Type_Body;
@@ -1644,8 +1643,8 @@ package body Trans.Chap3 is
       Mark  : Id_Mark_Type;
       Decl  : constant Iir := Get_Protected_Type_Declaration (Bod);
       Info  : constant Type_Info_Acc := Get_Info (Decl);
-      Final : Boolean;
       Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
+      Final : Boolean;
    begin
       Push_Identifier_Prefix (Mark, Get_Identifier (Bod));
 
@@ -1657,7 +1656,8 @@ package body Trans.Chap3 is
       Subprgs.Start_Prev_Subprg_Instance_Use_Via_Field
         (Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field);
 
-      Chap4.Translate_Declaration_Chain_Subprograms (Bod);
+      Chap4.Translate_Declaration_Chain_Subprograms
+        (Bod, Subprg_Translate_Spec_And_Body);
 
       Subprgs.Finish_Prev_Subprg_Instance_Use_Via_Field
         (Prev_Subprg_Instance, Info.B.Prot_Subprg_Instance_Field);
@@ -2349,29 +2349,33 @@ package body Trans.Chap3 is
       Create_Scalar_Type_Range_Type (Def, True);
    end Translate_Bool_Type_Definition;
 
-   procedure Translate_Type_Subprograms (Decl : Iir)
+   procedure Translate_Type_Subprograms
+     (Decl : Iir; Kind : Subprg_Translate_Kind)
    is
-      Def   : Iir;
+      Def   : constant Iir := Get_Type_Definition (Decl);
       Tinfo : Type_Info_Acc;
       Id    : Name_Id;
    begin
-      Def := Get_Type_Definition (Decl);
-
-      if Get_Kind (Def) in Iir_Kinds_Subtype_Definition then
-         --  Also elaborate the base type, iff DEF and its BASE_TYPE have
-         --  been declared by the same type declarator.  This avoids several
-         --  elaboration of the same type.
-         Def := Get_Base_Type (Def);
-
-         --  Consistency check.
-         pragma Assert (Get_Type_Declarator (Def) = Decl);
-      elsif Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
-         return;
-      end if;
-
-      if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then
-         Translate_Protected_Type_Subprograms (Def);
-      end if;
+      case Get_Kind (Def) is
+         when Iir_Kind_Incomplete_Type_Definition =>
+            return;
+         when Iir_Kind_Protected_Type_Declaration =>
+            Translate_Protected_Type_Subprograms_Spec (Def);
+            return;
+         when Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition =>
+            null;
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Floating_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_File_Type_Definition
+           | Iir_Kind_Access_Type_Definition =>
+            --  Never complex.
+            return;
+         when others =>
+            raise Internal_Error;
+      end case;
 
       Tinfo := Get_Info (Def);
       if not Is_Complex_Type (Tinfo)
@@ -2380,32 +2384,36 @@ package body Trans.Chap3 is
          return;
       end if;
 
-      --  Declare subprograms.
-      Id := Get_Identifier (Decl);
-      Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value);
-      if Get_Has_Signal_Flag (Def) then
-         Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal);
+      if Kind in Subprg_Translate_Spec then
+         --  Declare subprograms.
+         Id := Get_Identifier (Decl);
+         Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value);
+         if Get_Has_Signal_Flag (Def) then
+            Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal);
+         end if;
       end if;
 
-      if Global_Storage = O_Storage_External then
-         return;
-      end if;
+      if Kind in Subprg_Translate_Body then
+         if Global_Storage = O_Storage_External then
+            return;
+         end if;
 
-      --  Define subprograms.
-      case Get_Kind (Def) is
-         when Iir_Kind_Array_Type_Definition =>
-            Create_Array_Type_Builder (Def, Mode_Value);
-            if Get_Has_Signal_Flag (Def) then
-               Create_Array_Type_Builder (Def, Mode_Signal);
-            end if;
-         when Iir_Kind_Record_Type_Definition =>
-            Create_Record_Type_Builder (Def, Mode_Value);
-            if Get_Has_Signal_Flag (Def) then
-               Create_Record_Type_Builder (Def, Mode_Signal);
-            end if;
-         when others =>
-            Error_Kind ("translate_type_subprograms", Def);
-      end case;
+         --  Define subprograms.
+         case Get_Kind (Def) is
+            when Iir_Kind_Array_Type_Definition =>
+               Create_Array_Type_Builder (Def, Mode_Value);
+               if Get_Has_Signal_Flag (Def) then
+                  Create_Array_Type_Builder (Def, Mode_Signal);
+               end if;
+            when Iir_Kind_Record_Type_Definition =>
+               Create_Record_Type_Builder (Def, Mode_Value);
+               if Get_Has_Signal_Flag (Def) then
+                  Create_Record_Type_Builder (Def, Mode_Signal);
+               end if;
+            when others =>
+               Error_Kind ("translate_type_subprograms", Def);
+         end case;
+      end if;
    end Translate_Type_Subprograms;
 
    --  Initialize the objects related to a type (type range and type
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index ec0921b01..70a6fa35d 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -44,7 +44,8 @@ package Trans.Chap3 is
    procedure Translate_Anonymous_Type_Definition (Def : Iir);
 
    --  Translate subprograms for types.
-   procedure Translate_Type_Subprograms (Decl : Iir);
+   procedure Translate_Type_Subprograms
+     (Decl : Iir; Kind : Subprg_Translate_Kind);
 
    procedure Create_Type_Definition_Type_Range (Def : Iir);
    function Create_Static_Composite_Subtype_Bounds (Def : Iir) return O_Cnode;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 7d20e51fe..97bef532e 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2321,7 +2321,8 @@ package body Trans.Chap4 is
       Create_Union_Scope (State_Scope.all, Scope_Type);
    end Translate_Statements_Chain_State_Declaration;
 
-   procedure Translate_Declaration_Chain_Subprograms (Parent : Iir)
+   procedure Translate_Declaration_Chain_Subprograms
+     (Parent : Iir; What : Subprg_Translate_Kind)
    is
       El     : Iir;
       Infos  : Chap7.Implicit_Subprogram_Infos;
@@ -2341,51 +2342,68 @@ package body Trans.Chap4 is
                           | Iir_Predefined_Record_Equality =>
                            --  Used implicitly in case statement or other
                            --  predefined equality.
-                           Chap7.Translate_Implicit_Subprogram_Spec
-                             (El, Infos);
-                           Chap7.Translate_Implicit_Subprogram_Body (El);
+                           if What in Subprg_Translate_Spec then
+                              Chap7.Translate_Implicit_Subprogram_Spec
+                                (El, Infos);
+                           end if;
+                           if What in Subprg_Translate_Body then
+                              Chap7.Translate_Implicit_Subprogram_Body (El);
+                           end if;
                         when others =>
                            null;
                      end case;
                   else
-                     Chap7.Translate_Implicit_Subprogram_Spec (El, Infos);
-                     Chap7.Translate_Implicit_Subprogram_Body (El);
+                     if What in Subprg_Translate_Spec then
+                        Chap7.Translate_Implicit_Subprogram_Spec
+                          (El, Infos);
+                     end if;
+                     if What in Subprg_Translate_Body then
+                        Chap7.Translate_Implicit_Subprogram_Body (El);
+                     end if;
                   end if;
                else
                   --  Translate only if used.
-                  if Get_Info (El) /= null then
+                  if What in Subprg_Translate_Spec
+                    and then Get_Info (El) /= null
+                  then
                      Chap2.Translate_Subprogram_Declaration (El);
                      Translate_Resolution_Function (El);
                   end if;
                end if;
             when Iir_Kind_Function_Body
-               | Iir_Kind_Procedure_Body =>
-               --  Do not translate body if generating only specs (for
-               --  subprograms in an entity).
-               if Global_Storage /= O_Storage_External
-                 and then
-                   (not Flag_Discard_Unused
-                    or else
-                    Get_Use_Flag (Get_Subprogram_Specification (El)))
-               then
-                  Chap2.Translate_Subprogram_Body (El);
-                  Translate_Resolution_Function_Body
-                    (Get_Subprogram_Specification (El));
+              | Iir_Kind_Procedure_Body =>
+               if What in Subprg_Translate_Body then
+                  --  Do not translate body if generating only specs (for
+                  --  subprograms in an entity).
+                  if Global_Storage /= O_Storage_External
+                    and then
+                    (not Flag_Discard_Unused
+                       or else
+                       Get_Use_Flag (Get_Subprogram_Specification (El)))
+                  then
+                     Chap2.Translate_Subprogram_Body (El);
+                     Translate_Resolution_Function_Body
+                       (Get_Subprogram_Specification (El));
+                  end if;
                end if;
             when Iir_Kind_Type_Declaration
                | Iir_Kind_Anonymous_Type_Declaration =>
-               Chap3.Translate_Type_Subprograms (El);
+               Chap3.Translate_Type_Subprograms (El, What);
                Chap7.Init_Implicit_Subprogram_Infos (Infos);
             when Iir_Kind_Protected_Type_Body =>
-               Chap3.Translate_Protected_Type_Body (El);
-               Chap3.Translate_Protected_Type_Body_Subprograms (El);
+               if What in Subprg_Translate_Spec then
+                  Chap3.Translate_Protected_Type_Body (El);
+               end if;
+               if What in Subprg_Translate_Body then
+                  Chap3.Translate_Protected_Type_Body_Subprograms (El);
+               end if;
             when Iir_Kind_Package_Declaration
               | Iir_Kind_Package_Body =>
                declare
                   Mark  : Id_Mark_Type;
                begin
                   Push_Identifier_Prefix (Mark, Get_Identifier (El));
-                  Translate_Declaration_Chain_Subprograms (El);
+                  Translate_Declaration_Chain_Subprograms (El, What);
                   Pop_Identifier_Prefix (Mark);
                end;
             when Iir_Kind_Package_Instantiation_Declaration =>
@@ -2397,11 +2415,11 @@ package body Trans.Chap4 is
                      Mark  : Id_Mark_Type;
                   begin
                      Push_Identifier_Prefix (Mark, Get_Identifier (El));
-                     Translate_Declaration_Chain_Subprograms (El);
+                     Translate_Declaration_Chain_Subprograms (El, What);
                      if Is_Valid (Bod)
                        and then Global_Storage /= O_Storage_External
                      then
-                        Translate_Declaration_Chain_Subprograms (Bod);
+                        Translate_Declaration_Chain_Subprograms (Bod, What);
                      end if;
                      Pop_Identifier_Prefix (Mark);
                   end;
diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads
index cfc1917fe..6ada12419 100644
--- a/src/vhdl/translate/trans-chap4.ads
+++ b/src/vhdl/translate/trans-chap4.ads
@@ -36,7 +36,8 @@ package Trans.Chap4 is
      (Stmts : Iir; State_Scope : Var_Scope_Acc);
 
    --  Translate subprograms in declaration chain of PARENT.
-   procedure Translate_Declaration_Chain_Subprograms (Parent : Iir);
+   procedure Translate_Declaration_Chain_Subprograms
+     (Parent : Iir; What : Subprg_Translate_Kind);
 
    --  Create subprograms for type/function conversion of signal
    --  associations.
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 1b8f55a43..bbad1754a 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -996,7 +996,8 @@ package body Trans.Chap9 is
       Stmt      : Iir;
       Mark      : Id_Mark_Type;
    begin
-      Chap4.Translate_Declaration_Chain_Subprograms (Block);
+      Chap4.Translate_Declaration_Chain_Subprograms
+        (Block, Subprg_Translate_Spec_And_Body);
 
       Stmt := Get_Concurrent_Statement_Chain (Block);
       while Stmt /= Null_Iir loop
@@ -1008,7 +1009,8 @@ package body Trans.Chap9 is
                   Chap9.Set_Direct_Drivers (Stmt);
                end if;
 
-               Chap4.Translate_Declaration_Chain_Subprograms (Stmt);
+               Chap4.Translate_Declaration_Chain_Subprograms
+                 (Stmt, Subprg_Translate_Spec_And_Body);
                Translate_Process_Statement (Stmt, Base_Info);
 
                if Flag_Direct_Drivers then
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 80392c86e..598e662f4 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -171,6 +171,16 @@ package Trans is
    type Allocation_Kind is
      (Alloc_Stack, Alloc_Return, Alloc_Heap, Alloc_System);
 
+   --  Sometimes useful to factorize code.  Defines what has to be translated.
+   type Subprg_Translate_Kind is
+     (Subprg_Translate_Only_Spec,
+      Subprg_Translate_Spec_And_Body,
+      Subprg_Translate_Only_Body);
+   subtype Subprg_Translate_Spec is Subprg_Translate_Kind range
+     Subprg_Translate_Only_Spec .. Subprg_Translate_Spec_And_Body;
+   subtype Subprg_Translate_Body is Subprg_Translate_Kind range
+     Subprg_Translate_Spec_And_Body .. Subprg_Translate_Only_Body;
+
    --  Return the value of field FIELD of lnode L that is contains
    --   a pointer to a record.
    --  This is equivalent to: