synth-disp_vhdl: handle record for input ports.

8 files changed, 114 insertions, 44 deletions

diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 8f423f5d9..0f566ad6b 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -44,6 +44,7 @@ with Netlists.Disp_Vhdl;
 
 with Synthesis;
 with Synth.Disp_Vhdl;
+with Synth.Context; use Synth.Context;
 
 package body Ghdlsynth is
    type Out_Format is (Format_Raw, Format_Vhdl);
@@ -210,6 +211,7 @@ package body Ghdlsynth is
       Cmd : Command_Acc;
       First_Arg : Natural;
       Config : Node;
+      Inst : Synth_Instance_Acc;
    begin
       --  Create arguments list.
       for I in 0 .. Argc - 1 loop
@@ -229,7 +231,7 @@ package body Ghdlsynth is
          return No_Module;
       end if;
 
-      Res := Synthesis.Synth_Design (Config);
+      Synthesis.Synth_Design (Config, Res, Inst);
       return Res;
 
    exception
@@ -244,6 +246,7 @@ package body Ghdlsynth is
                              Args : Argument_List)
    is
       Res : Module;
+      Inst : Synth_Instance_Acc;
       Config : Iir;
       Ent : Iir;
    begin
@@ -253,7 +256,7 @@ package body Ghdlsynth is
          raise Errorout.Compilation_Error;
       end if;
 
-      Res := Synthesis.Synth_Design (Config);
+      Synthesis.Synth_Design (Config, Res, Inst);
       if Res = No_Module then
          raise Errorout.Compilation_Error;
       end if;
@@ -265,7 +268,7 @@ package body Ghdlsynth is
          when Format_Vhdl =>
             if Boolean'(True) then
                Ent := Vhdl.Utils.Get_Entity_From_Configuration (Config);
-               Synth.Disp_Vhdl.Disp_Vhdl_Wrapper (Ent, Res);
+               Synth.Disp_Vhdl.Disp_Vhdl_Wrapper (Ent, Res, Inst);
             else
                Netlists.Disp_Vhdl.Disp_Vhdl (Res);
             end if;
diff --git a/src/synth/netlists-disp_vhdl.ads b/src/synth/netlists-disp_vhdl.ads
index afc29458f..a088c4968 100644
--- a/src/synth/netlists-disp_vhdl.ads
+++ b/src/synth/netlists-disp_vhdl.ads
@@ -19,6 +19,8 @@
 --  MA 02110-1301, USA.
 
 package Netlists.Disp_Vhdl is
+   procedure Put_Uns32 (V : Uns32);
+
    procedure Disp_Vhdl (M : Module);
 
    procedure Disp_Architecture_Declarations (M : Module);
diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb
index c550e83f0..a65e7ba91 100644
--- a/src/synth/synth-disp_vhdl.adb
+++ b/src/synth/synth-disp_vhdl.adb
@@ -32,6 +32,8 @@ with Vhdl.Utils; use Vhdl.Utils;
 with Netlists.Iterators; use Netlists.Iterators;
 with Netlists.Disp_Vhdl; use Netlists.Disp_Vhdl;
 
+with Synth.Values; use Synth.Values;
+
 package body Synth.Disp_Vhdl is
    procedure Disp_Signal (Desc : Port_Desc) is
    begin
@@ -52,11 +54,37 @@ package body Synth.Disp_Vhdl is
       end loop;
    end Disp_Ports_As_Signals;
 
