Rework warnings to have a uniq tag per warning.

21 files changed, 295 insertions, 180 deletions

diff --git a/src/flags.ads b/src/flags.ads
index 03e9fe959..4bb6ec486 100644
--- a/src/flags.ads
+++ b/src/flags.ads
@@ -143,47 +143,6 @@ package Flags is
    -- --warn-undriven
    --Warn_Undriven : Boolean := False;
 
-   --  --warn-default-binding
-   --  Should emit a warning when there is no default binding for a component
-   --  instantiation.
-   Warn_Default_Binding : Boolean := False;
-
-   --  --warn-binding
-   --  Emit a warning at elaboration for unbound component.
-   Warn_Binding : Boolean := True;
-
-   --  --warn-reserved
-   --  Emit a warning when a vhdl93 reserved word is used as a
-   --  vhdl87 identifier.
-   Warn_Reserved_Word : Boolean := False;
-
-   --  --warn-library
-   --  Emit a warning when a design unit redefines another design unit.
-   Warn_Library : Boolean := False;
-
-   --  --warn-vital-generic
-   --  Emit a warning when a generic of a vital entity is not a vital name.
-   Warn_Vital_Generic : Boolean := True;
-
-   --  --warn-delayed-checks
-   --  Emit warnings about delayed checks (checks performed at elaboration
-   --   time).
-   Warn_Delayed_Checks : Boolean := False;
-
-   --  --warn-body
-   --  Emit a warning when a package body is not required but is analyzed.
-   Warn_Body : Boolean := True;
-
-   --  --warn-specs
-   --  Emit a warning when an all/others specification does not apply, because
-   --  there is no such named entities.
-   Warn_Specs : Boolean := True;
-
-   --  --warn-unused
-   --  Emit a warning when a declaration is never used.
-   --  FIXME: currently only subprograms are handled.
-   Warn_Unused : Boolean := True;
-
    --  --warn-error
    --  Turns warnings into errors.
    Warn_Error : Boolean := False;
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb
index 180240710..d496c148c 100644
--- a/src/ghdldrv/ghdlcomp.adb
+++ b/src/ghdldrv/ghdlcomp.adb
@@ -363,7 +363,8 @@ package body Ghdlcomp is
             --  Do late analysis checks.
             Unit := Get_First_Design_Unit (New_Design_File);
             while Unit /= Null_Iir loop
-               Sem.Sem_Analysis_Checks_List (Unit, Flags.Warn_Delayed_Checks);
+               Sem.Sem_Analysis_Checks_List
+                 (Unit, Is_Warning_Enabled (Warnid_Delayed_Checks));
                Unit := Get_Chain (Unit);
             end loop;
 
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
index 97f54ebde..f9b814404 100644
--- a/src/ghdldrv/ghdlprint.adb
+++ b/src/ghdldrv/ghdlprint.adb
@@ -240,7 +240,7 @@ package body Ghdlprint is
             Ref := Find (Loc);
             if Ref = Bad_Xref then
                Disp_Text;
-               Warning_Msg_Sem ("cannot find xref", Loc);
+               Warning_Msg_Sem ("cannot find xref", Loc, Warnid_Missing_Xref);
                Missing_Xref := True;
                return;
             end if;
diff --git a/src/libraries.adb b/src/libraries.adb
index d3bf84cdb..71ae71e46 100644
--- a/src/libraries.adb
+++ b/src/libraries.adb
@@ -50,13 +50,13 @@ package body Libraries is
    --  Report an error message.
    procedure Error_Lib_Msg (Msg : String) is
    begin
-      Report_Msg (Error, Library, No_Location, Msg);
+      Report_Msg (Msgid_Error, Library, No_Location, Msg);
    end Error_Lib_Msg;
 
    --  Report a warning message.
    procedure Warning_Lib_Msg (Msg : String) is
    begin
-      Report_Msg (Warning, Library, No_Location, Msg);
+      Report_Msg (Msgid_Warning, Library, No_Location, Msg);
    end Warning_Lib_Msg;
 
    --  Initialize pathes table.
@@ -1005,14 +1005,14 @@ package body Libraries is
                --  In the same file.
                if Get_Date_State (Design_Unit) = Date_Analyze then
                   --  Warns only if we are not re-analyzing the file.
-                  if Flags.Warn_Library then
+                  if Is_Warning_Enabled (Warnid_Library) then
                      Warning_Msg_Sem
                        ("redefinition of a library unit in "
-                        & "same design file:", Unit);
+                        & "same design file:", Unit, Warnid_Library);
                      Warning_Msg_Sem
                        (Disp_Node (Library_Unit) & " defined at "
                         & Disp_Location (Library_Unit) & " is now "
-                        & Disp_Node (New_Library_Unit), Unit);
+                        & Disp_Node (New_Library_Unit), Unit, Warnid_Library);
                   end if;
                else
                   --  Free the stub.
@@ -1024,7 +1024,7 @@ package body Libraries is
                --  Note: the current design unit should not be freed if
                --  in use; unfortunatly, this is not obvious to check.
             else
-               if Flags.Warn_Library then
+               if Is_Warning_Enabled (Warnid_Library) then
                   if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit)
                   then
                      Warning_Lib_Msg
diff --git a/src/options.adb b/src/options.adb
index c5feac2fe..ccc2e534f 100644
--- a/src/options.adb
+++ b/src/options.adb
@@ -17,7 +17,7 @@
 --  02111-1307, USA.
 with Ada.Text_IO; use Ada.Text_IO;
 with Name_Table;
