aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ghdldrv/ghdlprint.adb2
-rw-r--r--src/libraries.adb12
-rw-r--r--src/vhdl/configuration.adb33
-rw-r--r--src/vhdl/errorout.adb226
-rw-r--r--src/vhdl/errorout.ads84
-rw-r--r--src/vhdl/evaluation.adb49
-rw-r--r--src/vhdl/ieee-vital_timing.adb2
-rw-r--r--src/vhdl/parse.adb95
-rw-r--r--src/vhdl/psl-errors.ads2
-rw-r--r--src/vhdl/scanner.adb71
-rw-r--r--src/vhdl/sem.adb31
-rw-r--r--src/vhdl/sem_decls.adb11
-rw-r--r--src/vhdl/sem_expr.adb10
-rw-r--r--src/vhdl/sem_names.adb10
-rw-r--r--src/vhdl/sem_specs.adb33
-rw-r--r--src/vhdl/sem_stmts.adb15
-rw-r--r--src/vhdl/simulate/elaboration.adb15
-rw-r--r--src/vhdl/simulate/execution.adb4
-rw-r--r--src/vhdl/translate/trans-chap7.adb6
19 files changed, 464 insertions, 247 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index f9b814404..04f2ba4ee 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -240,7 +240,7 @@ package body Ghdlprint is
Ref := Find (Loc);
if Ref = Bad_Xref then
Disp_Text;
- Warning_Msg_Sem ("cannot find xref", Loc, Warnid_Missing_Xref);
+ Warning_Msg_Sem (Warnid_Missing_Xref, Loc, "cannot find xref");
Missing_Xref := True;
return;
end if;
diff --git a/src/libraries.adb b/src/libraries.adb
index 71ae71e46..0a91dbc8c 100644
--- a/src/libraries.adb
+++ b/src/libraries.adb
@@ -1007,12 +1007,14 @@ package body Libraries is
-- Warns only if we are not re-analyzing the file.
if Is_Warning_Enabled (Warnid_Library) then
Warning_Msg_Sem
- ("redefinition of a library unit in "
- & "same design file:", Unit, Warnid_Library);
+ (Warnid_Library, +Unit,
+ "redefinition of a library unit in "
+ & "same design file:");
Warning_Msg_Sem
- (Disp_Node (Library_Unit) & " defined at "
- & Disp_Location (Library_Unit) & " is now "
- & Disp_Node (New_Library_Unit), Unit, Warnid_Library);
+ (Warnid_Library, +Unit,
+ Disp_Node (Library_Unit) & " defined at "
+ & Disp_Location (Library_Unit) & " is now "
+ & Disp_Node (New_Library_Unit));
end if;
else
-- Free the stub.
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index 671514e46..5e9bafc99 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -197,8 +197,9 @@ package body Configuration is
if not Flags.Flag_Elaborate_With_Outdated then
-- LIB_UNIT requires a body.
if Bod = Null_Iir then
- Error_Msg_Elab ("body of " & Disp_Node (Lib_Unit)
- & " was never analyzed", Lib_Unit);
+ Error_Msg_Elab
+ (Lib_Unit, "body of " & Disp_Node (Lib_Unit)
+ & " was never analyzed");
elsif Get_Date (Bod) < Get_Date (Unit) then
Error_Msg_Elab (Disp_Node (Bod) & " is outdated");
Bod := Null_Iir;
@@ -321,8 +322,8 @@ package body Configuration is
else
Arch := Get_Latest_Architecture (Entity_Lib);
if Arch = Null_Iir then
- Error_Msg_Elab ("no architecture in library for "
- & Disp_Node (Entity_Lib), Aspect);
+ Error_Msg_Elab (Aspect, "no architecture in library for "
+ & Disp_Node (Entity_Lib));
return;
end if;
Arch := Get_Design_Unit (Arch);
@@ -372,7 +373,7 @@ package body Configuration is
if Get_Default_Value (Port) = Null_Iir then
if Loc /= Null_Iir then
Error_Msg_Elab
- ("IN " & Disp_Node (Port) & " must be connected", Loc);
+ (Loc, "IN " & Disp_Node (Port) & " must be connected");
end if;
return True;
end if;
@@ -389,8 +390,8 @@ package body Configuration is
/= Fully_Constrained)
then
if Loc /= Null_Iir then
- Error_Msg_Elab ("unconstrained " & Disp_Node (Port)
- & " must be connected", Loc);
+ Error_Msg_Elab (Loc, "unconstrained " & Disp_Node (Port)
+ & " must be connected");
end if;
return True;
end if;
@@ -429,11 +430,12 @@ package body Configuration is
and then not Get_Artificial_Flag (Assoc)
then
Warning_Msg_Elab
- (Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
- & " is not bound", Assoc, Warnid_Binding);
+ (Warnid_Binding, Assoc,
+ Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
+ & " is not bound", Cont => True);
Warning_Msg_Elab
- ("(in " & Disp_Node (Current_Configuration) & ")",
- Current_Configuration, Warnid_Binding);
+ (Warnid_Binding, Current_Configuration,
+ "(in " & Disp_Node (Current_Configuration) & ")");
end if;
end if;
Assoc := Get_Chain (Assoc);
@@ -522,10 +524,11 @@ package body Configuration is
if Is_Warning_Enabled (Warnid_Binding) then
Inst := Get_First_Element (Get_Instantiation_List (Conf));
Warning_Msg_Elab
- (Disp_Node (Inst) & " is not bound", Conf, Warnid_Binding);
+ (Warnid_Binding, Conf,
+ Disp_Node (Inst) & " is not bound", Cont => True);
Warning_Msg_Elab
- ("(in " & Disp_Node (Current_Configuration) & ")",
- Current_Configuration, Warnid_Binding);
+ (Warnid_Binding, Current_Configuration,
+ "(in " & Disp_Node (Current_Configuration) & ")");
end if;
return;
end if;
@@ -707,7 +710,7 @@ package body Configuration is
(Disp_Node (Entity) & " cannot be at the top of a design");
Has_Error := True;
end if;
- Error_Msg_Elab (Msg, Loc);
+ Error_Msg_Elab (Loc, Msg);
end Error;
El : Iir;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 680160098..afb7be49d 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -75,6 +75,42 @@ package body Errorout is
return Res;
end Warning_Image;
+ function "+" (V : Iir) return Earg_Type is
+ begin
+ return (Kind => Earg_Iir, Val_Iir => V);
+ end "+";
+
+ function "+" (V : Location_Type) return Earg_Type is
+ begin
+ return (Kind => Earg_Location, Val_Loc => V);
+ end "+";
+
+ function "+" (V : Name_Id) return Earg_Type is
+ begin
+ return (Kind => Earg_Id, Val_Id => V);
+ end "+";
+
+ function "+" (V : Tokens.Token_Type) return Earg_Type is
+ begin
+ return (Kind => Earg_Token, Val_Tok => V);
+ end "+";
+
+ function "+" (V : Character) return Earg_Type is
+ begin
+ return (Kind => Earg_Char, Val_Char => V);
+ end "+";
+
+ function Get_Location_Safe (N : Iir) return Location_Type is
+ begin
+ if N = Null_Iir then
+ return Location_Nil;
+ else
+ return Get_Location (N);
+ end if;
+ end Get_Location_Safe;
+
+ function "+" (L : Iir) return Location_Type renames Get_Location_Safe;
+
procedure Put (Str : String)
is
use Ada.Text_IO;
@@ -146,8 +182,11 @@ package body Errorout is
procedure Report_Msg (Id : Msgid_Type;
Origin : Report_Origin;
Loc : Location_Type;
- Msg : String)
+ Msg : String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False)
is
+ pragma Unreferenced (Cont);
procedure Location_To_Position (Location : Location_Type;
File : out Source_File_Entry;
Line : out Natural;
@@ -234,7 +273,127 @@ package body Errorout is
end case;
Put (' ');
- Put_Line (Msg);
+
+ -- Display message.
+ declare
+ First, N : Positive;
+ Argn : Integer;
+ begin
+ N := Msg'First;
+ First := N;
+ Argn := Args'First;
+ while N <= Msg'Last loop
+ if Msg (N) = '%' then
+ Put (Msg (First .. N - 1));
+ First := N + 2;
+ pragma Assert (N < Msg'Last);
+ N := N + 1;
+ case Msg (N) is
+ when '%' =>
+ Put ('%');
+ Argn := Argn - 1;
+ when 'i' =>
+ -- Identifier.
+ declare
+ Arg : Earg_Type renames Args (Argn);
+ Id : Name_Id;
+ begin
+ Put ('"');
+ case Arg.Kind is
+ when Earg_Iir =>
+ Id := Get_Identifier (Arg.Val_Iir);
+ when Earg_Id =>
+ Id := Arg.Val_Id;
+ when others =>
+ -- Invalid conversion to identifier.
+ raise Internal_Error;
+ end case;
+ Put (Name_Table.Image (Id));
+ Put ('"');
+ end;
+ when 'c' =>
+ -- Character
+ declare
+ Arg : Earg_Type renames Args (Argn);
+ begin
+ Put (''');
+ case Arg.Kind is
+ when Earg_Char =>
+ Put (Arg.Val_Char);
+ when others =>
+ -- Invalid conversion to character.
+ raise Internal_Error;
+ end case;
+ Put (''');
+ end;
+ when 't' =>
+ -- A token
+ declare
+ use Tokens;
+ Arg : Earg_Type renames Args (Argn);
+ Tok : Token_Type;
+ begin
+ case Arg.Kind is
+ when Earg_Token =>
+ Tok := Arg.Val_Tok;
+ when others =>
+ -- Invalid conversion to character.
+ raise Internal_Error;
+ end case;
+ if Tok = Tok_Identifier then
+ Put ("an identifier");
+ else
+ Put (''');
+ Put (Image (Tok));
+ Put (''');
+ end if;
+ end;
+ when 'l' =>
+ -- Location
+ declare
+ Arg : Earg_Type renames Args (Argn);
+ Arg_Loc : Location_Type;
+ Arg_File : Source_File_Entry;
+ Arg_Line : Natural;
+ Arg_Col : Natural;
+ begin
+ pragma Assert (not Progname);
+ case Arg.Kind is
+ when Earg_Location =>
+ Arg_Loc := Arg.Val_Loc;
+ when Earg_Iir =>
+ Arg_Loc := Get_Location (Arg.Val_Iir);
+ when others =>
+ raise Internal_Error;
+ end case;
+ Location_To_Position
+ (Arg_Loc, Arg_File, Arg_Line, Arg_Col);
+
+ -- Do not print the filename if in the same file as
+ -- the error location.
+ if Arg_File = File then
+ Put ("line ");
+ else
+ Put (Name_Table.Image (Get_File_Name (Arg_File)));
+ Put (':');
+ end if;
+ Disp_Natural (Arg_Line);
+ Put (':');
+ Disp_Natural (Arg_Col);
+ end;
+ when others =>
+ -- Unknown format.
+ raise Internal_Error;
+ end case;
+ Argn := Argn + 1;
+ end if;
+ N := N + 1;
+ end loop;
+ Put_Line (Msg (First .. N - 1));
+
+ -- Are all arguments displayed ?
+ pragma Assert (Argn > Args'Last);
+ end;
if Flag_Show_Caret
and then (File /= No_Source_File_Entry and Line /= 0)
@@ -269,17 +428,8 @@ package body Errorout is
raise Option_Error;
end Error_Msg_Option;
- function Get_Location_Safe (N : Iir) return Location_Type is
- begin
- if N = Null_Iir then
- return Location_Nil;
- else
- return Get_Location (N);
- end if;
- end Get_Location_Safe;
-
procedure Warning_Msg_Sem
- (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
+ (Id : Msgid_Warnings; Loc : Location_Type; Msg: String) is
begin
if Flags.Flag_Only_Elab_Warnings then
return;
@@ -287,20 +437,10 @@ package body Errorout is
Report_Msg (Id, Semantic, Loc, Msg);
end Warning_Msg_Sem;
- procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
- begin
- Warning_Msg_Sem (Msg, Get_Location_Safe (Loc), Id);
- end Warning_Msg_Sem;
-
procedure Warning_Msg_Elab
- (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
- begin
- Report_Msg (Id, Elaboration, Loc, Msg);
- end Warning_Msg_Elab;
-
- procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
+ (Id : Msgid_Warnings; Loc : Iir; Msg: String; Cont : Boolean := False) is
begin
- Warning_Msg_Elab (Msg, Get_Location_Safe (Loc), Id);
+ Report_Msg (Id, Elaboration, Get_Location_Safe (Loc), Msg, Cont => Cont);
end Warning_Msg_Elab;
-- Disp a message during scan.
@@ -309,29 +449,47 @@ package body Errorout is
Report_Msg (Msgid_Error, Scan, No_Location, Msg);
end Error_Msg_Scan;
- procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is
+ procedure Error_Msg_Scan (Loc : Location_Type; Msg: String) is
begin
Report_Msg (Msgid_Error, Scan, Loc, Msg);
end Error_Msg_Scan;
+ procedure Error_Msg_Scan (Msg: String; Arg1 : Earg_Type) is
+ begin
+ Report_Msg (Msgid_Error, Scan, No_Location, Msg, (1 => Arg1));
+ end Error_Msg_Scan;
+
-- Disp a message during scan.
- procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings) is
+ procedure Warning_Msg_Scan (Id : Msgid_Warnings; Msg: String) is
begin
Report_Msg (Id, Scan, No_Location, Msg);
end Warning_Msg_Scan;
- -- Disp a message during scan.
- procedure Error_Msg_Parse (Msg: String) is
+ procedure Warning_Msg_Scan (Id : Msgid_Warnings;
+ Msg: String;
+ Arg1 : Earg_Type;
+ Cont : Boolean := False) is
begin
- Report_Msg (Msgid_Error, Parse, No_Location, Msg);
+ Report_Msg (Id, Scan, No_Location, Msg, (1 => Arg1), Cont);
+ end Warning_Msg_Scan;
+
+ procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type) is
+ begin
+ Report_Msg (Msgid_Error, Parse, No_Location, Msg, (1 => Arg1));
end Error_Msg_Parse;
- procedure Error_Msg_Parse (Msg: String; Loc : Iir) is
+ procedure Error_Msg_Parse
+ (Msg: String; Args : Earg_Arr := No_Eargs; Cont : Boolean := False) is
begin
- Report_Msg (Msgid_Error, Parse, Get_Location_Safe (Loc), Msg);
+ Report_Msg (Msgid_Error, Parse, No_Location, Msg, Args, Cont);
end Error_Msg_Parse;
- procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is
+ procedure Error_Msg_Parse_1 (Msg: String) is
+ begin
+ Report_Msg (Msgid_Error, Parse, No_Location, Msg);
+ end Error_Msg_Parse_1;
+
+ procedure Error_Msg_Parse (Loc : Location_Type; Msg: String) is
begin
Report_Msg (Msgid_Error, Parse, Loc, Msg);
end Error_Msg_Parse;
@@ -375,7 +533,7 @@ package body Errorout is
Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg);
end Error_Msg_Relaxed;
- procedure Error_Msg_Sem_Relaxed (Msg : String; Loc : Iir) is
+ procedure Error_Msg_Sem_Relaxed (Loc : Iir; Msg : String) is
begin
Error_Msg_Relaxed (Semantic, Msg, Loc);
end Error_Msg_Sem_Relaxed;
@@ -386,7 +544,7 @@ package body Errorout is
Report_Msg (Msgid_Error, Elaboration, No_Location, Msg);
end Error_Msg_Elab;
- procedure Error_Msg_Elab (Msg: String; Loc : Iir) is
+ procedure Error_Msg_Elab (Loc : Iir; Msg: String) is
begin
Report_Msg (Msgid_Error, Elaboration, Get_Location_Safe (Loc), Msg);
end Error_Msg_Elab;
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index c1d219011..16f26df22 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
with Types; use Types;
with Iirs; use Iirs;
+with Tokens;
package Errorout is
Option_Error: exception;
@@ -110,6 +111,28 @@ package Errorout is
-- Get enable status of a warning.
function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;
+ type Earg_Type is private;
+ type Earg_Arr is array (Natural range <>) of Earg_Type;
+
+ -- An empty array (for no arguments).
+ No_Eargs : constant Earg_Arr;
+
+ -- Report display:
+ -- %%: %
+ -- %i: identifier
+ -- %c: character
+ -- %t: token
+ -- %l: location
+ function "+" (V : Iir) return Earg_Type;
+ function "+" (V : Location_Type) return Earg_Type;
+ function "+" (V : Name_Id) return Earg_Type;
+ function "+" (V : Tokens.Token_Type) return Earg_Type;
+ function "+" (V : Character) return Earg_Type;
+
+ -- Convert location.
+ function "+" (L : Iir) return Location_Type;
+
+ -- Pass that detected the error.
type Report_Origin is
(Option, Library, Scan, Parse, Semantic, Elaboration);
@@ -119,7 +142,9 @@ package Errorout is
procedure Report_Msg (Id : Msgid_Type;
Origin : Report_Origin;
Loc : Location_Type;
- Msg : String);
+ Msg : String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False);
-- Disp an error, prepended with program name, and raise option_error.
-- This is used for errors before initialisation, such as bad option or
@@ -130,39 +155,44 @@ package Errorout is
-- Same as Error_Msg_Option but do not raise Option_Error.
procedure Error_Msg_Option_NR (Msg: String);
- -- Disp a warning.
- procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings);
- procedure Warning_Msg_Sem
- (Msg: String; Loc : Location_Type; Id : Msgid_Warnings);
-
-- Disp a message during scan.
-- The current location is automatically displayed before the message.
procedure Error_Msg_Scan (Msg: String);
- procedure Error_Msg_Scan (Msg: String; Loc : Location_Type);
- procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings);
+ procedure Error_Msg_Scan (Msg: String; Arg1 : Earg_Type);
+ procedure Error_Msg_Scan (Loc : Location_Type; Msg: String);
+ procedure Warning_Msg_Scan (Id : Msgid_Warnings; Msg: String);
+ procedure Warning_Msg_Scan (Id : Msgid_Warnings;
+ Msg: String;
+ Arg1 : Earg_Type;
+ Cont : Boolean := False);
-- Disp a message during parse
-- The location of the current token is automatically displayed before
-- the message.
- procedure Error_Msg_Parse (Msg: String);
- procedure Error_Msg_Parse (Msg: String; Loc : Iir);
- procedure Error_Msg_Parse (Msg: String; Loc : Location_Type);
+ procedure Error_Msg_Parse_1 (Msg: String);
+ procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type);
+ procedure Error_Msg_Parse
+ (Msg: String; Args : Earg_Arr := No_Eargs; Cont : Boolean := False);
+ procedure Error_Msg_Parse (Loc : Location_Type; Msg: String);
-- Disp a message during semantic analysis.
- -- an_iir is used for location and current token.
+ procedure Warning_Msg_Sem
+ (Id : Msgid_Warnings; Loc : Location_Type; Msg: String);
+
procedure Error_Msg_Sem (Msg: String; Loc: Iir);
procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node);
procedure Error_Msg_Sem (Msg: String; Loc: Location_Type);
-- Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c.
- procedure Error_Msg_Sem_Relaxed (Msg : String; Loc : Iir);
+ procedure Error_Msg_Sem_Relaxed (Loc : Iir; Msg : String);
-- Disp a message during elaboration (or configuration).
procedure Error_Msg_Elab (Msg: String);
- procedure Error_Msg_Elab (Msg: String; Loc: Iir);
+ procedure Error_Msg_Elab (Loc: Iir; Msg: String);
-- Disp a warning durig elaboration (or configuration).
- procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings);
+ procedure Warning_Msg_Elab
+ (Id : Msgid_Warnings; Loc : Iir; Msg: String; Cont : Boolean := False);
-- Disp a bug message.
procedure Error_Internal (Expr: Iir; Msg: String := "");
@@ -207,4 +237,28 @@ package Errorout is
-- Disp interface mode MODE.
function Get_Mode_Name (Mode : Iir_Mode) return String;
+
+private
+ type Earg_Kind is
+ (Earg_None,
+ Earg_Iir, Earg_Location, Earg_Id, Earg_Char, Earg_Token);
+
+ type Earg_Type (Kind : Earg_Kind := Earg_None) is record
+ case Kind is
+ when Earg_None =>
+ null;
+ when Earg_Iir =>
+ Val_Iir : Iir;
+ when Earg_Location =>
+ Val_Loc : Location_Type;
+ when Earg_Id =>
+ Val_Id : Name_Id;
+ when Earg_Char =>
+ Val_Char : Character;
+ when Earg_Token =>
+ Val_Tok : Tokens.Token_Type;
+ end case;
+ end record;
+
+ No_Eargs : constant Earg_Arr := (1 .. 0 => (Kind => Earg_None));
end Errorout;
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index e0b52fd9f..952f05cd0 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -560,8 +560,8 @@ package body Evaluation is
exception
when Constraint_Error =>
-- Can happen for absolute.
- Warning_Msg_Sem ("arithmetic overflow in static expression",
- Orig, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Orig,
+ "arithmetic overflow in static expression");
return Build_Overflow (Orig);
end Eval_Monadic_Operator;
@@ -580,8 +580,8 @@ package body Evaluation is
begin
Len := Get_String_Length (Left);
if Len /= Get_String_Length (Right) then
- Warning_Msg_Sem ("length of left and right operands mismatch",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "length of left and right operands mismatch");
return Build_Overflow (Expr);
else
Id := Create_String8;
@@ -680,7 +680,7 @@ package body Evaluation is
is
begin
if Get_Value (Val) = 0 then
- Warning_Msg_Sem ("division by 0", Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr, "division by 0");
return False;
else
return True;
@@ -1127,8 +1127,8 @@ package body Evaluation is
(Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig);
when Iir_Predefined_Floating_Div =>
if Get_Fp_Value (Right) = 0.0 then
- Warning_Msg_Sem ("right operand of division is 0",
- Orig, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Orig,
+ "right operand of division is 0");
return Build_Overflow (Orig);
else
return Build_Floating
@@ -1455,8 +1455,8 @@ package body Evaluation is
end case;
exception
when Constraint_Error =>
- Warning_Msg_Sem ("arithmetic overflow in static expression",
- Orig, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Orig,
+ "arithmetic overflow in static expression");
return Build_Overflow (Orig);
end Eval_Dyadic_Operator;
@@ -1649,8 +1649,9 @@ package body Evaluation is
if Res /= Null_Iir then
return Build_Constant (Res, Expr);
else
- Warning_Msg_Sem ("value """ & Value & """ not in enumeration "
- & Disp_Node (Enum), Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "value """ & Value & """ not in enumeration "
+ & Disp_Node (Enum));
return Build_Overflow (Expr);
end if;
end Build_Enumeration_Value;
@@ -1723,9 +1724,9 @@ package body Evaluation is
Unit := Get_Chain (Unit);
end loop;
if Unit = Null_Iir then
- Warning_Msg_Sem ("Unit """ & UnitName (Sep + 1 .. UnitName'Last)
- & """ not in physical type",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "Unit """ & UnitName (Sep + 1 .. UnitName'Last)
+ & """ not in physical type");
return Build_Overflow (Expr);
end if;
@@ -1808,8 +1809,8 @@ package body Evaluation is
(Get_Enumeration_Literal_List
(Get_Base_Type (Get_Type (Expr))))))
then
- Warning_Msg_Sem ("static constant violates bounds",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "static constant violates bounds");
return Build_Overflow (Origin);
else
return Build_Enumeration (Iir_Index32 (P), Origin);
@@ -1867,8 +1868,8 @@ package body Evaluation is
if Get_Constraint_State (Conv_Type) = Fully_Constrained then
Set_Type (Res, Conv_Type);
if not Eval_Is_In_Bound (Val, Conv_Type) then
- Warning_Msg_Sem ("non matching length in type conversion",
- Conv, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Conv,
+ "non matching length in type conversion");
return Build_Overflow (Conv);
end if;
return Res;
@@ -1937,8 +1938,8 @@ package body Evaluation is
end if;
if not Eval_Is_In_Bound (Res, Get_Type (Expr)) then
if Get_Kind (Res) /= Iir_Kind_Overflow_Literal then
- Warning_Msg_Sem ("result of conversion out of bounds",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "result of conversion out of bounds");
Res := Build_Overflow (Res);
end if;
end if;
@@ -2124,8 +2125,8 @@ package body Evaluation is
and then
not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type))
then
- Warning_Msg_Sem ("static argument out of the type range",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "static argument out of the type range");
return Build_Overflow (Expr);
end if;
if Get_Kind (Get_Base_Type (Get_Type (Expr)))
@@ -2173,8 +2174,8 @@ package body Evaluation is
Set_Parameter (Expr, Param);
if Get_Kind (Param) /= Iir_Kind_String_Literal8 then
-- FIXME: Isn't it an implementation restriction.
- Warning_Msg_Sem ("'value argument not a string",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "'value argument not a string");
return Build_Overflow (Expr);
else
return Eval_Value_Attribute
diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
index fb92efaf7..5f5af94b6 100644
--- a/src/vhdl/ieee-vital_timing.adb
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -191,7 +191,7 @@ package body Ieee.Vital_Timing is
procedure Warning_Vital (Msg : String; Loc : Iir) is
begin
- Warning_Msg_Sem (Msg, Loc, Warnid_Vital_Generic);
+ Warning_Msg_Sem (Warnid_Vital_Generic, +Loc, Msg);
end Warning_Vital;
-- Check DECL is the VITAL level 0 attribute specification.
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index 6991b8c7b..92e0f5851 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -25,7 +25,6 @@ with Flags; use Flags;
with Parse_Psl;
with Name_Table;
with Str_Table;
-with Files_Map; use Files_Map;
with Xrefs;
-- Recursive descendant parser.
@@ -87,7 +86,7 @@ package body Parse is
procedure Unexpected (Where: String) is
begin
Error_Msg_Parse
- ("unexpected token '" & Image (Current_Token) & "' in a " & Where);
+ ("unexpected token %t in a " & Where, +Current_Token);
end Unexpected;
-- procedure Unexpected_Eof is
@@ -102,16 +101,14 @@ package body Parse is
begin
if Current_Token /= Token then
if Msg'Length > 0 then
- Error_Msg_Parse (Msg);
- Error_Msg_Parse ("(found: " & Image (Current_Token) & ")");
+ Error_Msg_Parse (Msg, Args => No_Eargs, Cont => True);
+ Error_Msg_Parse ("(found: %t)", +Current_Token);
elsif Current_Token = Tok_Identifier then
Error_Msg_Parse
- (''' & Image(Token) & "' is expected instead of '"
- & Name_Table.Image (Current_Identifier) & ''');
+ ("%t is expected instead of %i", (+Token, +Current_Identifier));
else
Error_Msg_Parse
- (''' & Image(Token) & "' is expected instead of '"
- & Image (Current_Token) & ''');
+ ("%t is expected instead of %t", (+Token, + Current_Token));
end if;
raise Expect_Error;
end if;
@@ -142,8 +139,7 @@ package body Parse is
("end label for an unlabeled declaration or statement");
else
if Current_Identifier /= Name then
- Error_Msg_Parse
- ("mispelling, """ & Name_Table.Image (Name) & """ expected");
+ Error_Msg_Parse ("mispelling, %i expected", +Name);
else
Set_End_Has_Identifier (Decl, True);
Xrefs.Xref_End (Get_Token_Location, Decl);
@@ -168,8 +164,7 @@ package body Parse is
else
Scan;
if Current_Token /= Tok then
- Error_Msg_Parse
- ("""end"" must be followed by """ & Image (Tok) & """");
+ Error_Msg_Parse ("""end"" must be followed by %t", +Tok);
else
Set_End_Has_Reserved_Id (Decl, True);
Scan;
@@ -434,15 +429,15 @@ package body Parse is
procedure Bad_Operator_Symbol is
begin
- Error_Msg_Parse ("""" & Str_Table.String_String8 (Str_Id, Len)
- & """ is not an operator symbol", Loc);
+ Error_Msg_Parse (Loc, """" & Str_Table.String_String8 (Str_Id, Len)
+ & """ is not an operator symbol");
end Bad_Operator_Symbol;
procedure Check_Vhdl93 is
begin
if Flags.Vhdl_Std = Vhdl_87 then
- Error_Msg_Parse ("""" & Str_Table.String_String8 (Str_Id, Len)
- & """ is not a vhdl87 operator symbol", Loc);
+ Error_Msg_Parse (Loc, """" & Str_Table.String_String8 (Str_Id, Len)
+ & """ is not a vhdl87 operator symbol");
end if;
end Check_Vhdl93;
@@ -1015,7 +1010,7 @@ package body Parse is
Scan;
when others =>
Error_Msg_Parse
- ("constant, signal or variable expected after <<");
+ ("constant, signal or variable expected after '<<'");
Kind := Iir_Kind_External_Signal_Name;
end case;
@@ -1099,7 +1094,7 @@ package body Parse is
| Iir_Kind_Selected_Name =>
null;
when others =>
- Error_Msg_Parse ("type mark must be a name of a type", Mark);
+ Error_Msg_Parse (+Mark, "type mark must be a name of a type");
end case;
end Check_Type_Mark;
@@ -1505,10 +1500,10 @@ package body Parse is
when Tok_Right_Paren =>
if Res = Null_Iir then
Error_Msg_Parse
- ("empty interface list not allowed", Prev_Loc);
+ (Prev_Loc, "empty interface list not allowed");
else
Error_Msg_Parse
- ("extra ';' at end of interface list", Prev_Loc);
+ (Prev_Loc, "extra ';' at end of interface list");
end if;
exit;
when others =>
@@ -1578,7 +1573,7 @@ package body Parse is
El := Res;
while El /= Null_Iir loop
if Get_Kind (El) /= Iir_Kind_Interface_Signal_Declaration then
- Error_Msg_Parse ("port must be a signal", El);
+ Error_Msg_Parse (+El, "port must be a signal");
end if;
El := Get_Chain (El);
end loop;
@@ -2284,8 +2279,8 @@ package body Parse is
Error_Msg_Parse ("protected type not allowed in vhdl87/93");
Decl := Parse_Protected_Type_Definition (Ident, Loc);
else
- Error_Msg_Parse ("type '" & Name_Table.Image (Ident) &
- "' cannot be defined from another type");
+ Error_Msg_Parse ("type %i cannot be defined from another type",
+ (1 => +Ident), Cont => True);
Error_Msg_Parse ("(you should declare a subtype)");
Decl := Create_Iir (Iir_Kind_Type_Declaration);
Eat_Tokens_Until_Semi_Colon;
@@ -2376,7 +2371,7 @@ package body Parse is
if Get_Kind (Ind) = Iir_Kind_Simple_Name then
Id := Get_Identifier (Ind);
else
- Error_Msg_Parse ("element name expected", Ind);
+ Error_Msg_Parse (+Ind, "element name expected");
Id := Null_Identifier;
end if;
Free_Iir (Ind);
@@ -3411,8 +3406,7 @@ package body Parse is
| Tok_File =>
null;
when others =>
- Error_Msg_Parse
- (''' & Tokens.Image (Current_Token) & "' is not a entity class");
+ Error_Msg_Parse ("%t is not a entity class", +Current_Token);
end case;
Res := Current_Token;
Scan;
@@ -3770,8 +3764,8 @@ package body Parse is
then
case Get_Kind (Parent) is
when Iir_Kind_Package_Declaration =>
- Error_Msg_Parse ("protected type body not allowed "
- & "in package declaration", Decl);
+ Error_Msg_Parse (+Decl, "protected type body not "
+ & "allowed in package declaration");
when others =>
null;
end case;
@@ -3939,7 +3933,7 @@ package body Parse is
Scan;
if Current_Token = Tok_Entity then
if Flags.Vhdl_Std = Vhdl_87 then
- Error_Msg_Parse ("""entity"" keyword not allowed here by vhdl 87");
+ Error_Msg_Parse ("'entity' keyword not allowed here by vhdl 87");
end if;
Set_End_Has_Reserved_Id (Res, True);
Scan;
@@ -4072,8 +4066,8 @@ package body Parse is
-- Parenthesis around aggregate is useless and change the
-- context for array aggregate.
Warning_Msg_Sem
- ("suspicious parenthesis around aggregate",
- Expr, Warnid_Parenthesis);
+ (Warnid_Parenthesis, +Expr,
+ "suspicious parenthesis around aggregate");
elsif not Flag_Parse_Parenthesis then
return Expr;
end if;
@@ -4088,8 +4082,8 @@ package body Parse is
-- Surely a missing parenthesis.
-- FIXME: in case of multiple missing parenthesises, several
-- messages will be displayed
- Error_Msg_Parse ("missing ')' for opening parenthesis at "
- & Image (Loc, Filename => False));
+ Error_Msg_Parse
+ ("missing ')' for opening parenthesis at %l", +Loc);
return Expr;
when others =>
-- Surely a parse error...
@@ -4251,7 +4245,7 @@ package body Parse is
if Is_Signed then
if Old_Len = 0 then
Error_Msg_Parse
- ("cannot expand an empty signed bit string", Lit);
+ (+Lit, "cannot expand an empty signed bit string");
C := Character'Pos ('0');
else
C := Element_String8 (Id, 1);
@@ -4297,7 +4291,7 @@ package body Parse is
for I in 1 .. Old_Len - Nlen loop
if Element_String8 (Id, I) /= C then
Error_Msg_Parse
- ("truncation of bit string changes the value", Lit);
+ (+Lit, "truncation of bit string changes the value");
-- Avoid error storm.
exit;
end if;
@@ -4410,7 +4404,7 @@ package body Parse is
| Tok_Double_Less =>
Res := Parse_Name (Allow_Indexes => True);
if Get_Kind (Res) = Iir_Kind_Signature then
- Error_Msg_Parse ("signature not allowed in expression", Res);
+ Error_Msg_Parse (+Res, "signature not allowed in expression");
return Get_Signature_Prefix (Res);
else
return Res;
@@ -4458,8 +4452,8 @@ package body Parse is
Resize_Bit_String (Res, Nat32 (Int));
else
Error_Msg_Parse
- ("space is required between number and unit name",
- Get_Token_Location);
+ (Get_Token_Location,
+ "space is required between number and unit name");
Res := Parse_Integer_Literal (Int);
end if;
Set_Location (Res, Loc);
@@ -4825,8 +4819,10 @@ package body Parse is
-- operator...
-- TODO: avoid repetition of this message ?
if Op_Token = Tok_Nand or Op_Token = Tok_Nor then
- Error_Msg_Parse ("sequence of 'nor' or 'nand' not allowed");
- Error_Msg_Parse ("('nor' and 'nand' are not associative)");
+ Error_Msg_Parse
+ ("sequence of 'nor' or 'nand' not allowed", Cont => True);
+ Error_Msg_Parse
+ ("('nor' and 'nand' are not associative)");
end if;
if Op_Token /= Current_Token then
-- Expression is a sequence of relations, with the same
@@ -4842,7 +4838,7 @@ package body Parse is
-- Catch errors for Ada programmers.
if Current_Token = Tok_Then or Current_Token = Tok_Else then
Error_Msg_Parse ("""or else"" and ""and then"" sequences "
- & "are not allowed in vhdl");
+ & "are not allowed in vhdl", Cont => True);
Error_Msg_Parse ("""and"" and ""or"" are short-circuit "
& "operators for BIT and BOOLEAN types");
Scan;
@@ -5558,8 +5554,8 @@ package body Parse is
return Parenthesis_Name_To_Procedure_Call
(Target, Iir_Kind_Procedure_Call_Statement);
else
- Error_Msg_Parse ("""<="" or "":="" expected instead of "
- & Image (Current_Token));
+ Error_Msg_Parse
+ ("""<="" or "":="" expected instead of %t", +Current_Token);
Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement);
Call := Create_Iir (Iir_Kind_Procedure_Call);
Set_Prefix (Call, Target);
@@ -5980,8 +5976,10 @@ package body Parse is
if Current_Token = Tok_Return then
if Kind = Iir_Kind_Procedure_Declaration then
- Error_Msg_Parse ("'return' not allowed for a procedure");
- Error_Msg_Parse ("(remove return part or define a function)");
+ Error_Msg_Parse
+ ("'return' not allowed for a procedure", Cont => True);
+ Error_Msg_Parse
+ ("(remove return part or declare a function)");
-- Skip 'return'
Scan;
@@ -6192,7 +6190,7 @@ package body Parse is
-- parenthesis.
null;
when others =>
- Error_Msg_Parse ("incorrect formal name", Formal);
+ Error_Msg_Parse (+Formal, "incorrect formal name");
end case;
end Check_Formal_Form;
@@ -6370,7 +6368,8 @@ package body Parse is
begin
if Flags.Vhdl_Std = Vhdl_87 then
Error_Msg_Parse
- ("component instantiation using keyword 'component', 'entity',");
+ ("component instantiation using keyword 'component', 'entity',",
+ Cont => True);
Error_Msg_Parse (" or 'configuration' is not allowed in vhdl87");
end if;
@@ -8263,7 +8262,7 @@ package body Parse is
Set_Identifier (Res, Get_Identifier (Name));
else
Set_Location (Res, Loc);
- Error_Msg_Parse ("identifier for context expected", Name);
+ Error_Msg_Parse (+Name, "identifier for context expected");
end if;
Free_Iir (Name);
diff --git a/src/vhdl/psl-errors.ads b/src/vhdl/psl-errors.ads
index 7742dcfef..c172ab80b 100644
--- a/src/vhdl/psl-errors.ads
+++ b/src/vhdl/psl-errors.ads
@@ -10,7 +10,7 @@ package PSL.Errors is
Errorout.Error_Kind;
procedure Error_Msg_Parse (Msg: String)
- renames Errorout.Error_Msg_Parse;
+ renames Errorout.Error_Msg_Parse_1;
procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
renames Errorout.Error_Msg_Sem;
end PSL.Errors;
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index 7c5dbdd00..40fe9a4e7 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -422,10 +422,8 @@ package body Scanner is
-- as the remainder operator, instead of 'rem'. This will
-- improve the error message.
Error_Msg_Scan
- ("'%' is not a vhdl operator, use 'rem'",
- File_Pos_To_Location
- (Current_Context.Source_File,
- Current_Context.Token_Pos));
+ (Get_Token_Location,
+ "'%%' is not a vhdl operator, use 'rem'");
Current_Token := Tok_Rem;
Pos := Current_Context.Token_Pos + 1;
return;
@@ -448,7 +446,7 @@ package body Scanner is
-- that the enclosed sequence of characters constains no quotation
-- marks, and provided that both string brackets are replaced.
Error_Msg_Scan
- ("'""' cannot be used in a string delimited with '%'");
+ ("'""' cannot be used in a string delimited with '%%'");
end if;
Length := Length + 1;
@@ -537,12 +535,12 @@ package body Scanner is
when '"' =>
pragma Assert (Mark = '%');
Error_Msg_Scan
- ("'""' cannot close a bit string opened by '%'");
+ ("'""' cannot close a bit string opened by '%%'");
exit;
when '%' =>
pragma Assert (Mark = '"');
Error_Msg_Scan
- ("'%' cannot close a bit string opened by '""'");
+ ("'%%' cannot close a bit string opened by '""'");
exit;
when others =>
if Characters_Kind (C) in Graphic_Character then
@@ -559,9 +557,9 @@ package body Scanner is
else
if Mark = '%' then
Error_Msg_Scan
- ("'%' is not a vhdl operator, use 'rem'",
- File_Pos_To_Location
- (Current_Context.Source_File, Orig_Pos));
+ (File_Pos_To_Location
+ (Current_Context.Source_File, Orig_Pos),
+ "'%%' is not a vhdl operator, use 'rem'");
Current_Token := Tok_Rem;
Pos := Orig_Pos + 1;
return;
@@ -857,7 +855,7 @@ package body Scanner is
when Other_Special_Character | Special_Character =>
if (C = '"' or C = '%') and then Len <= 2 then
if C = '%' and Vhdl_Std >= Vhdl_08 then
- Error_Msg_Scan ("'%' not allowed in vhdl 2008 "
+ Error_Msg_Scan ("'%%' not allowed in vhdl 2008 "
& "(was replacement character)");
-- Continue as a bit string.
end if;
@@ -933,9 +931,9 @@ package body Scanner is
if not AMS_Vhdl then
if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
- ("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ AMS-VHDL reserved word as an identifier",
- Warnid_Reserved_Word);
+ (Warnid_Reserved_Word,
+ "using %i AMS-VHDL reserved word as an identifier",
+ +Current_Identifier);
end if;
Current_Token := Tok_Identifier;
end if;
@@ -943,9 +941,9 @@ package body Scanner is
if Vhdl_Std < Vhdl_08 then
if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
- ("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ vhdl-2008 reserved word as an identifier",
- Warnid_Reserved_Word);
+ (Warnid_Reserved_Word,
+ "using %i vhdl-2008 reserved word as an identifier",
+ +Current_Identifier);
end if;
Current_Token := Tok_Identifier;
end if;
@@ -953,9 +951,9 @@ package body Scanner is
if Vhdl_Std < Vhdl_00 then
if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
- ("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ vhdl00 reserved word as an identifier",
- Warnid_Reserved_Word);
+ (Warnid_Reserved_Word,
+ "using %i vhdl-2000 reserved word as an identifier",
+ +Current_Identifier);
end if;
Current_Token := Tok_Identifier;
end if;
@@ -963,12 +961,12 @@ package body Scanner is
if Vhdl_Std = Vhdl_87 then
if Is_Warning_Enabled (Warnid_Reserved_Word) then
Warning_Msg_Scan
- ("using """ & Nam_Buffer (1 .. Nam_Length)
- & """ vhdl93 reserved word as a vhdl87 identifier",
- Warnid_Reserved_Word);
+ (Warnid_Reserved_Word,
+ "using %i vhdl93 reserved word as a vhdl87 identifier",
+ +Current_Identifier, True);
Warning_Msg_Scan
- ("(use option --std=93 to compile as vhdl93)",
- Warnid_Reserved_Word);
+ (Warnid_Reserved_Word,
+ "(use option --std=93 to compile as vhdl93)");
end if;
Current_Token := Tok_Identifier;
end if;
@@ -1155,7 +1153,7 @@ package body Scanner is
or else I = Nam_Length - 1
then
Error_Msg_Option ("anti-slash must be doubled "
- & "in extended identifier");
+ & "in extended identifier");
return;
end if;
end if;
@@ -1469,8 +1467,8 @@ package body Scanner is
-- the start of a nested delimited comment.
if Source (Pos + 1) = '*' then
Warning_Msg_Scan
- ("'/*' found within a block comment",
- Warnid_Nested_Comment);
+ (Warnid_Nested_Comment,
+ "'/*' found within a block comment");
end if;
Pos := Pos + 1;
when '*' =>
@@ -1488,10 +1486,8 @@ package body Scanner is
if Pos >= Current_Context.File_Len then
-- Point at the start of the comment.
Error_Msg_Scan
- ("block comment not terminated at end of file",
- File_Pos_To_Location
- (Current_Context.Source_File,
- Current_Context.Token_Pos));
+ (Get_Token_Location,
+ "block comment not terminated at end of file");
exit;
end if;
Pos := Pos + 1;
@@ -1713,7 +1709,7 @@ package body Scanner is
when '%' =>
if Vhdl_Std >= Vhdl_08 then
Error_Msg_Scan
- ("'%' not allowed in vhdl 2008 (was replacement character)");
+ ("'%%' not allowed in vhdl 2008 (was replacement character)");
-- Continue as a string.
end if;
Scan_String;
@@ -1843,8 +1839,9 @@ package body Scanner is
when '$' | '`'
| Inverted_Exclamation .. Inverted_Question
| Multiplication_Sign | Division_Sign =>
- Error_Msg_Scan ("character """ & Source (Pos)
- & """ can only be used in strings or comments");
+ Error_Msg_Scan
+ ("character %c can only be used in strings or comments",
+ +Source (Pos));
Pos := Pos + 1;
goto Again;
when '@' =>
@@ -1854,8 +1851,8 @@ package body Scanner is
return;
else
Error_Msg_Scan
- ("character """ & Source (Pos)
- & """ can only be used in strings or comments");
+ ("character %c can only be used in strings or comments",
+ +Source (Pos));
Pos := Pos + 1;
goto Again;
end if;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index d19061846..6cb547ec2 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -1906,8 +1906,9 @@ package body Sem is
and then Get_Pure_Flag (Subprg)
then
Error_Msg_Sem_Relaxed
- ("result subtype of a pure function cannot denote an"
- & " access type", Subprg);
+ (Subprg,
+ "result subtype of a pure function cannot denote an"
+ & " access type");
end if;
when others =>
if Vhdl_Std >= Vhdl_08
@@ -1915,8 +1916,8 @@ package body Sem is
and then Get_Pure_Flag (Subprg)
then
Error_Msg_Sem_Relaxed
- ("result subtype of a pure function cannot have"
- & " access subelements", Subprg);
+ (Subprg, "result subtype of a pure function cannot have"
+ & " access subelements");
end if;
end case;
@@ -2461,17 +2462,17 @@ package body Sem is
Callees := Get_Callees_List (El);
pragma Assert (Callees /= Null_Iir_List);
Warning_Msg_Sem
- ("can't assert that all calls in " & Disp_Node (El)
- & " are pure or have not wait; "
- & "will be checked at elaboration", El,
- Warnid_Delayed_Checks);
+ (Warnid_Delayed_Checks, +El,
+ "can't assert that all calls in " & Disp_Node (El)
+ & " are pure or have not wait; "
+ & "will be checked at elaboration");
Callee := Get_Nth_Element (Callees, 0);
-- FIXME: could improve this message by displaying the
-- chain of calls until the first subprograms in
-- unknown state.
Warning_Msg_Sem
- ("(first such call is to " & Disp_Node (Callee) & ")",
- Callee, Warnid_Delayed_Checks);
+ (Warnid_Delayed_Checks, +Callee,
+ "(first such call is to " & Disp_Node (Callee) & ")");
end if;
end if;
when Iir_Kind_Sensitized_Process_Statement =>
@@ -2479,9 +2480,9 @@ package body Sem is
Keep := True;
if Emit_Warnings then
Warning_Msg_Sem
- ("can't assert that " & Disp_Node (El)
- & " has not wait; will be checked at elaboration",
- El, Warnid_Delayed_Checks);
+ (Warnid_Delayed_Checks, +El,
+ "can't assert that " & Disp_Node (El)
+ & " has not wait; will be checked at elaboration");
end if;
end if;
when others =>
@@ -2635,8 +2636,8 @@ package body Sem is
-- Emit a warning is a body is not necessary.
if not Get_Need_Body (Package_Decl) then
Warning_Msg_Sem
- (Disp_Node (Package_Decl) & " does not require a body",
- Decl, Warnid_Body);
+ (Warnid_Body, +Decl,
+ Disp_Node (Package_Decl) & " does not require a body");
end if;
Set_Package (Decl, Package_Decl);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 48c3ae2d9..a78f52b6e 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1823,8 +1823,8 @@ package body Sem_Decls is
-- shared variable declaration must be a protected type.
if Get_Shared_Flag (Decl) and not Is_Protected then
Error_Msg_Sem_Relaxed
- ("type of a shared variable must be a protected type",
- Decl);
+ (Decl,
+ "type of a shared variable must be a protected type");
end if;
-- LRM00 4.3.1.3 Variable declarations
@@ -1973,7 +1973,7 @@ package body Sem_Decls is
Spec := Get_Subprogram_Specification (Parent);
if Get_Pure_Flag (Spec) then
Error_Msg_Sem_Relaxed
- ("cannot declare a file in a pure function", Decl);
+ (Decl, "cannot declare a file in a pure function");
end if;
when Iir_Kind_Procedure_Body =>
Spec := Get_Subprogram_Specification (Parent);
@@ -3078,9 +3078,8 @@ package body Sem_Decls is
and then not Is_Implicit_Subprogram (El)
and then not Is_Second_Subprogram_Specification (El)
then
- Warning_Msg_Sem
- (Disp_Node (El) & " is never referenced", El,
- Warnid_Unused);
+ Warning_Msg_Sem (Warnid_Unused, +El,
+ Disp_Node (El) & " is never referenced");
end if;
when others =>
null;
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 10e07bf22..381068e88 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -862,8 +862,9 @@ package body Sem_Expr is
-- eg: for i in -1 to 1 loop
-- Be tolerant.
- Warning_Msg_Sem ("universal integer bound must be numeric literal "
- & "or attribute", Res, Warnid_Universal);
+ Warning_Msg_Sem (Warnid_Universal, +Res,
+ "universal integer bound must be numeric literal "
+ & "or attribute");
else
Error_Msg_Sem ("universal integer bound must be numeric literal "
& "or attribute", Res);
@@ -3431,9 +3432,8 @@ package body Sem_Expr is
if not Eval_Is_In_Bound (Expr, Element_Type)
then
Info.Has_Bound_Error := True;
- Warning_Msg_Sem
- ("element is out of the bounds", Expr,
- Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
+ "element is out of the bounds");
end if;
-- FIXME: handle name/others in translate.
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 098268daa..b723782c1 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -734,9 +734,9 @@ package body Sem_Names is
then
if False and then Flags.Vhdl_Std = Vhdl_87 then
-- emit a warning for a null slice.
- Warning_Msg_Sem
- ("direction mismatch results in a null slice",
- Name, Warnid_Runtime_Error);
+ Warning_Msg_Sem (Warnid_Runtime_Error, +Name,
+ "direction mismatch results in a null slice");
+
end if;
Error_Msg_Sem ("direction of the range mismatch", Name);
end if;
@@ -1310,8 +1310,8 @@ package body Sem_Names is
is
begin
Error_Msg_Sem_Relaxed
- ("reference to " & Disp_Node (Obj) & " violate pure rule for "
- & Disp_Node (Subprg), Loc);
+ (Loc, "reference to " & Disp_Node (Obj) & " violate pure rule for "
+ & Disp_Node (Subprg));
end Error_Pure;
Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram;
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index 8b4a525f0..66aa7e17f 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -772,8 +772,8 @@ package body Sem_Specs is
Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, True);
if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
Warning_Msg_Sem
- ("attribute specification apply to no named entity",
- Spec, Warnid_Specs);
+ (Warnid_Specs, +Spec,
+ "attribute specification apply to no named entity");
end if;
elsif List = Iir_List_Others then
-- o If the reserved word OTHERS is supplied, then the attribute
@@ -785,8 +785,8 @@ package body Sem_Specs is
Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, False);
if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
Warning_Msg_Sem
- ("attribute specification apply to no named entity",
- Spec, Warnid_Specs);
+ (Warnid_Specs, +Spec,
+ "attribute specification apply to no named entity");
end if;
else
-- o If a list of entity designators is supplied, then the
@@ -1341,8 +1341,8 @@ package body Sem_Specs is
if not Apply_Component_Specification (Parent_Stmts, False)
and then Is_Warning_Enabled (Warnid_Specs)
then
- Warning_Msg_Sem ("component specification applies to no instance",
- Spec, Warnid_Specs);
+ Warning_Msg_Sem (Warnid_Specs, +Spec,
+ "component specification applies to no instance");
end if;
elsif List = Iir_List_Others then
-- LRM93 5.2
@@ -1359,8 +1359,8 @@ package body Sem_Specs is
if not Apply_Component_Specification (Parent_Stmts, True)
and then Is_Warning_Enabled (Warnid_Specs)
then
- Warning_Msg_Sem ("component specification applies to no instance",
- Spec, Warnid_Specs);
+ Warning_Msg_Sem (Warnid_Specs, +Spec,
+ "component specification applies to no instance");
end if;
else
-- LRM93 5.2
@@ -1788,9 +1788,9 @@ package body Sem_Specs is
-- the instantiated component and that is directly visible
-- (see 10.3),
Decl := Get_Declaration (Inter);
- Warning_Msg_Elab ("visible declaration for " & Name_Table.Image (Name)
- & " is " & Disp_Node (Decl),
- Decl, Warnid_Default_Binding);
+ Warning_Msg_Elab
+ (Warnid_Default_Binding, Decl,
+ "visible declaration for " & Name_Table.Image (Name));
-- b) An entity declaration that has the same simple name that of
-- the instantiated component and that would be directly
@@ -1801,9 +1801,9 @@ package body Sem_Specs is
Inter := Get_Under_Interpretation (Name);
if Valid_Interpretation (Inter) then
Decl := Get_Declaration (Inter);
- Warning_Msg_Elab
- ("interpretation behind the component is " & Disp_Node (Decl),
- Comp, Warnid_Default_Binding);
+ Warning_Msg_Elab (Warnid_Default_Binding, Comp,
+ "interpretation behind the component is "
+ & Disp_Node (Decl));
end if;
end if;
end if;
@@ -1822,8 +1822,9 @@ package body Sem_Specs is
Decl := Get_Parent (Decl);
end loop;
- Warning_Msg_Elab ("no entity """ & Name_Table.Image (Name) & """ in "
- & Disp_Node (Decl), Comp, Warnid_Default_Binding);
+ Warning_Msg_Elab (Warnid_Default_Binding, Comp,
+ "no entity """ & Name_Table.Image (Name) & """ in "
+ & Disp_Node (Decl));
end if;
end Explain_No_Visible_Entity;
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index 25c1ada95..3b2346cee 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -556,8 +556,9 @@ package body Sem_Stmts is
| Iir_Kind_Concurrent_Selected_Signal_Assignment =>
if Get_Postponed_Flag (Current_Concurrent_Statement) then
Warning_Msg_Sem
- ("waveform may cause a delta cycle in a " &
- "postponed process", We, Warnid_Delta_Cycle);
+ (Warnid_Delta_Cycle, +We,
+ "waveform may cause a delta cycle in a " &
+ "postponed process");
end if;
when others =>
-- Context is a subprogram.
@@ -832,8 +833,8 @@ package body Sem_Stmts is
and then not Check_Implicit_Conversion (Target_Type, Expr)
then
Warning_Msg_Sem
- ("expression length does not match target length",
- Stmt, Warnid_Runtime_Error);
+ (Warnid_Runtime_Error, +Stmt,
+ "expression length does not match target length");
Set_Expression (Stmt, Build_Overflow (Expr, Target_Type));
end if;
end if;
@@ -1502,9 +1503,9 @@ package body Sem_Stmts is
if Is_Warning_Enabled (Warnid_Default_Binding)
and then not Flags.Flag_Elaborate
then
- Warning_Msg_Sem
- ("no default binding for instantiation of "
- & Disp_Node (Decl), Stmt, Warnid_Default_Binding);
+ Warning_Msg_Sem (Warnid_Default_Binding, +Stmt,
+ "no default binding for instantiation of "
+ & Disp_Node (Decl));
Explain_No_Visible_Entity (Decl);
end if;
elsif Flags.Flag_Elaborate
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index b5f948038..93d60d928 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -1892,7 +1892,7 @@ package body Elaboration is
-- such a design entity.
if not Is_Fully_Bound (Conf) then
Warning_Msg_Elab
- (Disp_Node (Stmt) & " not bound", Stmt, Warnid_Binding);
+ (Warnid_Binding, Stmt, Disp_Node (Stmt) & " not bound");
return;
end if;
@@ -1950,16 +1950,17 @@ package body Elaboration is
if Arch_Name = Null_Identifier then
Arch := Libraries.Get_Latest_Architecture (Entity);
if Arch = Null_Iir then
- Error_Msg_Elab ("no architecture analysed for "
- & Disp_Node (Entity), Stmt);
+ Error_Msg_Elab (Stmt, "no architecture analysed for "
+ & Disp_Node (Entity));
end if;
Arch_Name := Get_Identifier (Arch);
end if;
Arch_Design := Libraries.Load_Secondary_Unit
(Get_Design_Unit (Entity), Arch_Name, Stmt);
if Arch_Design = Null_Iir then
- Error_Msg_Elab ("no architecture `" & Name_Table.Image (Arch_Name)
- & "' for " & Disp_Node (Entity), Stmt);
+ Error_Msg_Elab (Stmt,
+ "no architecture `" & Name_Table.Image (Arch_Name)
+ & "' for " & Disp_Node (Entity));
end if;
Arch := Get_Library_Unit (Arch_Design);
end if;
@@ -2815,8 +2816,8 @@ package body Elaboration is
and then not Is_Fully_Constrained_Type (Get_Type (Formal))
then
Error_Msg_Elab
- ("top-level " & Disp_Node (Formal) & " must have a value",
- Formal);
+ (Formal,
+ "top-level " & Disp_Node (Formal) & " must have a value");
end if;
end if;
Assoc := Get_Chain (Assoc);
diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb
index a788255d8..936cbd3f3 100644
--- a/src/vhdl/simulate/execution.adb
+++ b/src/vhdl/simulate/execution.adb
@@ -1470,8 +1470,8 @@ package body Execution is
end;
when others =>
- Error_Msg_Elab ("execute_implicit_function: unimplemented " &
- Iir_Predefined_Functions'Image (Func), Expr);
+ Error_Msg_Elab (Expr, "execute_implicit_function: unimplemented " &
+ Iir_Predefined_Functions'Image (Func));
raise Internal_Error;
end case;
return Result;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index e1ae36901..451dfcba6 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -516,7 +516,7 @@ package body Trans.Chap7 is
exception
when Constraint_Error =>
-- Can be raised by Get_Physical_Value.
- Error_Msg_Elab ("numeric literal not in range", Expr);
+ Error_Msg_Elab (Expr, "numeric literal not in range");
return New_Signed_Literal (Res_Type, 0);
end Translate_Numeric_Literal;
@@ -3784,8 +3784,8 @@ package body Trans.Chap7 is
return New_Lit (New_Signed_Literal (Otype, Integer_64 (Val)));
exception
when Constraint_Error =>
- Warning_Msg_Elab ("physical literal out of range",
- Expr, Warnid_Runtime_Error);
+ Warning_Msg_Elab (Warnid_Runtime_Error, Expr,
+ "physical literal out of range");
return Translate_Overflow_Literal (Expr);
end;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-02 19:30:01 +0000