From ab2fd3d52f149efcc9cc66f0a0a5e378a1d63918 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 2 Aug 2020 09:26:44 +0200 Subject: vhdl: handle force/release statements in translate and grt. For #1416 --- src/vhdl/translate/trans-chap8.adb | 129 ++++++++++++++++++++++++++++++++++++- src/vhdl/translate/trans_decls.ads | 15 +++++ src/vhdl/translate/translation.adb | 79 ++++++++++++++++++----- 3 files changed, 205 insertions(+), 18 deletions(-) (limited to 'src/vhdl/translate') diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 1e7bb1956..465fa3af5 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -4843,8 +4843,131 @@ package body Trans.Chap8 is Close_Temp; end Translate_Selected_Waveform_Assignment_Statement; - procedure Translate_Statement (Stmt : Iir) + procedure Translate_Signal_Release_Assignment_Statement (Stmt : Iir) is + Target : constant Iir := Get_Target (Stmt); + Targ : Mnode; + Proc : O_Dnode; + begin + Targ := Chap6.Translate_Name (Target, Mode_Signal); + case Get_Force_Mode (Stmt) is + when Iir_Force_In => + Proc := Ghdl_Signal_Release_Eff; + when Iir_Force_Out => + Proc := Ghdl_Signal_Release_Drv; + end case; + Register_Signal (Targ, Get_Type (Target), Proc); + end Translate_Signal_Release_Assignment_Statement; + + Signal_Force_Stmt : Iir; + procedure Gen_Signal_Force_Non_Composite (Targ : Mnode; + Targ_Type : Iir; + Val : O_Enode) + is + Type_Info : constant Type_Info_Acc := Get_Info (Targ_Type); + Subprg : O_Dnode; + Conv : O_Tnode; + Assoc : O_Assoc_List; + Val2 : O_Enode; + begin + case Type_Mode_Scalar (Type_Info.Type_Mode) is + when Type_Mode_B1 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_B1; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_B1; + end case; + Conv := Ghdl_Bool_Type; + when Type_Mode_E8 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_E8; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_E8; + end case; + Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_E32; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_E32; + end case; + Conv := Ghdl_I32_Type; + when Type_Mode_I32 + | Type_Mode_P32 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_I32; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_I32; + end case; + Conv := Ghdl_I32_Type; + when Type_Mode_P64 + | Type_Mode_I64 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_I64; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_I64; + end case; + Conv := Ghdl_I64_Type; + when Type_Mode_F64 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_F64; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_F64; + end case; + Conv := Ghdl_Real_Type; + end case; + Val2 := Chap3.Insert_Scalar_Check + (Val, Null_Iir, Targ_Type, Signal_Force_Stmt); + Start_Association (Assoc, Subprg); + New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)), + Ghdl_Signal_Ptr)); + New_Association (Assoc, New_Convert_Ov (Val2, Conv)); + New_Procedure_Call (Assoc); + end Gen_Signal_Force_Non_Composite; + + procedure Gen_Signal_Force is new Foreach_Non_Composite + (Data_Type => O_Enode, + Composite_Data_Type => Mnode, + Do_Non_Composite => Gen_Signal_Force_Non_Composite, + Prepare_Data_Array => Gen_Oenode_Prepare_Data_Composite, + Update_Data_Array => Gen_Oenode_Update_Data_Array, + Finish_Data_Array => Gen_Oenode_Finish_Data_Composite, + Prepare_Data_Record => Gen_Oenode_Prepare_Data_Composite, + Update_Data_Record => Gen_Oenode_Update_Data_Record, + Finish_Data_Record => Gen_Oenode_Finish_Data_Composite); + + procedure Translate_Signal_Force_Assignment_Statement (Stmt : Iir) + is + Target : constant Iir := Get_Target (Stmt); + Target_Type : constant Iir := Get_Type (Target); + Targ_Tinfo : constant Type_Info_Acc := Get_Info (Target_Type); + Expr : constant Iir := Get_Expression (Stmt); + Value : Mnode; + Targ : Mnode; + begin + Targ := Chap6.Translate_Name (Target, Mode_Signal); + Value := Chap7.Translate_Expression (Expr, Target_Type); + + if Is_Composite (Targ_Tinfo) + and then Get_Constraint_State (Target_Type) /= Fully_Constrained + then + Stabilize (Targ); + Stabilize (Value); + Chap3.Check_Composite_Match + (Target_Type, Targ, Get_Type (Expr), Value, Stmt); + end if; + + Signal_Force_Stmt := Stmt; + Gen_Signal_Force (Targ, Target_Type, M2E (Value)); + end Translate_Signal_Force_Assignment_Statement; + + procedure Translate_Statement (Stmt : Iir) is begin New_Debug_Line_Stmt (Get_Line_Number (Stmt)); Open_Temp; @@ -4895,6 +5018,10 @@ package body Trans.Chap8 is Trans.Update_Node_Infos; Translate_If_Statement (C_Stmt); end; + when Iir_Kind_Signal_Release_Assignment_Statement => + Translate_Signal_Release_Assignment_Statement (Stmt); + when Iir_Kind_Signal_Force_Assignment_Statement => + Translate_Signal_Force_Assignment_Statement (Stmt); when Iir_Kind_Null_Statement => -- A null statement is translated to a NOP, so that the diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads index 2f52b6035..0f0f3dd72 100644 --- a/src/vhdl/translate/trans_decls.ads +++ b/src/vhdl/translate/trans_decls.ads @@ -80,6 +80,9 @@ package Trans_Decls is Ghdl_Signal_Start_Assign_Null : O_Dnode; Ghdl_Signal_Next_Assign_Null : O_Dnode; + Ghdl_Signal_Release_Eff : O_Dnode; + Ghdl_Signal_Release_Drv : O_Dnode; + Ghdl_Create_Signal_B1 : O_Dnode; Ghdl_Signal_Simple_Assign_B1 : O_Dnode; Ghdl_Signal_Start_Assign_B1 : O_Dnode; @@ -88,6 +91,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_B1 : O_Dnode; Ghdl_Signal_Init_B1 : O_Dnode; Ghdl_Signal_Driving_Value_B1 : O_Dnode; + Ghdl_Signal_Force_Eff_B1 : O_Dnode; + Ghdl_Signal_Force_Drv_B1 : O_Dnode; Ghdl_Create_Signal_E8 : O_Dnode; Ghdl_Signal_Simple_Assign_E8 : O_Dnode; @@ -97,6 +102,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_E8 : O_Dnode; Ghdl_Signal_Init_E8 : O_Dnode; Ghdl_Signal_Driving_Value_E8 : O_Dnode; + Ghdl_Signal_Force_Eff_E8 : O_Dnode; + Ghdl_Signal_Force_Drv_E8 : O_Dnode; Ghdl_Create_Signal_E32 : O_Dnode; Ghdl_Signal_Simple_Assign_E32 : O_Dnode; @@ -106,6 +113,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_E32 : O_Dnode; Ghdl_Signal_Init_E32 : O_Dnode; Ghdl_Signal_Driving_Value_E32 : O_Dnode; + Ghdl_Signal_Force_Eff_E32 : O_Dnode; + Ghdl_Signal_Force_Drv_E32 : O_Dnode; Ghdl_Create_Signal_I32 : O_Dnode; Ghdl_Signal_Simple_Assign_I32 : O_Dnode; @@ -115,6 +124,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_I32 : O_Dnode; Ghdl_Signal_Init_I32 : O_Dnode; Ghdl_Signal_Driving_Value_I32 : O_Dnode; + Ghdl_Signal_Force_Eff_I32 : O_Dnode; + Ghdl_Signal_Force_Drv_I32 : O_Dnode; Ghdl_Create_Signal_F64 : O_Dnode; Ghdl_Signal_Simple_Assign_F64 : O_Dnode; @@ -124,6 +135,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_F64 : O_Dnode; Ghdl_Signal_Init_F64 : O_Dnode; Ghdl_Signal_Driving_Value_F64 : O_Dnode; + Ghdl_Signal_Force_Eff_F64 : O_Dnode; + Ghdl_Signal_Force_Drv_F64 : O_Dnode; Ghdl_Create_Signal_I64 : O_Dnode; Ghdl_Signal_Simple_Assign_I64 : O_Dnode; @@ -133,6 +146,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_I64 : O_Dnode; Ghdl_Signal_Init_I64 : O_Dnode; Ghdl_Signal_Driving_Value_I64 : O_Dnode; + Ghdl_Signal_Force_Eff_I64 : O_Dnode; + Ghdl_Signal_Force_Drv_I64 : O_Dnode; Ghdl_Signal_In_Conversion : O_Dnode; Ghdl_Signal_Out_Conversion : O_Dnode; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index b510a7ae5..165f57d43 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -809,17 +809,18 @@ package body Translation is Finish_Subprogram_Decl (Interfaces, Ghdl_Finalize_Register); end Initialize; - procedure Create_Signal_Subprograms - (Suffix : String; - Val_Type : O_Tnode; - Create_Signal : out O_Dnode; - Init_Signal : out O_Dnode; - Simple_Assign : out O_Dnode; - Start_Assign : out O_Dnode; - Next_Assign : out O_Dnode; - Associate_Value : out O_Dnode; - Add_Port_Driver : out O_Dnode; - Driving_Value : out O_Dnode) + procedure Create_Signal_Subprograms (Suffix : String; + Val_Type : O_Tnode; + Create_Signal : out O_Dnode; + Init_Signal : out O_Dnode; + Simple_Assign : out O_Dnode; + Start_Assign : out O_Dnode; + Next_Assign : out O_Dnode; + Associate_Value : out O_Dnode; + Add_Port_Driver : out O_Dnode; + Driving_Value : out O_Dnode; + Force_Drv : out O_Dnode; + Force_Eff : out O_Dnode) is Interfaces : O_Inter_List; Param : O_Dnode; @@ -910,6 +911,24 @@ package body Translation is O_Storage_External, Val_Type); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); Finish_Subprogram_Decl (Interfaces, Driving_Value); + + -- procedure __ghdl_signal_force_drv_XXX (sign : __ghdl_signal_ptr; + -- val : VAL_TYPE); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_force_drv_" & Suffix), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type); + Finish_Subprogram_Decl (Interfaces, Force_Drv); + + -- procedure __ghdl_signal_force_eff_XXX (sign : __ghdl_signal_ptr; + -- val : VAL_TYPE); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_force_eff_" & Suffix), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type); + Finish_Subprogram_Decl (Interfaces, Force_Eff); end Create_Signal_Subprograms; -- procedure __ghdl_image_NAME (res : std_string_ptr_node; @@ -1574,7 +1593,9 @@ package body Translation is Ghdl_Signal_Next_Assign_E8, Ghdl_Signal_Associate_E8, Ghdl_Signal_Add_Port_Driver_E8, - Ghdl_Signal_Driving_Value_E8); + Ghdl_Signal_Driving_Value_E8, + Ghdl_Signal_Force_Drv_E8, + Ghdl_Signal_Force_Eff_E8); -- function __ghdl_create_signal_e32 (init_val : ghdl_i32_type) -- return __ghdl_signal_ptr; @@ -1588,7 +1609,9 @@ package body Translation is Ghdl_Signal_Next_Assign_E32, Ghdl_Signal_Associate_E32, Ghdl_Signal_Add_Port_Driver_E32, - Ghdl_Signal_Driving_Value_E32); + Ghdl_Signal_Driving_Value_E32, + Ghdl_Signal_Force_Drv_E32, + Ghdl_Signal_Force_Eff_E32); -- function __ghdl_create_signal_b1 (init_val : ghdl_bool_type) -- return __ghdl_signal_ptr; @@ -1602,7 +1625,9 @@ package body Translation is Ghdl_Signal_Next_Assign_B1, Ghdl_Signal_Associate_B1, Ghdl_Signal_Add_Port_Driver_B1, - Ghdl_Signal_Driving_Value_B1); + Ghdl_Signal_Driving_Value_B1, + Ghdl_Signal_Force_Drv_B1, + Ghdl_Signal_Force_Eff_B1); Create_Signal_Subprograms ("i32", Ghdl_I32_Type, Ghdl_Create_Signal_I32, @@ -1612,7 +1637,9 @@ package body Translation is Ghdl_Signal_Next_Assign_I32, Ghdl_Signal_Associate_I32, Ghdl_Signal_Add_Port_Driver_I32, - Ghdl_Signal_Driving_Value_I32); + Ghdl_Signal_Driving_Value_I32, + Ghdl_Signal_Force_Drv_I32, + Ghdl_Signal_Force_Eff_I32); Create_Signal_Subprograms ("f64", Ghdl_Real_Type, Ghdl_Create_Signal_F64, @@ -1622,7 +1649,9 @@ package body Translation is Ghdl_Signal_Next_Assign_F64, Ghdl_Signal_Associate_F64, Ghdl_Signal_Add_Port_Driver_F64, - Ghdl_Signal_Driving_Value_F64); + Ghdl_Signal_Driving_Value_F64, + Ghdl_Signal_Force_Drv_F64, + Ghdl_Signal_Force_Eff_F64); Create_Signal_Subprograms ("i64", Ghdl_I64_Type, Ghdl_Create_Signal_I64, @@ -1632,7 +1661,23 @@ package body Translation is Ghdl_Signal_Next_Assign_I64, Ghdl_Signal_Associate_I64, Ghdl_Signal_Add_Port_Driver_I64, - Ghdl_Signal_Driving_Value_I64); + Ghdl_Signal_Driving_Value_I64, + Ghdl_Signal_Force_Drv_I64, + Ghdl_Signal_Force_Eff_I64); + + -- procedure __ghdl_signal_release_drv (sig : __ghdl_signal_ptr); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_release_drv"), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Release_Drv); + + -- procedure __ghdl_signal_release_eff (sig : __ghdl_signal_ptr); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_release_eff"), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Release_Eff); -- procedure __ghdl_process_add_sensitivity (sig : __ghdl_signal_ptr); Start_Procedure_Decl -- cgit v1.2.3