synth: add Id_Port gate to improve display.

5 files changed, 73 insertions, 29 deletions

diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb
index 8d6534b42..27364f109 100644
--- a/src/synth/netlists-builders.adb
+++ b/src/synth/netlists-builders.adb
@@ -272,22 +272,26 @@ package body Netlists.Builders is
       Outputs := (0 => Create_Output ("o"));
 
       Ctxt.M_Output := New_User_Module
-        (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("output")),
+        (Ctxt.Design, New_Sname_Artificial (Name_Output),
          Id_Output, 1, 1, 0);
       Set_Port_Desc (Ctxt.M_Output, Inputs, Outputs);
 
       Ctxt.M_Signal := New_User_Module
-        (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("signal")),
+        (Ctxt.Design, New_Sname_Artificial (Name_Signal),
          Id_Signal, 1, 1, 0);
       Set_Port_Desc (Ctxt.M_Signal, Inputs, Outputs);
 
-
       Inputs2 := (0 => Create_Input ("i"),
                   1 => Create_Input ("init"));
       Ctxt.M_Isignal := New_User_Module
         (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("isignal")),
          Id_Isignal, 2, 1, 0);
       Set_Port_Desc (Ctxt.M_Isignal, Inputs2, Outputs);
+
+      Ctxt.M_Port := New_User_Module
+        (Ctxt.Design, New_Sname_Artificial (Name_Port),
+         Id_Port, 1, 1, 0);
+      Set_Port_Desc (Ctxt.M_Port, Inputs, Outputs);
    end Create_Objects_Module;
 
    procedure Create_Dff_Modules (Ctxt : Context_Acc)
@@ -763,6 +767,20 @@ package body Netlists.Builders is
       return O;
    end Build_Isignal;
 
+   function Build_Port (Ctxt : Context_Acc; N : Net) return Net
+   is
+      Wd : constant Width := Get_Width (N);
+      pragma Assert (Wd /= No_Width);
+      Inst : Instance;
+      O : Net;
+   begin
+      Inst := New_Internal_Instance (Ctxt, Ctxt.M_Port);
+      O := Get_Output (Inst, 0);
+      Set_Width (O, Wd);
+      Connect (Get_Input (Inst, 0), N);
+      return O;
+   end Build_Port;
+
    function Build_Dff (Ctxt : Context_Acc;
                        Clk : Net;
                        D : Net) return Net
diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index 85d31a248..7c016dedc 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -94,6 +94,7 @@ package Netlists.Builders is
                          return Net;
    function Build_Isignal (Ctxt : Context_Acc; Name : Sname; Init : Net)
                           return Net;
+   function Build_Port (Ctxt : Context_Acc; N : Net) return Net;
 
    procedure Build_Assert (Ctxt : Context_Acc; Cond : Net);
    procedure Build_Assume (Ctxt : Context_Acc; Cond : Net);
@@ -134,6 +135,7 @@ private
       M_Output : Module;
       M_Signal : Module;
       M_Isignal : Module;
+      M_Port : Module;
       M_Dff : Module;
       M_Idff : Module;
       M_Adff : Module;
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index 72003c04f..f12dd7811 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -299,7 +299,24 @@ package body Netlists.Disp_Vhdl is
          Put_Interface_Name (Get_Output_Desc (Imod, Idx).Name);
          Idx := Idx + 1;
          Put (" => ");
-         Disp_Net_Name (O);
+         declare
+            I : Input;
+            O_Inst : Instance;
+         begin
+            I := Get_First_Sink (O);
+            if I /= No_Input then
+               O_Inst := Get_Parent (I);
+            else
+               O_Inst := No_Instance;
+            end if;
+            if O_Inst /= No_Instance
+              and then Get_Id (O_Inst) = Id_Port
+            then
+               Disp_Net_Name (Get_Output (O_Inst, 0));
+            else
+               Disp_Net_Name (O);
+            end if;
+         end;
       end loop;
       Put_Line (");");
    end Disp_Instance_Gate;
@@ -477,6 +494,8 @@ package body Netlists.Disp_Vhdl is
             Disp_Template ("  \o0 <= \i0; -- (output)" & NL, Inst);
          when Id_Signal =>
             Disp_Template ("  \o0 <= \i0; -- (signal)" & NL, Inst);
+         when Id_Port =>
+            null;
          when Id_Not =>
             Disp_Template ("  \o0 <= not \i0;" & NL, Inst);
          when Id_Extract =>
@@ -660,6 +679,7 @@ package body Netlists.Disp_Vhdl is
       for Inst of Instances (M) loop
          if not Is_Self_Instance (Inst)
            and then not (Flag_Merge_Lit and then Is_Const (Get_Id (Inst)))
+           and then Get_Id (Inst) < Id_User_None
          then
             for N of Outputs (Inst) loop
                Put ("  signal ");
diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads
index 8d8d5af42..44b5486bf 100644
--- a/src/synth/netlists-gates.ads
+++ b/src/synth/netlists-gates.ads
@@ -79,6 +79,7 @@ package Netlists.Gates is
    Id_Signal  : constant Module_Id := 35;
    Id_Isignal : constant Module_Id := 36;
    Id_Output  : constant Module_Id := 37;
+   Id_Port    : constant Module_Id := 38;
 
    --  Note: initial values must be constant nets.
    --
@@ -87,70 +88,70 @@ package Netlists.Gates is
    --  input.
    --  Inputs: CLK, D
    --  Output: Q
