synth: save and display locations for instances.

8 files changed, 247 insertions, 66 deletions

diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index 08ab63a94..f889510f3 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -21,9 +21,12 @@
 with Simple_IO; use Simple_IO;
 with Types_Utils; use Types_Utils;
 with Name_Table; use Name_Table;
+with Files_Map;
+
 with Netlists.Utils; use Netlists.Utils;
 with Netlists.Iterators; use Netlists.Iterators;
 with Netlists.Gates; use Netlists.Gates;
+with Netlists.Locations;
 
 package body Netlists.Disp_Vhdl is
    Flag_Merge_Lit : constant Boolean := True;
@@ -439,7 +442,24 @@ package body Netlists.Disp_Vhdl is
    procedure Disp_Instance_Inline (Inst : Instance)
    is
       Imod : constant Module := Get_Module (Inst);
+      Loc : constant Location_Type := Locations.Get_Location (Inst);
    begin
+      if Loc /= No_Location then
+         declare
+            File : Name_Id;
+            Line : Positive;
+            Col : Natural;
+         begin
+            Files_Map.Location_To_Position (Loc, File, Line, Col);
+            Put ("  -- ");
+            Put_Id (File);
+            Put (':');
+            Put_Uns32 (Uns32 (Line));
+            Put (':');
+            Put_Uns32 (Uns32 (Col));
+            New_Line;
+         end;
+      end if;
       case Get_Id (Imod) is
          when Id_Output =>
             Disp_Template ("  \o0 <= \i0; -- (output)" & NL, Inst);
diff --git a/src/synth/netlists-locations.adb b/src/synth/netlists-locations.adb
new file mode 100644
index 000000000..c754d2855
--- /dev/null
+++ b/src/synth/netlists-locations.adb
@@ -0,0 +1,69 @@
+--  Locations for instances.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Tables;
+
+package body Netlists.Locations is
+   package Loc_Table is new Tables
+     (Table_Component_Type => Location_Type,
+      Table_Index_Type => Instance,
+      Table_Low_Bound => No_Instance,
+      Table_Initial => 1024);
+
+   procedure Set_Location1 (Inst : Instance; Loc : Location_Type)
+   is
+      Cur_Last : constant Instance := Loc_Table.Last;
+   begin
+      if Inst > Cur_Last then
+         Loc_Table.Set_Last (Inst);
+         for I in Cur_Last + 1 .. Inst - 1 loop
+            Loc_Table.Table (I) := No_Location;
+         end loop;
+      end if;
+      Loc_Table.Table (Inst) := Loc;
+   end Set_Location1;
+
+   procedure Set_Location (Inst : Instance; Loc : Location_Type) is
+   begin
+      if Flag_Locations then
+         Set_Location1 (Inst, Loc);
+      end if;
+   end Set_Location;
+
+   function Get_Location1 (Inst : Instance) return Location_Type is
+   begin
+      if Inst > Loc_Table.Last then
+         return No_Location;
+      else
+         return Loc_Table.Table (Inst);
+      end if;
+   end Get_Location1;
+
+   function Get_Location (Inst : Instance) return Location_Type is
+   begin
+      if Flag_Locations then
+         return Get_Location1 (Inst);
+      else
+         return No_Location;
+      end if;
+   end Get_Location;
+begin
+   Loc_Table.Append (No_Location);
+end Netlists.Locations;
diff --git a/src/synth/netlists-locations.ads b/src/synth/netlists-locations.ads
new file mode 100644
index 000000000..9bc7d55f1
--- /dev/null
+++ b/src/synth/netlists-locations.ads
@@ -0,0 +1,31 @@
+--  Locations for instances.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+package Netlists.Locations is
+   --  If True, locations are enabled.
+   Flag_Locations : Boolean := True;
+
+   --  Save location LOC for INST.  Noop if locations are not enabled.
+   procedure Set_Location (Inst : Instance; Loc : Location_Type);
+
+   --  Get the previously saved location for INST.
+   --  Return Null_Location if no location set or locations are disabled.
+   function Get_Location (Inst : Instance) return Location_Type;
+end Netlists.Locations;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 3c5b5cb95..c8049f570 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -55,6 +55,7 @@ package body Synth.Decls is
             else
                Value := Build_Signal (Build_Context, Name, W);
             end if;
