synth: do not crash immediately on access type.

3 files changed, 70 insertions, 34 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 88a61d89b..fe764f50b 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -120,14 +120,12 @@ package body Synth.Decls is
       El : Node;
       El_Typ : Type_Acc;
       Off : Uns32;
-      Typ : Type_Acc;
    begin
       if not Is_Fully_Constrained_Type (Def) then
          return null;
       end if;
       Rec_Els := Create_Rec_El_Array
         (Iir_Index32 (Get_Nbr_Elements (El_List)));
-      Typ := Create_Record_Type (Rec_Els, 0);
 
       Off := 0;
       for I in Flist_First .. Flist_Last (El_List) loop
@@ -137,9 +135,8 @@ package body Synth.Decls is
                                              Typ => El_Typ);
          Off := Off + Get_Type_Width (El_Typ);
       end loop;
-      Typ.W := Off;
 
-      return Typ;
+      return Create_Record_Type (Rec_Els, Off);
    end Synth_Record_Type_Definition;
 
    function Synth_Access_Type_Definition
@@ -609,38 +606,50 @@ package body Synth.Decls is
                           Get_Declaration_Chain (Bod));
    end Synth_Package_Body;
 
+   procedure Synth_Variable
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean)
+   is
+      Def : constant Iir := Get_Default_Value (Decl);
+      --  Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+      Init : Value_Acc;
+      Obj_Type : Type_Acc;
+   begin
+      Synth_Declaration_Type (Syn_Inst, Decl);
+      Obj_Type := Get_Value_Type (Syn_Inst, Get_Type (Decl));
+      if not Obj_Type.Is_Synth
+        and then not Get_Instance_Const (Syn_Inst)
+      then
+         Error_Msg_Synth
+           (+Decl, "variable with access type is not synthesizable");
+         --  FIXME: use a poison value ?
+         Create_Object (Syn_Inst, Decl, Create_Value_Default (Obj_Type));
+      else
+         if Is_Valid (Def) then
+            Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Type);
+            Init := Synth_Subtype_Conversion (Init, Obj_Type, False, Decl);
+         else
+            Init := Create_Value_Default (Obj_Type);
+         end if;
+         if Get_Instance_Const (Syn_Inst) then
+            Create_Object (Syn_Inst, Decl, Unshare (Init, Current_Pool));
+         else
+            Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
+            Create_Var_Wire (Syn_Inst, Decl, Init);
+            if Is_Subprg then
+               Phi_Assign
+                 (Get_Build (Syn_Inst),
+                  Get_Value (Syn_Inst, Decl).W, Get_Net (Init), 0);
+            end if;
+         end if;
+      end if;
+   end Synth_Variable;
+
    procedure Synth_Declaration
      (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean) is
    begin
       case Get_Kind (Decl) is
          when Iir_Kind_Variable_Declaration =>
-            Synth_Declaration_Type (Syn_Inst, Decl);
-            declare
-               Def : constant Iir := Get_Default_Value (Decl);
-               --  Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
-               Init : Value_Acc;
-               Obj_Type : Type_Acc;
-            begin
-               Obj_Type := Get_Value_Type (Syn_Inst, Get_Type (Decl));
-               if Is_Valid (Def) then
-                  Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Type);
-                  Init := Synth_Subtype_Conversion
-                    (Init, Obj_Type, False, Decl);
-               else
-                  Init := Create_Value_Default (Obj_Type);
-               end if;
-               if Get_Instance_Const (Syn_Inst) then
-                  Create_Object (Syn_Inst, Decl, Unshare (Init, Current_Pool));
-               else
-                  Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
-                  Create_Var_Wire (Syn_Inst, Decl, Init);
-                  if Is_Subprg then
-                     Phi_Assign
-                       (Get_Build (Syn_Inst),
-                        Get_Value (Syn_Inst, Decl).W, Get_Net (Init), 0);
-                  end if;
-               end if;
-            end;
+            Synth_Variable (Syn_Inst, Decl, Is_Subprg);
          when Iir_Kind_Interface_Variable_Declaration =>
             --  Ignore default value.
             Create_Wire_Object (Syn_Inst, Wire_Variable, Decl);
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 7381c9f78..3d4459be3 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -271,7 +271,9 @@ package body Synth.Values is
       subtype Bit_Type_Type is Type_Type (Type_Bit);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Bit_Type_Type);
    begin