-with Errorout;
+with Errorout; use Errorout;
 with Libraries;
 with Std_Names;
 with PSL.Nodes;
@@ -38,32 +38,28 @@ package body Options is
 
    function Option_Warning (Opt: String; Val : Boolean) return Boolean is
    begin
---      if Opt = "undriven" then
---         Warn_Undriven := True;
-      if Opt = "library" then
-         Warn_Library := Val;
-      elsif Opt = "default-binding" then
-         Warn_Default_Binding := Val;
-      elsif Opt = "binding" then
-         Warn_Binding := Val;
-      elsif Opt = "reserved" then
-         Warn_Reserved_Word := Val;
-      elsif Opt = "vital-generic" then
-         Warn_Vital_Generic := Val;
-      elsif Opt = "delayed-checks" then
-         Warn_Delayed_Checks := Val;
-      elsif Opt = "body" then
-         Warn_Body := Val;
-      elsif Opt = "specs" then
-         Warn_Specs := Val;
-      elsif Opt = "unused" then
-         Warn_Unused := Val;
-      elsif Opt = "error" then
+      --  Handle -Werror.
+      if Opt = "error" then
          Warn_Error := Val;
-      else
-         return False;
+         return True;
       end if;
-      return True;
+
+      --  Normal warnings.
+      for I in Msgid_Warnings loop
+         if Warning_Image (I) = Opt then
+            Enable_Warning (I, Val);
+            return True;
+         end if;
+      end loop;
+
+      --  -Wreserved is an alias for -Wreserved-word.
+      if Opt = "reserved" then
+         Enable_Warning (Warnid_Reserved_Word, Val);
+         return True;
+      end if;
+
+      --  Unknown warning.
+      return False;
    end Option_Warning;
 
    function Parse_Option (Option : String) return Boolean
@@ -95,12 +91,12 @@ package body Options is
          AMS_Vhdl := True;
       elsif Opt'Length >= 2 and then Opt (1 .. 2) = "-P" then
          if Opt'Last = 2 then
-            Errorout.Error_Msg_Option ("missing directory after -P");
+            Error_Msg_Option ("missing directory after -P");
             return True;
          end if;
          if Opt (3) = '=' then
             if Opt'Last = 3 then
-               Errorout.Error_Msg_Option ("missing directory after -P=");
+               Error_Msg_Option ("missing directory after -P=");
                return True;
             end if;
             Libraries.Add_Library_Path (Opt (4 .. Opt'Last));
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index c4bc0434f..671514e46 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -67,10 +67,11 @@ package body Configuration is
       --  May be enabled to debug dependency construction.
       if False then
          if From = Null_Iir then
-            Warning_Msg_Elab (Disp_Node (Unit) & " added", Unit);
+            Report_Msg (Msgid_Note, Elaboration, Get_Location (Unit),
+                        Disp_Node (Unit) & " added");
          else
-            Warning_Msg_Elab
-              (Disp_Node (Unit) & " added by " & Disp_Node (From), From);
+            Report_Msg (Msgid_Note, Elaboration, Get_Location (From),
+                        Disp_Node (Unit) & " added by " & Disp_Node (From));
          end if;
       end if;
 
@@ -424,13 +425,15 @@ package body Configuration is
          if Get_Kind (Assoc) = Iir_Kind_Association_Element_Open then
             Formal := Get_Association_Interface (Assoc);
             Err := Err or Check_Open_Port (Formal, Assoc);
-            if Flags.Warn_Binding and then not Get_Artificial_Flag (Assoc) then
+            if Is_Warning_Enabled (Warnid_Binding)
+              and then not Get_Artificial_Flag (Assoc)
+            then
                Warning_Msg_Elab
                  (Disp_Node (Formal) & " of " & Disp_Node (Get_Parent (Formal))
-                  & " is not bound", Assoc);
+                  & " is not bound", Assoc, Warnid_Binding);
                Warning_Msg_Elab
                  ("(in " & Disp_Node (Current_Configuration) & ")",
-                  Current_Configuration);
+                  Current_Configuration, Warnid_Binding);
             end if;
          end if;
          Assoc := Get_Chain (Assoc);
@@ -516,13 +519,13 @@ package body Configuration is
       Inst : Iir;
    begin
       if Bind = Null_Iir then
-         if Flags.Warn_Binding then
+         if Is_Warning_Enabled (Warnid_Binding) then
             Inst := Get_First_Element (Get_Instantiation_List (Conf));
             Warning_Msg_Elab
-              (Disp_Node (Inst) & " is not bound", Conf);
+              (Disp_Node (Inst) & " is not bound", Conf, Warnid_Binding);
             Warning_Msg_Elab
               ("(in " & Disp_Node (Current_Configuration) & ")",
-               Current_Configuration);
+               Current_Configuration, Warnid_Binding);
          end if;
          return;
       end if;
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index 0da1dc166..680160098 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -30,6 +30,51 @@ package body Errorout is
    --  If True, disp original source line and a caret indicating the column.
    Flag_Show_Caret : constant Boolean := False;
 
