synth: improve support of return statement.

8 files changed, 117 insertions, 21 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index adc2277a3..77ed71856 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -49,7 +49,6 @@ package body Synth.Context is
                                       Block_Scope => Info,
                                       Up_Block => Parent,
                                       Elab_Objects => 0,
-                                      Return_Value => null,
                                       Objects => (others => null));
       return Res;
    end Make_Instance;
diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads
index 2f9c93ee0..0cfbc949c 100644
--- a/src/synth/synth-context.ads
+++ b/src/synth/synth-context.ads
@@ -48,8 +48,6 @@ package Synth.Context is
 
       Elab_Objects : Object_Slot_Type;
 
-      Return_Value : Value_Acc;
-
       --  Instance for synthesis.
       Objects : Objects_Array (1 .. Max_Objs);
    end record;
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index 41e6140ac..5a517b7d5 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -61,6 +61,11 @@ package body Synth.Environment is
       Wire_Id_Table.Table (Wid).Gate := Gate;
    end Set_Wire_Gate;
 
+   function Get_Wire_Gate (Wid : Wire_Id) return Net is
+   begin
+      return Wire_Id_Table.Table (Wid).Gate;
+   end Get_Wire_Gate;
+
    function Get_Wire_Id (W : Seq_Assign) return Wire_Id is
    begin
       return Assign_Table.Table (W).Id;
diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads
index ea6befb9b..3af1a7318 100644
--- a/src/synth/synth-environment.ads
+++ b/src/synth/synth-environment.ads
@@ -64,6 +64,7 @@ package Synth.Environment is
    --  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);
+   function Get_Wire_Gate (Wid : Wire_Id) return Net;
 
    --  The current value of WID.  For variables, this is the last assigned
    --  value.  For signals, this is the initial value.
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index a338e5cef..66ab2900b 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -45,7 +45,6 @@ with Synth.Source;
 
 with Vhdl.Annotations; use Vhdl.Annotations;
 
-with Netlists; use Netlists;
 with Netlists.Builders; use Netlists.Builders;
 with Netlists.Gates;
 with Netlists.Utils; use Netlists.Utils;
@@ -405,6 +404,7 @@ package body Synth.Stmts is
       Cond_Val : Value_Acc;
       Phi_True : Phi_Type;
       Phi_False : Phi_Type;
+      En_Prev, En_T, En_F : Tri_State_Type;
    begin
       Cond_Val := Synth_Expression (C.Inst, Cond);
       if Is_Const (Cond_Val) then
@@ -427,11 +427,15 @@ package body Synth.Stmts is
             end if;
          end if;
       else
+         En_Prev := C.T_En;
+         pragma Assert (En_Prev /= False);
          Push_Phi;
          Synth_Sequential_Statements
            (C, Get_Sequential_Statement_Chain (Stmt));
          Pop_Phi (Phi_True);
+         En_T := C.T_En;
 
+         C.T_En := En_Prev;
          Push_Phi;
          if Is_Valid (Els) then
             if Is_Null (Get_Condition (Els)) then
@@ -444,8 +448,14 @@ package body Synth.Stmts is
             end if;
          end if;
          Pop_Phi (Phi_False);
+         En_F := C.T_En;
 
          Merge_Phis (Build_Context, Get_Net (Cond_Val), Phi_True, Phi_False);
+         if En_T = En_F then
+            C.T_En := En_T;
+         else
+            C.T_En := Unknown;
+         end if;
       end if;
    end Synth_If_Statement;
 
@@ -1277,25 +1287,46 @@ package body Synth.Stmts is
       Val : Value_Acc;
       Expr : constant Node := Get_Expression (Stmt);
    begin
-      if Expr = Null_Node then
-         --  TODO: return in procedure.
-         raise Internal_Error;
-      end if;
-      Val := Synth_Expression (C.Inst, Expr);
-      if C.Inst.Return_Value /= null then
-         --  TODO: multiple return
-         raise Internal_Error;
+      if Expr /= Null_Node then
+         --  Return in function.
+         Val := Synth_Expression (C.Inst, Expr);
+         Val := Synth_Subtype_Conversion (Val, C.Ret_Typ, Stmt);
+
+         if C.Nbr_Ret = 0 then
+            C.Ret_Value := Val;
+            if not Is_Bounded_Type (C.Ret_Typ) then
+               --  The function was declared with an unconstrained return type.
+               --  Now that a value has been returned, we know the subtype of
+               --  the returned values.  So adjust it.
+               --  All the returned values must have the same length.
+               C.Ret_Typ := Val.Typ;
+               Set_Width (Get_Wire_Gate (C.W_Val), C.Ret_Typ.W);
+               Set_Width (C.Ret_Init, C.Ret_Typ.W);
+            end if;
+         end if;
+         Phi_Assign (Build_Context, C.W_Val, Get_Net (Val), 0);
       end if;
-      C.Inst.Return_Value := Val;
+
+      --  The subprogram has returned.  Do not execute further statements.
+      Phi_Assign (Build_Context, C.W_Ret,
+                  Build_Const_UB32 (Build_Context, 1, 1), 0);
+      C.Nbr_Ret := C.Nbr_Ret + 1;
+      C.T_En := False;
    end Synth_Return_Statement;
 
    procedure Synth_Sequential_Statements
      (C : in out Seq_Context; Stmts : Node)
    is
       Stmt : Node;
+      Phi_T, Phi_F : Phi_Type;
+      Has_Phi : Boolean;
    begin
       Stmt := Stmts;
       while Is_Valid (Stmt) loop
+         Has_Phi := C.T_En = Unknown;
+         if Has_Phi then
+            Push_Phi;
+         end if;
          case Get_Kind (Stmt) is
             when Iir_Kind_If_Statement =>
                Synth_If_Statement (C, Stmt);
