synth: finalize declarations and free wires.

6 files changed, 214 insertions, 21 deletions

diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index bca936229..3682c8781 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -582,4 +582,69 @@ package body Synth.Decls is
          Decl := Get_Chain (Decl);
       end loop;
    end Synth_Declarations;
+
+   procedure Finalize_Declaration
+     (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean)
+   is
+      Val : Value_Acc;
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Variable_Declaration =>
+            Val := Get_Value (Syn_Inst, Decl);
+            Free_Wire (Val.W);
+         when Iir_Kind_Interface_Variable_Declaration =>
+            Val := Get_Value (Syn_Inst, Decl);
+            Free_Wire (Val.W);
+         when Iir_Kind_Constant_Declaration =>
+            null;
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Anonymous_Signal_Declaration =>
+            pragma Assert (not Is_Subprg);
+            Val := Get_Value (Syn_Inst, Decl);
+            Free_Wire (Val.W);
+         when Iir_Kind_Object_Alias_Declaration =>
+            null;
+         when Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Function_Declaration =>
+            null;
+         when Iir_Kind_Procedure_Body
+           | Iir_Kind_Function_Body =>
+            null;
+         when Iir_Kind_Non_Object_Alias_Declaration =>
+            null;
+         when Iir_Kind_Attribute_Declaration =>
+            null;
+         when Iir_Kind_Attribute_Specification =>
+            null;
+         when Iir_Kind_Type_Declaration =>
+            null;
+         when Iir_Kind_Anonymous_Type_Declaration =>
+            null;
+         when  Iir_Kind_Subtype_Declaration =>
+            null;
+         when Iir_Kind_Component_Declaration =>
+            null;
+         when Iir_Kind_File_Declaration =>
+            null;
+         when Iir_Kind_Psl_Default_Clock =>
+            --  Ignored; directly used by PSL directives.
+            null;
+         when others =>
+            Error_Kind ("finalize_declaration", Decl);
+      end case;
+   end Finalize_Declaration;
+
+   procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
+                                    Decls : Iir;
+                                    Is_Subprg : Boolean := False)
+   is
+      Decl : Iir;
+   begin
+      Decl := Decls;
+      while Is_Valid (Decl) loop
+         Finalize_Declaration (Syn_Inst, Decl, Is_Subprg);
+
+         Decl := Get_Chain (Decl);
+      end loop;
+   end Finalize_Declarations;
 end Synth.Decls;
diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads
index c76fe1d61..ea2d434f7 100644
--- a/src/synth/synth-decls.ads
+++ b/src/synth/synth-decls.ads
@@ -40,4 +40,8 @@ package Synth.Decls is
    procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc;
                                  Decls : Iir;
                                  Is_Subprg : Boolean := False);
+
+   procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc;
+                                    Decls : Iir;
+                                    Is_Subprg : Boolean := False);
 end Synth.Decls;
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index 53c5e1493..b13c4dc89 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -56,6 +56,46 @@ package body Synth.Environment is
       return Wire_Id_Table.Last;
    end Alloc_Wire;
 
+   procedure Free_Wire (Wid : Wire_Id)
+   is
+      Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
+   begin
+      pragma Assert (Wire_Rec.Kind /= Wire_None);
+      pragma Assert (Wire_Rec.Cur_Assign = No_Seq_Assign);
+      Wire_Rec.Kind := Wire_None;
+   end Free_Wire;
+
+   procedure Mark (M : out Wire_Id) is
+   begin
+      M := Wire_Id_Table.Last;
+   end Mark;
+
+   procedure Release (M : in out Wire_Id) is
+   begin
+      --  Check all wires to be released are free.
+      for I in M + 1 .. Wire_Id_Table.Last loop
+         declare
+            Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (I);
+         begin
+            if Wire_Rec.Kind /= Wire_None then
+               raise Internal_Error;
+            end if;
+         end;
+      end loop;
+
+      --  Release.
+      Wire_Id_Table.Set_Last (M);
+
+      M := No_Wire_Id;
+   end Release;
+
+   procedure All_Released is
+   begin
+      if Wire_Id_Table.Last /= No_Wire_Id then
+         raise Internal_Error;
+      end if;
+   end All_Released;
+
    procedure Set_Wire_Gate (Wid : Wire_Id; Gate : Net) is
    begin
       --  Cannot override a gate.