+   type Warning_Control_Type is record
+      Enabled : Boolean;
+      Error : Boolean;
+   end record;
+
+   type Warnings_Array is array (Msgid_Warnings) of Warning_Control_Type;
+
+   Warnings_Control : Warnings_Array :=
+     (Warnid_Binding => (Enabled => True, Error => False),
+      others         => (Enabled => False, Error => False));
+
+   procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean) is
+   begin
+      Warnings_Control (Id).Enabled := Enable;
+   end Enable_Warning;
+
+   function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean is
+   begin
+      return Warnings_Control (Id).Enabled;
+   end Is_Warning_Enabled;
+
+   function Warning_Image (Id : Msgid_Warnings) return String
+   is
+      Img : constant String := Msgid_Warnings'Image (Id);
+      Prefix : constant String := "WARNID_";
+      pragma Assert (Img'Length > Prefix'Length);
+      pragma Assert (Img (1 .. Prefix'Length) = Prefix);
+      Res : String (1 .. Img'Last - Prefix'Length);
+      C : Character;
+   begin
+      for I in Res'Range loop
+         C := Img (Prefix'Length + I);
+         case C is
+            when '_' =>
+               C := '-';
+            when 'A' .. 'Z' =>
+               C := Character'Val (Character'Pos (C) + 32);
+            when others =>
+               raise Internal_Error;
+         end case;
+         Res (I) := C;
+      end loop;
+      return Res;
+   end Warning_Image;
+
    procedure Put (Str : String)
    is
       use Ada.Text_IO;
@@ -98,7 +143,7 @@ package body Errorout is
       Put (':');
    end Disp_Program_Name;
 
-   procedure Report_Msg (Level : Report_Level;
+   procedure Report_Msg (Id : Msgid_Type;
                          Origin : Report_Origin;
                          Loc : Location_Type;
                          Msg : String)
@@ -173,18 +218,18 @@ package body Errorout is
          Put ("??:??:??:");
       end if;
 
-      case Level is
-         when Note =>
+      case Id is
+         when Msgid_Note =>
             Put ("note:");
-         when Warning =>
+         when Msgid_Warning | Msgid_Warnings =>
             if Flags.Warn_Error then
                Nbr_Errors := Nbr_Errors + 1;
             else
                Put ("warning:");
             end if;
-         when Error =>
+         when Msgid_Error =>
             Nbr_Errors := Nbr_Errors + 1;
-         when Fatal =>
+         when Msgid_Fatal =>
             Put ("fatal:");
       end case;
 
@@ -215,7 +260,7 @@ package body Errorout is
 
    procedure Error_Msg_Option_NR (Msg: String) is
    begin
-      Report_Msg (Error, Option, No_Location, Msg);
+      Report_Msg (Msgid_Error, Option, No_Location, Msg);
    end Error_Msg_Option_NR;
 
    procedure Error_Msg_Option (Msg: String) is
@@ -233,67 +278,69 @@ package body Errorout is
       end if;
    end Get_Location_Safe;
 
-   procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type) is
+   procedure Warning_Msg_Sem
+     (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
    begin
       if Flags.Flag_Only_Elab_Warnings then
          return;
       end if;
-      Report_Msg (Warning, Semantic, Loc, Msg);
+      Report_Msg (Id, Semantic, Loc, Msg);
    end Warning_Msg_Sem;
 
-   procedure Warning_Msg_Sem (Msg: String; Loc : Iir) is
+   procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
    begin
-      Warning_Msg_Sem (Msg, Get_Location_Safe (Loc));
+      Warning_Msg_Sem (Msg, Get_Location_Safe (Loc), Id);
    end Warning_Msg_Sem;
 
-   procedure Warning_Msg_Elab (Msg: String; Loc : Location_Type) is
+   procedure Warning_Msg_Elab
+     (Msg: String; Loc : Location_Type; Id : Msgid_Warnings) is
    begin
-      Report_Msg (Warning, Elaboration, Loc, Msg);
+      Report_Msg (Id, Elaboration, Loc, Msg);
    end Warning_Msg_Elab;
 
-   procedure Warning_Msg_Elab (Msg: String; Loc : Iir) is
+   procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings) is
    begin
-      Warning_Msg_Elab (Msg, Get_Location_Safe (Loc));
+      Warning_Msg_Elab (Msg, Get_Location_Safe (Loc), Id);
    end Warning_Msg_Elab;
 
    -- Disp a message during scan.
    procedure Error_Msg_Scan (Msg: String) is
    begin
-      Report_Msg (Error, Scan, No_Location, Msg);
+      Report_Msg (Msgid_Error, Scan, No_Location, Msg);
    end Error_Msg_Scan;
 
    procedure Error_Msg_Scan (Msg: String; Loc : Location_Type) is
    begin
-      Report_Msg (Error, Scan, Loc, Msg);
+      Report_Msg (Msgid_Error, Scan, Loc, Msg);
    end Error_Msg_Scan;
 
    -- Disp a message during scan.
-   procedure Warning_Msg_Scan (Msg: String) is
+   procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings) is
    begin
-      Report_Msg (Warning, Scan, No_Location, Msg);
+      Report_Msg (Id, Scan, No_Location, Msg);
    end Warning_Msg_Scan;
 
    -- Disp a message during scan.
    procedure Error_Msg_Parse (Msg: String) is
    begin
-      Report_Msg (Error, Parse, No_Location, Msg);
+      Report_Msg (Msgid_Error, Parse, No_Location, Msg);
    end Error_Msg_Parse;
 
    procedure Error_Msg_Parse (Msg: String; Loc : Iir) is
    begin
-      Report_Msg (Error, Parse, Get_Location_Safe (Loc), Msg);
+      Report_Msg (Msgid_Error, Parse, Get_Location_Safe (Loc), Msg);
    end Error_Msg_Parse;
 
    procedure Error_Msg_Parse (Msg: String; Loc : Location_Type) is
    begin
-      Report_Msg (Error, Parse, Loc, Msg);
+      Report_Msg (Msgid_Error, Parse, Loc, Msg);
    end Error_Msg_Parse;
 
    -- 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 (Error, Semantic, Get_Location_Safe (Loc), Msg);
+      Report_Msg (Msgid_Error, Semantic, Get_Location_Safe (Loc), Msg);
    end Error_Msg_Sem;
 
    procedure Error_Msg_Sem (Msg: String; Loc: PSL_Node)
@@ -306,24 +353,24 @@ package body Errorout is
       else
          L := PSL.Nodes.Get_Location (Loc);
       end if;
-      Report_Msg (Error, Semantic, L, Msg);
+      Report_Msg (Msgid_Error, Semantic, L, Msg);
    end Error_Msg_Sem;
 
    procedure Error_Msg_Sem (Msg: String; Loc : Location_Type) is
    begin
-      Report_Msg (Error, Semantic, Loc, Msg);
+      Report_Msg (Msgid_Error, Semantic, Loc, Msg);
    end Error_Msg_Sem;
 
    procedure Error_Msg_Relaxed
      (Origin : Report_Origin; Msg : String; Loc : Iir)
    is
       use Flags;
-      Level : Report_Level;
+      Level : Msgid_Type;
    begin
       if Flag_Relaxed_Rules or Vhdl_Std = Vhdl_93c then
-         Level := Warning;
+         Level := Msgid_Warning;
       else
-         Level := Error;
+         Level := Msgid_Error;
       end if;
       Report_Msg (Level, Origin, Get_Location_Safe (Loc), Msg);
    end Error_Msg_Relaxed;
@@ -336,12 +383,12 @@ package body Errorout is
    -- Disp a message during elaboration.
    procedure Error_Msg_Elab (Msg: String) is
    begin
-      Report_Msg (Error, Elaboration, No_Location, Msg);
+      Report_Msg (Msgid_Error, Elaboration, No_Location, Msg);
    end Error_Msg_Elab;
 
    procedure Error_Msg_Elab (Msg: String; Loc : Iir) is
    begin
-      Report_Msg (Error, Elaboration, Get_Location_Safe (Loc), Msg);
+      Report_Msg (Msgid_Error, Elaboration, Get_Location_Safe (Loc), Msg);
    end Error_Msg_Elab;
 
    -- Disp a bug message.
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index ab7b3fcc2..c1d219011 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -33,14 +33,90 @@ package Errorout is
    -- The number of errors (ie, number of calls to error_msg*).
    Nbr_Errors: Natural := 0;
 
-   type Report_Level is (Note, Warning, Error, Fatal);
+   type Msgid_Type is
+     (--  Any note
+      Msgid_Note,
+
+      --  Any warning
+      Msgid_Warning,
+
+      --  Specific warnings
+
+      --  Design unit redefines another design unit.
+      Warnid_Library,
+
+      --  Missing Xref in pretty print.
+      Warnid_Missing_Xref,
+
+      --  No default binding for a component instantiation.
+      Warnid_Default_Binding,
+
+      --  Unbound component.
+      Warnid_Binding,
+
+      --  Vhdl93 reserved word is used as a vhdl87 identifier.
+      Warnid_Reserved_Word,
+
+      --  Start of block comment ('/*') appears in a block comment.
+      Warnid_Nested_Comment,
+
+      --  Weird use of parenthesis.
+      Warnid_Parenthesis,
+
+      --  Generic of a vital entity is not a vital name.
+      Warnid_Vital_Generic,
+
+      --  Delayed checks (checks performed at elaboration time).
+      Warnid_Delayed_Checks,
+
+      --  Package body is not required but is analyzed.
+      Warnid_Body,
+
+      --  An all/others specification does not apply, because there is no such
+      --  named entities.
+      Warnid_Specs,
+
+      --  Incorrect use of universal value.
+      Warnid_Universal,
+
+      --  Runtime error detected at analysis time.
+      Warnid_Runtime_Error,
+
+      --  Signal assignment creates a delta cycle in a postponed process.
+      Warnid_Delta_Cycle,
+
+      --  Emit a warning when a declaration is never used.
+      --  FIXME: currently only subprograms are handled.
+      Warnid_Unused,
+
+      --  Any error
+      Msgid_Error,
+
+      --  Any fatal error
+      Msgid_Fatal);
+
+   --  All specific warning messages.
+   subtype Msgid_Warnings is Msgid_Type
+     range Warnid_Library .. Warnid_Unused;
+
+   --  Get the image of a warning.  This correspond the the identifier of ID,
+   --  in lower case, without the Msgid_Warn_ prefix and with '_' replaced
+   --  by '-'.
+   function Warning_Image (Id : Msgid_Warnings) return String;
+
+   --  Enable or disable a warning.
+   procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean);
+
+   --  Get enable status of a warning.
+   function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;
+
    type Report_Origin is
      (Option, Library, Scan, Parse, Semantic, Elaboration);
 
    --  Generic report message.  LOC maybe No_Location.
    --  If ORIGIN is Option or Library, LOC must be No_Location and the program
    --  name is displayed.
