diff options
-rw-r--r-- | src/types.ads | 7 | ||||
-rw-r--r-- | src/vhdl/errorout.adb | 27 | ||||
-rw-r--r-- | src/vhdl/errorout.ads | 11 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 9 |
4 files changed, 45 insertions, 9 deletions
diff --git a/src/types.ads b/src/types.ads index 519ff94ee..876b3ca01 100644 --- a/src/types.ads +++ b/src/types.ads @@ -83,6 +83,13 @@ package Types is Null_String8 : constant String8_Id := 0; + -- The length of a string is not stored in the string table. Create a + -- tuple that is meaningful. + type String8_Len_Type is record + Str : String8_Id; + Len : Nat32; + end record; + -- Index type is the source file table. -- This table is defined in the files_map package. type Source_File_Entry is new Uns32; diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index e068e113c..a86eb890b 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -26,6 +26,7 @@ with Ada.Strings.Unbounded; with Std_Names; with Flags; use Flags; with PSL.Nodes; +with Str_Table; package body Errorout is -- Name of the program, used to report error message. @@ -183,6 +184,11 @@ package body Errorout is return (Kind => Earg_Char, Val_Char => V); end "+"; + function "+" (V : String8_Len_Type) return Earg_Type is + begin + return (Kind => Earg_String8, Val_Str8 => V); + end "+"; + function Get_Location_Safe (N : Iir) return Location_Type is begin if N = Null_Iir then @@ -543,6 +549,22 @@ package body Errorout is raise Internal_Error; end case; end; + when 's' => + -- String + declare + Arg : Earg_Type renames Args (Argn); + begin + Put ('"'); + case Arg.Kind is + when Earg_String8 => + Put (Str_Table.String_String8 + (Arg.Val_Str8.Str, Arg.Val_Str8.Len)); + when others => + -- Invalid conversion to character. + raise Internal_Error; + end case; + Put ('"'); + end; when others => -- Unknown format. raise Internal_Error; @@ -680,9 +702,10 @@ package body Errorout is Report_Msg (Msgid_Error, Parse, No_Location, Msg); end Error_Msg_Parse_1; - procedure Error_Msg_Parse (Loc : Location_Type; Msg: String) is + procedure Error_Msg_Parse + (Loc : Location_Type; Msg: String; Args : Earg_Arr := No_Eargs) is begin - Report_Msg (Msgid_Error, Parse, Loc, Msg); + Report_Msg (Msgid_Error, Parse, Loc, Msg, Args); end Error_Msg_Parse; -- Disp a message during semantic analysis. diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads index f16f44fa9..a6cf848a0 100644 --- a/src/vhdl/errorout.ads +++ b/src/vhdl/errorout.ads @@ -161,12 +161,14 @@ package Errorout is -- %t: token -- %l: location -- %n: node name - -- TODO: %m: mode, %y: type of, %s: disp_subprg + -- %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 : 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; @@ -216,7 +218,8 @@ package Errorout is procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type); procedure Error_Msg_Parse (Msg: String; Args : Earg_Arr := No_Eargs; Cont : Boolean := False); - procedure Error_Msg_Parse (Loc : Location_Type; Msg: String); + procedure Error_Msg_Parse + (Loc : Location_Type; Msg: String; Args : Earg_Arr := No_Eargs); -- Disp a message during semantic analysis. procedure Warning_Msg_Sem (Id : Msgid_Warnings; @@ -319,7 +322,7 @@ package Errorout is private type Earg_Kind is (Earg_None, - Earg_Iir, Earg_Location, Earg_Id, Earg_Char, Earg_Token); + Earg_Iir, Earg_Location, Earg_Id, Earg_Char, Earg_Token, Earg_String8); type Earg_Type (Kind : Earg_Kind := Earg_None) is record case Kind is @@ -335,6 +338,8 @@ private Val_Char : Character; when Earg_Token => Val_Tok : Tokens.Token_Type; + when Earg_String8 => + Val_Str8 : String8_Len_Type; end case; end record; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 4ac5e0f2a..88ee15433 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -405,15 +405,16 @@ package body Parse is procedure Bad_Operator_Symbol is begin - Error_Msg_Parse (Loc, """" & Str_Table.String_String8 (Str_Id, Len) - & """ is not an operator symbol"); + Error_Msg_Parse + (+Loc, "%s is not an operator symbol", (1 => +((Str_Id, Len)))); end Bad_Operator_Symbol; procedure Check_Vhdl93 is begin if Flags.Vhdl_Std = Vhdl_87 then - Error_Msg_Parse (Loc, """" & Str_Table.String_String8 (Str_Id, Len) - & """ is not a vhdl87 operator symbol"); + Error_Msg_Parse + (+Loc, "%s is not a vhdl87 operator symbol", + (1 => +((Str_Id, Len)))); end if; end Check_Vhdl93; |