synth: initial support of access type. For #1004

4 files changed, 72 insertions, 4 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 33daa4079..aceb4954d 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -127,6 +127,20 @@ package body Synth.Decls is
       return Typ;
    end Synth_Record_Type_Definition;
 
+   function Synth_Access_Type_Definition
+     (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc
+   is
+      Des_Type : constant Node := Get_Designated_Type (Def);
+      Des_Typ : Type_Acc;
+      Typ : Type_Acc;
+   begin
+      Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type);
+      Des_Typ := Get_Value_Type (Syn_Inst, Des_Type);
+
+      Typ := Create_Access_Type (Des_Typ);
+      return Typ;
+   end Synth_Access_Type_Definition;
+
    procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
    is
       Typ : Type_Acc;
@@ -158,8 +172,9 @@ package body Synth.Decls is
             end if;
          when Iir_Kind_Array_Type_Definition =>
             Typ := Synth_Array_Type_Definition (Syn_Inst, Def);
-         when Iir_Kind_Access_Type_Definition
-           | Iir_Kind_File_Type_Definition =>
+         when Iir_Kind_Access_Type_Definition =>
+            Typ := Synth_Access_Type_Definition (Syn_Inst, Def);
+         when Iir_Kind_File_Type_Definition =>
             Typ := null;
          when Iir_Kind_Record_Type_Definition =>
             Typ := Synth_Record_Type_Definition (Syn_Inst, Def);
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 6588bf338..db35e95e4 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -853,6 +853,8 @@ package body Synth.Expr is
          when Type_Record =>
             --  TODO: handle elements.
             return Val;
+         when Type_Access =>
+            return Val;
       end case;
    end Synth_Subtype_Conversion;
 
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 58fc892ac..87ba22018 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -54,6 +54,8 @@ package body Synth.Values is
          when Value_Array
            | Value_Record =>
             return False;
+         when Value_Access =>
+            return False;
          when Value_Alias =>
             return Is_Const (Val.A_Obj);
          when Value_Const =>
@@ -81,6 +83,8 @@ package body Synth.Values is
          when Value_Array
            | Value_Record =>
             return False;
+         when Value_Access =>
+            return False;
          when Value_Const =>
             return True;
          when Value_Instance
@@ -101,7 +105,8 @@ package body Synth.Values is
            | Type_Vector
            | Type_Slice
            | Type_Array
-           | Type_Record =>
+           | Type_Record
+           | Type_Access =>
             return True;
          when Type_Unbounded_Array
            | Type_Unbounded_Vector =>
@@ -367,6 +372,16 @@ package body Synth.Values is
                                                 Rec => Els)));
    end Create_Record_Type;
 
+   function Create_Access_Type (Acc_Type : Type_Acc) return Type_Acc
+   is
+      subtype Access_Type_Type is Type_Type (Type_Access);
+      function Alloc is new Areapools.Alloc_On_Pool_Addr (Access_Type_Type);
+   begin
+      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Access,
+                                                W => 32,
+                                                Acc_Acc => Acc_Type)));
+   end Create_Access_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);
@@ -414,6 +429,20 @@ package body Synth.Values is
                                    Fp => Val)));
    end Create_Value_Float;
 
+   function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index)
+                                return Value_Acc
+   is
+      subtype Value_Type_Access is Value_Type (Value_Access);
+      function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Access);
+   begin
+      pragma Assert (Vtype /= null);
+      return To_Value_Acc (Alloc (Current_Pool,
+                                  (Kind => Value_Access,
+                                   Typ => Vtype,
+                                   Acc => Acc)));
+   end Create_Value_Access;
+
+
    function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc
    is
       use System;
@@ -637,6 +666,8 @@ package body Synth.Values is
          when Value_Const_Record =>
             Arr := Copy_Array (Src.Rec);
             Res := Create_Value_Const_Record (Src.Typ, Arr);
+         when Value_Access =>
+            Res := Create_Value_Access (Src.Typ, Src.Acc);
          when Value_Instance =>
             raise Internal_Error;
          when Value_Const =>
@@ -710,6 +741,8 @@ package body Synth.Values is
          when Type_Record =>
             --  FIXME: handle vhdl-08
             return True;
+         when Type_Access =>
+            return True;
       end case;
    end Is_Matching_Bounds;
 
@@ -763,6 +796,8 @@ package body Synth.Values is
                end loop;
                return Create_Value_Record (Typ, Els);
             end;
+         when Type_Access =>
+            return Create_Value_Access (Typ, Null_Heap_Index);
       end case;
    end Create_Value_Default;
 
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 80ddbc210..7c15f84b5 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -84,7 +84,9 @@ package Synth.Values is
       Type_Slice,
       Type_Array,
       Type_Unbounded_Array,
-      Type_Record
+      Type_Record,
+
+      Type_Access
      );
 
    subtype Type_Nets is Type_Kind range Type_Bit .. Type_Logic;
@@ -129,6 +131,8 @@ package Synth.Values is
             Uarr_El : Type_Acc;
          when Type_Record =>
             Rec : Rec_El_Array_Acc;
+         when Type_Access =>
+            Acc_Acc : Type_Acc;
       end case;
    end record;
 
@@ -158,6 +162,8 @@ package Synth.Values is
       Value_Record,
       Value_Const_Record,
 
+      Value_Access,
+
       --  A package.
       Value_Instance,
 
@@ -188,6 +194,9 @@ package Synth.Values is
 
    type Instance_Id is new Nat32;
 
+   type Heap_Index is new Uns32;
+   Null_Heap_Index : constant Heap_Index := 0;
+
    type Value_Type (Kind : Value_Kind) is record
       Typ : Type_Acc;
       case Kind is
@@ -207,6 +216,8 @@ package Synth.Values is
          when Value_Record
            | Value_Const_Record =>
             Rec : Value_Array_Acc;
+         when Value_Access =>
+            Acc : Heap_Index;
          when Value_Instance =>
             Instance : Instance_Id;
          when Value_Const =>
@@ -248,6 +259,8 @@ package Synth.Values is
    function Create_Record_Type (Els : Rec_El_Array_Acc; W : Width)
                                return Type_Acc;
 
+   function Create_Access_Type (Acc_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;
 
@@ -271,6 +284,9 @@ package Synth.Values is
 
    function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc;
 
+   function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_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;