diff options
| -rw-r--r-- | src/grt/grt-errors.adb | 14 | ||||
| -rw-r--r-- | src/grt/grt-errors.ads | 5 | ||||
| -rw-r--r-- | src/grt/grt-processes.adb | 14 | ||||
| -rw-r--r-- | src/grt/grt-processes.ads | 8 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/translation.adb | 4 |
6 files changed, 39 insertions, 8 deletions
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb index e9e2f54ad..51a50418c 100644 --- a/src/grt/grt-errors.adb +++ b/src/grt/grt-errors.adb @@ -254,6 +254,20 @@ package body Grt.Errors is Fatal_Error; end Error; + procedure Error (Str : String; + Filename : Ghdl_C_String; + Line : Ghdl_I32) is + begin + Error_H; + Put_Err (Str); + Put_Err (" at "); + Put_Err (Filename); + Put_Err (" line "); + Put_I32 (Error_Stream, Line); + Newline_Err; + Fatal_Error; + end Error; + procedure Info (Str : String) is begin Put_Err (Progname); diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads index 5d316aaea..ceaef6a8e 100644 --- a/src/grt/grt-errors.ads +++ b/src/grt/grt-errors.ads @@ -58,6 +58,11 @@ package Grt.Errors is procedure Error (Str : String); pragma No_Return (Error); + procedure Error (Str : String; + Filename : Ghdl_C_String; + Line : Ghdl_I32); + pragma No_Return (Error); + -- Warning message. procedure Warning (Str : String); diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb index de39cde53..a1137210d 100644 --- a/src/grt/grt-processes.adb +++ b/src/grt/grt-processes.adb @@ -388,14 +388,15 @@ package body Grt.Processes is Proc.Timeout_Chain_Prev := null; end Remove_Process_From_Timeout_Chain; - procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time) + procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time; + Filename : Ghdl_C_String; + Line : Ghdl_I32) is Proc : constant Process_Acc := Get_Current_Process; begin if Time < 0 then -- LRM93 8.1 - Disp_Process_Name (Get_Error_Stream, Proc); - Error ("negative timeout clause"); + Error ("negative timeout clause", Filename, Line); end if; Proc.Timeout := Current_Time + Time; Update_Process_First_Timeout (Proc); @@ -514,7 +515,9 @@ package body Grt.Processes is Proc.State := State_Dead; end Ghdl_Process_Wait_Exit; - procedure Ghdl_Process_Wait_Timeout (Time : Std_Time) + procedure Ghdl_Process_Wait_Timeout (Time : Std_Time; + Filename : Ghdl_C_String; + Line : Ghdl_I32) is Proc : constant Process_Acc := Get_Current_Process; begin @@ -523,8 +526,7 @@ package body Grt.Processes is end if; if Time < 0 then -- LRM93 8.1 - Disp_Process_Name (Get_Error_Stream, Proc); - Error ("negative timeout clause"); + Error ("negative timeout clause", Filename, Line); end if; Proc.State := State_Delayed; if Time <= Std_Time'Last - Current_Time then diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads index e09f553e5..818b81f7d 100644 --- a/src/grt/grt-processes.ads +++ b/src/grt/grt-processes.ads @@ -124,7 +124,9 @@ package Grt.Processes is procedure Ghdl_Process_Wait_Exit; -- Wait for a timeout (without sensitivity): wait for X; - procedure Ghdl_Process_Wait_Timeout (Time : Std_Time); + procedure Ghdl_Process_Wait_Timeout (Time : Std_Time; + Filename : Ghdl_C_String; + Line : Ghdl_I32); -- Full wait statement: -- 1. Call Ghdl_Process_Wait_Set_Timeout (if there is a timeout) @@ -135,7 +137,9 @@ package Grt.Processes is -- 4. Call Ghdl_Process_Wait_Close -- Add a timeout for a wait. - procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time); + procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time; + Filename : Ghdl_C_String; + Line : Ghdl_I32); -- Add a sensitivity for a wait. procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr); -- Wait until timeout or sensitivity. diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 2d74663e5..0d10a3d80 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -3309,6 +3309,7 @@ package body Trans.Chap8 is Start_Association (Constr, Ghdl_Process_Wait_Timeout); New_Association (Constr, Chap7.Translate_Expression (Timeout, Time_Type_Definition)); + Assoc_Filename_Line (Constr, Get_Line_Number (Stmt)); New_Procedure_Call (Constr); Close_Temp; end if; @@ -3333,6 +3334,7 @@ package body Trans.Chap8 is Start_Association (Constr, Ghdl_Process_Wait_Set_Timeout); New_Association (Constr, Chap7.Translate_Expression (Timeout, Time_Type_Definition)); + Assoc_Filename_Line (Constr, Get_Line_Number (Stmt)); New_Procedure_Call (Constr); end if; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index ecf5c778a..42620ba91 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -1712,6 +1712,8 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"), Std_Time_Otype); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Timeout); -- void __ghdl_process_wait_set_timeout (time : std_time); @@ -1720,6 +1722,8 @@ package body Translation is O_Storage_External); New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"), Std_Time_Otype); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Set_Timeout); -- void __ghdl_process_wait_add_sensitivity (sig : __ghdl_signal_ptr); |