synth: initial support for file types. For #1004

5 files changed, 105 insertions, 33 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index aceb4954d..e91849af0 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -141,6 +141,19 @@ package body Synth.Decls is
       return Typ;
    end Synth_Access_Type_Definition;
 
+   function Synth_File_Type_Definition
+     (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
+   is
+      File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def));
+      File_Typ : Type_Acc;
+      Typ : Type_Acc;
+   begin
+      File_Typ := Get_Value_Type (Syn_Inst, File_Type);
+
+      Typ := Create_File_Type (File_Typ);
+      return Typ;
+   end Synth_File_Type_Definition;
+
    procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
    is
       Typ : Type_Acc;
@@ -175,7 +188,7 @@ package body Synth.Decls is
          when Iir_Kind_Access_Type_Definition =>
             Typ := Synth_Access_Type_Definition (Syn_Inst, Def);
          when Iir_Kind_File_Type_Definition =>
-            Typ := null;
+            Typ := Synth_File_Type_Definition (Syn_Inst, Def);
          when Iir_Kind_Record_Type_Definition =>
             Typ := Synth_Record_Type_Definition (Syn_Inst, Def);
          when others =>
@@ -683,7 +696,14 @@ package body Synth.Decls is
          when Iir_Kind_Component_Declaration =>
             null;
          when Iir_Kind_File_Declaration =>
-            null;
+            declare
+               Res : Value_Acc;
+               Obj_Typ : Type_Acc;
+            begin
+               Obj_Typ := Get_Value_Type (Syn_Inst, Get_Type (Decl));
+               Res := Create_Value_File (Obj_Typ, 0);
+               Create_Object (Syn_Inst, Decl, Res);
+            end;
          when Iir_Kind_Psl_Default_Clock =>
             --  Ignored; directly used by PSL directives.
             null;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index db35e95e4..b848265a6 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -855,6 +855,8 @@ package body Synth.Expr is
             return Val;
          when Type_Access =>
             return Val;
+         when Type_File =>
+            raise Internal_Error;
       end case;
    end Synth_Subtype_Conversion;
 
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 87ba22018..a27056ee5 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -54,7 +54,8 @@ package body Synth.Values is
          when Value_Array
            | Value_Record =>
             return False;
-         when Value_Access =>
+         when Value_Access
+           | Value_File =>
             return False;
          when Value_Alias =>
             return Is_Const (Val.A_Obj);
@@ -83,7 +84,8 @@ package body Synth.Values is
          when Value_Array
            | Value_Record =>
             return False;
-         when Value_Access =>
+         when Value_Access
+           | Value_File =>
             return False;
          when Value_Const =>
             return True;
@@ -106,7 +108,8 @@ package body Synth.Values is
            | Type_Slice
            | Type_Array
            | Type_Record
-           | Type_Access =>
+           | Type_Access
+           | Type_File =>
             return True;
          when Type_Unbounded_Array
            | Type_Unbounded_Vector =>
@@ -382,6 +385,16 @@ package body Synth.Values is
                                                 Acc_Acc => Acc_Type)));
    end Create_Access_Type;
 
+   function Create_File_Type (File_Type : Type_Acc) return Type_Acc
+   is
+      subtype File_Type_Type is Type_Type (Type_File);
+      function Alloc is new Areapools.Alloc_On_Pool_Addr (File_Type_Type);
+   begin
+      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_File,
+                                                W => 32,
+                                                File_Typ => File_Type)));
+   end Create_File_Type;
+
    function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc
    is
       subtype Value_Type_Wire is Value_Type (Values.Value_Wire);
@@ -442,6 +455,18 @@ package body Synth.Values is
                                    Acc => Acc)));
    end Create_Value_Access;
 
+   function Create_Value_File (Vtype : Type_Acc; File : File_Index)
+                              return Value_Acc
+   is
+      subtype Value_Type_File is Value_Type (Value_File);
+      function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_File);
+   begin
+      pragma Assert (Vtype /= null);
+      return To_Value_Acc (Alloc (Current_Pool,
+                                  (Kind => Value_File,
+                                   Typ => Vtype,
+                                   File => File)));
+   end Create_Value_File;
 
    function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc
    is
@@ -668,6 +693,8 @@ package body Synth.Values is
             Res := Create_Value_Const_Record (Src.Typ, Arr);
          when Value_Access =>
             Res := Create_Value_Access (Src.Typ, Src.Acc);
+         when Value_File =>
+            Res := Create_Value_File (Src.Typ, Src.File);
          when Value_Instance =>
             raise Internal_Error;
          when Value_Const =>
@@ -743,6 +770,8 @@ package body Synth.Values is
             return True;
          when Type_Access =>
             return True;
+         when Type_File =>
+            raise Internal_Error;
       end case;
    end Is_Matching_Bounds;
 
