diff options
Diffstat (limited to 'src/vhdl')
-rw-r--r-- | src/vhdl/errorout.adb | 77 | ||||
-rw-r--r-- | src/vhdl/errorout.ads | 4 | ||||
-rw-r--r-- | src/vhdl/simulate/debugger.adb | 10 | ||||
-rw-r--r-- | src/vhdl/simulate/execution.adb | 2 |
4 files changed, 45 insertions, 48 deletions
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index 531dda4..5f55222 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -89,35 +89,6 @@ package body Errorout is Put (':'); end Disp_Location; - procedure Disp_Current_Location is - begin - Disp_Location (Scanner.Get_Current_File, - Scanner.Get_Current_Line, - Scanner.Get_Current_Column); - end Disp_Current_Location; - - procedure Disp_Token_Location is - begin - Disp_Location (Scanner.Get_Current_File, - Scanner.Get_Current_Line, - Scanner.Get_Token_Column); - end Disp_Token_Location; - - procedure Disp_Location (Loc : Location_Type) - is - Name : Name_Id; - Line : Natural; - Col : Natural; - begin - if Loc = Location_Nil then - -- Avoid a crash, but should not happen. - Put ("??:??:??:"); - else - Location_To_Position (Loc, Name, Line, Col); - Disp_Location (Name, Line, Col); - end if; - end Disp_Location; - procedure Disp_Program_Name is begin Put (Ada.Command_Line.Command_Name); @@ -127,34 +98,59 @@ package body Errorout is procedure Report_Msg (Level : Report_Level; Origin : Report_Origin; Loc : Location_Type; - Msg : String) is + Msg : String) + is + File : Name_Id; + Line : Natural; + Col : Natural; + Progname : Boolean; begin + -- By default, no location. + File := Null_Identifier; + Line := 0; + Col := 0; + + -- And no program name. + Progname := False; + case Origin is when Option | Library => - Disp_Program_Name; + Progname := True; when Elaboration => if Loc = No_Location then - Disp_Program_Name; + Progname := True; else - Disp_Location (Loc); + Location_To_Position (Loc, File, Line, Col); end if; when Scan => if Loc = No_Location then - Disp_Current_Location; + File := Scanner.Get_Current_File; + Line := Scanner.Get_Current_Line; + Col := Scanner.Get_Current_Column; else - Disp_Location (Loc); + Location_To_Position (Loc, File, Line, Col); end if; when Parse => if Loc = No_Location then - Disp_Token_Location; + File := Scanner.Get_Current_File; + Line := Scanner.Get_Current_Line; + Col := Scanner.Get_Token_Column; else - Disp_Location (Loc); + Location_To_Position (Loc, File, Line, Col); end if; when Semantic => - Disp_Location (Loc); + Location_To_Position (Loc, File, Line, Col); end case; + if Progname then + Disp_Program_Name; + elsif File /= Null_Identifier then + Disp_Location (File, Line, Col); + else + Put ("??:??:??:"); + end if; + case Level is when Note => Put ("note:"); @@ -194,11 +190,6 @@ package body Errorout is end if; end Get_Location_Safe; - procedure Disp_Iir_Location (An_Iir: Iir) is - begin - Disp_Location (Get_Location_Safe (An_Iir)); - end Disp_Iir_Location; - procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is begin if Flags.Flag_Only_Elab_Warnings then diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads index 876dec1..9dd70d2 100644 --- a/src/vhdl/errorout.ads +++ b/src/vhdl/errorout.ads @@ -54,10 +54,6 @@ package Errorout is -- Same as Error_Msg_Option but do not raise Option_Error. procedure Error_Msg_Option_NR (Msg: String); - -- Disp an error location (using AN_IIR location) using the standard - -- format `file:line:col: '. - procedure Disp_Iir_Location (An_Iir: Iir); - -- Disp a warning. procedure Warning_Msg_Sem (Msg: String; Loc : Iir); procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type); diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index b56efaf..a2532f2 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -123,6 +123,16 @@ package body Debugger is -- Current statement for next_stmt. Exec_Statement : Iir; + procedure Disp_Iir_Location (N : Iir) is + begin + if N = Null_Iir then + Put (Standard_Error, "??:??:??"); + else + Put (Standard_Error, Disp_Location (N)); + end if; + Put (Standard_Error, ": "); + end Disp_Iir_Location; + -- Disp a message during execution. procedure Error_Msg_Exec (Msg: String; Loc: in Iir) is begin diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index c1af588..ba97d3d 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -4124,7 +4124,7 @@ package body Execution is -- The error message consists of at least: -- 4: name of the design unit containing the assertion. - Disp_Iir_Location (Stmt); + Put (Standard_Error, Disp_Location (Stmt)); -- 1: an indication that this message is from an assertion. Put (Standard_Error, "(assertion "); |