diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/vhdl-errors.adb | 56 | ||||
| -rw-r--r-- | src/vhdl/vhdl-errors.ads | 9 | 
2 files changed, 61 insertions, 4 deletions
diff --git a/src/vhdl/vhdl-errors.adb b/src/vhdl/vhdl-errors.adb index 6fcdacf67..ad57a735c 100644 --- a/src/vhdl/vhdl-errors.adb +++ b/src/vhdl/vhdl-errors.adb @@ -999,4 +999,60 @@ package body Vhdl.Errors is        end case;     end Get_Mode_Name; +   function "+" (V : Iir) return Earg_Type is +   begin +      return Make_Earg_Vhdl_Node (Uns32 (V)); +   end "+"; + +   function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type is +   begin +      return Make_Earg_Vhdl_Token (Vhdl.Tokens.Token_Type'Pos (V)); +   end "+"; + +   procedure Vhdl_Node_Handler +     (Format : Character; Err : Error_Record; Val : Uns32) +   is +      N : constant Iir := Iir (Val); +   begin +      case Format is +         when 'i' => +            Output_Identifier (Get_Identifier (N)); +         when 'l' => +            Output_Location (Err, Get_Location (N)); +         when 'n' => +            Output_Message (Disp_Node (N)); +         when others => +            raise Internal_Error; +      end case; +   end Vhdl_Node_Handler; + +   procedure Vhdl_Token_Handler +     (Format : Character; Err : Error_Record; Val : Uns32) +   is +      pragma Unreferenced (Err); +      use Vhdl.Tokens; +      Tok : constant Token_Type := Token_Type'Val (Val); +   begin +      case Format is +         when 't' => +            case Tok is +               when Tok_Identifier => +                  Output_Message ("an identifier"); +               when Tok_Eof => +                  Output_Message ("end of file"); +               when others => +                  Output_Message ("'"); +                  Output_Message (Image (Tok)); +                  Output_Message ("'"); +            end case; +         when others => +            raise Internal_Error; +      end case; +   end Vhdl_Token_Handler; + +   procedure Initialize is +   begin +      Register_Earg_Handler (Earg_Vhdl_Node, Vhdl_Node_Handler'Access); +      Register_Earg_Handler (Earg_Vhdl_Token, Vhdl_Token_Handler'Access); +   end Initialize;  end Vhdl.Errors; diff --git a/src/vhdl/vhdl-errors.ads b/src/vhdl/vhdl-errors.ads index 97d38e7d6..98b8f1c9e 100644 --- a/src/vhdl/vhdl-errors.ads +++ b/src/vhdl/vhdl-errors.ads @@ -21,16 +21,17 @@ with Vhdl.Nodes; use Vhdl.Nodes;  with Vhdl.Tokens;  package Vhdl.Errors is +   --  Register handlers so that errors can be handled. +   procedure Initialize; +     --  This kind can't be handled.     procedure Error_Kind (Msg: String; N : 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; +   function "+" (V : Iir) return Earg_Type; +   function "+" (V : Vhdl.Tokens.Token_Type) return Earg_Type;     --  Convert location.     function "+" (L : Iir) return Location_Type;  | 