@@ -156,6 +196,39 @@ package body Synth.Environment is
       end loop;
    end Pop_Phi;
 
+   procedure Phi_Discard_Wires (Wid1 : Wire_Id; Wid2 : Wire_Id)
+   is
+      Phi : Phi_Type renames Phis_Table.Table (Current_Phi);
+      Asgn, Next_Asgn : Seq_Assign;
+      First, Last : Seq_Assign;
+      Wid : Wire_Id;
+   begin
+      First := No_Seq_Assign;
+      Last := No_Seq_Assign;
+      Asgn := Phi.First;
+      while Asgn /= No_Seq_Assign loop
+         pragma Assert (Assign_Table.Table (Asgn).Phi = Current_Phi);
+         Next_Asgn := Get_Assign_Chain (Asgn);
+
+         Wid := Get_Wire_Id (Asgn);
+         if Wid = Wid1 or Wid = Wid2 then
+            --  Discard.
+            pragma Assert (Wid /= No_Wire_Id);
+            Wire_Id_Table.Table (Wid).Cur_Assign := No_Seq_Assign;
+         else
+            --  Append.
+            if First = No_Seq_Assign then
+               First := Asgn;
+            else
+               Set_Assign_Chain (Last, Asgn);
+            end if;
+            Last := Asgn;
+         end if;
+         Asgn := Next_Asgn;
+      end loop;
+      Phi.First := First;
+   end Phi_Discard_Wires;
+
    function Get_Conc_Offset (Asgn : Conc_Assign) return Uns32 is
    begin
       return Conc_Assign_Table.Table (Asgn).Offset;
@@ -181,6 +254,7 @@ package body Synth.Environment is
    is
       Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
    begin