-   procedure Report_Msg (Level : Report_Level;
+   procedure Report_Msg (Id : Msgid_Type;
                          Origin : Report_Origin;
                          Loc : Location_Type;
                          Msg : String);
@@ -55,14 +131,15 @@ package Errorout is
    procedure Error_Msg_Option_NR (Msg: String);
 
    -- Disp a warning.
-   procedure Warning_Msg_Sem (Msg: String; Loc : Iir);
-   procedure Warning_Msg_Sem (Msg: String; Loc : Location_Type);
+   procedure Warning_Msg_Sem (Msg: String; Loc : Iir; Id : Msgid_Warnings);
+   procedure Warning_Msg_Sem
+     (Msg: String; Loc : Location_Type; Id : Msgid_Warnings);
 
    -- Disp a message during scan.
    -- The current location is automatically displayed before the message.
    procedure Error_Msg_Scan (Msg: String);
    procedure Error_Msg_Scan (Msg: String; Loc : Location_Type);
-   procedure Warning_Msg_Scan (Msg: String);
+   procedure Warning_Msg_Scan (Msg: String; Id : Msgid_Warnings);
 
    -- Disp a message during parse
    -- The location of the current token is automatically displayed before
@@ -85,7 +162,7 @@ package Errorout is
    procedure Error_Msg_Elab (Msg: String; Loc: Iir);
 
    --  Disp a warning durig elaboration (or configuration).
-   procedure Warning_Msg_Elab (Msg: String; Loc : Iir);
+   procedure Warning_Msg_Elab (Msg: String; Loc : Iir; Id : Msgid_Warnings);
 
    -- Disp a bug message.
    procedure Error_Internal (Expr: Iir; Msg: String := "");
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index bd3b9e286..e0b52fd9f 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -560,7 +560,8 @@ package body Evaluation is
    exception
       when Constraint_Error =>
          --  Can happen for absolute.
-         Warning_Msg_Sem ("arithmetic overflow in static expression", Orig);
+         Warning_Msg_Sem ("arithmetic overflow in static expression",
+                          Orig, Warnid_Runtime_Error);
          return Build_Overflow (Orig);
    end Eval_Monadic_Operator;
 
@@ -579,7 +580,8 @@ package body Evaluation is
    begin
       Len := Get_String_Length (Left);
       if Len /= Get_String_Length (Right) then
-         Warning_Msg_Sem ("length of left and right operands mismatch", Expr);
+         Warning_Msg_Sem ("length of left and right operands mismatch",
+                          Expr, Warnid_Runtime_Error);
          return Build_Overflow (Expr);
       else
          Id := Create_String8;
@@ -678,7 +680,7 @@ package body Evaluation is
    is
    begin
       if Get_Value (Val) = 0 then
-         Warning_Msg_Sem ("division by 0", Expr);
+         Warning_Msg_Sem ("division by 0", Expr, Warnid_Runtime_Error);
          return False;
       else
          return True;
@@ -1125,7 +1127,8 @@ package body Evaluation is
               (Get_Fp_Value (Left) * Get_Fp_Value (Right), Orig);
          when Iir_Predefined_Floating_Div =>
             if Get_Fp_Value (Right) = 0.0 then
-               Warning_Msg_Sem ("right operand of division is 0", Orig);
+               Warning_Msg_Sem ("right operand of division is 0",
+                                Orig, Warnid_Runtime_Error);
                return Build_Overflow (Orig);
             else
                return Build_Floating
@@ -1452,7 +1455,8 @@ package body Evaluation is
       end case;
    exception
       when Constraint_Error =>
-         Warning_Msg_Sem ("arithmetic overflow in static expression", Orig);
+         Warning_Msg_Sem ("arithmetic overflow in static expression",
+                          Orig, Warnid_Runtime_Error);
          return Build_Overflow (Orig);
    end Eval_Dyadic_Operator;
 
@@ -1646,7 +1650,7 @@ package body Evaluation is
          return Build_Constant (Res, Expr);
       else
          Warning_Msg_Sem ("value """ & Value & """ not in enumeration "
-                            & Disp_Node (Enum), Expr);
+                            & Disp_Node (Enum), Expr, Warnid_Runtime_Error);
          return Build_Overflow (Expr);
       end if;
    end Build_Enumeration_Value;
@@ -1720,7 +1724,8 @@ package body Evaluation is
       end loop;
       if Unit = Null_Iir then
          Warning_Msg_Sem ("Unit """ & UnitName (Sep + 1 .. UnitName'Last)
-                         & """ not in physical type", Expr);
+                            & """ not in physical type",
+                          Expr, Warnid_Runtime_Error);
          return Build_Overflow (Expr);
       end if;
 
@@ -1803,7 +1808,8 @@ package body Evaluation is
                             (Get_Enumeration_Literal_List
                                (Get_Base_Type (Get_Type (Expr))))))
             then