-   procedure Disp_In_Converter
-     (M : Module; Idx : in out Port_Idx; Pfx : String; Ptype : Node)
+   procedure Disp_Pfx (Off : Uns32; W : Width; Full : Boolean) is
+   begin
+      if Full then
+         return;
+      end if;
+      Put (" (");
+      if W > 1 then
+         Put_Uns32 (Off + W - 1);
+         Put (" downto ");
+      end if;
+      Put_Uns32 (Off);
+      Put (')');
+   end Disp_Pfx;
+
+   procedure Disp_In_Lhs
+     (Mname : String; Off : Uns32; W : Width; Full : Boolean) is
+   begin
+      Put ("  wrap_" & Mname);
+      Disp_Pfx (Off, W, Full);
+      Put (" <= ");
+   end Disp_In_Lhs;
+
+   procedure Disp_In_Converter (Mname : String;
+                                Pfx : String;
+                                Off : Uns32;
+                                Ptype : Node;
+                                Typ : Type_Acc;
+                                Full : Boolean)
    is
       Btype : constant Node := Get_Base_Type (Ptype);
-      Desc : constant Port_Desc := Get_Input_Desc (M, Idx);
+      W : Width;
    begin
       case Get_Kind (Btype) is
          when Iir_Kind_Enumeration_Type_Definition =>
@@ -64,63 +92,97 @@ package body Synth.Disp_Vhdl is
               or else Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
             then
                --  Nothing to do.
-               Put_Line ("  wrap_" & Pfx & " <= " & Pfx & ";");
-               Idx := Idx + 1;
+               Disp_In_Lhs (Mname, Off, 1, Full);
+               Put_Line (Pfx & ";");
             else
                --  Any other enum.
                --  TODO: width = 1
-               Put ("  wrap_" & Pfx & " <= std_logic_vector(to_unsigned(");
+               W := Typ.Drange.W;
+               Disp_In_Lhs (Mname, Off, W, Full);
+               Put ("std_logic_vector(to_unsigned(");
                Put (Name_Table.Image (Get_Identifier
                                         (Get_Type_Declarator (Ptype))));