+            Set_Location (Value, Decl);
             Set_Wire_Gate (Val.W, Value);
          when others =>
             raise Internal_Error;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 558b54d2c..01b5ac649 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -40,6 +40,7 @@ with Synth.Environment; use Synth.Environment;
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
 with Netlists.Utils; use Netlists.Utils;
+with Netlists.Locations; use Netlists.Locations;
 
 package body Synth.Expr is
    function Is_Const (Val : Value_Acc) return Boolean is
@@ -73,6 +74,19 @@ package body Synth.Expr is
       end case;
    end Get_Width;
 
+   procedure Set_Location2 (N : Net; Loc : Node) is
+   begin
+      Set_Location (Get_Net_Parent (N), Get_Location (Loc));
+   end Set_Location2;
+
+   procedure Set_Location (N : Net; Loc : Node) is
+   begin
+      --  Short and compact code as it is inlined.
+      if Flag_Locations then
+         Set_Location2 (N, Loc);
+      end if;
+   end Set_Location;
+
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is
    begin
       case Enum is
@@ -127,7 +141,10 @@ package body Synth.Expr is
       end if;
    end To_Logic;
 
-   function Bit_Extract (Val : Value_Acc; Off : Uns32) return Value_Acc is
+   function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node)
+                        return Value_Acc
+   is
+      N : Net;
    begin
       case Val.Kind is
          when Value_Array =>
@@ -135,10 +152,10 @@ package body Synth.Expr is
             return Val.Arr.V (Iir_Index32 (Val.Bounds.D (1).Len - Off));
          when Value_Net
            | Value_Wire =>
-            return Create_Value_Net
-              (Build_Extract_Bit
-                 (Build_Context, Get_Net (Val, Null_Node), Off),
-               No_Bound);
+            N := Build_Extract_Bit
+              (Build_Context, Get_Net (Val, Null_Node), Off);
+            Set_Location (N, Loc);
+            return Create_Value_Net (N, No_Bound);
          when others =>
             raise Internal_Error;
       end case;
@@ -518,21 +535,22 @@ package body Synth.Expr is
      (Cst : Value_Acc; Expr : Value_Acc; Etype : Node; Loc : Node)
      return Value_Acc
    is
-      pragma Unreferenced (Loc);
       Val : Uns32;
       Zx : Uns32;
+      N : Net;
    begin
       To_Logic (Cst.Scal, Etype, Val, Zx);
       if Zx /= 0 then
-         return Create_Value_Net
-           (Build_Const_UL32 (Build_Context, 0, 1, 1), No_Bound);
+         N := Build_Const_UL32 (Build_Context, 0, 1, 1);
+         Set_Location (N, Loc);
+         return Create_Value_Net (N, No_Bound);
       elsif Val = 1 then
          return Expr;
       else
          pragma Assert (Val = 0);
-         return Create_Value_Net
-           (Build_Monadic (Build_Context, Id_Not, Get_Net (Expr, Etype)),
-            No_Bound);
+         N := Build_Monadic (Build_Context, Id_Not, Get_Net (Expr, Etype));
+         Set_Location (N, Loc);
+         return Create_Value_Net (N, No_Bound);
       end if;
    end Synth_Bit_Eq_Const;
 
@@ -611,39 +629,46 @@ package body Synth.Expr is
       Left : Value_Acc;
       Right : Value_Acc;
 
-      function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Value_Acc is
+      function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Value_Acc
+      is
+         N : Net;
       begin