+      pragma Assert (Wire_Rec.Kind /= Wire_None);
       Conc_Assign_Table.Append ((Next => Wire_Rec.Final_Assign,
                                  Value => Val,
                                  Offset => Off,
@@ -453,6 +527,7 @@ package body Synth.Environment is
          declare
             Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
          begin
+            pragma Assert (Wire_Rec.Kind /= Wire_None);
             pragma Assert (Wire_Rec.Cur_Assign = No_Seq_Assign);
             Finalize_Assignment (Ctxt, Wire_Rec);
          end;
@@ -561,21 +636,22 @@ package body Synth.Environment is
    function Get_Current_Value (Ctxt : Builders.Context_Acc; Wid : Wire_Id)
                               return Net
    is
-      Wid_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
+      Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
+      pragma Assert (Wire_Rec.Kind /= Wire_None);
    begin
-      case Wid_Rec.Kind is
+      case Wire_Rec.Kind is
          when Wire_Variable =>
-            if Wid_Rec.Cur_Assign = No_Seq_Assign then
+            if Wire_Rec.Cur_Assign = No_Seq_Assign then
                --  The variable was never assigned, so the variable value is
                --  the initial value.
                --  FIXME: use initial value directly ?
-               return Wid_Rec.Gate;
+               return Wire_Rec.Gate;
             else
-               return Get_Assign_Value (Ctxt, Wid_Rec.Cur_Assign);
+               return Get_Assign_Value (Ctxt, Wire_Rec.Cur_Assign);
             end if;
          when Wire_Signal | Wire_Output | Wire_Inout | Wire_Input =>
             --  For signals, always read the previous value.
-            return Wid_Rec.Gate;
+            return Wire_Rec.Gate;
          when Wire_None =>
             raise Internal_Error;
       end case;
@@ -586,15 +662,16 @@ package body Synth.Environment is
      (Ctxt : Builders.Context_Acc; Wid : Wire_Id; Off : Uns32; Wd : Width)
      return Net
    is
-      Wire : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
+      Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Wid);
+      pragma Assert (Wire_Rec.Kind /= Wire_None);
       First_Seq : Seq_Assign;
    begin
       --  Latest seq assign
-      First_Seq := Wire.Cur_Assign;
+      First_Seq := Wire_Rec.Cur_Assign;
 
       --  If no seq assign, return current value.
       if First_Seq = No_Seq_Assign then
-         return Build2_Extract (Ctxt, Wire.Gate, Off, Wd);
+         return Build2_Extract (Ctxt, Wire_Rec.Gate, Off, Wd);
       end if;
 
       --  If the range is the same as the seq assign, return the value.
@@ -669,9 +746,8 @@ package body Synth.Environment is
                      Seq := Get_Assign_Prev (Seq);
                      if Seq = No_Seq_Assign then
                         --  Extract from gate.
-                        Append
-                          (Vec, Build_Extract (Ctxt, Wire.Gate,
-                                               Cur_Off, Cur_Wd));
+                        Append (Vec, Build_Extract (Ctxt, Wire_Rec.Gate,
+                                                    Cur_Off, Cur_Wd));
                         exit;
                      end if;
                      P := Get_Assign_Partial (Seq);
@@ -1079,7 +1155,9 @@ package body Synth.Environment is
    procedure Phi_Assign
      (Ctxt : Builders.Context_Acc; Dest : Wire_Id; Pasgn : Partial_Assign)
    is
-      Cur_Asgn : constant Seq_Assign := Wire_Id_Table.Table (Dest).Cur_Assign;
+      Wire_Rec : Wire_Id_Record renames Wire_Id_Table.Table (Dest);
+      pragma Assert (Wire_Rec.Kind /= Wire_None);
+      Cur_Asgn : constant Seq_Assign := Wire_Rec.Cur_Assign;
    begin
       if Cur_Asgn = No_Seq_Assign
         or else Assign_Table.Table (Cur_Asgn).Phi < Current_Phi
@@ -1090,7 +1168,7 @@ package body Synth.Environment is
                                Prev => Cur_Asgn,
                                Chain => No_Seq_Assign,
                                Asgns => Pasgn));
-         Wire_Id_Table.Table (Dest).Cur_Assign := Assign_Table.Last;
+         Wire_Rec.Cur_Assign := Assign_Table.Last;
          Phi_Insert_Assign (Assign_Table.Last);
       else
          --  Overwrite.
diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads
index 71388c610..5c1d9fdbe 100644
--- a/src/synth/synth-environment.ads
+++ b/src/synth/synth-environment.ads
@@ -58,9 +58,26 @@ package Synth.Environment is
    type Conc_Assign is private;
    No_Conc_Assign : constant Conc_Assign;
 
+   --  Create a wire.
    function Alloc_Wire (Kind : Wire_Kind; Obj : Source.Syn_Src)
                        return Wire_Id;
 
+   --  Mark the wire as free.
+   procedure Free_Wire (Wid : Wire_Id);
+
+   --  Simple mark & release.  This is a very simple mechanism (will free
+   --  all wires allocated after the mark), but efficient and working well
+   --  for the stack based allocation.
+   procedure Mark (M : out Wire_Id);
+   procedure Release (M : in out Wire_Id);
+
+   --  Check that all the wires have been released.
+   procedure All_Released;
+
+   --  Remove wires WID1 and WID2 from current phi.
+   --  Used for internal wires (exit/quit) when exiting their scope.
+   procedure Phi_Discard_Wires (Wid1 : Wire_Id; Wid2 : Wire_Id);
+
    --  Set the gate for a wire.
    --  The gate represent the current value.  It is usually an Id_Signal.
    procedure Set_Wire_Gate (Wid : Wire_Id; Gate : Net);
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 324c9526a..6d42193b3 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -1345,6 +1345,8 @@ package body Synth.Stmts is
       Lc : constant Loop_Context_Acc := C.Cur_Loop;
 
    begin
