diff options
| -rw-r--r-- | src/synth/synth-stmts.adb | 318 |
1 files changed, 200 insertions, 118 deletions
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 7d09680c1..d4eecead1 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -250,7 +250,7 @@ package body Synth.Stmts is Aggr : Node; when Target_Memory => -- For a memory: the destination is known. - Mem_Wid : Wire_Id; + Mem_Obj : Value_Acc; -- The width of the whole mrmory. Mem_Width : Width; -- The dynamic offset. @@ -259,6 +259,8 @@ package body Synth.Stmts is end case; end record; + type Target_Info_Array is array (Natural range <>) of Target_Info; + function Synth_Target (Syn_Inst : Synth_Instance_Acc; Target : Node) return Target_Info is begin @@ -309,7 +311,7 @@ package body Synth.Stmts is else return Target_Info'(Kind => Target_Memory, Targ_Type => Typ, - Mem_Wid => Obj.W, + Mem_Obj => Obj, Mem_Width => Rdwd, Mem_Voff => Voff, Mem_Off => Off); @@ -361,13 +363,13 @@ package body Synth.Stmts is V : Net; begin V := Get_Current_Assign_Value - (Get_Build (Syn_Inst), Target.Mem_Wid, Target.Mem_Off, + (Get_Build (Syn_Inst), Target.Mem_Obj.W, Target.Mem_Off, Target.Mem_Width); V := Build_Dyn_Insert (Get_Build (Syn_Inst), V, Get_Net (Val), Target.Mem_Voff, Target.Mem_Off); Set_Location (V, Loc); Synth_Assign - (Target.Mem_Wid, Target.Targ_Type, + (Target.Mem_Obj.W, Target.Targ_Type, Create_Value_Net (V, Target.Targ_Type), Target.Mem_Off, Loc); end; end case; @@ -397,6 +399,10 @@ package body Synth.Stmts is N := Build_Dyn_Extract (Get_Build (Syn_Inst), Get_Net (Obj), Voff, Off, Typ.W); else + if Off = 0 and then Typ.W = Obj.Typ.W then + -- Nothing to do if extracting the whole object. + return Obj; + end if; N := Build_Extract (Get_Build (Syn_Inst), Get_Net (Obj), Off, Typ.W); end if; Set_Location (N, Loc); @@ -1207,17 +1213,21 @@ package body Synth.Stmts is procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; - Assoc_Chain : Node) + Assoc_Chain : Node; + Infos : out Target_Info_Array) is + pragma Assert (Infos'First = 1); Inter : Node; Inter_Type : Type_Acc; Assoc : Node; Assoc_Inter : Node; Actual : Node; Val : Value_Acc; + Nbr_Inout : Natural; begin Set_Instance_Const (Subprg_Inst, True); + Nbr_Inout := 0; Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop @@ -1239,8 +1249,25 @@ package body Synth.Stmts is raise Internal_Error; end case; when Iir_Out_Mode | Iir_Inout_Mode => - -- FIXME: todo - raise Internal_Error; + Nbr_Inout := Nbr_Inout + 1; + Actual := Get_Actual (Assoc); + Infos (Nbr_Inout) := Synth_Target (Caller_Inst, Actual); + declare + Info : Target_Info renames Infos (Nbr_Inout); + begin + case Info.Kind is + when Target_Aggregate => + raise Internal_Error; + when Target_Simple => + Val := Synth_Read_Memory + (Caller_Inst, Info.Obj, Info.Off, No_Net, + Info.Targ_Type, Assoc); + when Target_Memory => + Val := Synth_Read_Memory + (Caller_Inst, Info.Mem_Obj, Info.Mem_Off, + Info.Mem_Voff, Info.Targ_Type, Assoc); + end case; + end; end case; Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc); @@ -1250,10 +1277,13 @@ package body Synth.Stmts is end if; case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is - when Iir_Kind_Interface_Constant_Declaration - | Iir_Kind_Interface_Variable_Declaration => + when Iir_Kind_Interface_Constant_Declaration => + -- Pass by reference. + Create_Object (Subprg_Inst, Inter, Val); + when Iir_Kind_Interface_Variable_Declaration => -- FIXME: Arguments are passed by copy. Create_Object (Subprg_Inst, Inter, Val); + raise Internal_Error; when Iir_Kind_Interface_Signal_Declaration => Create_Object (Subprg_Inst, Inter, Val); when Iir_Kind_Interface_File_Declaration => @@ -1264,30 +1294,50 @@ package body Synth.Stmts is end loop; end Synth_Subprogram_Association; + procedure Synth_Subprogram_Association (Subprg_Inst : Synth_Instance_Acc; + Caller_Inst : Synth_Instance_Acc; + Inter_Chain : Node; + Assoc_Chain : Node) + is + Infos : Target_Info_Array (1 .. 0); + pragma Unreferenced (Infos); + begin + Synth_Subprogram_Association + (Subprg_Inst, Caller_Inst, Inter_Chain, Assoc_Chain, Infos); + end Synth_Subprogram_Association; + procedure Synth_Subprogram_Back_Association (Subprg_Inst : Synth_Instance_Acc; Caller_Inst : Synth_Instance_Acc; Inter_Chain : Node; - Assoc_Chain : Node) + Assoc_Chain : Node; + Infos : Target_Info_Array) is + pragma Assert (Infos'First = 1); Inter : Node; Assoc : Node; Assoc_Inter : Node; Val : Value_Acc; + Nbr_Inout : Natural; begin + Nbr_Inout := 0; Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); - if Get_Mode (Inter) = Iir_Out_Mode then - Val := Synth_Expression (Subprg_Inst, Inter); - Synth_Assignment (Caller_Inst, Get_Actual (Assoc), Val, Assoc); - - end if; + case Iir_Parameter_Modes (Get_Mode (Inter)) is + when Iir_In_Mode => + null; + when Iir_Out_Mode | Iir_Inout_Mode => + Nbr_Inout := Nbr_Inout + 1; + Val := Synth_Expression (Subprg_Inst, Inter); + Synth_Assignment (Caller_Inst, Infos (Nbr_Inout), Val, Assoc); + end case; Next_Association_Interface (Assoc, Assoc_Inter); end loop; + pragma Assert (Nbr_Inout = Infos'Last); end Synth_Subprogram_Back_Association; function Synth_Label (Stmt : Node) return Sname @@ -1301,47 +1351,152 @@ package body Synth.Stmts is end if; end Synth_Label; - procedure Synth_Procedure_Call (C : in out Seq_Context; Stmt : Node) + procedure Count_Associations + (Inter_Chain : Node; Assoc_Chain : Node; Nbr_Inout : out Natural) + is + Assoc : Node; + Assoc_Inter : Node; + Inter : Node; + begin + Nbr_Inout := 0; + + Assoc := Assoc_Chain; + Assoc_Inter := Inter_Chain; + while Is_Valid (Assoc) loop + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + + case Iir_Parameter_Modes (Get_Mode (Inter)) is + when Iir_In_Mode => + null; + when Iir_Out_Mode | Iir_Inout_Mode => + Nbr_Inout := Nbr_Inout + 1; + end case; + + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Count_Associations; + + function Synth_Subprogram_Call + (Syn_Inst : Synth_Instance_Acc; Call : Node) return Value_Acc is - Call : constant Node := Get_Procedure_Call (Stmt); Imp : constant Node := Get_Implementation (Call); + Is_Func : constant Boolean := Is_Function_Declaration (Imp); Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); - Subprg_Body : constant Node := Get_Subprogram_Body (Imp); - Decls_Chain : constant Node := Get_Declaration_Chain (Subprg_Body); - Sub_C : Seq_Context; - Sub_Sname : Sname; - M : Areapools.Mark_Type; + Bod : constant Node := Get_Subprogram_Body (Imp); + Area_Mark : Areapools.Mark_Type; + Res : Value_Acc; + C : Seq_Context; + Wire_Mark : Wire_Id; + Subprg_Phi : Phi_Type; + Nbr_Inout : Natural; begin - if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then - Error_Msg_Synth (+Stmt, "call to implicit %n is not supported", +Imp); - return; - elsif Get_Foreign_Flag (Imp) then - Error_Msg_Synth (+Stmt, "call to foreign %n is not supported", +Imp); - return; + 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, + W_En => Alloc_Wire (Wire_Variable, Imp), + W_Ret => Alloc_Wire (Wire_Variable, Imp), + W_Val => No_Wire_Id, + Ret_Init => No_Net, + Ret_Value => null, + Ret_Typ => null, + Nbr_Ret => 0); + + if Is_Func then + C.W_Val := Alloc_Wire (Wire_Variable, Imp); end if; - Areapools.Mark (M, Instance_Pool.all); - Sub_Sname := New_Sname (Get_Sname (C.Inst), Get_Identifier (Imp)); - Sub_C.Inst := Make_Instance (C.Inst, Imp, Sub_Sname); + Count_Associations (Inter_Chain, Assoc_Chain, Nbr_Inout); - Synth_Subprogram_Association - (Sub_C.Inst, C.Inst, Inter_Chain, Assoc_Chain); + declare + Infos : Target_Info_Array (1 .. Nbr_Inout); + begin + Synth_Subprogram_Association + (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + + Push_Phi; - Synth_Declarations (Sub_C.Inst, Decls_Chain); + if Is_Func then + -- 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); + end if; - if Is_Valid (Decls_Chain) then - Synth_Declarations (Sub_C.Inst, Decls_Chain); + Set_Wire_Gate + (C.W_En, Build_Signal (Build_Context, + New_Internal_Name (Build_Context), 1)); + Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); + + Set_Wire_Gate + (C.W_Ret, Build_Signal (Build_Context, + New_Internal_Name (Build_Context), 1)); + Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0); + + Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); + + Synth_Sequential_Statements + (C, Get_Sequential_Statement_Chain (Bod)); + + if Is_Func then + if C.Nbr_Ret = 0 then + raise Internal_Error; + 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; + else + Res := null; + Synth_Subprogram_Back_Association + (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain, Infos); + end if; + + Pop_Phi (Subprg_Phi); + + Decls.Finalize_Declarations + (C.Inst, Get_Declaration_Chain (Bod), True); + pragma Unreferenced (Infos); + end; + + -- Free wires. + Free_Wire (C.W_En); + Free_Wire (C.W_Ret); + if Is_Func then + Free_Wire (C.W_Val); end if; - Synth_Sequential_Statements - (Sub_C, Get_Sequential_Statement_Chain (Subprg_Body)); + Free_Instance (C.Inst); + Areapools.Release (Area_Mark, Instance_Pool.all); - Synth_Subprogram_Back_Association - (Sub_C.Inst, C.Inst, Inter_Chain, Assoc_Chain); + Release (Wire_Mark); - Free_Instance (Sub_C.Inst); - Areapools.Release (M, Instance_Pool.all); + return Res; + end Synth_Subprogram_Call; + + procedure Synth_Procedure_Call (C : in out Seq_Context; Stmt : Node) + is + Call : constant Node := Get_Procedure_Call (Stmt); + Imp : constant Node := Get_Implementation (Call); + Res : Value_Acc; + begin + if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then + Error_Msg_Synth (+Stmt, "call to implicit %n is not supported", +Imp); + return; + elsif Get_Foreign_Flag (Imp) then + Error_Msg_Synth (+Stmt, "call to foreign %n is not supported", +Imp); + return; + end if; + + Res := Synth_Subprogram_Call (C.Inst, Call); + pragma Assert (Res = null); end Synth_Procedure_Call; function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean is @@ -1799,20 +1954,11 @@ package body Synth.Stmts is end Synth_Process_Statement; 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); - Area_Mark : Areapools.Mark_Type; - Res : Value_Acc; - C : Seq_Context; - Wire_Mark : Wire_Id; - Subprg_Phi : Phi_Type; + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc is begin -- Is it a call to an ieee function ? declare + Imp : constant Node := Get_Implementation (Expr); Pkg : constant Node := Get_Parent (Imp); Unit : Node; Lib : Node; @@ -1830,71 +1976,7 @@ package body Synth.Stmts is end if; end; - 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, - W_En => Alloc_Wire (Wire_Variable, Imp), - 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); - - Synth_Subprogram_Association - (C.Inst, Syn_Inst, Inter_Chain, Assoc_Chain); - - 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_En, - Build_Signal (Build_Context, New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_En, Get_Inst_Bit1 (Syn_Inst), 0); - - Set_Wire_Gate - (C.W_Ret, - Build_Signal (Build_Context, New_Internal_Name (Build_Context), 1)); - Phi_Assign (Build_Context, C.W_Ret, Get_Inst_Bit1 (Syn_Inst), 0); - - Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); - - Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Bod)); - - - if C.Nbr_Ret = 0 then - raise Internal_Error; - 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 (Area_Mark, Instance_Pool.all); - - Release (Wire_Mark); - - return Res; + return Synth_Subprogram_Call (Syn_Inst, Expr); end Synth_User_Function_Call; procedure Synth_Concurrent_Assertion_Statement |