-               Warning_Msg_Sem ("static constant violates bounds", Expr);
+               Warning_Msg_Sem ("static constant violates bounds",
+                                Expr, Warnid_Runtime_Error);
                return Build_Overflow (Origin);
             else
                return Build_Enumeration (Iir_Index32 (P), Origin);
@@ -1861,8 +1867,8 @@ package body Evaluation is
       if Get_Constraint_State (Conv_Type) = Fully_Constrained then
          Set_Type (Res, Conv_Type);
          if not Eval_Is_In_Bound (Val, Conv_Type) then
-            Warning_Msg_Sem
-              ("non matching length in type conversion", Conv);
+            Warning_Msg_Sem ("non matching length in type conversion",
+                             Conv, Warnid_Runtime_Error);
             return Build_Overflow (Conv);
          end if;
          return Res;
@@ -1931,7 +1937,8 @@ package body Evaluation is
       end if;
       if not Eval_Is_In_Bound (Res, Get_Type (Expr)) then
          if Get_Kind (Res) /= Iir_Kind_Overflow_Literal then
-            Warning_Msg_Sem ("result of conversion out of bounds", Expr);
+            Warning_Msg_Sem ("result of conversion out of bounds",
+                             Expr, Warnid_Runtime_Error);
             Res := Build_Overflow (Res);
          end if;
       end if;
