aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-05-08 07:33:04 +0200
committerTristan Gingold <tgingold@free.fr>2019-05-08 07:33:04 +0200
commita05c5813bee6c063dc196471e66816fbca5dc50e (patch)
tree7e6e01af2cbb3bcb02bf52fab6bf3075e613a211
parentd87e8284e3dc3adced8b8aa2258e3a87097396b1 (diff)
downloadghdl-a05c5813bee6c063dc196471e66816fbca5dc50e.tar.gz
ghdl-a05c5813bee6c063dc196471e66816fbca5dc50e.tar.bz2
ghdl-a05c5813bee6c063dc196471e66816fbca5dc50e.zip
vhdl: extract vhdl.errors from errorout.
-rw-r--r--src/ghdldrv/ghdlprint.adb1
-rw-r--r--src/ghdldrv/ghdlrun.adb1
-rw-r--r--src/libraries.adb1
-rw-r--r--src/synth/synth-context.adb2
-rw-r--r--src/synth/synth-decls.adb2
-rw-r--r--src/synth/synth-expr.adb2
-rw-r--r--src/synth/synth-stmts.adb2
-rw-r--r--src/synth/synth-types.adb2
-rw-r--r--src/synth/synthesis.adb1
-rw-r--r--src/vhdl/errorout.adb979
-rw-r--r--src/vhdl/errorout.ads105
-rw-r--r--src/vhdl/psl-errors.ads3
-rw-r--r--src/vhdl/simulate/simul-annotations.adb2
-rw-r--r--src/vhdl/simulate/simul-debugger.adb1
-rw-r--r--src/vhdl/simulate/simul-elaboration-ams.adb2
-rw-r--r--src/vhdl/simulate/simul-elaboration.adb1
-rw-r--r--src/vhdl/simulate/simul-execution.adb2
-rw-r--r--src/vhdl/simulate/simul-simulation-main.adb1
-rw-r--r--src/vhdl/translate/ortho_front.adb1
-rw-r--r--src/vhdl/translate/trans-chap1.adb3
-rw-r--r--src/vhdl/translate/trans-chap12.adb1
-rw-r--r--src/vhdl/translate/trans-chap14.adb2
-rw-r--r--src/vhdl/translate/trans-chap2.adb2
-rw-r--r--src/vhdl/translate/trans-chap3.adb2
-rw-r--r--src/vhdl/translate/trans-chap4.adb2
-rw-r--r--src/vhdl/translate/trans-chap5.adb2
-rw-r--r--src/vhdl/translate/trans-chap6.adb2
-rw-r--r--src/vhdl/translate/trans-chap7.adb1
-rw-r--r--src/vhdl/translate/trans-chap8.adb2
-rw-r--r--src/vhdl/translate/trans-chap9.adb1
-rw-r--r--src/vhdl/translate/trans-foreach_non_composite.adb2
-rw-r--r--src/vhdl/translate/trans-rtis.adb2
-rw-r--r--src/vhdl/translate/trans_analyzes.adb1
-rw-r--r--src/vhdl/translate/trans_be.adb3
-rw-r--r--src/vhdl/translate/translation.adb1
-rw-r--r--src/vhdl/vhdl-canon.adb1
-rw-r--r--src/vhdl/vhdl-configuration.adb1
-rw-r--r--src/vhdl/vhdl-disp_vhdl.adb1
-rw-r--r--src/vhdl/vhdl-errors.adb990
-rw-r--r--src/vhdl/vhdl-errors.ads136
-rw-r--r--src/vhdl/vhdl-evaluation.adb1
-rw-r--r--src/vhdl/vhdl-ieee-numeric.adb2
-rw-r--r--src/vhdl/vhdl-ieee-std_logic_1164.adb2
-rw-r--r--src/vhdl/vhdl-ieee-vital_timing.adb1
-rw-r--r--src/vhdl/vhdl-nodes_gc.adb2
-rw-r--r--src/vhdl/vhdl-nodes_walk.adb2
-rw-r--r--src/vhdl/vhdl-parse.adb1
-rw-r--r--src/vhdl/vhdl-sem.adb1
-rw-r--r--src/vhdl/vhdl-sem_assocs.adb1
-rw-r--r--src/vhdl/vhdl-sem_decls.adb1
-rw-r--r--src/vhdl/vhdl-sem_expr.adb1
-rw-r--r--src/vhdl/vhdl-sem_inst.adb2
-rw-r--r--src/vhdl/vhdl-sem_lib.adb1
-rw-r--r--src/vhdl/vhdl-sem_names.adb1
-rw-r--r--src/vhdl/vhdl-sem_psl.adb1
-rw-r--r--src/vhdl/vhdl-sem_scopes.adb1
-rw-r--r--src/vhdl/vhdl-sem_specs.adb1
-rw-r--r--src/vhdl/vhdl-sem_stmts.adb1
-rw-r--r--src/vhdl/vhdl-sem_types.adb1
-rw-r--r--src/vhdl/vhdl-sem_utils.adb2
-rw-r--r--src/vhdl/vhdl-utils.adb2
-rw-r--r--src/vhdl/vhdl-xrefs.adb2
62 files changed, 1198 insertions, 1101 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index 73f386f4a..3addfbfe3 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -26,6 +26,7 @@ with Name_Table; use Name_Table;
with Files_Map;
with Libraries;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Tokens;
with Vhdl.Scanner;
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 9ae929efe..5cf5ca4dd 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -35,6 +35,7 @@ with Vhdl.Nodes; use Vhdl.Nodes;
with Vhdl.Std_Package;
with Flags;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Libraries;
with Vhdl.Canon;
with Vhdl.Configuration;
diff --git a/src/libraries.adb b/src/libraries.adb
index 0f552e911..0540c709e 100644
--- a/src/libraries.adb
+++ b/src/libraries.adb
@@ -21,6 +21,7 @@ with GNAT.OS_Lib;
with Logging; use Logging;
with Tables;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Scanner;
with Vhdl.Utils; use Vhdl.Utils;
with Name_Table; use Name_Table;
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index a84f56e38..135b40d7c 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -22,7 +22,7 @@ with Ada.Unchecked_Deallocation;
with Types; use Types;
with Grt.Types; use Grt.Types;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils;
with Vhdl.Std_Package;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 23e34b957..576a90918 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -21,7 +21,7 @@
with Types; use Types;
with Netlists; use Netlists;
with Netlists.Builders; use Netlists.Builders;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Synth.Context; use Synth.Context;
with Synth.Types; use Synth.Types;
with Synth.Environment; use Synth.Environment;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index 7a682dbff..0384aa785 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -23,7 +23,7 @@ with Ada.Unchecked_Deallocation;
with Std_Names;
with Vhdl.Ieee.Std_Logic_1164;
with Vhdl.Std_Package;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Simul.Execution;
with Grt.Types; use Grt.Types;
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index 613bcdbdd..99021984a 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -23,7 +23,7 @@ with Ada.Unchecked_Deallocation;
with Types; use Types;
with Grt.Algos;
with Areapools;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Expr;
with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/synth/synth-types.adb b/src/synth/synth-types.adb
index 19e9677ec..cc89eefe3 100644
--- a/src/synth/synth-types.adb
+++ b/src/synth/synth-types.adb
@@ -25,7 +25,7 @@ with Vhdl.Utils; use Vhdl.Utils;
with Simul.Environments; use Simul.Environments;
with Simul.Execution;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
package body Synth.Types is
function Is_Bit_Type (Atype : Iir) return Boolean is
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index 770fb52c9..4a346b0a9 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -39,6 +39,7 @@ with Synth.Environment.Debug;
pragma Unreferenced (Synth.Environment.Debug);
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
package body Synthesis is
function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 2dd867246..1b022391d 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -19,30 +19,14 @@
with Logging; use Logging;
with Vhdl.Scanner;
with Name_Table;
-with Vhdl.Utils; use Vhdl.Utils;
with Files_Map; use Files_Map;
-with Ada.Strings.Unbounded;
-with Std_Names;
with Flags; use Flags;
with PSL.Nodes;
with Str_Table;
-package body Errorout is
- procedure Error_Kind (Msg : String; An_Iir : Iir) is
- begin
- Log_Line
- (Msg & ": cannot handle " & Iir_Kind'Image (Get_Kind (An_Iir))
- & " (" & Disp_Location (An_Iir) & ')');
- raise Internal_Error;
- end Error_Kind;
-
- procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions) is
- begin
- Log_Line
- (Msg & ": cannot handle " & Iir_Predefined_Functions'Image (Def));
- raise Internal_Error;
- end Error_Kind;
+with Vhdl.Errors; use Vhdl.Errors;
+package body Errorout is
procedure Error_Kind (Msg : String; N : PSL_Node) is
begin
Log (Msg);
@@ -132,11 +116,6 @@ package body Errorout is
-- Error arguments
- 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);
@@ -147,11 +126,6 @@ package body Errorout is
return (Kind => Earg_Id, Val_Id => V);
end "+";
- function "+" (V : Vhdl.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);
@@ -162,17 +136,6 @@ package body Errorout is
return (Kind => Earg_String8, Val_Str8 => 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;
-
function "+" (L : PSL_Node) return Location_Type
is
use PSL.Nodes;
@@ -459,940 +422,16 @@ package body Errorout is
Report_Msg (Id, Option, No_Location, Msg);
end Warning_Msg_Option;
- procedure Warning_Msg_Sem (Id : Msgid_Warnings;
- Loc : Location_Type;
- Msg: String;
- Args : Earg_Arr := No_Eargs;
- Cont : Boolean := False) is
- begin
- if Flags.Flag_Only_Elab_Warnings then
- return;
- end if;
- Report_Msg (Id, Semantic, Loc, Msg, Args, Cont);
- end Warning_Msg_Sem;
-
- procedure Warning_Msg_Sem (Id : Msgid_Warnings;
- Loc : Location_Type;
- Msg: String;
- Arg1 : Earg_Type;
- Cont : Boolean := False) is
- begin
- Warning_Msg_Sem (Id, Loc, Msg, Earg_Arr'(1 => Arg1), Cont);
- end Warning_Msg_Sem;
-
- procedure Warning_Msg_Elab (Id : Msgid_Warnings;
- Loc : Iir;
- Msg: String;
- Arg1 : Earg_Type;
- Cont : Boolean := False) is
- begin
- Report_Msg (Id, Elaboration, +Loc, Msg, Earg_Arr'(1 => Arg1), Cont);
- end Warning_Msg_Elab;
-
- procedure Warning_Msg_Elab (Id : Msgid_Warnings;
- Loc : Iir;
- Msg: String;
- Args : Earg_Arr := No_Eargs;
- Cont : Boolean := False) is
- begin
- Report_Msg (Id, Elaboration, +Loc, Msg, Args, Cont);
- end Warning_Msg_Elab;
-
- -- Disp a message during semantic analysis.
- -- LOC is used for location and current token.
- procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is
- begin
- Report_Msg (Msgid_Error, Semantic, Get_Location_Safe (Loc), Msg);
- end Error_Msg_Sem;
-
- procedure Error_Msg_Sem (Loc: Location_Type;
- Msg: String;
- Args : Earg_Arr := No_Eargs;
- Cont : Boolean := False) is
- begin
- Report_Msg (Msgid_Error, Semantic, Loc, Msg, Args, Cont);
- end Error_Msg_Sem;
-
- procedure Error_Msg_Sem
- (Loc: Location_Type; Msg: String; Arg1 : Earg_Type) is
- begin
- Report_Msg (Msgid_Error, Semantic, Loc, Msg, (1 => Arg1));
- end Error_Msg_Sem;
-
- procedure Error_Msg_Sem_1 (Msg: String; Loc : PSL_Node) is
- begin
- Error_Msg_Sem (+Loc, Msg);
- end Error_Msg_Sem_1;
-
- procedure Error_Msg_Relaxed (Origin : Report_Origin;
- Id : Msgid_Warnings;
- Msg : String;
- Loc : Iir;
- Args : Earg_Arr := No_Eargs)
- is
- Level : Msgid_Type;
- begin
- if Flag_Relaxed_Rules or Vhdl_Std = Vhdl_93c then
- if not Is_Warning_Enabled (Id) then
- return;
- end if;
- Level := Id;
- else
- Level := Msgid_Error;
- end if;
- Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg, Args);
- end Error_Msg_Relaxed;
-
- procedure Error_Msg_Sem_Relaxed (Loc : Iir;
- Id : Msgid_Warnings;
- Msg : String;
- Args : Earg_Arr := No_Eargs) is
- begin
- Error_Msg_Relaxed (Semantic, Id, Msg, Loc, Args);
- end Error_Msg_Sem_Relaxed;
-
- -- Disp a message during elaboration.
- procedure Error_Msg_Elab
- (Msg: String; Args : Earg_Arr := No_Eargs) is
- begin
- Report_Msg (Msgid_Error, Elaboration, No_Location, Msg, Args);
- end Error_Msg_Elab;
-
- procedure Error_Msg_Elab
- (Msg: String; Arg1 : Earg_Type) is
- begin
- Error_Msg_Elab (Msg, Earg_Arr'(1 => Arg1));
- end Error_Msg_Elab;
-
- procedure Error_Msg_Elab
- (Loc: Iir; Msg: String; Args : Earg_Arr := No_Eargs) is
- begin
- Report_Msg (Msgid_Error, Elaboration, +Loc, Msg, Args);
- end Error_Msg_Elab;
-
- procedure Error_Msg_Elab
- (Loc: Iir; Msg: String; Arg1 : Earg_Type) is
- begin
- Error_Msg_Elab (Loc, Msg, Earg_Arr'(1 => Arg1));
- end Error_Msg_Elab;
-
- procedure Error_Msg_Elab_Relaxed (Loc : Iir;
- Id : Msgid_Warnings;
- Msg : String;
- Args : Earg_Arr := No_Eargs) is
- begin
- Error_Msg_Relaxed (Elaboration, Id, Msg, Loc, Args);
- end Error_Msg_Elab_Relaxed;
-
- -- Disp a bug message.
- procedure Error_Internal (Expr: in Iir; Msg: String := "")
- is
- pragma Unreferenced (Expr);
- begin
- Log ("internal error: ");
- Log_Line (Msg);
- raise Internal_Error;
- end Error_Internal;
-
- function Disp_Label (Node : Iir; Str : String) return String
- is
- Id : Name_Id;
- begin
- Id := Get_Label (Node);
- if Id = Null_Identifier then
- return "(unlabeled) " & Str;
- else
- return Str & " labeled """ & Name_Table.Image (Id) & """";
- end if;
- end Disp_Label;
-
- -- Disp a node.
- -- Used for output of message.
- function Disp_Node (Node: Iir) return String is
- function Disp_Identifier (Node : Iir; Str : String) return String
- is
- Id : Name_Id;
- begin
- Id := Get_Identifier (Node);
- return Str & " """ & Name_Table.Image (Id) & """";
- end Disp_Identifier;
-
- function Disp_Type (Node : Iir; Str : String) return String
- is
- Decl: Iir;
- begin
- Decl := Get_Type_Declarator (Node);
- if Decl = Null_Iir then
- return "anonymous " & Str
- & " defined at " & Disp_Location (Node);
- else
- return Disp_Identifier (Decl, Str);
- end if;
- end Disp_Type;
-
- begin
- case Get_Kind (Node) is
- when Iir_Kind_String_Literal8 =>
- return "string literal";
- when Iir_Kind_Character_Literal =>
- return "character literal " & Image_Identifier (Node);
- when Iir_Kind_Integer_Literal =>
- return "integer literal";
- when Iir_Kind_Floating_Point_Literal =>
- return "floating point literal";
- when Iir_Kind_Physical_Int_Literal
- | Iir_Kind_Physical_Fp_Literal =>
- return "physical literal";
- when Iir_Kind_Enumeration_Literal =>
- return "enumeration literal " & Image_Identifier (Node);
- when Iir_Kind_Element_Declaration =>
- return Disp_Identifier (Node, "element");
- when Iir_Kind_Record_Element_Constraint =>
- return "record element constraint";
- when Iir_Kind_Array_Element_Resolution =>
- return "array element resolution";
- when Iir_Kind_Record_Resolution =>
- return "record resolution";
- when Iir_Kind_Record_Element_Resolution =>
- return "record element resolution";
- when Iir_Kind_Null_Literal =>
- return "null literal";
- when Iir_Kind_Overflow_Literal =>
- return Disp_Node (Get_Literal_Origin (Node));
- when Iir_Kind_Unaffected_Waveform =>
- return "unaffected waveform";
- when Iir_Kind_Aggregate =>
- return "aggregate";
- when Iir_Kind_Unit_Declaration =>
- return Disp_Identifier (Node, "physical unit");
- when Iir_Kind_Simple_Aggregate =>
- return "locally static array literal";
-
- when Iir_Kind_Operator_Symbol =>
- return "operator name";
- when Iir_Kind_Aggregate_Info =>
- return "aggregate info";
- when Iir_Kind_Signature =>
- return "signature";
- when Iir_Kind_Waveform_Element =>
- return "waveform element";
- when Iir_Kind_Conditional_Waveform =>
- return "conditional waveform";
- when Iir_Kind_Conditional_Expression =>
- return "conditional expression";
- when Iir_Kind_Association_Element_Open =>
- return "open association element";
- when Iir_Kind_Association_Element_By_Individual =>
- return "individual association element";
- when Iir_Kind_Association_Element_By_Expression
- | Iir_Kind_Association_Element_Package
- | Iir_Kind_Association_Element_Type
- | Iir_Kind_Association_Element_Subprogram =>
- return "association element";
- when Iir_Kind_Overload_List =>
- return "overloaded name or expression";
-
- when Iir_Kind_Integer_Type_Definition
- | Iir_Kind_Enumeration_Type_Definition =>
- return Image_Identifier (Get_Type_Declarator (Node));
- when Iir_Kind_Wildcard_Type_Definition =>
- return "<any>";
- when Iir_Kind_Array_Type_Definition =>
- return Disp_Type (Node, "array type");
- when Iir_Kind_Array_Subtype_Definition =>
- return Disp_Type (Node, "array subtype");
- when Iir_Kind_Record_Type_Definition =>
- return Disp_Type (Node, "record type");
- when Iir_Kind_Record_Subtype_Definition =>
- return Disp_Type (Node, "record subtype");
- when Iir_Kind_Enumeration_Subtype_Definition =>
- return Disp_Type (Node, "enumeration subtype");
- when Iir_Kind_Integer_Subtype_Definition =>
- return Disp_Type (Node, "integer subtype");
- when Iir_Kind_Physical_Type_Definition =>
- return Disp_Type (Node, "physical type");
- when Iir_Kind_Physical_Subtype_Definition =>
- return Disp_Type (Node, "physical subtype");
- when Iir_Kind_File_Type_Definition =>
- return Disp_Type (Node, "file type");
- when Iir_Kind_Access_Type_Definition =>
- return Disp_Type (Node, "access type");
- when Iir_Kind_Access_Subtype_Definition =>
- return Disp_Type (Node, "access subtype");
- when Iir_Kind_Floating_Subtype_Definition
- | Iir_Kind_Floating_Type_Definition =>
- return Disp_Type (Node, "floating type");
- when Iir_Kind_Incomplete_Type_Definition =>
- return Disp_Type (Node, "incomplete type");
- when Iir_Kind_Interface_Type_Definition =>
- return Disp_Type (Node, "interface type");
- when Iir_Kind_Protected_Type_Declaration =>
- return Disp_Type (Node, "protected type");
- when Iir_Kind_Protected_Type_Body =>
- return Disp_Type (Node, "protected type body");
- when Iir_Kind_Subtype_Definition =>
- return "subtype definition";
-
- when Iir_Kind_Scalar_Nature_Definition =>
- return Image_Identifier (Get_Nature_Declarator (Node));
-
- when Iir_Kind_Choice_By_Expression =>
- return "choice by expression";
- when Iir_Kind_Choice_By_Range =>
- return "choice by range";
- when Iir_Kind_Choice_By_Name =>
- return "choice by name";
- when Iir_Kind_Choice_By_Others =>
- return "others choice";
- when Iir_Kind_Choice_By_None =>
- return "positionnal choice";
-
- when Iir_Kind_Function_Call =>
- return "function call";
- when Iir_Kind_Procedure_Call_Statement =>
- return "procedure call statement";
- when Iir_Kind_Procedure_Call =>
- return "procedure call";
- when Iir_Kind_Selected_Name =>
- return ''' & Name_Table.Image (Get_Identifier (Node)) & ''';
- when Iir_Kind_Simple_Name =>
- return ''' & Name_Table.Image (Get_Identifier (Node)) & ''';
- when Iir_Kind_Reference_Name =>
- -- Shouldn't happen.
- return "name";
- when Iir_Kind_External_Constant_Name =>
- return "external constant name";
- when Iir_Kind_External_Signal_Name =>
- return "external signal name";
- when Iir_Kind_External_Variable_Name =>
- return "external variable name";
-
- when Iir_Kind_Package_Pathname =>
- return "package pathname";
- when Iir_Kind_Absolute_Pathname =>
- return "absolute pathname";
- when Iir_Kind_Relative_Pathname =>
- return "relative pathname";
- when Iir_Kind_Pathname_Element =>
- return "pathname element";
-
- when Iir_Kind_Entity_Aspect_Entity =>
- declare
- Arch : constant Iir := Get_Architecture (Node);
- Ent : constant Iir := Get_Entity (Node);
- begin
- if Arch = Null_Iir then
- return "aspect " & Disp_Node (Ent);
- else
- return "aspect " & Disp_Node (Ent)
- & '(' & Image_Identifier (Arch) & ')';
- end if;
- end;
- when Iir_Kind_Entity_Aspect_Configuration =>
- return "configuration entity aspect";
- when Iir_Kind_Entity_Aspect_Open =>
- return "open entity aspect";
-
- when Iir_Kinds_Monadic_Operator
- | Iir_Kinds_Dyadic_Operator =>
- return "operator """
- & Name_Table.Image (Get_Operator_Name (Node)) & """";
- when Iir_Kind_Parenthesis_Expression =>
- return "expression";
- when Iir_Kind_Qualified_Expression =>
- return "qualified expression";
- when Iir_Kind_Type_Conversion =>
- return "type conversion";
- when Iir_Kind_Allocator_By_Subtype
- | Iir_Kind_Allocator_By_Expression =>
- return "allocator";
- when Iir_Kind_Indexed_Name =>
- return "indexed name";
- when Iir_Kind_Range_Expression =>
- return "range expression";
- when Iir_Kind_Implicit_Dereference =>
- return "implicit access dereference";
- when Iir_Kind_Dereference =>
- return "access dereference";
- when Iir_Kind_Selected_Element =>
- return "selected element";
- when Iir_Kind_Selected_By_All_Name =>
- return ".all name";
- when Iir_Kind_Psl_Expression =>
- return "PSL instantiation";
-
- when Iir_Kind_Interface_Constant_Declaration =>
- if Get_Parent (Node) = Null_Iir then
- -- For constant interface of predefined operator.
- return "anonymous interface";
- end if;
- case Get_Kind (Get_Parent (Node)) is
- when Iir_Kind_Entity_Declaration
- | Iir_Kind_Block_Statement
- | Iir_Kind_Block_Header =>
- return Disp_Identifier (Node, "generic");
- when others =>
- return Disp_Identifier (Node, "constant interface");
- end case;
- when Iir_Kind_Interface_Signal_Declaration =>
- case Get_Kind (Get_Parent (Node)) is
- when Iir_Kind_Entity_Declaration
- | Iir_Kind_Block_Statement
- | Iir_Kind_Block_Header =>
- return Disp_Identifier (Node, "port");
- when others =>
- return Disp_Identifier (Node, "signal interface");
- end case;
- when Iir_Kind_Interface_Variable_Declaration =>
- return Disp_Identifier (Node, "variable interface");
- when Iir_Kind_Interface_File_Declaration =>
- return Disp_Identifier (Node, "file interface");
- when Iir_Kind_Interface_Package_Declaration =>
- return Disp_Identifier (Node, "package interface");
- when Iir_Kind_Interface_Type_Declaration =>
- return Disp_Identifier (Node, "type interface");
- when Iir_Kind_Signal_Declaration =>
- return Disp_Identifier (Node, "signal");
- when Iir_Kind_Variable_Declaration =>
- return Disp_Identifier (Node, "variable");
- when Iir_Kind_Iterator_Declaration
- | Iir_Kind_Constant_Declaration =>
- return Disp_Identifier (Node, "constant");
- when Iir_Kind_File_Declaration =>
- return Disp_Identifier (Node, "file");
- when Iir_Kind_Object_Alias_Declaration =>
- return Disp_Identifier (Node, "alias");
- when Iir_Kind_Non_Object_Alias_Declaration =>
- return Disp_Identifier (Node, "non-object alias");
- when Iir_Kind_Guard_Signal_Declaration =>
- return "GUARD signal";
- when Iir_Kind_Signal_Attribute_Declaration =>
- -- Should not appear.
- return "signal attribute";
- when Iir_Kind_Group_Template_Declaration =>
- return Disp_Identifier (Node, "group template");
- when Iir_Kind_Group_Declaration =>
- return Disp_Identifier (Node, "group");
-
- when Iir_Kind_Library_Declaration
- | Iir_Kind_Library_Clause =>
- return Disp_Identifier (Node, "library");
- when Iir_Kind_Design_File =>
- return "design file";
-
- when Iir_Kind_Procedure_Declaration =>
- return Disp_Identifier (Node, "procedure");
- when Iir_Kind_Function_Declaration =>
- return Disp_Identifier (Node, "function");
- when Iir_Kind_Interface_Procedure_Declaration =>
- return Disp_Identifier (Node, "interface procedure");
- when Iir_Kind_Interface_Function_Declaration =>
- return Disp_Identifier (Node, "interface function");
- when Iir_Kind_Procedure_Body
- | Iir_Kind_Function_Body =>
- return "subprogram body";
-
- when Iir_Kind_Package_Declaration =>
- return Disp_Identifier (Node, "package");
- when Iir_Kind_Package_Body =>
- return Disp_Identifier (Node, "package body");
- when Iir_Kind_Entity_Declaration =>
- return Disp_Identifier (Node, "entity");
- when Iir_Kind_Architecture_Body =>
- return Disp_Identifier (Node, "architecture") &
- " of" & Disp_Identifier (Get_Entity_Name (Node), "");
- when Iir_Kind_Configuration_Declaration =>
- declare
- Id : Name_Id;
- Ent : Iir;
- Arch : Iir;
- begin
- Id := Get_Identifier (Node);
- if Id /= Null_Identifier then
- return Disp_Identifier (Node, "configuration");
- else
- Ent := Get_Entity (Node);
- Arch := Get_Block_Specification
- (Get_Block_Configuration (Node));
- return "default configuration of "
- & Image_Identifier (Ent)
- & '(' & Image_Identifier (Arch) & ')';
- end if;
- end;
- when Iir_Kind_Context_Declaration =>
- return Disp_Identifier (Node, "context");
- when Iir_Kind_Package_Instantiation_Declaration =>
- return Disp_Identifier (Node, "instantiation package");
-
- when Iir_Kind_Package_Header =>
- return "package header";
-
- when Iir_Kind_Component_Declaration =>
- return Disp_Identifier (Node, "component");
-
- when Iir_Kind_Design_Unit =>
- return Disp_Node (Get_Library_Unit (Node));
- when Iir_Kind_Use_Clause =>
- return "use clause";
- when Iir_Kind_Context_Reference =>
- return "context reference";
- when Iir_Kind_Disconnection_Specification =>
- return "disconnection specification";
-
- when Iir_Kind_Slice_Name =>
- return "slice";
- when Iir_Kind_Parenthesis_Name =>
- return "function call, slice or indexed name";
- when Iir_Kind_Type_Declaration =>
- return Disp_Identifier (Node, "type");
- when Iir_Kind_Anonymous_Type_Declaration =>
- return Disp_Identifier (Node, "type");
- when Iir_Kind_Subtype_Declaration =>
- return Disp_Identifier (Node, "subtype");
-
- when Iir_Kind_Nature_Declaration =>
- return Disp_Identifier (Node, "nature");
- when Iir_Kind_Subnature_Declaration =>
- return Disp_Identifier (Node, "subnature");
-
- when Iir_Kind_Component_Instantiation_Statement =>
- return Disp_Identifier (Node, "component instance");
- when Iir_Kind_Configuration_Specification =>
- return "configuration specification";
- when Iir_Kind_Component_Configuration =>
- return "component configuration";
-
- when Iir_Kind_Concurrent_Procedure_Call_Statement =>
- return "concurrent procedure call";
- when Iir_Kind_For_Generate_Statement =>
- return "for generate statement";
- when Iir_Kind_If_Generate_Statement
- | Iir_Kind_If_Generate_Else_Clause =>
- return "if generate statement";
- when Iir_Kind_Case_Generate_Statement =>
- return "case generate statement";
- when Iir_Kind_Generate_Statement_Body =>
- return "generate statement";
-
- when Iir_Kind_Simple_Simultaneous_Statement =>
- return "simple simultaneous statement";
-
- when Iir_Kind_Psl_Declaration =>
- return Disp_Identifier (Node, "PSL declaration");
- when Iir_Kind_Psl_Endpoint_Declaration =>
- return Disp_Identifier (Node, "PSL endpoint declaration");
-
- when Iir_Kind_Terminal_Declaration =>
- return Disp_Identifier (Node, "terminal declaration");
- when Iir_Kind_Free_Quantity_Declaration
- | Iir_Kind_Across_Quantity_Declaration
- | Iir_Kind_Through_Quantity_Declaration =>
- return Disp_Identifier (Node, "quantity declaration");
-
- when Iir_Kind_Attribute_Declaration =>
- return Disp_Identifier (Node, "attribute");
- when Iir_Kind_Attribute_Specification =>
- return "attribute specification";
- when Iir_Kind_Entity_Class =>
- return "entity class";
- when Iir_Kind_Attribute_Value =>
- return "attribute value";
- when Iir_Kind_Attribute_Name =>
- return "attribute";
- when Iir_Kind_Base_Attribute =>
- return "'base attribute";
- when Iir_Kind_Length_Array_Attribute =>
- return "'length attribute";
- when Iir_Kind_Range_Array_Attribute =>
- return "'range attribute";
- when Iir_Kind_Reverse_Range_Array_Attribute =>
- return "'reverse_range attribute";
- when Iir_Kind_Subtype_Attribute =>
- return "'subtype attribute";
- when Iir_Kind_Element_Attribute =>
- return "'element attribute";
- when Iir_Kind_Ascending_Type_Attribute
- | Iir_Kind_Ascending_Array_Attribute =>
- return "'ascending attribute";
- when Iir_Kind_Left_Type_Attribute
- | Iir_Kind_Left_Array_Attribute =>
- return "'left attribute";
- when Iir_Kind_Right_Type_Attribute
- | Iir_Kind_Right_Array_Attribute =>
- return "'right attribute";
- when Iir_Kind_Low_Type_Attribute
- | Iir_Kind_Low_Array_Attribute =>
- return "'low attribute";
- when Iir_Kind_Leftof_Attribute =>
- return "'leftof attribute";
- when Iir_Kind_Rightof_Attribute =>
- return "'rightof attribute";
- when Iir_Kind_Pred_Attribute =>
- return "'pred attribute";
- when Iir_Kind_Succ_Attribute =>
- return "'succ attribute";
- when Iir_Kind_Pos_Attribute =>
- return "'pos attribute";
- when Iir_Kind_Val_Attribute =>
- return "'val attribute";
- when Iir_Kind_Image_Attribute =>
- return "'image attribute";
- when Iir_Kind_Value_Attribute =>
- return "'value attribute";
- when Iir_Kind_High_Type_Attribute
- | Iir_Kind_High_Array_Attribute =>
- return "'high attribute";
- when Iir_Kind_Transaction_Attribute =>
- return "'transaction attribute";
- when Iir_Kind_Stable_Attribute =>
- return "'stable attribute";
- when Iir_Kind_Quiet_Attribute =>
- return "'quiet attribute";
- when Iir_Kind_Delayed_Attribute =>
- return "'delayed attribute";
- when Iir_Kind_Driving_Attribute =>
- return "'driving attribute";
- when Iir_Kind_Driving_Value_Attribute =>
- return "'driving_value attribute";
- when Iir_Kind_Event_Attribute =>
- return "'event attribute";
- when Iir_Kind_Active_Attribute =>
- return "'active attribute";
- when Iir_Kind_Last_Event_Attribute =>
- return "'last_event attribute";
- when Iir_Kind_Last_Active_Attribute =>
- return "'last_active attribute";
- when Iir_Kind_Last_Value_Attribute =>
- return "'last_value attribute";
- when Iir_Kind_Behavior_Attribute =>
- return "'behavior attribute";
- when Iir_Kind_Structure_Attribute =>
- return "'structure attribute";
-
- when Iir_Kind_Path_Name_Attribute =>
- return "'path_name attribute";
- when Iir_Kind_Instance_Name_Attribute =>
- return "'instance_name attribute";
- when Iir_Kind_Simple_Name_Attribute =>
- return "'simple_name attribute";
-
- when Iir_Kind_For_Loop_Statement =>
- return Disp_Label (Node, "for loop statement");
- when Iir_Kind_While_Loop_Statement =>
- return Disp_Label (Node, "loop statement");
- when Iir_Kind_Process_Statement
- | Iir_Kind_Sensitized_Process_Statement =>
- return Disp_Label (Node, "process");
- when Iir_Kind_Block_Statement =>
- return Disp_Label (Node, "block statement");
- when Iir_Kind_Block_Header =>
- return "block header";
- when Iir_Kind_Concurrent_Simple_Signal_Assignment =>
- return Disp_Label
- (Node, "concurrent simple signal assignment");
- when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
- return Disp_Label
- (Node, "concurrent conditional signal assignment");
- when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
- return Disp_Label
- (Node, "concurrent selected signal assignment");
- when Iir_Kind_Concurrent_Assertion_Statement =>
- return Disp_Label (Node, "concurrent assertion");
- when Iir_Kind_Psl_Assert_Statement =>
- return Disp_Label (Node, "PSL assertion");
- when Iir_Kind_Psl_Cover_Statement =>
- return Disp_Label (Node, "PSL cover");
- when Iir_Kind_Psl_Default_Clock =>
- return "PSL default clock";
-
- when Iir_Kind_If_Statement =>
- return Disp_Label (Node, "if statement");
- when Iir_Kind_Elsif =>
- return Disp_Label (Node, "else/elsif statement");
- when Iir_Kind_Next_Statement =>
- return Disp_Label (Node, "next statement");
- when Iir_Kind_Exit_Statement =>
- return Disp_Label (Node, "exit statement");
- when Iir_Kind_Case_Statement =>
- return Disp_Label (Node, "case statement");
- when Iir_Kind_Return_Statement =>
- return Disp_Label (Node, "return statement");
- when Iir_Kind_Simple_Signal_Assignment_Statement =>
- return Disp_Label (Node, "signal assignment statement");
- when Iir_Kind_Conditional_Signal_Assignment_Statement =>
- return Disp_Label
- (Node, "conditional signal assignment statement");
- when Iir_Kind_Selected_Waveform_Assignment_Statement =>
- return Disp_Label
- (Node, "selected waveform assignment statement");
- when Iir_Kind_Variable_Assignment_Statement =>
- return Disp_Label (Node, "variable assignment statement");
- when Iir_Kind_Conditional_Variable_Assignment_Statement =>
- return Disp_Label
- (Node, "conditional variable assignment statement");
- when Iir_Kind_Null_Statement =>
- return Disp_Label (Node, "null statement");
- when Iir_Kind_Wait_Statement =>
- return Disp_Label (Node, "wait statement");
- when Iir_Kind_Assertion_Statement =>
- return Disp_Label (Node, "assertion statement");
- when Iir_Kind_Report_Statement =>
- return Disp_Label (Node, "report statement");
-
- when Iir_Kind_Block_Configuration =>
- return "block configuration";
- when Iir_Kind_Binding_Indication =>
- return "binding indication";
-
- when Iir_Kind_Error =>
- return "error";
- when Iir_Kind_Unused =>
- return "*unused*";
- end case;
- end Disp_Node;
-
- -- Disp a node location.
- -- Used for output of message.
-
- function Disp_Location (Node: Iir) return String is
- begin
- return Image (Get_Location (Node));
- end Disp_Location;
-
- function Disp_Name (Kind : Iir_Kind) return String is
- begin
- case Kind is
- when Iir_Kind_Constant_Declaration =>
- return "constant declaration";
- when Iir_Kind_Signal_Declaration =>
- return "signal declaration";
- when Iir_Kind_Variable_Declaration =>
- return "variable declaration";
- when Iir_Kind_File_Declaration =>
- return "file declaration";
- when others =>
- return "???" & Iir_Kind'Image (Kind);
- end case;
- end Disp_Name;
-
- function Image (N : Iir_Int64) return String
- is
- Res : constant String := Iir_Int64'Image (N);
- begin
- if Res (1) = ' ' then
- return Res (2 .. Res'Last);
- else
- return Res;
- end if;
- end Image;
-
- function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String is
- begin
- case Get_Kind (Dtype) is
- when Iir_Kind_Integer_Type_Definition =>
- return Image (Pos);
- when Iir_Kind_Enumeration_Type_Definition =>
- return Name_Table.Image
- (Get_Identifier (Get_Nth_Element
- (Get_Enumeration_Literal_List (Dtype),
- Natural (Pos))));
- when others =>
- Error_Kind ("disp_discrete", Dtype);
- end case;
- end Disp_Discrete;
-
- function Disp_Subprg (Subprg : Iir) return String
- is
- use Ada.Strings.Unbounded;
- Res : Unbounded_String;
-
- procedure Append_Type (Def : Iir)
- is
- use Name_Table;
- Decl : Iir := Get_Type_Declarator (Def);
- begin
- if Decl = Null_Iir then
- Decl := Get_Type_Declarator (Get_Base_Type (Def));
- if Decl = Null_Iir then
- Append (Res, "*unknown*");
- return;
- end if;
- end if;
- Append (Res, Image (Get_Identifier (Decl)));
- end Append_Type;
-
+ function Make_Earg_Vhdl_Node (V : Iir) return Earg_Type is
begin
- case Get_Kind (Subprg) is
- when Iir_Kind_Enumeration_Literal =>
- Append (Res, "enumeration literal ");
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Interface_Function_Declaration =>
- Append (Res, "function ");
- when Iir_Kind_Procedure_Declaration
- | Iir_Kind_Interface_Procedure_Declaration =>
- Append (Res, "procedure ");
- when others =>
- Error_Kind ("disp_subprg", Subprg);
- end case;
-
- declare
- use Name_Table;
-
- Id : constant Name_Id := Get_Identifier (Subprg);
- begin
- case Id is
- when Std_Names.Name_Id_Operators
- | Std_Names.Name_Word_Operators
- | Std_Names.Name_Xnor
- | Std_Names.Name_Shift_Operators =>
- Append (Res, """");
- Append (Res, Image (Id));
- Append (Res, """");
- when others =>
- Append (Res, Image (Id));
- end case;
- end;
-
- Append (Res, " [");
-
- case Get_Kind (Subprg) is
- when Iir_Kinds_Subprogram_Declaration
- | Iir_Kinds_Interface_Subprogram_Declaration =>
- declare
- El : Iir;
- begin
- El := Get_Interface_Declaration_Chain (Subprg);
- while El /= Null_Iir loop
- Append_Type (Get_Type (El));
- El := Get_Chain (El);
- exit when El = Null_Iir;
- Append (Res, ", ");
- end loop;
- end;
- when others =>
- null;
- end case;
-
- case Get_Kind (Subprg) is
- when Iir_Kind_Function_Declaration
- | Iir_Kind_Interface_Function_Declaration
- | Iir_Kind_Enumeration_Literal =>
- Append (Res, " return ");
- Append_Type (Get_Return_Type (Subprg));
- when others =>
- null;
- end case;
-
- Append (Res, "]");
-
- return To_String (Res);
- end Disp_Subprg;
-
- -- DEF must be any type definition.
- -- Return the type name of DEF, handle anonymous subtypes.
- function Disp_Type_Name (Def : Iir) return String
- is
- Decl : Iir;
- begin
- Decl := Get_Type_Declarator (Def);
- if Decl /= Null_Iir then
- return Image_Identifier (Decl);
- end if;
- Decl := Get_Type_Declarator (Get_Base_Type (Def));
- if Decl /= Null_Iir then
- return "a subtype of " & Image_Identifier (Decl);
- else
- return "an unknown type";
- end if;
- end Disp_Type_Name;
-
- function Disp_Type_Of (Node : Iir) return String
- is
- A_Type : Iir;
- begin
- A_Type := Get_Type (Node);
- if A_Type = Null_Iir then
- return "unknown";
- elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then
- declare
- use Ada.Strings.Unbounded;
- List : constant Iir_List := Get_Overload_List (A_Type);
- Nbr : constant Natural := Get_Nbr_Elements (List);
- Res : Unbounded_String;
- El : Iir;
- It : List_Iterator;
- begin
- if Nbr = 0 then
- return "unknown";
- elsif Nbr = 1 then
- return Disp_Type_Name (Get_First_Element (List));
- else
- Append (Res, "one of ");
- It := List_Iterate (List);
- for I in 0 .. Nbr - 1 loop
- pragma Assert (Is_Valid (It));
- El := Get_Element (It);
- Append (Res, Disp_Type_Name (El));
- if I < Nbr - 2 then
- Append (Res, ", ");
- elsif I = Nbr - 2 then
- Append (Res, " or ");
- end if;
- Next (It);
- end loop;
- return To_String (Res);
- end if;
- end;
- else
- return Disp_Type_Name (A_Type);
- end if;
- end Disp_Type_Of;
-
- procedure Error_Pure
- (Origin : Report_Origin; Caller : Iir; Callee : Iir; Loc : Iir)
- is
- L : Iir;
- begin
- if Loc = Null_Iir then
- L := Caller;
- else
- L := Loc;
- end if;
- Error_Msg_Relaxed
- (Origin, Warnid_Pure,
- "pure " & Disp_Node (Caller) & " cannot call (impure) "
- & Disp_Node (Callee), L);
- Error_Msg_Relaxed
- (Origin, Warnid_Pure,
- "(" & Disp_Node (Callee) & " is defined here)", Callee);
- end Error_Pure;
+ return (Kind => Earg_Iir, Val_Iir => V);
+ end Make_Earg_Vhdl_Node;
- procedure Error_Not_Match (Expr: Iir; A_Type: Iir) is
+ function Make_Earg_Vhdl_Token (V : Vhdl.Tokens.Token_Type)
+ return Earg_Type is
begin
- if Get_Kind (A_Type) = Iir_Kind_Error then
- -- Cascade error message.
- return;
- end if;
- Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type "
- & Disp_Node (A_Type), Expr);
- end Error_Not_Match;
+ return (Kind => Earg_Token, Val_Tok => V);
+ end Make_Earg_Vhdl_Token;
- function Get_Mode_Name (Mode : Iir_Mode) return String is
- begin
- case Mode is
- when Iir_Unknown_Mode =>
- raise Internal_Error;
- when Iir_Linkage_Mode =>
- return "linkage";
- when Iir_Buffer_Mode =>
- return "buffer";
- when Iir_Out_Mode =>
- return "out";
- when Iir_Inout_Mode =>
- return "inout";
- when Iir_In_Mode =>
- return "in";
- end case;
- end Get_Mode_Name;
end Errorout;
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index 6825b1c0d..1abacca3a 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -24,8 +24,6 @@ package Errorout is
Compilation_Error: exception;
-- This kind can't be handled.
- procedure Error_Kind (Msg: String; An_Iir: in Iir);
- procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions);
procedure Error_Kind (Msg : String; N : PSL_Node);
pragma No_Return (Error_Kind);
@@ -163,15 +161,12 @@ package Errorout is
-- %n: node name
-- %s: a string
-- TODO: %m: mode, %y: type of
- function "+" (V : Iir) return Earg_Type;
function "+" (V : Location_Type) return Earg_Type;
function "+" (V : Name_Id) return Earg_Type;
- function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type;
function "+" (V : Character) return Earg_Type;
function "+" (V : String8_Len_Type) return Earg_Type;
-- Convert location.
- function "+" (L : Iir) return Location_Type;
function "+" (L : PSL_Node) return Location_Type;
-- Pass that detected the error.
@@ -230,104 +225,8 @@ package Errorout is
-- Warn about an option.
procedure Warning_Msg_Option (Id : Msgid_Warnings; Msg: String);
- -- Disp a message during semantic analysis.
- procedure Warning_Msg_Sem (Id : Msgid_Warnings;
- Loc : Location_Type;
- Msg: String;
- Args : Earg_Arr := No_Eargs;
- Cont : Boolean := False);
- procedure Warning_Msg_Sem (Id : Msgid_Warnings;
- Loc : Location_Type;
- Msg: String;
- Arg1 : Earg_Type;
- Cont : Boolean := False);
-
- procedure Error_Msg_Sem (Loc: Location_Type;
- Msg: String;
- Args : Earg_Arr := No_Eargs;
- Cont : Boolean := False);
- procedure Error_Msg_Sem
- (Loc: Location_Type; Msg: String; Arg1 : Earg_Type);
- procedure Error_Msg_Sem_1 (Msg: String; Loc : PSL_Node);
-
- -- Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c.
- procedure Error_Msg_Sem_Relaxed (Loc : Iir;
- Id : Msgid_Warnings;
- Msg : String;
- Args : Earg_Arr := No_Eargs);
-
- -- Disp a message during elaboration (or configuration).
- procedure Error_Msg_Elab
- (Msg: String; Args : Earg_Arr := No_Eargs);
- procedure Error_Msg_Elab
- (Msg: String; Arg1 : Earg_Type);
- procedure Error_Msg_Elab
- (Loc: Iir; Msg: String; Args : Earg_Arr := No_Eargs);
- procedure Error_Msg_Elab
- (Loc: Iir; Msg: String; Arg1 : Earg_Type);
-
- -- Like Error_Msg_Elab, but a warning if -frelaxed or --std=93c.
- procedure Error_Msg_Elab_Relaxed (Loc : Iir;
- Id : Msgid_Warnings;
- Msg : String;
- Args : Earg_Arr := No_Eargs);
-
- -- Disp a warning durig elaboration (or configuration).
- procedure Warning_Msg_Elab (Id : Msgid_Warnings;
- Loc : Iir;
- Msg: String;
- Arg1 : Earg_Type;
- Cont : Boolean := False);
- procedure Warning_Msg_Elab (Id : Msgid_Warnings;
- Loc : Iir;
- Msg: String;
- Args : Earg_Arr := No_Eargs;
- Cont : Boolean := False);
-
- -- Disp a bug message.
- procedure Error_Internal (Expr: Iir; Msg: String := "");
- pragma No_Return (Error_Internal);
-
- -- Disp a node.
- -- Used for output of message.
- function Disp_Node (Node: Iir) return String;
-
- -- Disp a node location.
- -- Used for output of message.
- function Disp_Location (Node: Iir) return String;
-
- -- Disp non-terminal name from KIND.
- function Disp_Name (Kind : Iir_Kind) return String;
-
- -- SUBPRG must be a subprogram declaration or an enumeration literal
- -- declaration.
- -- Returns:
- -- "enumeration literal XX [ return TYPE ]"
- -- "function XXX [ TYPE1, TYPE2 return TYPE ]"
- -- "procedure XXX [ TYPE1, TYPE2 ]"
- -- "implicit function XXX [ TYPE1, TYPE2 return TYPE ]"
- -- "implicit procedure XXX [ TYPE1, TYPE2 ]"
- function Disp_Subprg (Subprg : Iir) return String;
-
- -- Print element POS of discrete type DTYPE.
- function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String;
-
- -- Disp the name of the type of NODE if known.
- -- Disp "unknown" if it is not known.
- -- Disp all possible types if it is an overload list.
- function Disp_Type_Of (Node : Iir) return String;
-
- -- Disp an error message when a pure function CALLER calls impure CALLEE.
- procedure Error_Pure
- (Origin : Report_Origin; Caller : Iir; Callee : Iir; Loc : Iir);
-
- -- Report an error message as type of EXPR does not match A_TYPE.
- -- Location is EXPR.
- procedure Error_Not_Match (Expr: Iir; A_Type: Iir);
-
- -- Disp interface mode MODE.
- function Get_Mode_Name (Mode : Iir_Mode) return String;
-
+ function Make_Earg_Vhdl_Node (V : Iir) return Earg_Type;
+ function Make_Earg_Vhdl_Token (V : Vhdl.Tokens.Token_Type) return Earg_Type;
private
type Earg_Kind is
(Earg_None,
diff --git a/src/vhdl/psl-errors.ads b/src/vhdl/psl-errors.ads
index c65443aee..4d33faa51 100644
--- a/src/vhdl/psl-errors.ads
+++ b/src/vhdl/psl-errors.ads
@@ -1,5 +1,6 @@
with Types; use Types;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Files_Map;
package PSL.Errors is
@@ -10,5 +11,5 @@ package PSL.Errors is
Errorout.Error_Kind;
procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
- renames Errorout.Error_Msg_Sem_1;
+ renames Vhdl.Errors.Error_Msg_Sem_1;
end PSL.Errors;
diff --git a/src/vhdl/simulate/simul-annotations.adb b/src/vhdl/simulate/simul-annotations.adb
index 6fe7852f6..240464eed 100644
--- a/src/vhdl/simulate/simul-annotations.adb
+++ b/src/vhdl/simulate/simul-annotations.adb
@@ -19,7 +19,7 @@
with Tables;
with Ada.Text_IO;
with Vhdl.Std_Package;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Types; use Types;
diff --git a/src/vhdl/simulate/simul-debugger.adb b/src/vhdl/simulate/simul-debugger.adb
index a50542f38..d4bf1bce8 100644
--- a/src/vhdl/simulate/simul-debugger.adb
+++ b/src/vhdl/simulate/simul-debugger.adb
@@ -37,6 +37,7 @@ with Simul.Elaboration; use Simul.Elaboration;
with Simul.Execution; use Simul.Execution;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Disp_Vhdl;
with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk;
with Areapools; use Areapools;
diff --git a/src/vhdl/simulate/simul-elaboration-ams.adb b/src/vhdl/simulate/simul-elaboration-ams.adb
index f5cf20110..7772c9cf9 100644
--- a/src/vhdl/simulate/simul-elaboration-ams.adb
+++ b/src/vhdl/simulate/simul-elaboration-ams.adb
@@ -16,7 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Simul.Execution;
package body Simul.Elaboration.AMS is
diff --git a/src/vhdl/simulate/simul-elaboration.adb b/src/vhdl/simulate/simul-elaboration.adb
index 0d006f3a5..996a36804 100644
--- a/src/vhdl/simulate/simul-elaboration.adb
+++ b/src/vhdl/simulate/simul-elaboration.adb
@@ -19,6 +19,7 @@
with Ada.Text_IO;
with Str_Table;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Evaluation;
with Simul.Execution; use Simul.Execution;
with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/vhdl/simulate/simul-execution.adb b/src/vhdl/simulate/simul-execution.adb
index 19f9286b0..a9411d62f 100644
--- a/src/vhdl/simulate/simul-execution.adb
+++ b/src/vhdl/simulate/simul-execution.adb
@@ -21,7 +21,7 @@ with Ada.Text_IO; use Ada.Text_IO;
with System;
with Grt.Types; use Grt.Types;
with Flags; use Flags;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package;
with Vhdl.Evaluation;
with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb
index ab9b083fc..8a91ed179 100644
--- a/src/vhdl/simulate/simul-simulation-main.adb
+++ b/src/vhdl/simulate/simul-simulation-main.adb
@@ -21,6 +21,7 @@ with Ada.Text_IO; use Ada.Text_IO;
with Types; use Types;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with PSL.Nodes;
with PSL.NFAs;
with PSL.NFAs.Utils;
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index f29dfa76f..ea375b1d0 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -33,6 +33,7 @@ with Vhdl.Sem;
with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
with Errorout; use Errorout;
with Errorout.Console;
+with Vhdl.Errors; use Vhdl.Errors;
with GNAT.OS_Lib;
with Bug;
with Trans_Be;
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 164f7df3b..585b81fde 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -15,7 +15,8 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Errorout; use Errorout;
+
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Translation; use Translation;
with Trans.Chap2;
diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb
index 540f775d6..469de7cf6 100644
--- a/src/vhdl/translate/trans-chap12.adb
+++ b/src/vhdl/translate/trans-chap12.adb
@@ -18,6 +18,7 @@
with Vhdl.Configuration;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Utils; use Vhdl.Utils;
with Libraries;
diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb
index 439fc7035..e95afb5c4 100644
--- a/src/vhdl/translate/trans-chap14.adb
+++ b/src/vhdl/translate/trans-chap14.adb
@@ -18,7 +18,7 @@
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Std_Package; use Vhdl.Std_Package;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Trans_Decls; use Trans_Decls;
with Trans.Chap3;
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 0546a5cb7..7d32e50f6 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -18,7 +18,7 @@
with Std_Names;
with Vhdl.Std_Package; use Vhdl.Std_Package;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Inst;
with Vhdl.Nodes_Meta;
with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 9388c8fdc..971d52b31 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Name_Table;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Trans.Chap2;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 91861f0c6..419229e66 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -16,7 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Files_Map;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package; use Vhdl.Std_Package;
diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb
index b9c8e42d3..2aa7cfdea 100644
--- a/src/vhdl/translate/trans-chap5.adb
+++ b/src/vhdl/translate/trans-chap5.adb
@@ -16,7 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Trans.Chap3;
with Trans.Chap4;
diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index ffb0581a0..9d0da87c8 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Files_Map;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Trans.Chap3;
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 347281d3a..98cc8894e 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -23,6 +23,7 @@ with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Flags; use Flags;
with Vhdl.Canon;
with Vhdl.Evaluation; use Vhdl.Evaluation;
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index 34adc93c6..79b05a055 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -18,7 +18,7 @@
with Ada.Text_IO;
with Std_Names;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Nodes_Utils;
with Vhdl.Canon;
with Vhdl.Evaluation; use Vhdl.Evaluation;
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index f6f7cc465..0ff2d31d0 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -18,6 +18,7 @@
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Flags;
with Libraries;
diff --git a/src/vhdl/translate/trans-foreach_non_composite.adb b/src/vhdl/translate/trans-foreach_non_composite.adb
index 373246415..e34e09e4a 100644
--- a/src/vhdl/translate/trans-foreach_non_composite.adb
+++ b/src/vhdl/translate/trans-foreach_non_composite.adb
@@ -16,7 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Trans.Chap3;
with Trans.Chap6;
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 49b5b30a2..759a066cb 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -18,7 +18,7 @@
with Name_Table;
with Files_Map;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Configuration;
with Libraries;
diff --git a/src/vhdl/translate/trans_analyzes.adb b/src/vhdl/translate/trans_analyzes.adb
index b3940e398..8362938d8 100644
--- a/src/vhdl/translate/trans_analyzes.adb
+++ b/src/vhdl/translate/trans_analyzes.adb
@@ -21,6 +21,7 @@ with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk;
with Vhdl.Disp_Vhdl;
with Ada.Text_IO;
with Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
package body Trans_Analyzes is
Driver_List : Iir_List;
diff --git a/src/vhdl/translate/trans_be.adb b/src/vhdl/translate/trans_be.adb
index af76725d1..de7078651 100644
--- a/src/vhdl/translate/trans_be.adb
+++ b/src/vhdl/translate/trans_be.adb
@@ -15,7 +15,8 @@
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-with Errorout; use Errorout;
+
+with Vhdl.Errors; use Vhdl.Errors;
with Ada.Text_IO;
with Vhdl.Back_End;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 3f2ce1a7f..de83ba132 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -21,6 +21,7 @@ with Ortho_Ident; use Ortho_Ident;
with Flags; use Flags;
with Types; use Types;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Name_Table; -- use Name_Table;
with Str_Table;
with Files_Map;
diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
index 181e55217..29b52c798 100644
--- a/src/vhdl/vhdl-canon.adb
+++ b/src/vhdl/vhdl-canon.adb
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Types; use Types;
with Flags; use Flags;
diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb
index e23d8e9cf..95ed0eb4e 100644
--- a/src/vhdl/vhdl-configuration.adb
+++ b/src/vhdl/vhdl-configuration.adb
@@ -18,6 +18,7 @@
with Libraries;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package;
with Name_Table; use Name_Table;
with Flags;
diff --git a/src/vhdl/vhdl-disp_vhdl.adb b/src/vhdl/vhdl-disp_vhdl.adb
index b6904c07f..464e003f1 100644
--- a/src/vhdl/vhdl-disp_vhdl.adb
+++ b/src/vhdl/vhdl-disp_vhdl.adb
@@ -24,6 +24,7 @@ with GNAT.OS_Lib;
with Vhdl.Std_Package;
with Flags; use Flags;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Name_Table;
with Str_Table;
diff --git a/src/vhdl/vhdl-errors.adb b/src/vhdl/vhdl-errors.adb
new file mode 100644
index 000000000..18ed5d4f8
--- /dev/null
+++ b/src/vhdl/vhdl-errors.adb
@@ -0,0 +1,990 @@
+-- Error message handling for vhdl.
+-- Copyright (C) 2002-2019 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+
+with Flags; use Flags;
+with Name_Table;
+with Files_Map;
+with Vhdl.Utils; use Vhdl.Utils;
+with Ada.Strings.Unbounded;
+with Std_Names;
+with Logging; use Logging;
+
+package body Vhdl.Errors is
+ procedure Error_Kind (Msg : String; An_Iir : Iir) is
+ begin
+ Log_Line
+ (Msg & ": cannot handle " & Iir_Kind'Image (Get_Kind (An_Iir))
+ & " (" & Disp_Location (An_Iir) & ')');
+ raise Internal_Error;
+ end Error_Kind;
+
+ procedure Error_Kind (Msg : String; Def : Iir_Predefined_Functions) is
+ begin
+ Log_Line
+ (Msg & ": cannot handle " & Iir_Predefined_Functions'Image (Def));
+ raise Internal_Error;
+ end Error_Kind;
+
+ 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 Warning_Msg_Sem (Id : Msgid_Warnings;
+ Loc : Location_Type;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False) is
+ begin
+ if Flags.Flag_Only_Elab_Warnings then
+ return;
+ end if;
+ Report_Msg (Id, Semantic, Loc, Msg, Args, Cont);
+ end Warning_Msg_Sem;
+
+ procedure Warning_Msg_Sem (Id : Msgid_Warnings;
+ Loc : Location_Type;
+ Msg: String;
+ Arg1 : Earg_Type;
+ Cont : Boolean := False) is
+ begin
+ Warning_Msg_Sem (Id, Loc, Msg, Earg_Arr'(1 => Arg1), Cont);
+ end Warning_Msg_Sem;
+
+ procedure Warning_Msg_Elab (Id : Msgid_Warnings;
+ Loc : Iir;
+ Msg: String;
+ Arg1 : Earg_Type;
+ Cont : Boolean := False) is
+ begin
+ Report_Msg (Id, Elaboration, +Loc, Msg, Earg_Arr'(1 => Arg1), Cont);
+ end Warning_Msg_Elab;
+
+ procedure Warning_Msg_Elab (Id : Msgid_Warnings;
+ Loc : Iir;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False) is
+ begin
+ Report_Msg (Id, Elaboration, +Loc, Msg, Args, Cont);
+ end Warning_Msg_Elab;
+
+ -- Disp a message during semantic analysis.
+ -- LOC is used for location and current token.
+ procedure Error_Msg_Sem (Msg: String; Loc: in Iir) is
+ begin
+ Report_Msg (Msgid_Error, Semantic, Get_Location_Safe (Loc), Msg);
+ end Error_Msg_Sem;
+
+ procedure Error_Msg_Sem (Loc: Location_Type;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False) is
+ begin
+ Report_Msg (Msgid_Error, Semantic, Loc, Msg, Args, Cont);
+ end Error_Msg_Sem;
+
+ procedure Error_Msg_Sem
+ (Loc: Location_Type; Msg: String; Arg1 : Earg_Type) is
+ begin
+ Report_Msg (Msgid_Error, Semantic, Loc, Msg, (1 => Arg1));
+ end Error_Msg_Sem;
+
+ procedure Error_Msg_Sem_1 (Msg: String; Loc : PSL_Node) is
+ begin
+ Error_Msg_Sem (+Loc, Msg);
+ end Error_Msg_Sem_1;
+
+ procedure Error_Msg_Relaxed (Origin : Report_Origin;
+ Id : Msgid_Warnings;
+ Msg : String;
+ Loc : Iir;
+ Args : Earg_Arr := No_Eargs)
+ is
+ Level : Msgid_Type;
+ begin
+ if Flag_Relaxed_Rules or Vhdl_Std = Vhdl_93c then
+ if not Is_Warning_Enabled (Id) then
+ return;
+ end if;
+ Level := Id;
+ else
+ Level := Msgid_Error;
+ end if;
+ Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg, Args);
+ end Error_Msg_Relaxed;
+
+ procedure Error_Msg_Sem_Relaxed (Loc : Iir;
+ Id : Msgid_Warnings;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs) is
+ begin
+ Error_Msg_Relaxed (Semantic, Id, Msg, Loc, Args);
+ end Error_Msg_Sem_Relaxed;
+
+ -- Disp a message during elaboration.
+ procedure Error_Msg_Elab
+ (Msg: String; Args : Earg_Arr := No_Eargs) is
+ begin
+ Report_Msg (Msgid_Error, Elaboration, No_Location, Msg, Args);
+ end Error_Msg_Elab;
+
+ procedure Error_Msg_Elab
+ (Msg: String; Arg1 : Earg_Type) is
+ begin
+ Error_Msg_Elab (Msg, Earg_Arr'(1 => Arg1));
+ end Error_Msg_Elab;
+
+ procedure Error_Msg_Elab
+ (Loc: Iir; Msg: String; Args : Earg_Arr := No_Eargs) is
+ begin
+ Report_Msg (Msgid_Error, Elaboration, +Loc, Msg, Args);
+ end Error_Msg_Elab;
+
+ procedure Error_Msg_Elab
+ (Loc: Iir; Msg: String; Arg1 : Earg_Type) is
+ begin
+ Error_Msg_Elab (Loc, Msg, Earg_Arr'(1 => Arg1));
+ end Error_Msg_Elab;
+
+ procedure Error_Msg_Elab_Relaxed (Loc : Iir;
+ Id : Msgid_Warnings;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs) is
+ begin
+ Error_Msg_Relaxed (Elaboration, Id, Msg, Loc, Args);
+ end Error_Msg_Elab_Relaxed;
+
+ -- Disp a bug message.
+ procedure Error_Internal (Expr: in Iir; Msg: String := "")
+ is
+ pragma Unreferenced (Expr);
+ begin
+ Log ("internal error: ");
+ Log_Line (Msg);
+ raise Internal_Error;
+ end Error_Internal;
+
+ function Disp_Label (Node : Iir; Str : String) return String
+ is
+ Id : Name_Id;
+ begin
+ Id := Get_Label (Node);
+ if Id = Null_Identifier then
+ return "(unlabeled) " & Str;
+ else
+ return Str & " labeled """ & Name_Table.Image (Id) & """";
+ end if;
+ end Disp_Label;
+
+ -- Disp a node.
+ -- Used for output of message.
+ function Disp_Node (Node: Iir) return String is
+ function Disp_Identifier (Node : Iir; Str : String) return String
+ is
+ Id : Name_Id;
+ begin
+ Id := Get_Identifier (Node);
+ return Str & " """ & Name_Table.Image (Id) & """";
+ end Disp_Identifier;
+
+ function Disp_Type (Node : Iir; Str : String) return String
+ is
+ Decl: Iir;
+ begin
+ Decl := Get_Type_Declarator (Node);
+ if Decl = Null_Iir then
+ return "anonymous " & Str
+ & " defined at " & Disp_Location (Node);
+ else
+ return Disp_Identifier (Decl, Str);
+ end if;
+ end Disp_Type;
+
+ begin
+ case Get_Kind (Node) is
+ when Iir_Kind_String_Literal8 =>
+ return "string literal";
+ when Iir_Kind_Character_Literal =>
+ return "character literal " & Image_Identifier (Node);
+ when Iir_Kind_Integer_Literal =>
+ return "integer literal";
+ when Iir_Kind_Floating_Point_Literal =>
+ return "floating point literal";
+ when Iir_Kind_Physical_Int_Literal
+ | Iir_Kind_Physical_Fp_Literal =>
+ return "physical literal";
+ when Iir_Kind_Enumeration_Literal =>
+ return "enumeration literal " & Image_Identifier (Node);
+ when Iir_Kind_Element_Declaration =>
+ return Disp_Identifier (Node, "element");
+ when Iir_Kind_Record_Element_Constraint =>
+ return "record element constraint";
+ when Iir_Kind_Array_Element_Resolution =>
+ return "array element resolution";
+ when Iir_Kind_Record_Resolution =>
+ return "record resolution";
+ when Iir_Kind_Record_Element_Resolution =>
+ return "record element resolution";
+ when Iir_Kind_Null_Literal =>
+ return "null literal";
+ when Iir_Kind_Overflow_Literal =>
+ return Disp_Node (Get_Literal_Origin (Node));
+ when Iir_Kind_Unaffected_Waveform =>
+ return "unaffected waveform";
+ when Iir_Kind_Aggregate =>
+ return "aggregate";
+ when Iir_Kind_Unit_Declaration =>
+ return Disp_Identifier (Node, "physical unit");
+ when Iir_Kind_Simple_Aggregate =>
+ return "locally static array literal";
+
+ when Iir_Kind_Operator_Symbol =>
+ return "operator name";
+ when Iir_Kind_Aggregate_Info =>
+ return "aggregate info";
+ when Iir_Kind_Signature =>
+ return "signature";
+ when Iir_Kind_Waveform_Element =>
+ return "waveform element";
+ when Iir_Kind_Conditional_Waveform =>
+ return "conditional waveform";
+ when Iir_Kind_Conditional_Expression =>
+ return "conditional expression";
+ when Iir_Kind_Association_Element_Open =>
+ return "open association element";
+ when Iir_Kind_Association_Element_By_Individual =>
+ return "individual association element";
+ when Iir_Kind_Association_Element_By_Expression
+ | Iir_Kind_Association_Element_Package
+ | Iir_Kind_Association_Element_Type
+ | Iir_Kind_Association_Element_Subprogram =>
+ return "association element";
+ when Iir_Kind_Overload_List =>
+ return "overloaded name or expression";
+
+ when Iir_Kind_Integer_Type_Definition
+ | Iir_Kind_Enumeration_Type_Definition =>
+ return Image_Identifier (Get_Type_Declarator (Node));
+ when Iir_Kind_Wildcard_Type_Definition =>
+ return "<any>";
+ when Iir_Kind_Array_Type_Definition =>
+ return Disp_Type (Node, "array type");
+ when Iir_Kind_Array_Subtype_Definition =>
+ return Disp_Type (Node, "array subtype");
+ when Iir_Kind_Record_Type_Definition =>
+ return Disp_Type (Node, "record type");
+ when Iir_Kind_Record_Subtype_Definition =>
+ return Disp_Type (Node, "record subtype");
+ when Iir_Kind_Enumeration_Subtype_Definition =>
+ return Disp_Type (Node, "enumeration subtype");
+ when Iir_Kind_Integer_Subtype_Definition =>
+ return Disp_Type (Node, "integer subtype");
+ when Iir_Kind_Physical_Type_Definition =>
+ return Disp_Type (Node, "physical type");
+ when Iir_Kind_Physical_Subtype_Definition =>
+ return Disp_Type (Node, "physical subtype");
+ when Iir_Kind_File_Type_Definition =>
+ return Disp_Type (Node, "file type");
+ when Iir_Kind_Access_Type_Definition =>
+ return Disp_Type (Node, "access type");
+ when Iir_Kind_Access_Subtype_Definition =>
+ return Disp_Type (Node, "access subtype");
+ when Iir_Kind_Floating_Subtype_Definition
+ | Iir_Kind_Floating_Type_Definition =>
+ return Disp_Type (Node, "floating type");
+ when Iir_Kind_Incomplete_Type_Definition =>
+ return Disp_Type (Node, "incomplete type");
+ when Iir_Kind_Interface_Type_Definition =>
+ return Disp_Type (Node, "interface type");
+ when Iir_Kind_Protected_Type_Declaration =>
+ return Disp_Type (Node, "protected type");
+ when Iir_Kind_Protected_Type_Body =>
+ return Disp_Type (Node, "protected type body");
+ when Iir_Kind_Subtype_Definition =>
+ return "subtype definition";
+
+ when Iir_Kind_Scalar_Nature_Definition =>
+ return Image_Identifier (Get_Nature_Declarator (Node));
+
+ when Iir_Kind_Choice_By_Expression =>
+ return "choice by expression";
+ when Iir_Kind_Choice_By_Range =>
+ return "choice by range";
+ when Iir_Kind_Choice_By_Name =>
+ return "choice by name";
+ when Iir_Kind_Choice_By_Others =>
+ return "others choice";
+ when Iir_Kind_Choice_By_None =>
+ return "positionnal choice";
+
+ when Iir_Kind_Function_Call =>
+ return "function call";
+ when Iir_Kind_Procedure_Call_Statement =>
+ return "procedure call statement";
+ when Iir_Kind_Procedure_Call =>
+ return "procedure call";
+ when Iir_Kind_Selected_Name =>
+ return ''' & Name_Table.Image (Get_Identifier (Node)) & ''';
+ when Iir_Kind_Simple_Name =>
+ return ''' & Name_Table.Image (Get_Identifier (Node)) & ''';
+ when Iir_Kind_Reference_Name =>
+ -- Shouldn't happen.
+ return "name";
+ when Iir_Kind_External_Constant_Name =>
+ return "external constant name";
+ when Iir_Kind_External_Signal_Name =>
+ return "external signal name";
+ when Iir_Kind_External_Variable_Name =>
+ return "external variable name";
+
+ when Iir_Kind_Package_Pathname =>
+ return "package pathname";
+ when Iir_Kind_Absolute_Pathname =>
+ return "absolute pathname";
+ when Iir_Kind_Relative_Pathname =>
+ return "relative pathname";
+ when Iir_Kind_Pathname_Element =>
+ return "pathname element";
+
+ when Iir_Kind_Entity_Aspect_Entity =>
+ declare
+ Arch : constant Iir := Get_Architecture (Node);
+ Ent : constant Iir := Get_Entity (Node);
+ begin
+ if Arch = Null_Iir then
+ return "aspect " & Disp_Node (Ent);
+ else
+ return "aspect " & Disp_Node (Ent)
+ & '(' & Image_Identifier (Arch) & ')';
+ end if;
+ end;
+ when Iir_Kind_Entity_Aspect_Configuration =>
+ return "configuration entity aspect";
+ when Iir_Kind_Entity_Aspect_Open =>
+ return "open entity aspect";
+
+ when Iir_Kinds_Monadic_Operator
+ | Iir_Kinds_Dyadic_Operator =>
+ return "operator """
+ & Name_Table.Image (Get_Operator_Name (Node)) & """";
+ when Iir_Kind_Parenthesis_Expression =>
+ return "expression";
+ when Iir_Kind_Qualified_Expression =>
+ return "qualified expression";
+ when Iir_Kind_Type_Conversion =>
+ return "type conversion";
+ when Iir_Kind_Allocator_By_Subtype
+ | Iir_Kind_Allocator_By_Expression =>
+ return "allocator";
+ when Iir_Kind_Indexed_Name =>
+ return "indexed name";
+ when Iir_Kind_Range_Expression =>
+ return "range expression";
+ when Iir_Kind_Implicit_Dereference =>
+ return "implicit access dereference";
+ when Iir_Kind_Dereference =>
+ return "access dereference";
+ when Iir_Kind_Selected_Element =>
+ return "selected element";
+ when Iir_Kind_Selected_By_All_Name =>
+ return ".all name";
+ when Iir_Kind_Psl_Expression =>
+ return "PSL instantiation";
+
+ when Iir_Kind_Interface_Constant_Declaration =>
+ if Get_Parent (Node) = Null_Iir then
+ -- For constant interface of predefined operator.
+ return "anonymous interface";
+ end if;
+ case Get_Kind (Get_Parent (Node)) is
+ when Iir_Kind_Entity_Declaration
+ | Iir_Kind_Block_Statement
+ | Iir_Kind_Block_Header =>
+ return Disp_Identifier (Node, "generic");
+ when others =>
+ return Disp_Identifier (Node, "constant interface");
+ end case;
+ when Iir_Kind_Interface_Signal_Declaration =>
+ case Get_Kind (Get_Parent (Node)) is
+ when Iir_Kind_Entity_Declaration
+ | Iir_Kind_Block_Statement
+ | Iir_Kind_Block_Header =>
+ return Disp_Identifier (Node, "port");
+ when others =>
+ return Disp_Identifier (Node, "signal interface");
+ end case;
+ when Iir_Kind_Interface_Variable_Declaration =>
+ return Disp_Identifier (Node, "variable interface");
+ when Iir_Kind_Interface_File_Declaration =>
+ return Disp_Identifier (Node, "file interface");
+ when Iir_Kind_Interface_Package_Declaration =>
+ return Disp_Identifier (Node, "package interface");
+ when Iir_Kind_Interface_Type_Declaration =>
+ return Disp_Identifier (Node, "type interface");
+ when Iir_Kind_Signal_Declaration =>
+ return Disp_Identifier (Node, "signal");
+ when Iir_Kind_Variable_Declaration =>
+ return Disp_Identifier (Node, "variable");
+ when Iir_Kind_Iterator_Declaration
+ | Iir_Kind_Constant_Declaration =>
+ return Disp_Identifier (Node, "constant");
+ when Iir_Kind_File_Declaration =>
+ return Disp_Identifier (Node, "file");
+ when Iir_Kind_Object_Alias_Declaration =>
+ return Disp_Identifier (Node, "alias");
+ when Iir_Kind_Non_Object_Alias_Declaration =>
+ return Disp_Identifier (Node, "non-object alias");
+ when Iir_Kind_Guard_Signal_Declaration =>
+ return "GUARD signal";
+ when Iir_Kind_Signal_Attribute_Declaration =>
+ -- Should not appear.
+ return "signal attribute";
+ when Iir_Kind_Group_Template_Declaration =>
+ return Disp_Identifier (Node, "group template");
+ when Iir_Kind_Group_Declaration =>
+ return Disp_Identifier (Node, "group");
+
+ when Iir_Kind_Library_Declaration
+ | Iir_Kind_Library_Clause =>
+ return Disp_Identifier (Node, "library");
+ when Iir_Kind_Design_File =>
+ return "design file";
+
+ when Iir_Kind_Procedure_Declaration =>
+ return Disp_Identifier (Node, "procedure");
+ when Iir_Kind_Function_Declaration =>
+ return Disp_Identifier (Node, "function");
+ when Iir_Kind_Interface_Procedure_Declaration =>
+ return Disp_Identifier (Node, "interface procedure");
+ when Iir_Kind_Interface_Function_Declaration =>
+ return Disp_Identifier (Node, "interface function");
+ when Iir_Kind_Procedure_Body
+ | Iir_Kind_Function_Body =>
+ return "subprogram body";
+
+ when Iir_Kind_Package_Declaration =>
+ return Disp_Identifier (Node, "package");
+ when Iir_Kind_Package_Body =>
+ return Disp_Identifier (Node, "package body");
+ when Iir_Kind_Entity_Declaration =>
+ return Disp_Identifier (Node, "entity");
+ when Iir_Kind_Architecture_Body =>
+ return Disp_Identifier (Node, "architecture") &
+ " of" & Disp_Identifier (Get_Entity_Name (Node), "");
+ when Iir_Kind_Configuration_Declaration =>
+ declare
+ Id : Name_Id;
+ Ent : Iir;
+ Arch : Iir;
+ begin
+ Id := Get_Identifier (Node);
+ if Id /= Null_Identifier then
+ return Disp_Identifier (Node, "configuration");
+ else
+ Ent := Get_Entity (Node);
+ Arch := Get_Block_Specification
+ (Get_Block_Configuration (Node));
+ return "default configuration of "
+ & Image_Identifier (Ent)
+ & '(' & Image_Identifier (Arch) & ')';
+ end if;
+ end;
+ when Iir_Kind_Context_Declaration =>
+ return Disp_Identifier (Node, "context");
+ when Iir_Kind_Package_Instantiation_Declaration =>
+ return Disp_Identifier (Node, "instantiation package");
+
+ when Iir_Kind_Package_Header =>
+ return "package header";
+
+ when Iir_Kind_Component_Declaration =>
+ return Disp_Identifier (Node, "component");
+
+ when Iir_Kind_Design_Unit =>
+ return Disp_Node (Get_Library_Unit (Node));
+ when Iir_Kind_Use_Clause =>
+ return "use clause";
+ when Iir_Kind_Context_Reference =>
+ return "context reference";
+ when Iir_Kind_Disconnection_Specification =>
+ return "disconnection specification";
+
+ when Iir_Kind_Slice_Name =>
+ return "slice";
+ when Iir_Kind_Parenthesis_Name =>
+ return "function call, slice or indexed name";
+ when Iir_Kind_Type_Declaration =>
+ return Disp_Identifier (Node, "type");
+ when Iir_Kind_Anonymous_Type_Declaration =>
+ return Disp_Identifier (Node, "type");
+ when Iir_Kind_Subtype_Declaration =>
+ return Disp_Identifier (Node, "subtype");
+
+ when Iir_Kind_Nature_Declaration =>
+ return Disp_Identifier (Node, "nature");
+ when Iir_Kind_Subnature_Declaration =>
+ return Disp_Identifier (Node, "subnature");
+
+ when Iir_Kind_Component_Instantiation_Statement =>
+ return Disp_Identifier (Node, "component instance");
+ when Iir_Kind_Configuration_Specification =>
+ return "configuration specification";
+ when Iir_Kind_Component_Configuration =>
+ return "component configuration";
+
+ when Iir_Kind_Concurrent_Procedure_Call_Statement =>
+ return "concurrent procedure call";
+ when Iir_Kind_For_Generate_Statement =>
+ return "for generate statement";
+ when Iir_Kind_If_Generate_Statement
+ | Iir_Kind_If_Generate_Else_Clause =>
+ return "if generate statement";
+ when Iir_Kind_Case_Generate_Statement =>
+ return "case generate statement";
+ when Iir_Kind_Generate_Statement_Body =>
+ return "generate statement";
+
+ when Iir_Kind_Simple_Simultaneous_Statement =>
+ return "simple simultaneous statement";
+
+ when Iir_Kind_Psl_Declaration =>
+ return Disp_Identifier (Node, "PSL declaration");
+ when Iir_Kind_Psl_Endpoint_Declaration =>
+ return Disp_Identifier (Node, "PSL endpoint declaration");
+
+ when Iir_Kind_Terminal_Declaration =>
+ return Disp_Identifier (Node, "terminal declaration");
+ when Iir_Kind_Free_Quantity_Declaration
+ | Iir_Kind_Across_Quantity_Declaration
+ | Iir_Kind_Through_Quantity_Declaration =>
+ return Disp_Identifier (Node, "quantity declaration");
+
+ when Iir_Kind_Attribute_Declaration =>
+ return Disp_Identifier (Node, "attribute");
+ when Iir_Kind_Attribute_Specification =>
+ return "attribute specification";
+ when Iir_Kind_Entity_Class =>
+ return "entity class";
+ when Iir_Kind_Attribute_Value =>
+ return "attribute value";
+ when Iir_Kind_Attribute_Name =>
+ return "attribute";
+ when Iir_Kind_Base_Attribute =>
+ return "'base attribute";
+ when Iir_Kind_Length_Array_Attribute =>
+ return "'length attribute";
+ when Iir_Kind_Range_Array_Attribute =>
+ return "'range attribute";
+ when Iir_Kind_Reverse_Range_Array_Attribute =>
+ return "'reverse_range attribute";
+ when Iir_Kind_Subtype_Attribute =>
+ return "'subtype attribute";
+ when Iir_Kind_Element_Attribute =>
+ return "'element attribute";
+ when Iir_Kind_Ascending_Type_Attribute
+ | Iir_Kind_Ascending_Array_Attribute =>
+ return "'ascending attribute";
+ when Iir_Kind_Left_Type_Attribute
+ | Iir_Kind_Left_Array_Attribute =>
+ return "'left attribute";
+ when Iir_Kind_Right_Type_Attribute
+ | Iir_Kind_Right_Array_Attribute =>
+ return "'right attribute";
+ when Iir_Kind_Low_Type_Attribute
+ | Iir_Kind_Low_Array_Attribute =>
+ return "'low attribute";
+ when Iir_Kind_Leftof_Attribute =>
+ return "'leftof attribute";
+ when Iir_Kind_Rightof_Attribute =>
+ return "'rightof attribute";
+ when Iir_Kind_Pred_Attribute =>
+ return "'pred attribute";
+ when Iir_Kind_Succ_Attribute =>
+ return "'succ attribute";
+ when Iir_Kind_Pos_Attribute =>
+ return "'pos attribute";
+ when Iir_Kind_Val_Attribute =>
+ return "'val attribute";
+ when Iir_Kind_Image_Attribute =>
+ return "'image attribute";
+ when Iir_Kind_Value_Attribute =>
+ return "'value attribute";
+ when Iir_Kind_High_Type_Attribute
+ | Iir_Kind_High_Array_Attribute =>
+ return "'high attribute";
+ when Iir_Kind_Transaction_Attribute =>
+ return "'transaction attribute";
+ when Iir_Kind_Stable_Attribute =>
+ return "'stable attribute";
+ when Iir_Kind_Quiet_Attribute =>
+ return "'quiet attribute";
+ when Iir_Kind_Delayed_Attribute =>
+ return "'delayed attribute";
+ when Iir_Kind_Driving_Attribute =>
+ return "'driving attribute";
+ when Iir_Kind_Driving_Value_Attribute =>
+ return "'driving_value attribute";
+ when Iir_Kind_Event_Attribute =>
+ return "'event attribute";
+ when Iir_Kind_Active_Attribute =>
+ return "'active attribute";
+ when Iir_Kind_Last_Event_Attribute =>
+ return "'last_event attribute";
+ when Iir_Kind_Last_Active_Attribute =>
+ return "'last_active attribute";
+ when Iir_Kind_Last_Value_Attribute =>
+ return "'last_value attribute";
+ when Iir_Kind_Behavior_Attribute =>
+ return "'behavior attribute";
+ when Iir_Kind_Structure_Attribute =>
+ return "'structure attribute";
+
+ when Iir_Kind_Path_Name_Attribute =>
+ return "'path_name attribute";
+ when Iir_Kind_Instance_Name_Attribute =>
+ return "'instance_name attribute";
+ when Iir_Kind_Simple_Name_Attribute =>
+ return "'simple_name attribute";
+
+ when Iir_Kind_For_Loop_Statement =>
+ return Disp_Label (Node, "for loop statement");
+ when Iir_Kind_While_Loop_Statement =>
+ return Disp_Label (Node, "loop statement");
+ when Iir_Kind_Process_Statement
+ | Iir_Kind_Sensitized_Process_Statement =>
+ return Disp_Label (Node, "process");
+ when Iir_Kind_Block_Statement =>
+ return Disp_Label (Node, "block statement");
+ when Iir_Kind_Block_Header =>
+ return "block header";
+ when Iir_Kind_Concurrent_Simple_Signal_Assignment =>
+ return Disp_Label
+ (Node, "concurrent simple signal assignment");
+ when Iir_Kind_Concurrent_Conditional_Signal_Assignment =>
+ return Disp_Label
+ (Node, "concurrent conditional signal assignment");
+ when Iir_Kind_Concurrent_Selected_Signal_Assignment =>
+ return Disp_Label
+ (Node, "concurrent selected signal assignment");
+ when Iir_Kind_Concurrent_Assertion_Statement =>
+ return Disp_Label (Node, "concurrent assertion");
+ when Iir_Kind_Psl_Assert_Statement =>
+ return Disp_Label (Node, "PSL assertion");
+ when Iir_Kind_Psl_Cover_Statement =>
+ return Disp_Label (Node, "PSL cover");
+ when Iir_Kind_Psl_Default_Clock =>
+ return "PSL default clock";
+
+ when Iir_Kind_If_Statement =>
+ return Disp_Label (Node, "if statement");
+ when Iir_Kind_Elsif =>
+ return Disp_Label (Node, "else/elsif statement");
+ when Iir_Kind_Next_Statement =>
+ return Disp_Label (Node, "next statement");
+ when Iir_Kind_Exit_Statement =>
+ return Disp_Label (Node, "exit statement");
+ when Iir_Kind_Case_Statement =>
+ return Disp_Label (Node, "case statement");
+ when Iir_Kind_Return_Statement =>
+ return Disp_Label (Node, "return statement");
+ when Iir_Kind_Simple_Signal_Assignment_Statement =>
+ return Disp_Label (Node, "signal assignment statement");
+ when Iir_Kind_Conditional_Signal_Assignment_Statement =>
+ return Disp_Label
+ (Node, "conditional signal assignment statement");
+ when Iir_Kind_Selected_Waveform_Assignment_Statement =>
+ return Disp_Label
+ (Node, "selected waveform assignment statement");
+ when Iir_Kind_Variable_Assignment_Statement =>
+ return Disp_Label (Node, "variable assignment statement");
+ when Iir_Kind_Conditional_Variable_Assignment_Statement =>
+ return Disp_Label
+ (Node, "conditional variable assignment statement");
+ when Iir_Kind_Null_Statement =>
+ return Disp_Label (Node, "null statement");
+ when Iir_Kind_Wait_Statement =>
+ return Disp_Label (Node, "wait statement");
+ when Iir_Kind_Assertion_Statement =>
+ return Disp_Label (Node, "assertion statement");
+ when Iir_Kind_Report_Statement =>
+ return Disp_Label (Node, "report statement");
+
+ when Iir_Kind_Block_Configuration =>
+ return "block configuration";
+ when Iir_Kind_Binding_Indication =>
+ return "binding indication";
+
+ when Iir_Kind_Error =>
+ return "error";
+ when Iir_Kind_Unused =>
+ return "*unused*";
+ end case;
+ end Disp_Node;
+
+ -- Disp a node location.
+ -- Used for output of message.
+
+ function Disp_Location (Node: Iir) return String is
+ begin
+ return Files_Map.Image (Get_Location (Node));
+ end Disp_Location;
+
+ function Disp_Name (Kind : Iir_Kind) return String is
+ begin
+ case Kind is
+ when Iir_Kind_Constant_Declaration =>
+ return "constant declaration";
+ when Iir_Kind_Signal_Declaration =>
+ return "signal declaration";
+ when Iir_Kind_Variable_Declaration =>
+ return "variable declaration";
+ when Iir_Kind_File_Declaration =>
+ return "file declaration";
+ when others =>
+ return "???" & Iir_Kind'Image (Kind);
+ end case;
+ end Disp_Name;
+
+ function Image (N : Iir_Int64) return String
+ is
+ Res : constant String := Iir_Int64'Image (N);
+ begin
+ if Res (1) = ' ' then
+ return Res (2 .. Res'Last);
+ else
+ return Res;
+ end if;
+ end Image;
+
+ function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String is
+ begin
+ case Get_Kind (Dtype) is
+ when Iir_Kind_Integer_Type_Definition =>
+ return Image (Pos);
+ when Iir_Kind_Enumeration_Type_Definition =>
+ return Name_Table.Image
+ (Get_Identifier (Get_Nth_Element
+ (Get_Enumeration_Literal_List (Dtype),
+ Natural (Pos))));
+ when others =>
+ Error_Kind ("disp_discrete", Dtype);
+ end case;
+ end Disp_Discrete;
+
+ function Disp_Subprg (Subprg : Iir) return String
+ is
+ use Ada.Strings.Unbounded;
+ Res : Unbounded_String;
+
+ procedure Append_Type (Def : Iir)
+ is
+ use Name_Table;
+ Decl : Iir := Get_Type_Declarator (Def);
+ begin
+ if Decl = Null_Iir then
+ Decl := Get_Type_Declarator (Get_Base_Type (Def));
+ if Decl = Null_Iir then
+ Append (Res, "*unknown*");
+ return;
+ end if;
+ end if;
+ Append (Res, Image (Get_Identifier (Decl)));
+ end Append_Type;
+
+ begin
+ case Get_Kind (Subprg) is
+ when Iir_Kind_Enumeration_Literal =>
+ Append (Res, "enumeration literal ");
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration =>
+ Append (Res, "function ");
+ when Iir_Kind_Procedure_Declaration
+ | Iir_Kind_Interface_Procedure_Declaration =>
+ Append (Res, "procedure ");
+ when others =>
+ Error_Kind ("disp_subprg", Subprg);
+ end case;
+
+ declare
+ use Name_Table;
+
+ Id : constant Name_Id := Get_Identifier (Subprg);
+ begin
+ case Id is
+ when Std_Names.Name_Id_Operators
+ | Std_Names.Name_Word_Operators
+ | Std_Names.Name_Xnor
+ | Std_Names.Name_Shift_Operators =>
+ Append (Res, """");
+ Append (Res, Image (Id));
+ Append (Res, """");
+ when others =>
+ Append (Res, Image (Id));
+ end case;
+ end;
+
+ Append (Res, " [");
+
+ case Get_Kind (Subprg) is
+ when Iir_Kinds_Subprogram_Declaration
+ | Iir_Kinds_Interface_Subprogram_Declaration =>
+ declare
+ El : Iir;
+ begin
+ El := Get_Interface_Declaration_Chain (Subprg);
+ while El /= Null_Iir loop
+ Append_Type (Get_Type (El));
+ El := Get_Chain (El);
+ exit when El = Null_Iir;
+ Append (Res, ", ");
+ end loop;
+ end;
+ when others =>
+ null;
+ end case;
+
+ case Get_Kind (Subprg) is
+ when Iir_Kind_Function_Declaration
+ | Iir_Kind_Interface_Function_Declaration
+ | Iir_Kind_Enumeration_Literal =>
+ Append (Res, " return ");
+ Append_Type (Get_Return_Type (Subprg));
+ when others =>
+ null;
+ end case;
+
+ Append (Res, "]");
+
+ return To_String (Res);
+ end Disp_Subprg;
+
+ -- DEF must be any type definition.
+ -- Return the type name of DEF, handle anonymous subtypes.
+ function Disp_Type_Name (Def : Iir) return String
+ is
+ Decl : Iir;
+ begin
+ Decl := Get_Type_Declarator (Def);
+ if Decl /= Null_Iir then
+ return Image_Identifier (Decl);
+ end if;
+ Decl := Get_Type_Declarator (Get_Base_Type (Def));
+ if Decl /= Null_Iir then
+ return "a subtype of " & Image_Identifier (Decl);
+ else
+ return "an unknown type";
+ end if;
+ end Disp_Type_Name;
+
+ function Disp_Type_Of (Node : Iir) return String
+ is
+ A_Type : Iir;
+ begin
+ A_Type := Get_Type (Node);
+ if A_Type = Null_Iir then
+ return "unknown";
+ elsif Get_Kind (A_Type) = Iir_Kind_Overload_List then
+ declare
+ use Ada.Strings.Unbounded;
+ List : constant Iir_List := Get_Overload_List (A_Type);
+ Nbr : constant Natural := Get_Nbr_Elements (List);
+ Res : Unbounded_String;
+ El : Iir;
+ It : List_Iterator;
+ begin
+ if Nbr = 0 then
+ return "unknown";
+ elsif Nbr = 1 then
+ return Disp_Type_Name (Get_First_Element (List));
+ else
+ Append (Res, "one of ");
+ It := List_Iterate (List);
+ for I in 0 .. Nbr - 1 loop
+ pragma Assert (Is_Valid (It));
+ El := Get_Element (It);
+ Append (Res, Disp_Type_Name (El));
+ if I < Nbr - 2 then
+ Append (Res, ", ");
+ elsif I = Nbr - 2 then
+ Append (Res, " or ");
+ end if;
+ Next (It);
+ end loop;
+ return To_String (Res);
+ end if;
+ end;
+ else
+ return Disp_Type_Name (A_Type);
+ end if;
+ end Disp_Type_Of;
+
+ procedure Error_Pure
+ (Origin : Report_Origin; Caller : Iir; Callee : Iir; Loc : Iir)
+ is
+ L : Iir;
+ begin
+ if Loc = Null_Iir then
+ L := Caller;
+ else
+ L := Loc;
+ end if;
+ Error_Msg_Relaxed
+ (Origin, Warnid_Pure,
+ "pure " & Disp_Node (Caller) & " cannot call (impure) "
+ & Disp_Node (Callee), L);
+ Error_Msg_Relaxed
+ (Origin, Warnid_Pure,
+ "(" & Disp_Node (Callee) & " is defined here)", Callee);
+ end Error_Pure;
+
+ procedure Error_Not_Match (Expr: Iir; A_Type: Iir) is
+ begin
+ if Get_Kind (A_Type) = Iir_Kind_Error then
+ -- Cascade error message.
+ return;
+ end if;
+ Error_Msg_Sem ("can't match " & Disp_Node (Expr) & " with type "
+ & Disp_Node (A_Type), Expr);
+ end Error_Not_Match;
+
+ function Get_Mode_Name (Mode : Iir_Mode) return String is
+ begin
+ case Mode is
+ when Iir_Unknown_Mode =>
+ raise Internal_Error;
+ when Iir_Linkage_Mode =>
+ return "linkage";
+ when Iir_Buffer_Mode =>
+ return "buffer";
+ when Iir_Out_Mode =>
+ return "out";
+ when Iir_Inout_Mode =>
+ return "inout";
+ when Iir_In_Mode =>
+ return "in";
+ end case;
+ end Get_Mode_Name;
+
+end Vhdl.Errors;
diff --git a/src/vhdl/vhdl-errors.ads b/src/vhdl/vhdl-errors.ads
new file mode 100644
index 000000000..0b44c2795
--- /dev/null
+++ b/src/vhdl/vhdl-errors.ads
@@ -0,0 +1,136 @@
+-- Error message handling for vhdl.
+-- Copyright (C) 2002-2019 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GHDL; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+with Types; use Types;
+with Errorout; use Errorout;
+with Vhdl.Nodes; use Vhdl.Nodes;
+with Vhdl.Tokens;
+
+package Vhdl.Errors is
+ -- This kind can't be handled.
+ procedure Error_Kind (Msg: String; An_Iir: in Iir);
+ procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions);
+ pragma No_Return (Error_Kind);
+
+ -- Conversions
+ function "+" (V : Iir) return Earg_Type
+ renames Errorout.Make_Earg_Vhdl_Node;
+ function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type
+ renames Errorout.Make_Earg_Vhdl_Token;
+
+ -- Convert location.
+ function "+" (L : Iir) return Location_Type;
+
+ -- Disp a message during semantic analysis.
+ procedure Warning_Msg_Sem (Id : Msgid_Warnings;
+ Loc : Location_Type;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False);
+ procedure Warning_Msg_Sem (Id : Msgid_Warnings;
+ Loc : Location_Type;
+ Msg: String;
+ Arg1 : Earg_Type;
+ Cont : Boolean := False);
+
+ procedure Error_Msg_Sem (Loc: Location_Type;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False);
+ procedure Error_Msg_Sem
+ (Loc: Location_Type; Msg: String; Arg1 : Earg_Type);
+ procedure Error_Msg_Sem_1 (Msg: String; Loc : PSL_Node);
+
+ -- Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c.
+ procedure Error_Msg_Sem_Relaxed (Loc : Iir;
+ Id : Msgid_Warnings;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs);
+
+ -- Disp a message during elaboration (or configuration).
+ procedure Error_Msg_Elab
+ (Msg: String; Args : Earg_Arr := No_Eargs);
+ procedure Error_Msg_Elab
+ (Msg: String; Arg1 : Earg_Type);
+ procedure Error_Msg_Elab
+ (Loc: Iir; Msg: String; Args : Earg_Arr := No_Eargs);
+ procedure Error_Msg_Elab
+ (Loc: Iir; Msg: String; Arg1 : Earg_Type);
+
+ -- Like Error_Msg_Elab, but a warning if -frelaxed or --std=93c.
+ procedure Error_Msg_Elab_Relaxed (Loc : Iir;
+ Id : Msgid_Warnings;
+ Msg : String;
+ Args : Earg_Arr := No_Eargs);
+
+ -- Disp a warning durig elaboration (or configuration).
+ procedure Warning_Msg_Elab (Id : Msgid_Warnings;
+ Loc : Iir;
+ Msg: String;
+ Arg1 : Earg_Type;
+ Cont : Boolean := False);
+ procedure Warning_Msg_Elab (Id : Msgid_Warnings;
+ Loc : Iir;
+ Msg: String;
+ Args : Earg_Arr := No_Eargs;
+ Cont : Boolean := False);
+
+ -- Disp a bug message.
+ procedure Error_Internal (Expr: Iir; Msg: String := "");
+ pragma No_Return (Error_Internal);
+
+ -- Disp a node.
+ -- Used for output of message.
+ function Disp_Node (Node: Iir) return String;
+
+ -- Disp a node location.
+ -- Used for output of message.
+ function Disp_Location (Node: Iir) return String;
+
+ -- Disp non-terminal name from KIND.
+ function Disp_Name (Kind : Iir_Kind) return String;
+
+ -- SUBPRG must be a subprogram declaration or an enumeration literal
+ -- declaration.
+ -- Returns:
+ -- "enumeration literal XX [ return TYPE ]"
+ -- "function XXX [ TYPE1, TYPE2 return TYPE ]"
+ -- "procedure XXX [ TYPE1, TYPE2 ]"
+ -- "implicit function XXX [ TYPE1, TYPE2 return TYPE ]"
+ -- "implicit procedure XXX [ TYPE1, TYPE2 ]"
+ function Disp_Subprg (Subprg : Iir) return String;
+
+ -- Print element POS of discrete type DTYPE.
+ function Disp_Discrete (Dtype : Iir; Pos : Iir_Int64) return String;
+
+ -- Disp the name of the type of NODE if known.
+ -- Disp "unknown" if it is not known.
+ -- Disp all possible types if it is an overload list.
+ function Disp_Type_Of (Node : Iir) return String;
+
+ -- Disp an error message when a pure function CALLER calls impure CALLEE.
+ procedure Error_Pure
+ (Origin : Report_Origin; Caller : Iir; Callee : Iir; Loc : Iir);
+
+ -- Report an error message as type of EXPR does not match A_TYPE.
+ -- Location is EXPR.
+ procedure Error_Not_Match (Expr: Iir; A_Type: Iir);
+
+ -- Disp interface mode MODE.
+ function Get_Mode_Name (Mode : Iir_Mode) return String;
+
+end Vhdl.Errors;
diff --git a/src/vhdl/vhdl-evaluation.adb b/src/vhdl/vhdl-evaluation.adb
index 6363411aa..ae2a38bc4 100644
--- a/src/vhdl/vhdl-evaluation.adb
+++ b/src/vhdl/vhdl-evaluation.adb
@@ -21,6 +21,7 @@ with Vhdl.Scanner;
with Errorout; use Errorout;
with Name_Table; use Name_Table;
with Str_Table;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Flags; use Flags;
diff --git a/src/vhdl/vhdl-ieee-numeric.adb b/src/vhdl/vhdl-ieee-numeric.adb
index 49f1ee4fb..c42fb59b4 100644
--- a/src/vhdl/vhdl-ieee-numeric.adb
+++ b/src/vhdl/vhdl-ieee-numeric.adb
@@ -19,7 +19,7 @@
with Types; use Types;
with Vhdl.Std_Package;
with Std_Names; use Std_Names;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Ieee.Std_Logic_1164;
package body Vhdl.Ieee.Numeric is
diff --git a/src/vhdl/vhdl-ieee-std_logic_1164.adb b/src/vhdl/vhdl-ieee-std_logic_1164.adb
index 6932dc9ef..58ce60769 100644
--- a/src/vhdl/vhdl-ieee-std_logic_1164.adb
+++ b/src/vhdl/vhdl-ieee-std_logic_1164.adb
@@ -18,7 +18,7 @@
with Types; use Types;
with Name_Table;
with Std_Names; use Std_Names;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
package body Vhdl.Ieee.Std_Logic_1164 is
function Is_Scalar_Parameter (Inter : Iir) return Boolean is
diff --git a/src/vhdl/vhdl-ieee-vital_timing.adb b/src/vhdl/vhdl-ieee-vital_timing.adb
index c4263672a..af68caabc 100644
--- a/src/vhdl/vhdl-ieee-vital_timing.adb
+++ b/src/vhdl/vhdl-ieee-vital_timing.adb
@@ -18,6 +18,7 @@
with Types; use Types;
with Std_Names;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Tokens; use Vhdl.Tokens;
with Name_Table;
diff --git a/src/vhdl/vhdl-nodes_gc.adb b/src/vhdl/vhdl-nodes_gc.adb
index 49fc0336a..7900355ec 100644
--- a/src/vhdl/vhdl-nodes_gc.adb
+++ b/src/vhdl/vhdl-nodes_gc.adb
@@ -20,7 +20,7 @@ with Ada.Unchecked_Deallocation;
with Types; use Types;
with Logging; use Logging;
with Vhdl.Nodes_Meta; use Vhdl.Nodes_Meta;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Libraries;
with Vhdl.Disp_Tree;
with Vhdl.Std_Package;
diff --git a/src/vhdl/vhdl-nodes_walk.adb b/src/vhdl/vhdl-nodes_walk.adb
index 2ada0a225..1f33ee23f 100644
--- a/src/vhdl/vhdl-nodes_walk.adb
+++ b/src/vhdl/vhdl-nodes_walk.adb
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Vhdl.Utils; use Vhdl.Utils;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
package body Vhdl.Nodes_Walk is
function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status
diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb
index a3ef79e76..63c67ec29 100644
--- a/src/vhdl/vhdl-parse.adb
+++ b/src/vhdl/vhdl-parse.adb
@@ -20,6 +20,7 @@ with Vhdl.Tokens; use Vhdl.Tokens;
with Vhdl.Scanner; use Vhdl.Scanner;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Std_Names; use Std_Names;
with Flags; use Flags;
with Vhdl.Parse_Psl;
diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb
index 62ab6b653..dd353134e 100644
--- a/src/vhdl/vhdl-sem.adb
+++ b/src/vhdl/vhdl-sem.adb
@@ -16,6 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Ieee.Std_Logic_1164;
with Libraries;
diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb
index 41b97953e..6c92566c6 100644
--- a/src/vhdl/vhdl-sem_assocs.adb
+++ b/src/vhdl/vhdl-sem_assocs.adb
@@ -17,6 +17,7 @@
-- 02111-1307, USA.
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Flags; use Flags;
with Types; use Types;
with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb
index 507ed1a3f..a45d37ecf 100644
--- a/src/vhdl/vhdl-sem_decls.adb
+++ b/src/vhdl/vhdl-sem_decls.adb
@@ -20,6 +20,7 @@ with Types; use Types;
with Std_Names;
with Vhdl.Tokens;
with Flags; use Flags;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 151d2d54c..988ee5df4 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -19,6 +19,7 @@
with Grt.Algos;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Flags; use Flags;
with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;
with Vhdl.Sem_Names; use Vhdl.Sem_Names;
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb
index 7a8c6e36f..2fa563987 100644
--- a/src/vhdl/vhdl-sem_inst.adb
+++ b/src/vhdl/vhdl-sem_inst.adb
@@ -20,7 +20,7 @@ with Vhdl.Nodes_Meta;
with Types; use Types;
with Files_Map;
with Vhdl.Utils; use Vhdl.Utils;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Utils;
package body Vhdl.Sem_Inst is
diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb
index 050beeee9..fcbb9bd1e 100644
--- a/src/vhdl/vhdl-sem_lib.adb
+++ b/src/vhdl/vhdl-sem_lib.adb
@@ -20,6 +20,7 @@ with Name_Table;
with Files_Map;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Libraries; use Libraries;
with Vhdl.Scanner;
with Vhdl.Parse;
diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb
index 07773341b..1e104fbff 100644
--- a/src/vhdl/vhdl-sem_names.adb
+++ b/src/vhdl/vhdl-sem_names.adb
@@ -18,6 +18,7 @@
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Utils; use Vhdl.Utils;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Flags; use Flags;
with Name_Table;
with Vhdl.Std_Package; use Vhdl.Std_Package;
diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb
index 994c1b833..4cf369d58 100644
--- a/src/vhdl/vhdl-sem_psl.adb
+++ b/src/vhdl/vhdl-sem_psl.adb
@@ -31,6 +31,7 @@ with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Std_Package;
with Vhdl.Ieee.Std_Logic_1164;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Xrefs; use Vhdl.Xrefs;
package body Vhdl.Sem_Psl is
diff --git a/src/vhdl/vhdl-sem_scopes.adb b/src/vhdl/vhdl-sem_scopes.adb
index c1f3fe8fd..0388faeb2 100644
--- a/src/vhdl/vhdl-sem_scopes.adb
+++ b/src/vhdl/vhdl-sem_scopes.adb
@@ -21,6 +21,7 @@ with Flags; use Flags;
with Name_Table; -- use Name_Table;
with Files_Map; use Files_Map;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Utils; use Vhdl.Utils;
package body Vhdl.Sem_Scopes is
diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb
index 9329fff14..033c8afbb 100644
--- a/src/vhdl/vhdl-sem_specs.adb
+++ b/src/vhdl/vhdl-sem_specs.adb
@@ -21,6 +21,7 @@ with Vhdl.Sem_Names; use Vhdl.Sem_Names;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem; use Vhdl.Sem;
with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;
diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb
index 18c38f67d..8248aee36 100644
--- a/src/vhdl/vhdl-sem_stmts.adb
+++ b/src/vhdl/vhdl-sem_stmts.adb
@@ -18,6 +18,7 @@
with Errorout; use Errorout;
with Types; use Types;
with Flags; use Flags;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Sem_Specs; use Vhdl.Sem_Specs;
with Vhdl.Std_Package; use Vhdl.Std_Package;
with Vhdl.Sem; use Vhdl.Sem;
diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb
index 0cc7bf314..1ecf718f7 100644
--- a/src/vhdl/vhdl-sem_types.adb
+++ b/src/vhdl/vhdl-sem_types.adb
@@ -19,6 +19,7 @@ with Libraries;
with Flags; use Flags;
with Types; use Types;
with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Evaluation; use Vhdl.Evaluation;
with Vhdl.Sem_Utils;
with Vhdl.Sem_Expr; use Vhdl.Sem_Expr;
diff --git a/src/vhdl/vhdl-sem_utils.adb b/src/vhdl/vhdl-sem_utils.adb
index 24a45a9a4..70573f6f1 100644
--- a/src/vhdl/vhdl-sem_utils.adb
+++ b/src/vhdl/vhdl-sem_utils.adb
@@ -18,7 +18,7 @@
with Ada.Unchecked_Conversion;
with Types; use Types;
with Flags; use Flags;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Nodes_Utils; use Vhdl.Nodes_Utils;
with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Ieee.Std_Logic_1164;
diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb
index e93becc60..4a82dc7f2 100644
--- a/src/vhdl/vhdl-utils.adb
+++ b/src/vhdl/vhdl-utils.adb
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Vhdl.Scanner; use Vhdl.Scanner;
with Vhdl.Tokens; use Vhdl.Tokens;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Name_Table;
with Str_Table;
with Std_Names; use Std_Names;
diff --git a/src/vhdl/vhdl-xrefs.adb b/src/vhdl/vhdl-xrefs.adb
index 021acd485..f03535fbe 100644
--- a/src/vhdl/vhdl-xrefs.adb
+++ b/src/vhdl/vhdl-xrefs.adb
@@ -19,7 +19,7 @@ with Tables;
with GNAT.Heap_Sort_A;
with Flags;
with Vhdl.Std_Package;
-with Errorout; use Errorout;
+with Vhdl.Errors; use Vhdl.Errors;
with Vhdl.Nodes_Priv;
package body Vhdl.Xrefs is