@@ -798,6 +827,8 @@ package body Synth.Values is
             end;
          when Type_Access =>
             return Create_Value_Access (Typ, Null_Heap_Index);
+         when Type_File =>
+            raise Internal_Error;
       end case;
    end Create_Value_Default;
 
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 7c15f84b5..bdf7aca84 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -86,7 +86,8 @@ package Synth.Values is
       Type_Unbounded_Array,
       Type_Record,
 
-      Type_Access
+      Type_Access,
+      Type_File
      );
 
    subtype Type_Nets is Type_Kind range Type_Bit .. Type_Logic;
@@ -133,6 +134,8 @@ package Synth.Values is
             Rec : Rec_El_Array_Acc;
          when Type_Access =>
             Acc_Acc : Type_Acc;
+         when Type_File =>
+            File_Typ : Type_Acc;
       end case;
    end record;
 
@@ -163,6 +166,7 @@ package Synth.Values is
       Value_Const_Record,
 
       Value_Access,
+      Value_File,
 
       --  A package.
       Value_Instance,
@@ -197,6 +201,8 @@ package Synth.Values is
    type Heap_Index is new Uns32;
    Null_Heap_Index : constant Heap_Index := 0;
 
+   type File_Index is new Nat32;
+
    type Value_Type (Kind : Value_Kind) is record
       Typ : Type_Acc;
       case Kind is
@@ -218,6 +224,8 @@ package Synth.Values is
             Rec : Value_Array_Acc;
          when Value_Access =>
             Acc : Heap_Index;
+         when Value_File =>
+            File : File_Index;
          when Value_Instance =>
             Instance : Instance_Id;
          when Value_Const =>
@@ -261,6 +269,8 @@ package Synth.Values is
 
    function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc;
 
+   function Create_File_Type (File_Type : Type_Acc) return Type_Acc;
+
    --  Return the element of a vector/array/unbounded_array.
    function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc;
 
@@ -287,6 +297,9 @@ package Synth.Values is
    function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index)
                                 return Value_Acc;
 
+   function Create_Value_File (Vtype : Type_Acc; File : File_Index)
+                              return Value_Acc;
+
    function Create_Value_Subtype (Typ : Type_Acc) return Value_Acc;
 
    function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc;
diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb
index 8e2973356..a349a8a07 100644
--- a/src/vhdl/vhdl-annotations.adb
+++ b/src/vhdl/vhdl-annotations.adb
@@ -445,33 +445,39 @@ package body Vhdl.Annotations is
             null;
 
          when Iir_Kind_File_Type_Definition =>
-            declare
-               Type_Name : constant Iir := Get_Type (Get_File_Type_Mark (Def));
-               Res : String_Acc;
-            begin
-               if Get_Text_File_Flag (Def)
-                 or else
-                 (Get_Kind (Type_Name)
-                    in Iir_Kinds_Scalar_Type_And_Subtype_Definition)
-               then
-                  Res := null;
-               else
-                  declare
-                     Sig : String
-                       (1 .. Get_File_Signature_Length (Type_Name) + 2);
-                     Off : Natural := Sig'First;
-                  begin
-                     Get_File_Signature (Type_Name, Sig, Off);
-                     Sig (Off + 0) := '.';
-                     Sig (Off + 1) := ASCII.NUL;
-                     Res := new String'(Sig);
-                  end;
-               end if;
-               Set_Info (Def,
-                         new Sim_Info_Type'(Kind => Kind_File_Type,
-                                            Ref => Def,
-                                            File_Signature => Res));
-            end;
+            if Flag_Synthesis then
+               --  For the File type.
+               Create_Object_Info (Block_Info, Def, Kind_Type);
+            else
+               declare
+                  Type_Name : constant Iir :=
+                    Get_Type (Get_File_Type_Mark (Def));
+                  Res : String_Acc;
+               begin
+                  if Get_Text_File_Flag (Def)
+                    or else
+                    (Get_Kind (Type_Name)
+                       in Iir_Kinds_Scalar_Type_And_Subtype_Definition)
+                  then
+                     Res := null;
+                  else
+                     declare
+                        Sig : String
+                          (1 .. Get_File_Signature_Length (Type_Name) + 2);
+                        Off : Natural := Sig'First;
+                     begin
+                        Get_File_Signature (Type_Name, Sig, Off);
+                        Sig (Off + 0) := '.';
+                        Sig (Off + 1) := ASCII.NUL;
+                        Res := new String'(Sig);
+                     end;
+                  end if;
+                  Set_Info (Def,
+                            new Sim_Info_Type'(Kind => Kind_File_Type,
+                                               Ref => Def,
+                                               File_Signature => Res));
+               end;
+            end if;
 
          when Iir_Kind_Protected_Type_Declaration =>
             Annotate_Protected_Type_Declaration (Block_Info, Def);