+      Mark (C.Cur_Loop.Wire_Mark);
+
       if (Lc.Prev_Loop /= null and then Lc.Prev_Loop.Need_Quit) then
          Lc.W_Quit := Alloc_Wire (Wire_Variable, Lc.Loop_Stmt);
          Set_Wire_Gate
@@ -1427,6 +1429,18 @@ package body Synth.Stmts is
                               Res, Get_Current_Value (null, Lc.W_Quit));
       end if;
 
+      Phi_Discard_Wires (Lc.W_Quit, Lc.W_Exit);
+
+      if Lc.W_Quit /= No_Wire_Id then
+         Free_Wire (Lc.W_Quit);
+      end if;
+
+      if Lc.W_Exit /= No_Wire_Id then
+         Free_Wire (Lc.W_Exit);
+      end if;
+
+      Release (C.Cur_Loop.Wire_Mark);
+
       Phi_Assign (Get_Build (C.Inst), C.W_En, Res, 0);
    end Loop_Control_Finish;
 
@@ -1495,7 +1509,8 @@ package body Synth.Stmts is
              Need_Quit => False,
              Saved_En => No_Net,
              W_Exit => No_Wire_Id,
-             W_Quit => No_Wire_Id);
+             W_Quit => No_Wire_Id,
+             Wire_Mark => No_Wire_Id);
       C.Cur_Loop := Lc'Unrestricted_Access;
 
       Loop_Control_Init (C, Stmt);
@@ -1718,9 +1733,11 @@ package body Synth.Stmts is
       Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Expr);
       Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp);
       Bod : constant Node := Get_Subprogram_Body (Imp);
-      M : Areapools.Mark_Type;
+      Area_Mark : Areapools.Mark_Type;
       Res : Value_Acc;
       C : Seq_Context;
+      Wire_Mark : Wire_Id;
+      Subprg_Phi : Phi_Type;
    begin
       --  Is it a call to an ieee function ?
       declare
@@ -1741,7 +1758,8 @@ package body Synth.Stmts is
          end if;
       end;
 
-      Areapools.Mark (M, Instance_Pool.all);
+      Mark (Wire_Mark);
+      Areapools.Mark (Area_Mark, Instance_Pool.all);
       C := (Inst => Make_Instance (Syn_Inst, Bod,
                                    New_Internal_Name (Build_Context)),
             Cur_Loop => null,
@@ -1780,21 +1798,29 @@ package body Synth.Stmts is
 
       Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod));
 
-      Pop_And_Merge_Phi (Build_Context, Bod);
 
       if C.Nbr_Ret = 0 then
          raise Internal_Error;
-      elsif C.Nbr_Ret = 1 then
+      elsif C.Nbr_Ret = 1 and then Is_Const (C.Ret_Value) then
          Res := C.Ret_Value;
       else
          Res := Create_Value_Net (Get_Current_Value (Build_Context, C.W_Val),
                                   C.Ret_Value.Typ);
       end if;
 
+      Pop_Phi (Subprg_Phi);
+
+      Decls.Finalize_Declarations (C.Inst, Get_Declaration_Chain (Bod), True);
+
+      --  Free wires.
+      Free_Wire (C.W_En);
+      Free_Wire (C.W_Ret);
+      Free_Wire (C.W_Val);
+
       Free_Instance (C.Inst);
-      Areapools.Release (M, Instance_Pool.all);
+      Areapools.Release (Area_Mark, Instance_Pool.all);
 
-      --  TODO: free wires.
+      Release (Wire_Mark);
 
       return Res;
    end Synth_User_Function_Call;
diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads
index 5b73dd561..0e4c2860d 100644
--- a/src/synth/synth-stmts.ads
+++ b/src/synth/synth-stmts.ads
@@ -81,6 +81,9 @@ private
       --  an outer loop.
       --  Initialized to 1.
       W_Quit : Wire_Id;
+
+      --  Mark to release wires.
+      Wire_Mark : Wire_Id;
    end record;
 
    --  Context for sequential statements.