synth: add ports attributes

3 files changed, 120 insertions, 0 deletions

diff --git a/src/synth/include/synth.h b/src/synth/include/synth.h
index c89eab7fc..fa6b78e2c 100644
--- a/src/synth/include/synth.h
+++ b/src/synth/include/synth.h
@@ -134,6 +134,8 @@ namespace GhdlSynth {
 
   struct Attribute { unsigned int id; };
   GHDLSYNTH_ADA_WRAPPER_WW(get_first_attribute, Attribute, Instance);
+  GHDLSYNTH_ADA_WRAPPER_WWD(get_first_input_port_attribute, Attribute, Module, Port_Idx);
+  GHDLSYNTH_ADA_WRAPPER_WWD(get_first_output_port_attribute, Attribute, Module, Port_Idx);
   GHDLSYNTH_ADA_WRAPPER_WW(get_attribute_name, Name_Id, Attribute);
   GHDLSYNTH_ADA_WRAPPER_DW(get_attribute_type, Param_Type, Attribute);
   GHDLSYNTH_ADA_WRAPPER_WW(get_attribute_pval, Pval, Attribute);
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index 31a3321b2..0a0a560ed 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -1292,6 +1292,107 @@ package body Netlists is
       return Attributes_Table.Table (Attr).Chain;
    end Get_Attribute_Next;
 
+   function Port_Attribute_Hash (Params : Port_Desc_Idx)
+                                return Hash_Value_Type is
+   begin
+      return Hash_Value_Type (Params);
+   end Port_Attribute_Hash;
+
+   function Port_Attribute_Build (Params : Port_Desc_Idx)
+                                 return Port_Desc_Idx is
+   begin
+      return Params;
+   end Port_Attribute_Build;
+
+   function Port_Attribute_Build_Value (Obj : Port_Desc_Idx) return Attribute
+   is
+      pragma Unreferenced (Obj);
+   begin
+      return No_Attribute;
+   end Port_Attribute_Build_Value;
+
+   package Ports_Attribute_Maps is new Dyn_Maps
+     (Params_Type => Port_Desc_Idx,
+      Object_Type => Port_Desc_Idx,
+      Value_Type => Attribute,
+      Hash => Port_Attribute_Hash,
+      Build => Port_Attribute_Build,
+      Build_Value => Port_Attribute_Build_Value,
+      Equal => "=");
+
+   Ports_Attribute_Map : Ports_Attribute_Maps.Instance;
+
+   procedure Set_Port_Attribute
+     (Port : Port_Desc_Idx; Id : Name_Id; Ptype : Param_Type; Pv : Pval)
+   is
+      Attr       : Attribute;
+      Idx        : Ports_Attribute_Maps.Index_Type;
+      Prev       : Attribute;
+   begin
+      Ports_Attribute_Maps.Get_Index (Ports_Attribute_Map, Port, Idx);
+
+      Prev := Ports_Attribute_Maps.Get_Value (Ports_Attribute_Map, Idx);
+      Attributes_Table.Append ((Name => Id,
+                                Typ => Ptype,
+                                Val => Pv,
+                                Chain => Prev));
+      Attr := Attributes_Table.Last;
+
+      Ports_Attribute_Maps.Set_Value (Ports_Attribute_Map, Idx, Attr);
+   end Set_Port_Attribute;
+
+   procedure Set_Input_Port_Attribute (M : Module;
+                                       Port : Port_Idx;
+                                       Id : Name_Id;
+                                       Ptype : Param_Type;
+                                       Pv : Pval)
+   is
+      Idx  : constant Port_Desc_Idx :=
+        Get_Input_First_Desc (M) + Port_Desc_Idx (Port);
+   begin
+      Set_Port_Attribute (Idx, Id, Ptype, Pv);
+   end Set_Input_Port_Attribute;
+
+   procedure Set_Output_Port_Attribute (M : Module;
+                                        Port : Port_Idx;
+                                        Id : Name_Id;
+                                        Ptype : Param_Type;
+                                        Pv : Pval)
+   is
+      Idx  : constant Port_Desc_Idx :=
+        Get_Output_First_Desc (M) + Port_Desc_Idx (Port);
+   begin
+      Set_Port_Attribute (Idx, Id, Ptype, Pv);
+   end Set_Output_Port_Attribute;
+
+   function Get_Port_First_Attribute (Port : Port_Desc_Idx) return Attribute
+   is
+      Idx        : Ports_Attribute_Maps.Index_Type;
+      Res        : Attribute;
+   begin
+      Ports_Attribute_Maps.Get_Index (Ports_Attribute_Map, Port, Idx);
+      Res := Ports_Attribute_Maps.Get_Value (Ports_Attribute_Map, Idx);
+      return Res;
+   end Get_Port_First_Attribute;
+
+   function Get_First_Input_Port_Attribute (M : Module; Port : Port_Idx)
+                                           return Attribute
+   is
+      Idx  : constant Port_Desc_Idx :=
+        Get_Input_First_Desc (M) + Port_Desc_Idx (Port);
+   begin
+      return Get_Port_First_Attribute (Idx);
+   end Get_First_Input_Port_Attribute;
+
+   function Get_First_Output_Port_Attribute (M : Module; Port : Port_Idx)
+                                            return Attribute
+   is
+      Idx  : constant Port_Desc_Idx :=
+        Get_Output_First_Desc (M) + Port_Desc_Idx (Port);
+   begin
+      return Get_Port_First_Attribute (Idx);
+   end Get_First_Output_Port_Attribute;
+
    --  Statistics
 
    function Count_Free_Inputs (Head : Input) return Natural
@@ -1499,4 +1600,6 @@ begin
                              Val => No_Pval,
                              Chain => No_Attribute));
    pragma Assert (Attributes_Table.Last = No_Attribute);
+
+   Ports_Attribute_Maps.Init (Ports_Attribute_Map);
 end Netlists;
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index a516efee4..55afc39be 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -332,8 +332,23 @@ package Netlists is
    procedure Set_Attribute
      (Inst : Instance; Id : Name_Id; Ptype : Param_Type; Pv : Pval);
 
+   procedure Set_Input_Port_Attribute (M : Module;
+                                       Port : Port_Idx;
+                                       Id : Name_Id;
+                                       Ptype : Param_Type;
+                                       Pv : Pval);
+   procedure Set_Output_Port_Attribute (M : Module;
+                                        Port : Port_Idx;
+                                        Id : Name_Id;
+                                        Ptype : Param_Type;
+                                        Pv : Pval);
+
    --  Return the first attribute for INST.  Returns No_Attribute if none.
    function Get_First_Attribute (Inst : Instance) return Attribute;
+   function Get_First_Input_Port_Attribute (M : Module; Port : Port_Idx)
+                                           return Attribute;
+   function Get_First_Output_Port_Attribute (M : Module; Port : Port_Idx)
+                                            return Attribute;
 
    --  Get name/type/value of an attribute.
    function Get_Attribute_Name (Attr : Attribute) return Name_Id;