@@ -2117,8 +2124,8 @@ package body Evaluation is
                  and then
                  not Eval_Int_In_Range (Val, Get_Range_Constraint (Expr_Type))
                then
-                  Warning_Msg_Sem
-                    ("static argument out of the type range", Expr);
+                  Warning_Msg_Sem ("static argument out of the type range",
+                                   Expr, Warnid_Runtime_Error);
                   return Build_Overflow (Expr);
                end if;
                if Get_Kind (Get_Base_Type (Get_Type (Expr)))
@@ -2166,7 +2173,8 @@ package body Evaluation is
                Set_Parameter (Expr, Param);
                if Get_Kind (Param) /= Iir_Kind_String_Literal8 then
                   --  FIXME: Isn't it an implementation restriction.
-                  Warning_Msg_Sem ("'value argument not a string", Expr);
+                  Warning_Msg_Sem ("'value argument not a string",
+                                   Expr, Warnid_Runtime_Error);
                   return Build_Overflow (Expr);
                else
                   return Eval_Value_Attribute
diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb
index 915ad00a6..fb92efaf7 100644
--- a/src/vhdl/ieee-vital_timing.adb
+++ b/src/vhdl/ieee-vital_timing.adb
@@ -27,7 +27,6 @@ with Sem_Specs;
 with Evaluation;
 with Sem;
 with Iirs_Utils;
-with Flags;
 
 package body Ieee.Vital_Timing is
    --  This package is based on IEEE 1076.4 1995.
@@ -189,7 +188,11 @@ package body Ieee.Vital_Timing is
    procedure Error_Vital (Msg : String; Loc : Iir) renames Error_Msg_Sem;
    procedure Error_Vital (Msg : String; Loc : Location_Type)
      renames Error_Msg_Sem;
-   procedure Warning_Vital (Msg : String; Loc : Iir) renames Warning_Msg_Sem;
+
+   procedure Warning_Vital (Msg : String; Loc : Iir) is
+   begin
+      Warning_Msg_Sem (Msg, Loc, Warnid_Vital_Generic);
+   end Warning_Vital;
 
    --  Check DECL is the VITAL level 0 attribute specification.
    procedure Check_Level0_Attribute_Specification (Decl : Iir)
@@ -1255,7 +1258,7 @@ package body Ieee.Vital_Timing is
          return;
       end if;
 
-      if Flags.Warn_Vital_Generic then
+      if Is_Warning_Enabled (Warnid_Vital_Generic) then
          Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl);
       end if;
    end Check_Entity_Generic_Declaration;
diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb
index eaab1351f..6991b8c7b 100644
--- a/src/vhdl/parse.adb
+++ b/src/vhdl/parse.adb
@@ -4072,7 +4072,8 @@ package body Parse is
                   --  Parenthesis around aggregate is useless and change the
                   --  context for array aggregate.
                   Warning_Msg_Sem
-                    ("suspicious parenthesis around aggregate", Expr);
+                    ("suspicious parenthesis around aggregate",
+                     Expr, Warnid_Parenthesis);
                elsif not Flag_Parse_Parenthesis then
                   return Expr;
                end if;
diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb
index b56c04e9a..7c5dbdd00 100644
--- a/src/vhdl/scanner.adb
+++ b/src/vhdl/scanner.adb
@@ -931,39 +931,44 @@ package body Scanner is
          case Current_Identifier is
             when Std_Names.Name_Id_AMS_Reserved_Words =>
                if not AMS_Vhdl then
-                  if Flags.Warn_Reserved_Word then
+                  if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
                        ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ AMS-VHDL reserved word as an identifier");
+                          & """ AMS-VHDL reserved word as an identifier",
+                       Warnid_Reserved_Word);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
             when Std_Names.Name_Id_Vhdl08_Reserved_Words =>
                if Vhdl_Std < Vhdl_08 then
-                  if Flags.Warn_Reserved_Word then
+                  if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
                        ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ vhdl-2008 reserved word as an identifier");
+                          & """ vhdl-2008 reserved word as an identifier",
+                       Warnid_Reserved_Word);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
             when Std_Names.Name_Id_Vhdl00_Reserved_Words =>
                if Vhdl_Std < Vhdl_00 then
-                  if Flags.Warn_Reserved_Word then
+                  if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
                        ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ vhdl00 reserved word as an identifier");
+                          & """ vhdl00 reserved word as an identifier",
+                        Warnid_Reserved_Word);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
             when Std_Names.Name_Id_Vhdl93_Reserved_Words =>
                if Vhdl_Std = Vhdl_87 then
-                  if Flags.Warn_Reserved_Word then
+                  if Is_Warning_Enabled (Warnid_Reserved_Word) then
                      Warning_Msg_Scan
                        ("using """ & Nam_Buffer (1 .. Nam_Length)
-                          & """ vhdl93 reserved word as a vhdl87 identifier");
+                          & """ vhdl93 reserved word as a vhdl87 identifier",
+                        Warnid_Reserved_Word);
                      Warning_Msg_Scan
-                       ("(use option --std=93 to compile as vhdl93)");
+                       ("(use option --std=93 to compile as vhdl93)",
+                        Warnid_Reserved_Word);
                   end if;
                   Current_Token := Tok_Identifier;
                end if;
