synth: handle simple user function calls.

6 files changed, 89 insertions, 18 deletions

diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index e34baa8ad..85d31a248 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -24,6 +24,8 @@ package Netlists.Builders is
    type Context is private;
    type Context_Acc is access Context;
 
+   function New_Internal_Name (Ctxt : Context_Acc) return Sname;
+
    --  Create a builder for Design.  Must be called once.
    function Build_Builders (Design : Module) return Context_Acc;
 
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index 84fac7ab5..5ec942e54 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -49,6 +49,7 @@ 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 ee7de6d72..874962260 100644
--- a/src/synth/synth-context.ads
+++ b/src/synth/synth-context.ads
@@ -48,6 +48,8 @@ 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-expr.adb b/src/synth/synth-expr.adb
index 477f56002..a12ed5912 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -34,6 +34,7 @@ with Vhdl.Annotations; use Vhdl.Annotations;
 with Synth.Errors; use Synth.Errors;
 with Synth.Types; use Synth.Types;
 with Synth.Stmts;
+with Synth.Decls;
 
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
@@ -1334,20 +1335,33 @@ package body Synth.Expr is
       Val : Value_Acc;
    begin
       Val := Synth_Expression (Syn_Inst, Expr);
-      if Is_Float (Val) then
-         if Get_Kind (Conv_Type) = Iir_Kind_Integer_Subtype_Definition then
-            return Create_Value_Discrete (Int64 (Val.Fp));
-         else
-            Error_Msg_Synth (+Conv, "unhandled type conversion (from float)");
+      case Get_Kind (Conv_Type) is
+         when Iir_Kind_Integer_Subtype_Definition =>
+            if Is_Float (Val) then
+               return Create_Value_Discrete (Int64 (Val.Fp));
+            else
+               Error_Msg_Synth (+Conv, "unhandled type conversion (to int)");
+               return null;
+            end if;
+         when Iir_Kind_Floating_Subtype_Definition =>
+            if Is_Const (Val) then
+               return Create_Value_Float (Fp64 (Val.Scal));
+            else
+               Error_Msg_Synth (+Conv, "unhandled type conversion (to float)");
+               return null;
+            end if;
+         when Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Array_Subtype_Definition =>
+            if Is_Vector_Type (Conv_Type) then
+               return Val;
+            else
+               Error_Msg_Synth (+Conv, "unhandled type conversion (to array)");
+               return Val;
+            end if;
+         when others =>
+            Error_Msg_Synth (+Conv, "unhandled type conversion");
             return null;
-         end if;
-      end if;
-      if Is_Vector_Type (Conv_Type) then
-         return Val;
-      else
-         Error_Msg_Synth (+Conv, "unhandled type conversion");
-         return Val;
-      end if;
+      end case;
    end Synth_Type_Conversion;
 
    function Synth_Assoc_In (Syn_Inst : Synth_Instance_Acc;
@@ -1419,6 +1433,38 @@ package body Synth.Expr is
       return Create_Value_Array (Bnds, Arr);
    end Eval_To_Unsigned;
 
+   function Synth_User_Function_Call
+     (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc
+   is
+      Imp  : constant Node := Get_Implementation (Expr);
+      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);
+      Subprg_Inst : Synth_Instance_Acc;
+      M : Areapools.Mark_Type;
+      Res : Value_Acc;
+   begin
+      Areapools.Mark (M, Instance_Pool.all);
+      Subprg_Inst := Make_Instance (Syn_Inst, Get_Info (Bod));
+
+      Subprg_Inst.Name := New_Internal_Name (Build_Context);
+
+      Stmts.Synth_Subprogram_Association
+        (Subprg_Inst, Syn_Inst, Inter_Chain, Assoc_Chain);
+
+      Decls.Synth_Declarations (Subprg_Inst, Get_Declaration_Chain (Bod));
+
+      Stmts.Synth_Sequential_Statements
+        (Subprg_Inst, Get_Sequential_Statement_Chain (Bod));
+
+      Res := Subprg_Inst.Return_Value;
+
+      Free_Instance (Subprg_Inst);
+      Areapools.Release (M, Instance_Pool.all);
+
+      return Res;
+   end Synth_User_Function_Call;
+
    function Synth_Predefined_Function_Call
      (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc
    is
@@ -1600,8 +1646,7 @@ package body Synth.Expr is
                elsif Get_Implicit_Definition (Imp) /= Iir_Predefined_None then
                   return Synth_Predefined_Function_Call (Syn_Inst, Expr);
                else
-                  Error_Msg_Synth
-                    (+Expr, "user function call to %i is not handled", +Imp);
+                  return Synth_User_Function_Call (Syn_Inst, Expr);
                end if;
             end;
          when Iir_Kind_Aggregate =>
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index cd60d4ff0..37c780662 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -247,9 +247,6 @@ package body Synth.Stmts is
       Synth_Assignment (Syn_Inst, Target, Val);
    end Synth_Variable_Assignment;
 
-   procedure Synth_Sequential_Statements
-     (Syn_Inst : Synth_Instance_Acc; Stmts : Node);
-
    procedure Synth_If_Statement
      (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
    is
@@ -937,6 +934,24 @@ package body Synth.Stmts is
       end if;
    end Synth_For_Loop_Statement;
 
+   procedure Synth_Return_Statement
+     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
+   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 (Syn_Inst, Expr);
+      if Syn_Inst.Return_Value /= null then
+         --  TODO: multiple return
+         raise Internal_Error;
+      end if;
+      Syn_Inst.Return_Value := Val;
+   end Synth_Return_Statement;
+
    procedure Synth_Sequential_Statements
      (Syn_Inst : Synth_Instance_Acc; Stmts : Node)
    is
@@ -958,6 +973,9 @@ package body Synth.Stmts is
             when Iir_Kind_Null_Statement =>
                --  Easy
                null;
+            when Iir_Kind_Return_Statement =>
+               Synth_Return_Statement (Syn_Inst, Stmt);
+               exit;
             when Iir_Kind_Procedure_Call_Statement =>
                Synth_Procedure_Call (Syn_Inst, Stmt);
             when others =>
diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads
index 102d63c7d..0ee3e3029 100644
--- a/src/synth/synth-stmts.ads
+++ b/src/synth/synth-stmts.ads
@@ -27,6 +27,9 @@ package Synth.Stmts is
                                            Inter_Chain : Node;
                                            Assoc_Chain : Node);
 
+   procedure Synth_Sequential_Statements
+     (Syn_Inst : Synth_Instance_Acc; Stmts : Node);
+
    --  Generate netlists for concurrent statements STMTS.
    procedure Synth_Concurrent_Statements
      (Syn_Inst : Synth_Instance_Acc; Stmts : Node);