@@ -1316,7 +1347,6 @@ package body Synth.Stmts is
                null;
             when Iir_Kind_Return_Statement =>
                Synth_Return_Statement (C, Stmt);
-               exit;
             when Iir_Kind_Procedure_Call_Statement =>
                Synth_Procedure_Call (C, Stmt);
             when Iir_Kind_Report_Statement
@@ -1326,6 +1356,17 @@ package body Synth.Stmts is
             when others =>
                Error_Kind ("synth_sequential_statements", Stmt);
          end case;
+         if Has_Phi then
+            Pop_Phi (Phi_T);
+            Push_Phi;
+            Pop_Phi (Phi_F);
+            Merge_Phis (Build_Context,
+                        Get_Current_Value (Build_Context, C.W_Ret),
+                        Phi_F, Phi_T);
+         end if;
+         if C.T_En = False then
+            return;
+         end if;
          Stmt := Get_Chain (Stmt);
       end loop;
    end Synth_Sequential_Statements;
@@ -1433,7 +1474,15 @@ package body Synth.Stmts is
       end;
 
       Areapools.Mark (M, Instance_Pool.all);
-      C.Inst := Make_Instance (Syn_Inst, Get_Info (Bod));
+      C := (Inst => Make_Instance (Syn_Inst, Get_Info (Bod)),
+            T_En => True,
+            W_En => No_Wire_Id,
+            W_Ret => Alloc_Wire (Wire_Variable, Imp),
+            W_Val => Alloc_Wire (Wire_Variable, Imp),
+            Ret_Init => No_Net,
+            Ret_Value => null,
+            Ret_Typ => null,
+            Nbr_Ret => 0);
       C.Inst.Name := New_Internal_Name (Build_Context);
 
       Synth_Subprogram_Association
@@ -1441,18 +1490,41 @@ package body Synth.Stmts is
 
       Push_Phi;
 
+      --  Set a default value for the return.
+      C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp));
+      Set_Wire_Gate (C.W_Val, Build_Signal (Build_Context,
+                                            New_Internal_Name (Build_Context),
+                                            C.Ret_Typ.W));
+      C.Ret_Init := Build_Const_X (Build_Context, C.Ret_Typ.W);
+      Phi_Assign (Build_Context, C.W_Val, C.Ret_Init, 0);
+
+      Set_Wire_Gate (C.W_Ret, Build_Signal (Build_Context,
+                                            New_Internal_Name (Build_Context),
+                                            1));
+      Phi_Assign (Build_Context, C.W_Ret,
+                  Build_Const_UB32 (Build_Context, 0, 1), 0);
+
       Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod));
 
       Synth_Sequential_Statements
         (C, Get_Sequential_Statement_Chain (Bod));
 
-      Res := C.Inst.Return_Value;
-
       Pop_And_Merge_Phi (Build_Context, Bod);
 
+      if C.Nbr_Ret = 0 then
+         raise Internal_Error;
+      elsif C.Nbr_Ret = 1 then
+         Res := C.Ret_Value;
+      else
+         Res := Create_Value_Net (Get_Current_Value (Build_Context, C.W_Val),
+                                  C.Ret_Value.Typ);
+      end if;
+
       Free_Instance (C.Inst);
       Areapools.Release (M, Instance_Pool.all);
 
+      --  TODO: free wires.
+
       return Res;
    end Synth_User_Function_Call;
 
diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads
index af83524b6..a60efab72 100644
--- a/src/synth/synth-stmts.ads
+++ b/src/synth/synth-stmts.ads
@@ -20,6 +20,9 @@
 
 with Types; use Types;
 with Vhdl.Nodes; use Vhdl.Nodes;
+
+with Netlists; use Netlists;
+
 with Synth.Values; use Synth.Values;
 with Synth.Context; use Synth.Context;
 with Synth.Environment; use Synth.Environment;
@@ -68,16 +71,16 @@ private
 
       W_En : Wire_Id;
 
-      --  If set, condition of the next statement.
-      W_Next : Wire_Id;
-      --  If set, condition of the exit statement.
-      W_Exit : Wire_Id;
       --  If set, condition of the return statement.
       W_Ret : Wire_Id;
 
       --  Return value.
       W_Val : Wire_Id;
 
+      Ret_Init : Net;
+
       Ret_Value : Value_Acc;
+      Ret_Typ : Type_Acc;
+      Nbr_Ret : Int32;
    end record;
 end Synth.Stmts;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index b7179e695..a8932501e 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -37,6 +37,22 @@ package body Synth.Values is
    function To_Value_Array_Acc is new Ada.Unchecked_Conversion
      (System.Address, Values.Value_Array_Acc);
 
+   function Is_Bounded_Type (Typ : Type_Acc) return Boolean is
+   begin
+      case Typ.Kind is
+         when Type_Bit
+           | Type_Discrete
+           | Type_Float
+           | Type_Vector
+           | Type_Slice
+           | Type_Array
+           | Type_Record =>
+            return True;
+         when Type_Unbounded_Array =>
+            return False;
+      end case;
+   end Is_Bounded_Type;
+
    function Is_Equal (L, R : Value_Acc) return Boolean is
    begin
       if L.Kind /= R.Kind then
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index 9d2026270..e8f20d9f8 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -238,6 +238,8 @@ package Synth.Values is
    --  Return the element of a vector/array/unbounded_array.
    function Get_Array_Element (Arr_Type : Type_Acc) return Type_Acc;
 
+   function Is_Bounded_Type (Typ : Type_Acc) return Boolean;
+
    function Is_Equal (L, R : Value_Acc) return Boolean;
 
    --  Create a Value_Net.