-   Id_Dff   : constant Module_Id := 38;
+   Id_Dff   : constant Module_Id := 40;
 
    --  A DFF with an asynchronous reset.  Note that the asynchronous reset
    --  has priority over the clock.  When RST is asserted, the value is
    --  set to RST_VAL.
    --  Inputs: CLK, D, RST, RST_VAL
    --  Output: Q
-   Id_Adff  : constant Module_Id := 39;
+   Id_Adff  : constant Module_Id := 41;
 
    --  A simple DFF with an initial value (must be constant).  This is
    --  for FPGAs.
-   Id_Idff  : constant Module_Id := 40;
+   Id_Idff  : constant Module_Id := 42;
    --  A DFF with an asynchronous reset and an initial value.
-   Id_Iadff : constant Module_Id := 41;
+   Id_Iadff : constant Module_Id := 43;
 
    --  Width change: truncate or extend.  Sign is know in order to possibly
    --  detect loss of value.
-   Id_Utrunc : constant Module_Id := 42;
-   Id_Strunc : constant Module_Id := 43;
-   Id_Uextend : constant Module_Id := 44;
-   Id_Sextend : constant Module_Id := 45;
+   Id_Utrunc : constant Module_Id := 46;
+   Id_Strunc : constant Module_Id := 47;
+   Id_Uextend : constant Module_Id := 48;
+   Id_Sextend : constant Module_Id := 49;
 
    subtype Truncate_Module_Id is Module_Id range Id_Utrunc .. Id_Strunc;
    subtype Extend_Module_Id is Module_Id range Id_Uextend .. Id_Sextend;
 
    --  Extract a bit or a slice at a constant offset.
    --  OUT := IN0[OFF+WD-1:OFF]
-   Id_Extract : constant Module_Id := 46;
+   Id_Extract : constant Module_Id := 50;
 
    --  OUT := IN0[IN1*STEP+OFF+WD-1:IN1*STEP+OFF]
-   Id_Dyn_Extract : constant Module_Id := 47;
+   Id_Dyn_Extract : constant Module_Id := 51;
 
    --  This gate has two inputs I, V and one parameter POS.
    --  It replaces bits POS + width(V) - 1 .. POS of I by V, ie:
    --  T := I;
    --  T [POS+width(V)-1:POS] := V
    --  OUT := T.
-   Id_Insert : constant Module_Id := 48;
+   Id_Insert : constant Module_Id := 52;
 
    --  Like Insert but for dynamic values.
    --  T := IN0
    --  T [IN2*STEP+OFF+WD-1:IN2*STEP+OFF] := IN1
    --  OUT := T
-   Id_Dyn_Insert : constant Module_Id := 49;
+   Id_Dyn_Insert : constant Module_Id := 53;
 
    --  Positive/rising edge detector.  This is a pseudo gate.
    --  A negative edge detector can be made using by negating the clock before
    --  the detector.
-   Id_Edge : constant Module_Id := 50;
+   Id_Edge : constant Module_Id := 55;
 
    --  Input signal must always be true.
-   Id_Assert : constant Module_Id := 51;
-   Id_Assume : constant Module_Id := 52;
+   Id_Assert : constant Module_Id := 56;
+   Id_Assume : constant Module_Id := 57;
 
    --  Constants are gates with only one constant output.  There are multiple
    --  kind of constant gates: for small width, the value is stored as a
    --  parameter, possibly signed or unsigned extended.  For large width
    --  (> 128), the value is stored in a table.
-   Id_Const_UB32 : constant Module_Id := 56;
-   Id_Const_SB32 : constant Module_Id := 57;
-   Id_Const_UB64 : constant Module_Id := 58;
-   Id_Const_SB64 : constant Module_Id := 59;
-   Id_Const_UB128 : constant Module_Id := 60;
-   Id_Const_SB128 : constant Module_Id := 61;
-   Id_Const_UL32 : constant Module_Id := 62;
-   Id_Const_SL32 : constant Module_Id := 63;
+   Id_Const_UB32 : constant Module_Id := 64;
+   Id_Const_SB32 : constant Module_Id := 65;
+   Id_Const_UB64 : constant Module_Id := 66;
+   Id_Const_SB64 : constant Module_Id := 67;
+   Id_Const_UB128 : constant Module_Id := 68;
+   Id_Const_SB128 : constant Module_Id := 69;
+   Id_Const_UL32 : constant Module_Id := 70;
+   Id_Const_SL32 : constant Module_Id := 71;
 end Netlists.Gates;
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index e29aed75b..5bffaacbf 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -276,6 +276,7 @@ package body Synth.Insts is
       Nbr_Outputs := 0;
       while Is_Valid (Inter) loop
          if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
+            --  TODO
             raise Internal_Error;
          end if;
          Synth_Declaration_Type (Sub_Inst, Inter);
@@ -315,6 +316,7 @@ package body Synth.Insts is
          Assoc : Node;
          Assoc_Inter : Node;
          Actual : Node;
+         Port : Net;
          O : Value_Acc;
       begin
          Assoc := Get_Port_Map_Aspect_Chain (Stmt);
@@ -343,8 +345,9 @@ package body Synth.Insts is
                   Nbr_Inputs := Nbr_Inputs + 1;
                when Port_Out
                  | Port_Inout =>
-                  O := Create_Value_Net (Get_Output (Inst, Nbr_Outputs),
-                                           null);
+                  Port := Get_Output (Inst, Nbr_Outputs);
+                  Port := Builders.Build_Port (Build_Context, Port);
+                  O := Create_Value_Net (Port, null);
                   Synth_Assignment (Syn_Inst, Actual, O);
                   Nbr_Outputs := Nbr_Outputs + 1;
             end case;