-         return Create_Value_Net
-           (Build_Dyadic (Build_Context, Id,
-                          Get_Net (Left, Ltype), Get_Net (Right, Rtype)),
-            No_Bound);
+         N := Build_Dyadic (Build_Context, Id,
+                            Get_Net (Left, Ltype), Get_Net (Right, Rtype));
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, No_Bound);
       end Synth_Bit_Dyadic;
 
-      function Synth_Compare (Id : Compare_Module_Id) return Value_Acc is
+      function Synth_Compare (Id : Compare_Module_Id) return Value_Acc
+      is
+         N : Net;
       begin
-         return Create_Value_Net
-           (Build_Compare (Build_Context, Id,
-                           Get_Net (Left, Ltype), Get_Net (Right, Rtype)),
-            No_Bound);
+         N := Build_Compare (Build_Context, Id,
+                             Get_Net (Left, Ltype), Get_Net (Right, Rtype));
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, No_Bound);
       end Synth_Compare;
 
       function Synth_Compare_Uns_Nat (Id : Compare_Module_Id)
-                                     return Value_Acc is
+                                     return Value_Acc
+      is
+         N : Net;
       begin
-         return Create_Value_Net
-           (Build_Compare (Build_Context, Id,
-                           Get_Net (Left, Ltype),
-                           Synth_Uresize (Right, Rtype, Get_Width (Left))),
-            No_Bound);
+         N := Synth_Uresize (Right, Rtype, Get_Width (Left));
+         Set_Location (N, Expr);
+         N := Build_Compare (Build_Context, Id, Get_Net (Left, Ltype), N);
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, No_Bound);
       end Synth_Compare_Uns_Nat;
 
       function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Value_Acc
       is
          L : constant Net := Get_Net (Left, Ltype);
+         N : Net;
       begin
-         return Create_Value_Net
-           (Build_Dyadic (Build_Context, Id, L, Get_Net (Right, Rtype)),
-            Create_Res_Bound (Left, L));
+         N := Build_Dyadic (Build_Context, Id, L, Get_Net (Right, Rtype));
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, Create_Res_Bound (Left, L));
       end Synth_Vec_Dyadic;
 
       function Synth_Dyadic_Uns (Id : Dyadic_Module_Id; Is_Res_Vec : Boolean)
@@ -653,16 +678,21 @@ package body Synth.Expr is
          R : constant Net := Get_Net (Right, Rtype);
          W : constant Width := Width'Max (Get_Width (L), Get_Width (R));
          Rtype : Value_Bound_Acc;
+         L1, R1 : Net;
+         N : Net;
       begin
          if Is_Res_Vec then
             Rtype := Create_Value_Bound ((Iir_Downto, Int32 (W - 1), 0, W));
          else
             Rtype := No_Bound;
          end if;
-         return Create_Value_Net
-           (Build_Dyadic
-              (Build_Context, Id, Synth_Uresize (L, W), Synth_Uresize (R, W)),
-            Rtype);
+         L1 := Synth_Uresize (L, W);
+         Set_Location (L1, Expr);
+         R1 := Synth_Uresize (R, W);
+         Set_Location (R1, Expr);
+         N := Build_Dyadic (Build_Context, Id, L1, R1);
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, Rtype);
       end Synth_Dyadic_Uns;
 
       function Synth_Compare_Uns_Uns (Id : Compare_Module_Id)
@@ -671,22 +701,29 @@ package body Synth.Expr is
          L : constant Net := Get_Net (Left, Ltype);
          R : constant Net := Get_Net (Right, Rtype);
          W : constant Width := Width'Max (Get_Width (L), Get_Width (R));
+         L1, R1 : Net;
+         N : Net;
       begin
-         return Create_Value_Net
-           (Build_Compare (Build_Context, Id,
-                           Synth_Uresize (L, W),
-                           Synth_Uresize (R, W)),
-            No_Bound);
+         L1 := Synth_Uresize (L, W);
+         Set_Location (L1, Expr);
+         R1 := Synth_Uresize (R, W);
+         Set_Location (R1, Expr);
+         N := Build_Compare (Build_Context, Id, L1, R1);
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, No_Bound);
       end Synth_Compare_Uns_Uns;
 
       function Synth_Dyadic_Uns_Nat (Id : Dyadic_Module_Id) return Value_Acc
       is
          L : constant Net := Get_Net (Left, Ltype);