@@ -1464,7 +1469,8 @@ package body Scanner is
                         --  the start of a nested delimited comment.
                         if Source (Pos + 1) = '*' then
                            Warning_Msg_Scan
-                             ("'/*' found within a block comment");
+                             ("'/*' found within a block comment",
+                             Warnid_Nested_Comment);
                         end if;
                         Pos := Pos + 1;
                      when '*' =>
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 4c31f3673..d19061846 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2463,14 +2463,15 @@ package body Sem is
                      Warning_Msg_Sem
                        ("can't assert that all calls in " & Disp_Node (El)
                         & " are pure or have not wait; "
-                        & "will be checked at elaboration", El);
+                          & "will be checked at elaboration", El,
+                        Warnid_Delayed_Checks);
                      Callee := Get_Nth_Element (Callees, 0);
                      --  FIXME: could improve this message by displaying the
                      --  chain of calls until the first subprograms in
                      --  unknown state.
                      Warning_Msg_Sem
                        ("(first such call is to " & Disp_Node (Callee) & ")",
-                        Callee);
+                        Callee, Warnid_Delayed_Checks);
                   end if;
                end if;
             when Iir_Kind_Sensitized_Process_Statement =>
@@ -2479,7 +2480,8 @@ package body Sem is
                   if Emit_Warnings then
                      Warning_Msg_Sem
                        ("can't assert that " & Disp_Node (El)
-                        & " has not wait; will be checked at elaboration", El);
+                          & " has not wait; will be checked at elaboration",
+                        El, Warnid_Delayed_Checks);
                   end if;
                end if;
             when others =>
@@ -2633,7 +2635,8 @@ package body Sem is
       --  Emit a warning is a body is not necessary.
       if not Get_Need_Body (Package_Decl) then
          Warning_Msg_Sem
-           (Disp_Node (Package_Decl) & " does not require a body", Decl);
+           (Disp_Node (Package_Decl) & " does not require a body",
+            Decl, Warnid_Body);
       end if;
 
       Set_Package (Decl, Package_Decl);
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index e05f2c552..48c3ae2d9 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -2995,7 +2995,7 @@ package body Sem_Decls is
 
       --  Set Check_Unused.
       Check_Unused := False;
-      if Flags.Warn_Unused then
+      if Is_Warning_Enabled (Warnid_Unused) then
          case Get_Kind (Decl) is
             when Iir_Kind_Entity_Declaration =>
                --  May be used in architecture.
@@ -3079,7 +3079,8 @@ package body Sem_Decls is
                     and then not Is_Second_Subprogram_Specification (El)
                   then
                      Warning_Msg_Sem
-                       (Disp_Node (El) & " is never referenced", El);
+                       (Disp_Node (El) & " is never referenced", El,
+                       Warnid_Unused);
                   end if;
                when others =>
                   null;
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index a856be072..10e07bf22 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -863,7 +863,7 @@ package body Sem_Expr is
 
             --  Be tolerant.
             Warning_Msg_Sem ("universal integer bound must be numeric literal "
-                               & "or attribute", Res);
+                               & "or attribute", Res, Warnid_Universal);
          else
             Error_Msg_Sem ("universal integer bound must be numeric literal "
                              & "or attribute", Res);
@@ -3431,7 +3431,9 @@ package body Sem_Expr is
                      if not Eval_Is_In_Bound (Expr, Element_Type)
                      then
                         Info.Has_Bound_Error := True;
-                        Warning_Msg_Sem ("element is out of the bounds", Expr);
+                        Warning_Msg_Sem
+                          ("element is out of the bounds", Expr,
+                           Warnid_Runtime_Error);
                      end if;
 
                      --  FIXME: handle name/others in translate.
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 006390332..098268daa 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -735,7 +735,8 @@ package body Sem_Names is
          if False and then Flags.Vhdl_Std = Vhdl_87 then
             -- emit a warning for a null slice.
             Warning_Msg_Sem
-              ("direction mismatch results in a null slice", Name);
+              ("direction mismatch results in a null slice",
+               Name, Warnid_Runtime_Error);
          end if;
          Error_Msg_Sem ("direction of the range mismatch", Name);
       end if;
diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb
index bdcf64563..8b4a525f0 100644
--- a/src/vhdl/sem_specs.adb
+++ b/src/vhdl/sem_specs.adb
@@ -770,9 +770,10 @@ package body Sem_Specs is
          --  class that are declared in the immediatly enclosing
          --  declarative part.
          Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, True);
-         if Res = False and then Flags.Warn_Specs then
+         if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
             Warning_Msg_Sem
-              ("attribute specification apply to no named entity", Spec);
+              ("attribute specification apply to no named entity",
+               Spec, Warnid_Specs);
          end if;
       elsif List = Iir_List_Others then
          --  o If the reserved word OTHERS is supplied, then the attribute
@@ -782,9 +783,10 @@ package body Sem_Specs is
          --  in the entity name list of a previous attribute specification
          --  for the given attribute.
          Res := Sem_Named_Entities (Scope, Null_Iir, Spec, False, False);
-         if Res = False and then Flags.Warn_Specs then
+         if Res = False and then Is_Warning_Enabled (Warnid_Specs) then
             Warning_Msg_Sem
-              ("attribute specification apply to no named entity", Spec);
+              ("attribute specification apply to no named entity",
+               Spec, Warnid_Specs);
          end if;
       else
          --  o If a list of entity designators is supplied, then the
@@ -1337,10 +1339,10 @@ package body Sem_Specs is
          --    statements whose corresponding instantiated units name
          --    component.
          if not Apply_Component_Specification (Parent_Stmts, False)
