Rework translation of unbounded and complex types.

1 files changed, 27 insertions, 8 deletions

diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index a7ec6e7da..68dd9a300 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -33,6 +33,7 @@ with Trans;
 with Trans_Decls; use Trans_Decls;
 with Trans.Chap1;
 with Trans.Chap2;
+with Trans.Chap3;
 with Trans.Chap4;
 with Trans.Chap7;
 with Trans.Chap12;
@@ -423,6 +424,9 @@ package body Translation is
 
       Ghdl_Index_0 := New_Unsigned_Literal (Ghdl_Index_Type, 0);
       Ghdl_Index_1 := New_Unsigned_Literal (Ghdl_Index_Type, 1);
+      Ghdl_Index_2 := New_Unsigned_Literal (Ghdl_Index_Type, 2);
+      Ghdl_Index_4 := New_Unsigned_Literal (Ghdl_Index_Type, 4);
+      Ghdl_Index_8 := New_Unsigned_Literal (Ghdl_Index_Type, 8);
 
       Ghdl_I32_Type := New_Signed_Type (32);
       New_Type_Decl (Get_Identifier ("__ghdl_i32"), Ghdl_I32_Type);
@@ -453,6 +457,8 @@ package body Translation is
       Char_Ptr_Type := New_Access_Type (Chararray_Type);
       New_Type_Decl (Get_Identifier ("__ghdl_char_ptr"), Char_Ptr_Type);
 
+      Ghdl_Index_Ptr_Align := New_Alignof (Char_Ptr_Type, Ghdl_Index_Type);
+
       Char_Ptr_Array_Type := New_Array_Type (Char_Ptr_Type, Ghdl_Index_Type);
       New_Type_Decl (Get_Identifier ("__ghdl_char_ptr_array"),
                      Char_Ptr_Array_Type);
@@ -531,6 +537,10 @@ package body Translation is
                         Ghdl_Sizes_Type);
       end;
 
+      --  __ghdl_sizes_ptr is access __ghdl_sizes_type;
+      Ghdl_Sizes_Ptr := New_Access_Type (Ghdl_Sizes_Type);
+      New_Type_Decl (Get_Identifier ("__ghdl_sizes_ptr"), Ghdl_Sizes_Ptr);
+
       --  Create type ghdl_compare_type is (lt, eq, ge);
       declare
          Constr : O_Enum_List;
@@ -1906,12 +1916,22 @@ package body Translation is
 
    end Post_Initialize;
 
-   procedure Translate_Type_Implicit_Subprograms (Decl : in out Iir)
+   procedure Translate_Type_Implicit_Subprograms
+     (Decl : in out Iir; Main : Boolean)
    is
       Infos : Chap7.Implicit_Subprogram_Infos;
+      Subprg_Kind : Subprg_Translate_Kind;
    begin
-      --  Skip type declaration.
       pragma Assert (Get_Kind (Decl) in Iir_Kinds_Type_Declaration);
+
+      if Main then
+         Subprg_Kind := Subprg_Translate_Spec_And_Body;
+      else
+         Subprg_Kind := Subprg_Translate_Only_Spec;
+      end if;
+      Chap3.Translate_Type_Subprograms (Decl, Subprg_Kind);
+
+      --  Skip type declaration.
       Decl := Get_Chain (Decl);
 
       --  Implicit subprograms are immediately follow the type declaration.
@@ -1988,22 +2008,22 @@ package body Translation is
         New_Array_Type (Std_Boolean_Type_Node, Ghdl_Index_Type);
       New_Type_Decl (Create_Identifier ("BOOLEAN_ARRAY"),
                      Std_Boolean_Array_Type);
-      Translate_Type_Implicit_Subprograms (Decl);
+      Translate_Type_Implicit_Subprograms (Decl, Main);
 
       --  Second declaration: bit.
       pragma Assert (Decl = Bit_Type_Declaration);
       Chap4.Translate_Bool_Type_Declaration (Bit_Type_Declaration);
-      Translate_Type_Implicit_Subprograms (Decl);
+      Translate_Type_Implicit_Subprograms (Decl, Main);
 
       --  Nothing special for other declarations.
       while Decl /= Null_Iir loop
          case Get_Kind (Decl) is
             when Iir_Kind_Type_Declaration =>
                Chap4.Translate_Type_Declaration (Decl);
-               Translate_Type_Implicit_Subprograms (Decl);
+               Translate_Type_Implicit_Subprograms (Decl, Main);
             when Iir_Kind_Anonymous_Type_Declaration =>
                Chap4.Translate_Anonymous_Type_Declaration (Decl);
-               Translate_Type_Implicit_Subprograms (Decl);
+               Translate_Type_Implicit_Subprograms (Decl, Main);
             when Iir_Kind_Subtype_Declaration =>
                Chap4.Translate_Subtype_Declaration (Decl);
                Decl := Get_Chain (Decl);
@@ -2078,8 +2098,7 @@ package body Translation is
       --Pop_Global_Factory;
    end Translate_Standard;
 
-   procedure Finalize
-   is
+   procedure Finalize is
    begin
       Free_Node_Infos;
       Free_Old_Temp;