+         R1 : Net;
+         N : Net;
       begin
-         return Create_Value_Net
-           (Build_Dyadic (Build_Context, Id,
-                          L, Synth_Uresize (Right, Rtype, Get_Width (Left))),
-            Create_Res_Bound (Left, L));
+         R1 := Synth_Uresize (Right, Rtype, Get_Width (Left));
+         Set_Location (R1, Expr);
+         N := Build_Dyadic (Build_Context, Id, L, R1);
+         Set_Location (N, Expr);
+         return Create_Value_Net (N, Create_Res_Bound (Left, L));
       end Synth_Dyadic_Uns_Nat;
    begin
       Left := Synth_Expression (Syn_Inst, Left_Expr);
@@ -808,10 +845,12 @@ package body Synth.Expr is
          when Iir_Predefined_Array_Element_Concat =>
             declare
                L : constant Net := Get_Net (Left, Ltype);
+               N : Net;
             begin
+               N := Build_Concat2 (Build_Context, L, Get_Net (Right, Rtype));
+               Set_Location (N, Expr);
                return Create_Value_Net
-                 (Build_Concat2 (Build_Context, L,
-                                 Get_Net (Right, Rtype)),
+                 (N,
                   Create_Bounds_From_Length
                     (Syn_Inst,
                      Get_Index_Type (Get_Type (Expr), 0),
@@ -820,28 +859,40 @@ package body Synth.Expr is
          when Iir_Predefined_Element_Array_Concat =>
             declare
                R : constant Net := Get_Net (Right, Rtype);
+               N : Net;
             begin
+               N := Build_Concat2 (Build_Context, Get_Net (Left, Ltype), R);
+               Set_Location (N, Expr);
                return Create_Value_Net
-                 (Build_Concat2 (Build_Context, Get_Net (Left, Ltype), R),
+                 (N,
                   Create_Bounds_From_Length
                     (Syn_Inst,
                      Get_Index_Type (Get_Type (Expr), 0),
                      Iir_Index32 (Get_Width (R) + 1)));
             end;
          when Iir_Predefined_Element_Element_Concat =>
-            return Create_Value_Net
-              (Build_Concat2 (Build_Context,
-                              Get_Net (Left, Ltype),
-                              Get_Net (Right, Rtype)),
-               Create_Bounds_From_Length
-                 (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2));
+            declare
+               N : Net;
+            begin
+               N := Build_Concat2 (Build_Context,
+                                   Get_Net (Left, Ltype),
+                                   Get_Net (Right, Rtype));
+               Set_Location (N, Expr);
+               return Create_Value_Net
+                 (N,
+                  Create_Bounds_From_Length
+                    (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2));
+            end;
          when Iir_Predefined_Array_Array_Concat =>
             declare
                L : constant Net := Get_Net (Left, Ltype);
                R : constant Net := Get_Net (Right, Ltype);
+               N : Net;
             begin
+               N := Build_Concat2 (Build_Context, L, R);
+               Set_Location (N, Expr);
                return Create_Value_Net
-                 (Build_Concat2 (Build_Context, L, R),
+                 (N,
                   Create_Bounds_From_Length
                     (Syn_Inst,
                      Get_Index_Type (Get_Type (Expr), 0),
@@ -1016,7 +1067,7 @@ package body Synth.Expr is
       end if;
 
       Off := Index_To_Offset (Pfx, Idx_Val.Scal, Name);
-      return Bit_Extract (Pfx, Off);
+      return Bit_Extract (Pfx, Off, Name);
    end Synth_Indexed_Name;
 
    function Is_Const (N : Net) return Boolean is
@@ -1265,21 +1316,22 @@ package body Synth.Expr is
       Step : Uns32;
       Off : Int32;
       Wd : Uns32;
+      N : Net;
    begin
       Bnd := Extract_Bound (Pfx);
       Synth_Slice_Suffix (Syn_Inst, Name, Bnd, Res_Bnd, Inp, Step, Off, Wd);
       if Inp /= No_Net then
-         return Create_Value_Net
-           (Build_Dyn_Extract (Build_Context,
-                               Get_Net (Pfx, Get_Type (Pfx_Node)),
-                               Inp, Step, Off, Wd),
-            null);
+         N := Build_Dyn_Extract (Build_Context,
+                                 Get_Net (Pfx, Get_Type (Pfx_Node)),
+                                 Inp, Step, Off, Wd);
+         Set_Location (N, Name);
+         return Create_Value_Net (N, null);
       else
-         return Create_Value_Net
-           (Build_Extract (Build_Context,
-                           Get_Net (Pfx, Get_Type (Pfx_Node)),
-                           Uns32 (Off), Wd),
-            Res_Bnd);
+         N := Build_Extract (Build_Context,
+                             Get_Net (Pfx, Get_Type (Pfx_Node)),
+                             Uns32 (Off), Wd);
+         Set_Location (N, Name);
+         return Create_Value_Net (N, Res_Bnd);
       end if;
    end Synth_Slice_Name;
 
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 1599eb22e..ec2c1c956 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -29,12 +29,16 @@ package Synth.Expr is
    function Is_Const (Val : Value_Acc) return Boolean;
    function Get_Width (Val : Value_Acc) return Uns32;
 
+   procedure Set_Location (N : Net; Loc : Node);
+   pragma Inline (Set_Location);
+
    procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx  : out Uns32);
    procedure From_Bit (Enum : Int64; Val : out Uns32);
    procedure To_Logic
      (Enum : Int64; Etype : Node; Val : out Uns32; Zx  : out Uns32);
 
-   function Bit_Extract (Val : Value_Acc; Off : Uns32) return Value_Acc;
+   function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node)
+                        return Value_Acc;
 
    type Net_Array is array (Int32 range <>) of Net;
    type Net_Array_Acc is access Net_Array;
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index ec63d2d1d..7c178b4f4 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -678,6 +678,7 @@ package body Synth.Insts is
             W := Get_Output_Desc (Get_Module (Self_Inst), Idx).W;
             pragma Assert (W = Val.W_Bound.Len);
             Value := Builders.Build_Output (Build_Context, W);
+            Set_Location (Value, Inter);
             Inp := Get_Input (Self_Inst, Idx);
             Connect (Inp, Value);
             Set_Wire_Gate (Val.W, Value);
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 315944e37..53d4f4515 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -96,7 +96,8 @@ package body Synth.Stmts is
             case Get_Kind (Choice) is
                when Iir_Kind_Choice_By_None =>
                   Pos := Pos - 1;
-                  Synth_Assignment (Syn_Inst, Assoc, Bit_Extract (Val, Pos));
+                  Synth_Assignment
+                    (Syn_Inst, Assoc, Bit_Extract (Val, Pos, Target));
                when others =>
                   Error_Kind ("synth_assignment_aggregate", Choice);
             end case;
@@ -149,6 +150,7 @@ package body Synth.Stmts is
                                      Targ_Net,
                                      Get_Net (Val, Get_Type (Target)),
                                      Index_To_Offset (Targ, Idx.Scal, Target));
+                  Set_Location (V, Target);
                else
                   raise Internal_Error;
                end if;
@@ -183,6 +185,7 @@ package body Synth.Stmts is
                   Res := Build_Insert
                     (Build_Context, Targ_Net, V, Uns32 (Off));
                end if;
+               Set_Location (Res, Target);
                Synth_Assign
                  (Targ, Create_Value_Net (Res, Res_Bnd), Get_Type (Pfx));
             end;