-           and then Flags.Warn_Specs
+           and then Is_Warning_Enabled (Warnid_Specs)
          then
-            Warning_Msg_Sem
-              ("component specification applies to no instance", Spec);
+            Warning_Msg_Sem ("component specification applies to no instance",
+                             Spec, Warnid_Specs);
          end if;
       elsif List = Iir_List_Others then
          --  LRM93 5.2
@@ -1355,10 +1357,10 @@ package body Sem_Specs is
          --    statements whose corresponding instantiated units name
          --    components.
          if not Apply_Component_Specification (Parent_Stmts, True)
-           and then Flags.Warn_Specs
+           and then Is_Warning_Enabled (Warnid_Specs)
          then
-            Warning_Msg_Sem
-              ("component specification applies to no instance", Spec);
+            Warning_Msg_Sem ("component specification applies to no instance",
+                             Spec, Warnid_Specs);
          end if;
       else
          --  LRM93 5.2
@@ -1787,7 +1789,8 @@ package body Sem_Specs is
          --     (see 10.3),
          Decl := Get_Declaration (Inter);
          Warning_Msg_Elab ("visible declaration for " & Name_Table.Image (Name)
-                           & " is " & Disp_Node (Decl), Decl);
+                             & " is " & Disp_Node (Decl),
+                           Decl, Warnid_Default_Binding);
 
          --  b)  An entity declaration that has the same simple name that of
          --      the instantiated component and that would be directly
@@ -1798,8 +1801,9 @@ package body Sem_Specs is
             Inter := Get_Under_Interpretation (Name);
             if Valid_Interpretation (Inter) then
                Decl := Get_Declaration (Inter);
-               Warning_Msg_Elab ("interpretation behind the component is "
-                                 & Disp_Node (Decl), Comp);
+               Warning_Msg_Elab
+                 ("interpretation behind the component is " & Disp_Node (Decl),
+                  Comp, Warnid_Default_Binding);
             end if;
          end if;
       end if;
@@ -1819,7 +1823,7 @@ package body Sem_Specs is
          end loop;
 
          Warning_Msg_Elab ("no entity """ & Name_Table.Image (Name) & """ in "
-                           & Disp_Node (Decl), Comp);
+                           & Disp_Node (Decl), Comp, Warnid_Default_Binding);
       end if;
    end Explain_No_Visible_Entity;
 
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index d0ca64a06..25c1ada95 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -557,7 +557,7 @@ package body Sem_Stmts is
                      if Get_Postponed_Flag (Current_Concurrent_Statement) then
                         Warning_Msg_Sem
                           ("waveform may cause a delta cycle in a " &
-                             "postponed process", We);
+                             "postponed process", We, Warnid_Delta_Cycle);
                      end if;
                   when others =>
                      --  Context is a subprogram.
@@ -833,7 +833,7 @@ package body Sem_Stmts is
                   then
                      Warning_Msg_Sem
                        ("expression length does not match target length",
-                        Stmt);
+                        Stmt, Warnid_Runtime_Error);
                      Set_Expression (Stmt, Build_Overflow (Expr, Target_Type));
                   end if;
                end if;
@@ -1499,11 +1499,12 @@ package body Sem_Stmts is
       then
          Entity_Unit := Get_Visible_Entity_Declaration (Decl);
          if Entity_Unit = Null_Iir then
-            if Flags.Warn_Default_Binding
+            if Is_Warning_Enabled (Warnid_Default_Binding)
               and then not Flags.Flag_Elaborate
             then
-               Warning_Msg_Sem ("no default binding for instantiation of "
-                                & Disp_Node (Decl), Stmt);
+               Warning_Msg_Sem
+                 ("no default binding for instantiation of "
+                    & Disp_Node (Decl), Stmt, Warnid_Default_Binding);
                Explain_No_Visible_Entity (Decl);
             end if;
          elsif Flags.Flag_Elaborate
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index a4919147c..b5f948038 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -1891,7 +1891,8 @@ package body Elaboration is
       --  declaration and architecture body or is bound to a configuration of
       --  such a design entity.
       if not Is_Fully_Bound (Conf) then
-         Warning_Msg_Elab (Disp_Node (Stmt) & " not bound", Stmt);
+         Warning_Msg_Elab
+           (Disp_Node (Stmt) & " not bound", Stmt, Warnid_Binding);
          return;
       end if;
 
diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb
index 46f303348..2c3da3189 100644
--- a/src/vhdl/translate/ortho_front.adb
+++ b/src/vhdl/translate/ortho_front.adb
@@ -391,7 +391,7 @@ package body Ortho_Front is
             Design := Get_First_Design_Unit (New_Design_File);
             while not Is_Null (Design) loop
                Sem.Sem_Analysis_Checks_List
-                 (Design, Flags.Warn_Delayed_Checks);
+                 (Design, Is_Warning_Enabled (Warnid_Delayed_Checks));
                Design := Get_Chain (Design);
             end loop;
 
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 8706dd3b3..e1ae36901 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -3784,7 +3784,8 @@ package body Trans.Chap7 is
                return New_Lit (New_Signed_Literal (Otype, Integer_64 (Val)));
             exception
                when Constraint_Error =>
-                  Warning_Msg_Elab ("physical literal out of range", Expr);
+                  Warning_Msg_Elab ("physical literal out of range",
+                                    Expr, Warnid_Runtime_Error);
                   return Translate_Overflow_Literal (Expr);
             end;