-               Put ("'pos (" & Pfx & ")," & Width'Image (Desc.W) & "));");
+               Put ("'pos (" & Pfx & ")," & Width'Image (W) & "));");
                New_Line;
-               Idx := Idx + 1;
             end if;
          when Iir_Kind_Integer_Type_Definition =>
             --  FIXME: signed or unsigned ?
-            Put ("  wrap_" & Pfx & " <= ");
-            if Desc.W > 1 then
+            W := Typ.Drange.W;
+            Disp_In_Lhs (Mname, Off, W, Full);
+            if W > 1 then
                Put ("std_logic_vector(");
             end if;
             Put ("to_unsigned(");
-            Put (Pfx & "," & Width'Image (Desc.W) & ")");
-            if Desc.W > 1 then
+            Put (Pfx & "," & Width'Image (W) & ")");
+            if W > 1 then
                Put (")");
-            elsif Desc.W = 1 then
+            elsif W = 1 then
                Put ("(0)");
             end if;
             Put_Line (";");
-            Idx := Idx + 1;
          when Iir_Kind_Array_Type_Definition =>
             if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Vector_Type
-            or Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type then
+              or Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Vector_Type
+            then
                --  Nothing to do.
-               Put ("  wrap_" & Pfx & " <= " & Pfx);
-               if Desc.W = 1 then
+               W := Typ.Vbound.Len;
+               Disp_In_Lhs (Mname, Off, W, Full);
+               Put (Pfx);
+               if W = 1 then
                   --  This is an array of length 1.  A scalar is used in the
                   --  netlist.
                   Put (" (" & Pfx & "'left)");
                end if;
                Put_Line (";");
-               Idx := Idx + 1;
             elsif Btype = Vhdl.Ieee.Numeric.Numeric_Std_Unsigned_Type
-               or Btype = Vhdl.Ieee.Numeric.Numeric_Std_Signed_Type then
-               Put ("  wrap_" & Pfx & " <= std_logic_vector(" & Pfx);
-               if Desc.W = 1 then
+              or Btype = Vhdl.Ieee.Numeric.Numeric_Std_Signed_Type
+            then
+               W := Typ.Vbound.Len;
+               Disp_In_Lhs (Mname, Off, W, Full);
+               Put ("std_logic_vector(" & Pfx);
+               if W = 1 then
                   --  This is an array of length 1.  A scalar is used in the
                   --  netlist.
                   Put (" (" & Pfx & "'left)");
                end if;
                Put_Line (");");
-               Idx := Idx + 1;
             else
                Error_Kind ("disp_in_converter(arr)", Ptype);
             end if;
+         when Iir_Kind_Record_Type_Definition =>
+            declare
+               Els : constant Node_Flist :=
+                 Get_Elements_Declaration_List (Ptype);
+            begin
+               for I in Flist_First .. Flist_Last (Els) loop
+                  declare
+                     El : constant Node := Get_Nth_Element (Els, I);
+                     Et : Rec_El_Type renames
+                       Typ.Rec.E (Iir_Index32 (I + 1));
+                  begin
+                     Disp_In_Converter
+                       (Mname,
+                        Pfx & '.' & Name_Table.Image (Get_Identifier (El)),
+                        Off + Et.Off, Get_Type (El), Et.Typ, False);
+                  end;
+               end loop;
+            end;
          when others =>
             Error_Kind ("disp_in_converter", Ptype);
       end case;
    end Disp_In_Converter;
 
+   procedure Disp_Input_Port_Converter (Inst : Synth_Instance_Acc;
+                                        Port : Node)
+   is
+      Port_Name : constant String :=
+        Name_Table.Image (Get_Identifier (Port));
+      Port_Type : constant Node := Get_Type (Port);
+      Typ : constant Type_Acc := Get_Value_Type (Inst, Port_Type);
+   begin
+      Disp_In_Converter (Port_Name, Port_Name, 0, Port_Type, Typ, True);
+   end Disp_Input_Port_Converter;
+
    procedure Disp_Out_Converter
      (M : Module; Idx : in out Port_Idx; Pfx : String; Ptype : Node)
    is
@@ -201,7 +263,8 @@ package body Synth.Disp_Vhdl is
       end case;
    end Disp_Out_Converter;
 
-   procedure Disp_Vhdl_Wrapper (Ent : Node; Top : Module)
+   procedure Disp_Vhdl_Wrapper
+     (Ent : Node; Top : Module; Inst : Synth_Instance_Acc)
    is
       Unit : constant Node := Get_Design_Unit (Ent);
       Main : Module;
@@ -268,23 +331,22 @@ package body Synth.Disp_Vhdl is
       Disp_Architecture_Declarations (Main);
 
       Put_Line ("begin");
-      --  TODO: add assert for the value of the generics.
+      if Inst /= null then
+         --  TODO: add assert for the value of the generics.
+         null;
+      end if;
 
       declare
          Idx : Port_Idx;
          Port : Node;
       begin
          Port := Get_Port_Chain (Ent);
-         Idx := 0;
          while Port /= Null_Node loop
             if Get_Mode (Port) = Iir_In_Mode then
-               Disp_In_Converter
-                 (Main, Idx,
-                  Name_Table.Image (Get_Identifier (Port)), Get_Type (Port));
+               Disp_Input_Port_Converter (Inst, Port);
             end if;
             Port := Get_Chain (Port);
          end loop;
-         pragma Assert (Idx = Get_Nbr_Inputs (Main));
 
          Port := Get_Port_Chain (Ent);
          Idx := 0;
diff --git a/src/synth/synth-disp_vhdl.ads b/src/synth/synth-disp_vhdl.ads
index 845a5f392..be994a1bb 100644
--- a/src/synth/synth-disp_vhdl.ads
+++ b/src/synth/synth-disp_vhdl.ads
@@ -20,8 +20,10 @@
 
 with Netlists; use Netlists;
 with Vhdl.Nodes; use Vhdl.Nodes;
+with Synth.Context; use Synth.Context;
 
 package Synth.Disp_Vhdl is
    --  Disp ENT (like the original text) and its content as a wrapper.
-   procedure Disp_Vhdl_Wrapper (Ent : Node; Top : Module);
+   procedure Disp_Vhdl_Wrapper
+     (Ent : Node; Top : Module; Inst : Synth_Instance_Acc);
 end Synth.Disp_Vhdl;
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index eb40a023e..5df7d4303 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -587,7 +587,8 @@ package body Synth.Insts is
       end;
    end Synth_Component_Instantiation_Statement;
 
-   procedure Synth_Top_Entity (Arch : Node; Config : Node)
+   procedure Synth_Top_Entity
+     (Arch : Node; Config : Node; Inst : out Synth_Instance_Acc)
    is
       Entity : constant Node := Get_Entity (Arch);
       Syn_Inst : Synth_Instance_Acc;
@@ -642,7 +643,7 @@ package body Synth.Insts is
           Arch => Arch,
           Config => Get_Block_Configuration (Config),
           Syn_Inst => Syn_Inst));
-      pragma Unreferenced (Inst_Obj);
+      Inst := Inst_Obj.Syn_Inst;
    end Synth_Top_Entity;
 
    procedure Create_Input_Wire (Self_Inst : Instance;
diff --git a/src/synth/synth-insts.ads b/src/synth/synth-insts.ads
index 8548cfe02..fdd66baa2 100644
--- a/src/synth/synth-insts.ads
+++ b/src/synth/synth-insts.ads
@@ -26,7 +26,8 @@ package Synth.Insts is
    procedure Init;
    procedure Synth_All_Instances;
 
-   procedure Synth_Top_Entity (Arch : Node; Config : Node);
+   procedure Synth_Top_Entity
+     (Arch : Node; Config : Node; Inst : out Synth_Instance_Acc);
 
    --  Apply block configuration CFG to BLK.
    --  Must be done before synthesis of BLK.
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index a84b4976a..a854c34cc 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -26,7 +26,6 @@ with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Annotations; use Vhdl.Annotations;
 
 with Synth.Values; use Synth.Values;
-with Synth.Context; use Synth.Context;
 with Synth.Decls; use Synth.Decls;
 with Synth.Insts; use Synth.Insts;
 
@@ -110,13 +109,12 @@ package body Synthesis is
       end loop;
    end Synth_Dependencies;
 
-   function Synth_Design (Design : Node) return Module
+   procedure Synth_Design
+     (Design : Node; M : out Module; Inst : out Synth_Instance_Acc)
    is
       Unit : constant Node := Get_Library_Unit (Design);
       Arch : Node;
       Config : Node;
-
-      Syn_Inst : Synth_Instance_Acc;
    begin
       --  Extract architecture from design.
       case Get_Kind (Unit) is
@@ -145,13 +143,12 @@ package body Synthesis is
       Synth_Dependencies
         (Global_Instance, Get_Design_Unit (Arch));
 
-      Synth_Top_Entity (Arch, Config);
+      Synth_Top_Entity (Arch, Config, Inst);
       Synth_All_Instances;
       if Errorout.Nbr_Errors > 0 then
          raise Compilation_Error;
       end if;
 
-      pragma Unreferenced (Syn_Inst);
-      return Global_Module;
+      M := Global_Module;
    end Synth_Design;
 end Synthesis;
diff --git a/src/synth/synthesis.ads b/src/synth/synthesis.ads
index 703d190e0..ac458ff88 100644
--- a/src/synth/synthesis.ads
+++ b/src/synth/synthesis.ads
@@ -20,9 +20,11 @@
 
 with Vhdl.Nodes; use Vhdl.Nodes;
 with Netlists; use Netlists;
+with Synth.Context; use Synth.Context;
 
 package Synthesis is
-   function Synth_Design (Design : Iir) return Module;
+   procedure Synth_Design
+     (Design : Iir; M : out Module; Inst : out Synth_Instance_Acc);
 
    Global_Module : Module;