-      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit, W => 1)));
+      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit,
+                                                Is_Synth => True,
+                                                W => 1)));
    end Create_Bit_Type;
 
    function Create_Logic_Type return Type_Acc
@@ -279,7 +281,9 @@ package body Synth.Values is
       subtype Logic_Type_Type is Type_Type (Type_Logic);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Logic_Type_Type);
    begin
-      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Logic, W => 1)));
+      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Logic,
+                                                Is_Synth => True,
+                                                W => 1)));
    end Create_Logic_Type;
 
    function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width)
@@ -289,6 +293,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Discrete_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete,
+                                                Is_Synth => True,
                                                 W => W,
                                                 Drange => Rng)));
    end Create_Discrete_Type;
@@ -299,6 +304,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Float_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float,
+                                                Is_Synth => True,
                                                 W => 64,
                                                 Frange => Rng)));
    end Create_Float_Type;
@@ -310,6 +316,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Vector,
+                                                Is_Synth => True,
                                                 W => Bnd.Len,
                                                 Vbound => Bnd,
                                                 Vec_El => El_Type)));
@@ -321,6 +328,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Slice_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Slice,
+                                                Is_Synth => El_Type.Is_Synth,
                                                 W => W,
                                                 Slice_El => El_Type)));
    end Create_Slice_Type;
@@ -374,6 +382,7 @@ package body Synth.Values is
          W := W * Bnd.D (I).Len;
       end loop;
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Array,
+                                                Is_Synth => El_Type.Is_Synth,
                                                 W => W,
                                                 Abounds => Bnd,
                                                 Arr_El => El_Type)));
@@ -386,6 +395,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array,
+                                                Is_Synth => El_Type.Is_Synth,
                                                 W => 0,
                                                 Uarr_Ndim => Ndim,
                                                 Uarr_El => El_Type)));
@@ -397,6 +407,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Vector,
+                                                Is_Synth => El_Type.Is_Synth,
                                                 W => 0,
                                                 Uvec_El => El_Type)));
    end Create_Unbounded_Vector;
@@ -449,8 +460,17 @@ package body Synth.Values is
    is
       subtype Record_Type_Type is Type_Type (Type_Record);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type);
-   begin
+      Is_Synth : Boolean;
+   begin
+      Is_Synth := True;
+      for I in Els.E'Range loop
+         if not Els.E (I).Typ.Is_Synth then
+            Is_Synth := False;
+            exit;
+         end if;
+      end loop;
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record,
+                                                Is_Synth => Is_Synth,
                                                 W => W,
                                                 Rec => Els)));
    end Create_Record_Type;
@@ -461,6 +481,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Access_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access,
+                                                Is_Synth => False,
                                                 W => 32,
                                                 Acc_Acc => Acc_Type)));
    end Create_Access_Type;
@@ -471,6 +492,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (File_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_File,
+                                                Is_Synth => False,
                                                 W => 32,
                                                 File_Typ => File_Type)));
    end Create_File_Type;
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 1afe6d0a4..416f2729d 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -104,7 +104,12 @@ package Synth.Values is
    type Rec_El_Array_Acc is access Rec_El_Array;
 
    type Type_Type (Kind : Type_Kind) is record
+      --  False if the type is not synthesisable: is or contains access/file.
+      Is_Synth : Boolean;
+
+      --  Number of bits for this type.
       W : Width;
+
       case Kind is
          when Type_Bit
            | Type_Logic =>