diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-12-31 06:35:55 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-12-31 06:35:55 +0100 |
commit | 032a613b864bd0ff4c632cfb8541203abf1f4e59 (patch) | |
tree | 485963e7bf92b8e8c3497721c3d1295a53e949f4 /src | |
parent | dfff5cae5a4b336ba0cf797f4122cfcace474736 (diff) | |
download | ghdl-032a613b864bd0ff4c632cfb8541203abf1f4e59.tar.gz ghdl-032a613b864bd0ff4c632cfb8541203abf1f4e59.tar.bz2 ghdl-032a613b864bd0ff4c632cfb8541203abf1f4e59.zip |
Rename name_table.name_buffer and name_length to avoid clash.
Diffstat (limited to 'src')
-rw-r--r-- | src/files_map.adb | 16 | ||||
-rw-r--r-- | src/ghdldrv/ghdllocal.adb | 46 | ||||
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 14 | ||||
-rw-r--r-- | src/ghdldrv/ghdlrun.adb | 4 | ||||
-rw-r--r-- | src/libraries.adb | 22 | ||||
-rw-r--r-- | src/name_table.adb | 36 | ||||
-rw-r--r-- | src/name_table.ads | 10 | ||||
-rw-r--r-- | src/options.adb | 4 | ||||
-rw-r--r-- | src/vhdl/disp_tree.adb | 2 | ||||
-rw-r--r-- | src/vhdl/errorout.adb | 10 | ||||
-rw-r--r-- | src/vhdl/evaluation.adb | 28 | ||||
-rw-r--r-- | src/vhdl/ieee-vital_timing.adb | 144 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 17 | ||||
-rw-r--r-- | src/vhdl/scanner.adb | 92 | ||||
-rw-r--r-- | src/vhdl/sem_names.adb | 2 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 2 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 4 | ||||
-rw-r--r-- | src/vhdl/translate/trans-helpers2.adb | 2 | ||||
-rw-r--r-- | src/vhdl/translate/trans-rtis.adb | 12 | ||||
-rw-r--r-- | src/vhdl/translate/trans.adb | 48 | ||||
-rw-r--r-- | src/vhdl/translate/translation.adb | 38 |
21 files changed, 286 insertions, 267 deletions
diff --git a/src/files_map.adb b/src/files_map.adb index 22c33e490..641ed73e7 100644 --- a/src/files_map.adb +++ b/src/files_map.adb @@ -89,7 +89,7 @@ package body Files_Map is function Get_Home_Directory return Name_Id is begin if Home_Dir = Null_Identifier then - GNAT.Directory_Operations.Get_Current_Dir (Name_Buffer, Name_Length); + GNAT.Directory_Operations.Get_Current_Dir (Nam_Buffer, Nam_Length); Home_Dir := Get_Identifier; end if; return Home_Dir; @@ -548,17 +548,17 @@ package body Files_Map is L : Natural; begin Image (Name); - if not GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then - L := Name_Length; + if not GNAT.OS_Lib.Is_Absolute_Path (Nam_Buffer (1 .. Nam_Length)) then + L := Nam_Length; Image (Directory); - Name_Buffer (Name_Length + 1 .. Name_Length + L) := Image (Name); - Name_Length := Name_Length + L; + Nam_Buffer (Nam_Length + 1 .. Nam_Length + L) := Image (Name); + Nam_Length := Nam_Length + L; end if; if Add_Nul then - Name_Length := Name_Length + 1; - Name_Buffer (Name_Length) := Character'Val (0); + Nam_Length := Nam_Length + 1; + Nam_Buffer (Nam_Length) := Character'Val (0); end if; - return Name_Buffer (1 .. Name_Length); + return Nam_Buffer (1 .. Nam_Length); end Get_Pathname; -- Find a source_file by DIRECTORY and NAME. diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 91bdfacf4..6b2a53e7c 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -494,17 +494,17 @@ package body Ghdllocal is return; end case; Image (Id); - Put (Name_Buffer (1 .. Name_Length)); + Put (Nam_Buffer (1 .. Nam_Length)); case Get_Kind (Unit) is when Iir_Kind_Architecture_Body => Put (" of "); Image (Get_Entity_Identifier_Of_Architecture (Unit)); - Put (Name_Buffer (1 .. Name_Length)); + Put (Nam_Buffer (1 .. Nam_Length)); when Iir_Kind_Configuration_Declaration => if Id = Null_Identifier then Put ("<default> of entity "); Image (Get_Entity_Identifier_Of_Architecture (Unit)); - Put (Name_Buffer (1 .. Name_Length)); + Put (Nam_Buffer (1 .. Nam_Length)); end if; when others => null; @@ -565,12 +565,12 @@ package body Ghdllocal is Basename : constant String := Get_Base_Name (File); begin Image (Libraries.Work_Directory); - Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) := + Nam_Buffer (Nam_Length + 1 .. Nam_Length + Basename'Length) := Basename; - Name_Length := Name_Length + Basename'Length; - Name_Buffer (Name_Length + 1 .. Name_Length + Suffix'Length) := Suffix; - Name_Length := Name_Length + Suffix'Length; - return new String'(Name_Buffer (1 .. Name_Length)); + Nam_Length := Nam_Length + Basename'Length; + Nam_Buffer (Nam_Length + 1 .. Nam_Length + Suffix'Length) := Suffix; + Nam_Length := Nam_Length + Suffix'Length; + return new String'(Nam_Buffer (1 .. Nam_Length)); end Append_Suffix; @@ -1449,18 +1449,18 @@ package body Ghdllocal is function Is_Bad_Unit_Name return Boolean is begin - if Name_Length = 0 then + if Nam_Length = 0 then return True; end if; -- Don't try to handle extended identifier. - if Name_Buffer (1) = '\' then + if Nam_Buffer (1) = '\' then return False; end if; -- Look for suspicious characters. -- Do not try to be exhaustive as the correct check will be done -- by convert_identifier. - for I in 1 .. Name_Length loop - case Name_Buffer (I) is + for I in 1 .. Nam_Length loop + case Nam_Buffer (I) is when '.' | '/' | '\' => return True; when others => @@ -1473,26 +1473,26 @@ package body Ghdllocal is function Is_A_File_Name return Boolean is begin -- Check .vhd - if Name_Length > 4 - and then Name_Buffer (Name_Length - 3 .. Name_Length) = ".vhd" + if Nam_Length > 4 + and then Nam_Buffer (Nam_Length - 3 .. Nam_Length) = ".vhd" then return True; end if; -- Check .vhdl - if Name_Length > 5 - and then Name_Buffer (Name_Length - 4 .. Name_Length) = ".vhdl" + if Nam_Length > 5 + and then Nam_Buffer (Nam_Length - 4 .. Nam_Length) = ".vhdl" then return True; end if; -- Check ../ - if Name_Length > 3 - and then Name_Buffer (1 .. 3) = "../" + if Nam_Length > 3 + and then Nam_Buffer (1 .. 3) = "../" then return True; end if; -- Check ..\ - if Name_Length > 3 - and then Name_Buffer (1 .. 3) = "..\" + if Nam_Length > 3 + and then Nam_Buffer (1 .. 3) = "..\" then return True; end if; @@ -1500,8 +1500,8 @@ package body Ghdllocal is return False; end Is_A_File_Name; begin - Name_Length := Name'Length; - Name_Buffer (1 .. Name_Length) := Name.all; + Nam_Length := Name'Length; + Nam_Buffer (1 .. Nam_Length) := Name.all; -- Try to identifier bad names (such as file names), so that -- friendly message can be displayed. @@ -1514,7 +1514,7 @@ package body Ghdllocal is raise Option_Error; end if; Scanner.Convert_Identifier; - return new String'(Name_Buffer (1 .. Name_Length)); + return new String'(Nam_Buffer (1 .. Nam_Length)); end Convert_Name; procedure Extract_Elab_Unit diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index d4e0f5f8a..7917f7f88 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -602,17 +602,17 @@ package body Ghdlprint is | Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration => Image (Id); - Append (Name_Buffer (1 .. Name_Length)); + Append (Nam_Buffer (1 .. Nam_Length)); when Iir_Kind_Package_Body => Image (Id); - Append (Name_Buffer (1 .. Name_Length)); + Append (Nam_Buffer (1 .. Nam_Length)); Append ("-body"); when Iir_Kind_Architecture_Body => Image (Get_Entity_Identifier_Of_Architecture (Lib)); - Append (Name_Buffer (1 .. Name_Length)); + Append (Nam_Buffer (1 .. Nam_Length)); Append ("-"); Image (Id); - Append (Name_Buffer (1 .. Name_Length)); + Append (Nam_Buffer (1 .. Nam_Length)); when others => raise Internal_Error; end case; @@ -1631,10 +1631,10 @@ package body Ghdlprint is Dir := Get_Source_File_Directory (Cur_File); if Dir /= Null_Identifier then Image (Dir); - Put (Name_Buffer (1 .. Name_Length)); + Put (Nam_Buffer (1 .. Nam_Length)); end if; Image (Get_File_Name (Cur_File)); - Put (Name_Buffer (1 .. Name_Length)); + Put (Nam_Buffer (1 .. Nam_Length)); New_Line; end if; @@ -1696,7 +1696,7 @@ package body Ghdlprint is null; when others => Image (Get_Identifier (N)); - Put (Name_Buffer (1 .. Name_Length)); + Put (Nam_Buffer (1 .. Nam_Length)); end case; end Emit_Decl; diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index 4647e6c2e..d927b4d16 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -166,7 +166,7 @@ package body Ghdlrun is when Foreign_Vhpidirect => declare Name : constant String := - Name_Table.Name_Buffer (Info.Subprg_First + Name_Table.Nam_Buffer (Info.Subprg_First .. Info.Subprg_Last); begin Res := Foreigns.Find_Foreign (Name); @@ -181,7 +181,7 @@ package body Ghdlrun is Name_Table.Image (Get_Identifier (Decl)); declare Name : constant String := - Name_Table.Name_Buffer (1 .. Name_Table.Name_Length); + Name_Table.Nam_Buffer (1 .. Name_Table.Nam_Length); begin if Name = "untruncated_text_read" then Def (Ortho, Grt.Files.Ghdl_Untruncated_Text_Read'Address); diff --git a/src/libraries.adb b/src/libraries.adb index 83565463d..6b9850bae 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -75,7 +75,7 @@ package body Libraries is return; end if; -- Nice message instead of constraint_error. - if Path'Length + 2 >= Name_Buffer'Length then + if Path'Length + 2 >= Nam_Buffer'Length then Error_Msg ("argument of -P is too long"); return; end if; @@ -299,10 +299,10 @@ package body Libraries is Str_Id : constant String8_Id := Current_String_Id; begin for I in 1 .. Len loop - Name_Table.Name_Buffer (Natural (I)) := + Name_Table.Nam_Buffer (Natural (I)) := Str_Table.Char_String8 (Str_Id, I); end loop; - Name_Table.Name_Length := Natural (Len); + Name_Table.Nam_Length := Natural (Len); -- FIXME: should remove last string. return Get_Identifier; end String_To_Name_Id; @@ -363,10 +363,10 @@ package body Libraries is begin for I in Pathes.First .. Pathes.Last loop Image (Pathes.Table (I)); - L := Name_Length + File_Name'Length; - Name_Buffer (Name_Length + 1 .. L) := File_Name; - Name_Buffer (L + 1) := Character'Val (0); - if GNAT.OS_Lib.Is_Regular_File (Name_Buffer'Address) then + L := Nam_Length + File_Name'Length; + Nam_Buffer (Nam_Length + 1 .. L) := File_Name; + Nam_Buffer (L + 1) := Character'Val (0); + if GNAT.OS_Lib.Is_Regular_File (Nam_Buffer'Address) then Dir := Pathes.Table (I); Set_Library_Directory (Library, Dir); exit; @@ -386,7 +386,7 @@ package body Libraries is -- Parse header. Scan; if Current_Token /= Tok_Identifier - or else Name_Length /= 1 or else Name_Buffer (1) /= 'v' + or else Nam_Length /= 1 or else Nam_Buffer (1) /= 'v' then Bad_Library_Format; raise Compilation_Error; @@ -901,7 +901,7 @@ package body Libraries is New_Lib_Time_Stamp := Files_Map.Get_File_Time_Stamp (File); File_Name := Files_Map.Get_File_Name (File); Image (File_Name); - if GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then + if GNAT.OS_Lib.Is_Absolute_Path (Nam_Buffer (1 .. Nam_Length)) then Dir_Name := Null_Identifier; else Dir_Name := Files_Map.Get_Home_Directory; @@ -1189,12 +1189,12 @@ package body Libraries is else Image (Dir); WR (""""); - WR (Name_Buffer (1 .. Name_Length)); + WR (Nam_Buffer (1 .. Nam_Length)); WR (""""); end if; WR (" """); Image (Get_Design_File_Filename (Design_File)); - WR (Name_Buffer (1 .. Name_Length)); + WR (Nam_Buffer (1 .. Nam_Length)); WR (""" """); WR (Files_Map.Get_Time_Stamp_String (Get_File_Time_Stamp (Design_File))); diff --git a/src/name_table.adb b/src/name_table.adb index a3c335347..1908ff8e2 100644 --- a/src/name_table.adb +++ b/src/name_table.adb @@ -82,10 +82,10 @@ package body Name_Table is is Res: Natural; begin - Res := Strings_Table.Allocate (Name_Length + 1); - Strings_Table.Table (Res .. Res + Name_Length - 1) := - Strings_Table.Table_Type (Name_Buffer (1 .. Name_Length)); - Strings_Table.Table (Res + Name_Length) := NUL; + Res := Strings_Table.Allocate (Nam_Length + 1); + Strings_Table.Table (Res .. Res + Nam_Length - 1) := + Strings_Table.Table_Type (Nam_Buffer (1 .. Nam_Length)); + Strings_Table.Table (Res + Nam_Length) := NUL; return Res; end Store; @@ -141,9 +141,9 @@ package body Name_Table is use Interfaces; Res : Unsigned_32; begin - Res := Unsigned_32 (Name_Length); - for I in 1 .. Name_Length loop - Res := Rotate_Left (Res, 4) + Res + Character'Pos (Name_Buffer (I)); + Res := Unsigned_32 (Nam_Length); + for I in 1 .. Nam_Length loop + Res := Rotate_Left (Res, 4) + Res + Character'Pos (Nam_Buffer (I)); end loop; return Hash_Value_Type (Res); end Hash; @@ -171,13 +171,13 @@ package body Name_Table is Name_Entry : Identifier renames Names_Table.Table (Id); begin if Is_Character (Id) then - Name_Buffer (1) := Get_Character (Id); - Name_Length := 1; + Nam_Buffer (1) := Get_Character (Id); + Nam_Length := 1; else - Name_Length := Get_Name_Length (Id); - Name_Buffer (1 .. Name_Length) := String + Nam_Length := Get_Name_Length (Id); + Nam_Buffer (1 .. Nam_Length) := String (Strings_Table.Table - (Name_Entry.Name .. Name_Entry.Name + Name_Length - 1)); + (Name_Entry.Name .. Name_Entry.Name + Nam_Length - 1)); end if; end Image; @@ -233,8 +233,8 @@ package body Name_Table is Ne: Identifier renames Names_Table.Table (Id); begin return String - (Strings_Table.Table (Ne.Name .. Ne.Name + Name_Length - 1)) - = Name_Buffer (1 .. Name_Length); + (Strings_Table.Table (Ne.Name .. Ne.Name + Nam_Length - 1)) + = Nam_Buffer (1 .. Nam_Length); end Compare_Name_Buffer_With_Name; -- Expand the hash table (double the size). @@ -287,7 +287,7 @@ package body Name_Table is Res := Hash_Table (Hash_Index); while Res /= Null_Identifier loop if Names_Table.Table (Res).Hash = Hash_Value - and then Get_Name_Length (Res) = Name_Length + and then Get_Name_Length (Res) = Nam_Length and then Compare_Name_Buffer_With_Name (Res) then return Res; @@ -328,7 +328,7 @@ package body Name_Table is Res := Hash_Table (Hash_Index); while Res /= Null_Identifier loop if Names_Table.Table (Res).Hash = Hash_Value - and then Get_Name_Length (Res) = Name_Length + and then Get_Name_Length (Res) = Nam_Length and then Compare_Name_Buffer_With_Name (Res) then return Res; @@ -341,8 +341,8 @@ package body Name_Table is -- Get or create an entry in the name table. function Get_Identifier (Str : String) return Name_Id is begin - Name_Length := Str'Length; - Name_Buffer (1 .. Name_Length) := Str; + Nam_Length := Str'Length; + Nam_Buffer (1 .. Nam_Length) := Str; return Get_Identifier; end Get_Identifier; diff --git a/src/name_table.ads b/src/name_table.ads index c5b6b9cb4..0d6ff6b8d 100644 --- a/src/name_table.ads +++ b/src/name_table.ads @@ -86,11 +86,13 @@ package Name_Table is procedure Assert_No_Infos; -- This buffer is used by get_token to set the name. - -- This can be seen as a copy buffer but this is necessary for two reasons: - -- names case must be 'normalized', because VHDL is case insensitive. - Name_Buffer : String (1 .. 1024); + -- This can be seen as a copy buffer but this is necessary because names + -- case is 'normalized' as VHDL is case insensitive. + -- To avoid name clash with std_names, Nam_Buffer and Nam_Length are used + -- instead of Name_Buffer and Name_Length. + Nam_Buffer : String (1 .. 1024); -- The length of the name string. - Name_Length: Natural; + Nam_Length: Natural; -- Disp statistics. -- Used for debugging. diff --git a/src/options.adb b/src/options.adb index 7af0804a4..8f02e3712 100644 --- a/src/options.adb +++ b/src/options.adb @@ -103,8 +103,8 @@ package body Options is declare use Name_Table; begin - Name_Length := Opt'Last - (Beg + 7) + 1; - Name_Buffer (1 .. Name_Length) := Opt (Beg + 7 .. Opt'Last); + Nam_Length := Opt'Last - (Beg + 7) + 1; + Nam_Buffer (1 .. Nam_Length) := Opt (Beg + 7 .. Opt'Last); Scanner.Convert_Identifier; Libraries.Work_Library_Name := Get_Identifier; end; diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb index f8cc5d6c4..70731e3ae 100644 --- a/src/vhdl/disp_tree.adb +++ b/src/vhdl/disp_tree.adb @@ -147,7 +147,7 @@ package body Disp_Tree is begin if Ident /= Null_Identifier then Image (Ident); - return ''' & Name_Buffer (1 .. Name_Length) & '''; + return ''' & Nam_Buffer (1 .. Nam_Length) & '''; else return "<anonymous>"; end if; diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index 940b8fc91..c059c5273 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -489,12 +489,12 @@ package body Errorout is when Iir_Kind_Selected_Name => Name_Table.Image (Get_Identifier (Node)); return ''' - & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length) + & Name_Table.Nam_Buffer (1 .. Name_Table.Nam_Length) & '''; when Iir_Kind_Simple_Name => Name_Table.Image (Get_Identifier (Node)); return ''' - & Name_Table.Name_Buffer (1 .. Name_Table.Name_Length) + & Name_Table.Nam_Buffer (1 .. Name_Table.Nam_Length) & '''; when Iir_Kind_Entity_Aspect_Entity => return "aspect " & Disp_Node (Get_Entity (Node)) @@ -920,7 +920,7 @@ package body Errorout is Decl := Get_Type_Declarator (Get_Base_Type (Def)); end if; Image (Get_Identifier (Decl)); - Append (Res, Name_Buffer (1 .. Name_Length)); + Append (Res, Nam_Buffer (1 .. Nam_Length)); end Append_Type; begin @@ -947,10 +947,10 @@ package body Errorout is | Std_Names.Name_Xnor | Std_Names.Name_Shift_Operators => Append (Res, """"); - Append (Res, Name_Buffer (1 .. Name_Length)); + Append (Res, Nam_Buffer (1 .. Nam_Length)); Append (Res, """"); when others => - Append (Res, Name_Buffer (1 .. Name_Length)); + Append (Res, Nam_Buffer (1 .. Nam_Length)); end case; end; diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb index 4093b9460..d6ddfc7e2 100644 --- a/src/vhdl/evaluation.adb +++ b/src/vhdl/evaluation.adb @@ -2104,10 +2104,10 @@ package body Evaluation is begin Id := Create_String8; Image (Get_Simple_Name_Identifier (Expr)); - for I in 1 .. Name_Length loop - Append_String8_Char (Name_Buffer (I)); + for I in 1 .. Nam_Length loop + Append_String8_Char (Nam_Buffer (I)); end loop; - return Build_String (Id, Nat32 (Name_Length), Expr); + return Build_String (Id, Nat32 (Nam_Length), Expr); end; when Iir_Kind_Null_Literal => @@ -2627,10 +2627,10 @@ package body Evaluation is is begin Image (Id); - Name_Buffer (2 .. Name_Length + 1) := Name_Buffer (1 .. Name_Length); - Name_Buffer (1) := '"'; --" - Name_Length := Name_Length + 2; - Name_Buffer (Name_Length) := '"'; --" + Nam_Buffer (2 .. Nam_Length + 1) := Nam_Buffer (1 .. Nam_Length); + Nam_Buffer (1) := '"'; --" + Nam_Length := Nam_Length + 2; + Nam_Buffer (Nam_Length) := '"'; --" end Eval_Operator_Symbol_Name; procedure Eval_Simple_Name (Id : Name_Id) @@ -2641,10 +2641,10 @@ package body Evaluation is -- Result: [...] but with apostrophes (in the case of a character -- literal) if Is_Character (Id) then - Name_Buffer (1) := '''; - Name_Buffer (2) := Get_Character (Id); - Name_Buffer (3) := '''; - Name_Length := 3; + Nam_Buffer (1) := '''; + Nam_Buffer (2) := Get_Character (Id); + Nam_Buffer (3) := '''; + Nam_Length := 3; return; end if; case Id is @@ -2807,7 +2807,7 @@ package body Evaluation is begin Adecl := Get_Type_Declarator (Atype); Image (Get_Identifier (Adecl)); - Path_Add (Name_Buffer (1 .. Name_Length)); + Path_Add (Nam_Buffer (1 .. Nam_Length)); end Path_Add_Type_Name; procedure Path_Add_Signature (Subprg : Iir) @@ -2837,9 +2837,9 @@ package body Evaluation is procedure Path_Add_Name (N : Iir) is begin Eval_Simple_Name (Get_Identifier (N)); - if Name_Buffer (1) /= 'P' then + if Nam_Buffer (1) /= 'P' then -- Skip anonymous processes. - Path_Add (Name_Buffer (1 .. Name_Length)); + Path_Add (Nam_Buffer (1 .. Nam_Length)); end if; end Path_Add_Name; diff --git a/src/vhdl/ieee-vital_timing.adb b/src/vhdl/ieee-vital_timing.adb index 90e1bda63..4b5c17800 100644 --- a/src/vhdl/ieee-vital_timing.adb +++ b/src/vhdl/ieee-vital_timing.adb @@ -59,45 +59,45 @@ package body Ieee.Vital_Timing is VitalDelayArrayType01ZX_Id : Name_Id; begin -- Get Vital delay type identifiers. - Name_Buffer (1 .. 18) := "vitaldelaytype01zx"; - Name_Length := 14; + Nam_Buffer (1 .. 18) := "vitaldelaytype01zx"; + Nam_Length := 14; VitalDelayType_Id := Get_Identifier_No_Create; if VitalDelayType_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Length := 16; + Nam_Length := 16; VitalDelayType01_Id := Get_Identifier_No_Create; if VitalDelayType01_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Length := 17; + Nam_Length := 17; VitalDelayType01Z_Id := Get_Identifier_No_Create; if VitalDelayType01Z_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Length := 18; + Nam_Length := 18; VitalDelayType01ZX_Id := Get_Identifier_No_Create; if VitalDelayType01ZX_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Buffer (1 .. 23) := "vitaldelayarraytype01zx"; - Name_Length := 19; + Nam_Buffer (1 .. 23) := "vitaldelayarraytype01zx"; + Nam_Length := 19; VitalDelayArrayType_Id := Get_Identifier_No_Create; if VitalDelayArrayType_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Length := 21; + Nam_Length := 21; VitalDelayArrayType01_Id := Get_Identifier_No_Create; if VitalDelayArrayType01_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Length := 22; + Nam_Length := 22; VitalDelayArrayType01Z_Id := Get_Identifier_No_Create; if VitalDelayArrayType01Z_Id = Null_Identifier then raise Ill_Formed; end if; - Name_Length := 23; + Nam_Length := 23; VitalDelayArrayType01ZX_Id := Get_Identifier_No_Create; if VitalDelayArrayType01ZX_Id = Null_Identifier then raise Ill_Formed; @@ -245,12 +245,12 @@ package body Ieee.Vital_Timing is -- The identifiers in an entity port declaration shall not contain -- underscore characters. Image (Get_Identifier (Decl)); - if Name_Buffer (1) = '/' then + if Nam_Buffer (1) = '/' then Error_Vital ("VITAL entity port shall not be an extended identifier", Decl); end if; - for I in 1 .. Name_Length loop - if Name_Buffer (I) = '_' then + for I in 1 .. Nam_Length loop + if Nam_Buffer (I) = '_' then Error_Vital ("VITAL entity port shall not contain underscore", Decl); exit; @@ -330,16 +330,16 @@ package body Ieee.Vital_Timing is Id : Name_Id; Inter : Name_Interpretation_Type; begin - Name_Length := 0; + Nam_Length := 0; while Gen_Name_Pos <= Gen_Name_Length loop - C := Name_Buffer (Gen_Name_Pos); + C := Nam_Buffer (Gen_Name_Pos); Gen_Name_Pos := Gen_Name_Pos + 1; exit when C = '_'; - Name_Length := Name_Length + 1; - Name_Buffer (Name_Length) := C; + Nam_Length := Nam_Length + 1; + Nam_Buffer (Nam_Length) := C; end loop; - if Name_Length = 0 then + if Nam_Length = 0 then Error_Vital_Name ("port expected in VITAL generic name"); return Null_Iir; end if; @@ -353,7 +353,7 @@ package body Ieee.Vital_Timing is end if; end if; if Res = Null_Iir then - Warning_Vital ("'" & Name_Buffer (1 .. Name_Length) + Warning_Vital ("'" & Nam_Buffer (1 .. Nam_Length) & "' is not a port name (in VITAL generic name)", Gen_Decl); end if; @@ -376,7 +376,7 @@ package body Ieee.Vital_Timing is | Iir_Inout_Mode => null; when others => - Error_Vital ("'" & Name_Buffer (1 .. Name_Length) + Error_Vital ("'" & Nam_Buffer (1 .. Nam_Length) & "' must be an input port", Gen_Decl); end case; end if; @@ -400,7 +400,7 @@ package body Ieee.Vital_Timing is | Iir_Buffer_Mode => null; when others => - Error_Vital ("'" & Name_Buffer (1 .. Name_Length) + Error_Vital ("'" & Nam_Buffer (1 .. Nam_Length) & "' must be an output port", Gen_Decl); end case; end if; @@ -427,7 +427,7 @@ package body Ieee.Vital_Timing is begin Len := 0; while Gen_Name_Pos <= Gen_Name_Length loop - C := Name_Buffer (Gen_Name_Pos); + C := Nam_Buffer (Gen_Name_Pos); Gen_Name_Pos := Gen_Name_Pos + 1; exit when C = '_'; Len := Len + 1; @@ -436,18 +436,18 @@ package body Ieee.Vital_Timing is return Suffix_Eon; end if; - case Name_Buffer (P) is + case Nam_Buffer (P) is when '0' => - if Len = 2 and then (Name_Buffer (P + 1) = '1' - or Name_Buffer (P + 1) = 'z') + if Len = 2 and then (Nam_Buffer (P + 1) = '1' + or Nam_Buffer (P + 1) = 'z') then return Suffix_Edge; else return Suffix_Num_Name; end if; when '1' => - if Len = 2 and then (Name_Buffer (P + 1) = '0' - or Name_Buffer (P + 1) = 'z') + if Len = 2 and then (Nam_Buffer (P + 1) = '0' + or Nam_Buffer (P + 1) = 'z') then return Suffix_Edge; else @@ -456,23 +456,23 @@ package body Ieee.Vital_Timing is when '2' .. '9' => return Suffix_Num_Name; when 'z' => - if Len = 2 and then (Name_Buffer (P + 1) = '0' - or Name_Buffer (P + 1) = '1') + if Len = 2 and then (Nam_Buffer (P + 1) = '0' + or Nam_Buffer (P + 1) = '1') then return Suffix_Edge; else return Suffix_Name; end if; when 'p' => - if Len = 7 and then Name_Buffer (P .. P + 6) = "posedge" then + if Len = 7 and then Nam_Buffer (P .. P + 6) = "posedge" then return Suffix_Edge; else return Suffix_Name; end if; when 'n' => - if Len = 7 and then Name_Buffer (P .. P + 6) = "negedge" then + if Len = 7 and then Nam_Buffer (P .. P + 6) = "negedge" then return Suffix_Edge; - elsif Len = 6 and then Name_Buffer (P .. P + 5) = "noedge" then + elsif Len = 6 and then Nam_Buffer (P .. P + 5) = "noedge" then return Suffix_Edge; else return Suffix_Name; @@ -806,12 +806,12 @@ package body Ieee.Vital_Timing is -- IEEE 1076.4 4.3.1 -- It is an error for a model to use a timing generic prefix to begin -- the simple name of an entity generic that is not a timing generic. - if Name_Length < Length or Name_Buffer (Length) /= '_' then + if Nam_Length < Length or Nam_Buffer (Length) /= '_' then Error_Vital ("invalid use of a VITAL timing generic prefix", Decl); return False; end if; Gen_Name_Pos := Length + 1; - Gen_Name_Length := Name_Length; + Gen_Name_Length := Nam_Length; Gen_Decl := Decl; return True; end Check_Timing_Generic_Prefix; @@ -1049,16 +1049,16 @@ package body Ieee.Vital_Timing is Image (Get_Identifier (Decl)); Tpd_Name (1) := 't'; -- The part before '_<ClockPort>'. - Tpd_Name (2 .. Clock_Start - 2) := Name_Buffer (3 .. Clock_Start - 1); + Tpd_Name (2 .. Clock_Start - 2) := Nam_Buffer (3 .. Clock_Start - 1); Tpd_Name (Clock_Start - 1 .. Tpd_Name'Last) := - Name_Buffer (Clock_End .. Name_Length); + Nam_Buffer (Clock_End .. Nam_Length); Tpd_Decl := Gen_Chain; loop exit when Tpd_Decl = Null_Iir; Image (Get_Identifier (Tpd_Decl)); - exit when Name_Length = Tpd_Name'Length - and then Name_Buffer (1 .. Name_Length) = Tpd_Name; + exit when Nam_Length = Tpd_Name'Length + and then Nam_Buffer (1 .. Nam_Length) = Tpd_Name; Tpd_Decl := Get_Chain (Tpd_Decl); end loop; @@ -1115,7 +1115,7 @@ package body Ieee.Vital_Timing is end if; declare use Name_Table; - Port : String (1 .. Name_Length); + Port : String (1 .. Nam_Length); El : Iir; Offset : Natural; @@ -1126,39 +1126,39 @@ package body Ieee.Vital_Timing is S := Offset; loop Offset := Offset + 1; - exit when Offset > Name_Length - or else Name_Buffer (Offset) = '_'; + exit when Offset > Nam_Length + or else Nam_Buffer (Offset) = '_'; end loop; if Offset - S = Port'Length - and then Name_Buffer (S .. Offset - 1) = Port + and then Nam_Buffer (S .. Offset - 1) = Port then Error_Vital ("clock port name of 'ticd' VITAL generic must not" & " appear here", El); end if; end Check_Not_Clock; begin - Port := Name_Buffer (P_Start .. Gen_Name_Length); + Port := Nam_Buffer (P_Start .. Gen_Name_Length); El := Gen_Chain; while El /= Null_Iir loop Image (Get_Identifier (El)); - if Name_Length > 5 - and then Name_Buffer (1) = 't' + if Nam_Length > 5 + and then Nam_Buffer (1) = 't' then - if Name_Buffer (2 .. 5) = "bpd_" then + if Nam_Buffer (2 .. 5) = "bpd_" then Offset := 6; Check_Not_Clock; -- input Check_Not_Clock; -- output - elsif Name_Buffer (2 .. 5) = "isd_" then + elsif Nam_Buffer (2 .. 5) = "isd_" then Offset := 6; Check_Not_Clock; -- input - elsif Name_Length > 10 - and then Name_Buffer (2 .. 10) = "recovery_" + elsif Nam_Length > 10 + and then Nam_Buffer (2 .. 10) = "recovery_" then Offset := 11; Check_Not_Clock; -- test port - elsif Name_Length > 9 - and then Name_Buffer (2 .. 9) = "removal_" + elsif Nam_Length > 9 + and then Nam_Buffer (2 .. 9) = "removal_" then Offset := 10; Check_Not_Clock; @@ -1179,60 +1179,60 @@ package body Ieee.Vital_Timing is Image (Id); -- Extract prefix. - if Name_Buffer (1) = 't' and Name_Length >= 3 then + if Nam_Buffer (1) = 't' and Nam_Length >= 3 then -- Timing generic names. - if Name_Buffer (2) = 'p' then - if Name_Buffer (3) = 'd' then + if Nam_Buffer (2) = 'p' then + if Nam_Buffer (3) = 'd' then Check_Propagation_Delay_Name (Decl); -- tpd return; - elsif Name_Buffer (3) = 'w' then + elsif Nam_Buffer (3) = 'w' then Check_Pulse_Width_Name (Decl); -- tpw return; - elsif Name_Length >= 7 - and then Name_Buffer (3 .. 7) = "eriod" + elsif Nam_Length >= 7 + and then Nam_Buffer (3 .. 7) = "eriod" then Check_Input_Period_Name (Decl); -- tperiod return; end if; - elsif Name_Buffer (2) = 'i' - and then Name_Length >= 4 - and then Name_Buffer (4) = 'd' + elsif Nam_Buffer (2) = 'i' + and then Nam_Length >= 4 + and then Nam_Buffer (4) = 'd' then - if Name_Buffer (3) = 'p' then + if Nam_Buffer (3) = 'p' then Check_Interconnect_Path_Delay_Name (Decl); -- tipd return; - elsif Name_Buffer (3) = 's' then + elsif Nam_Buffer (3) = 's' then Check_Internal_Signal_Delay_Name (Decl); -- tisd return; - elsif Name_Buffer (3) = 'c' then + elsif Nam_Buffer (3) = 'c' then Check_Internal_Clock_Delay_Generic_Name (Decl); -- ticd return; end if; - elsif Name_Length >= 6 and then Name_Buffer (2 .. 6) = "setup" then + elsif Nam_Length >= 6 and then Nam_Buffer (2 .. 6) = "setup" then Check_Input_Setup_Time_Name (Decl); -- tsetup return; - elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "hold" then + elsif Nam_Length >= 5 and then Nam_Buffer (2 .. 5) = "hold" then Check_Input_Hold_Time_Name (Decl); -- thold return; - elsif Name_Length >= 9 and then Name_Buffer (2 .. 9) = "recovery" then + elsif Nam_Length >= 9 and then Nam_Buffer (2 .. 9) = "recovery" then Check_Input_Recovery_Time_Name (Decl); -- trecovery return; - elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "removal" then + elsif Nam_Length >= 8 and then Nam_Buffer (2 .. 8) = "removal" then Check_Input_Removal_Time_Name (Decl); -- tremoval return; - elsif Name_Length >= 5 and then Name_Buffer (2 .. 5) = "skew" then + elsif Nam_Length >= 5 and then Nam_Buffer (2 .. 5) = "skew" then Check_Input_Skew_Time_Name (Decl); -- tskew return; - elsif Name_Length >= 8 and then Name_Buffer (2 .. 8) = "ncsetup" then + elsif Nam_Length >= 8 and then Nam_Buffer (2 .. 8) = "ncsetup" then Check_No_Change_Setup_Time_Name (Decl); -- tncsetup return; - elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "nchold" then + elsif Nam_Length >= 7 and then Nam_Buffer (2 .. 7) = "nchold" then Check_No_Change_Hold_Time_Name (Decl); -- tnchold return; - elsif Name_Length >= 7 and then Name_Buffer (2 .. 7) = "device" then + elsif Nam_Length >= 7 and then Nam_Buffer (2 .. 7) = "device" then Check_Device_Delay_Name (Decl); -- tdevice return; - elsif Name_Length >= 4 and then Name_Buffer (2 .. 4) = "bpd" then + elsif Nam_Length >= 4 and then Nam_Buffer (2 .. 4) = "bpd" then Check_Biased_Propagation_Delay_Name (Decl); -- tbpd return; end if; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 0633cad67..7d8e3a724 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -3949,6 +3949,7 @@ package body Parse is -- Simply create the node for a bit string. function Parse_Bit_String return Iir is + use Name_Table; Res : Iir; C : Character; B : Base_Type; @@ -3957,21 +3958,21 @@ package body Parse is Set_Location (Res); Set_String8_Id (Res, Current_String_Id); Set_String_Length (Res, Current_String_Length); - if Name_Table.Name_Buffer (1) = 's' then + if Nam_Buffer (1) = 's' then Set_Has_Sign (Res, True); Set_Has_Signed (Res, True); - pragma Assert (Name_Table.Name_Length = 2); - C := Name_Table.Name_Buffer (2); - elsif Name_Table.Name_Buffer (1) = 'u' then + pragma Assert (Nam_Length = 2); + C := Name_Table.Nam_Buffer (2); + elsif Nam_Buffer (1) = 'u' then Set_Has_Sign (Res, True); Set_Has_Signed (Res, False); - pragma Assert (Name_Table.Name_Length = 2); - C := Name_Table.Name_Buffer (2); + pragma Assert (Nam_Length = 2); + C := Nam_Buffer (2); else Set_Has_Sign (Res, False); Set_Has_Signed (Res, False); - pragma Assert (Name_Table.Name_Length = 1); - C := Name_Table.Name_Buffer (1); + pragma Assert (Nam_Length = 1); + C := Nam_Buffer (1); end if; case C is diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb index 02cd752fd..32ae03ff6 100644 --- a/src/vhdl/scanner.adb +++ b/src/vhdl/scanner.adb @@ -78,7 +78,7 @@ package body Scanner is '0' .. '9' => Digit, -- 3. special characters - Quotation | '#' | '&' | ''' | '(' | ')' | '+' | ',' | '-' | '.' | '/' + '"' | '#' | '&' | ''' | '(' | ')' | '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' | '=' | '>' | '[' | ']' | '_' | '|' | '*' => Special_Character, @@ -397,7 +397,7 @@ package body Scanner is end if; end case; - if C = Quotation and Mark = '%' then + if C = '"' and Mark = '%' then -- LRM93 13.10 -- The quotation marks (") used as string brackets at both ends of -- a string literal can be replaced by percent signs (%), provided @@ -553,13 +553,15 @@ package body Scanner is Length := Length + Base_Log; end loop; - if Length = 0 then - Error_Msg_Scan ("empty bit string is not allowed"); - end if; + -- Note: the length of the bit string may be 0. + Current_Token := Tok_Bit_String; Current_Context.Str_Len := Length; end Scan_Bit_String; + -- Scan a decimal bit string literal. For base specifier D the algorithm + -- is rather different: all the graphic characters shall be digits, and we + -- need to use a (not very efficient) arbitrary precision multiplication. procedure Scan_Dec_Bit_String is use Str_Table; @@ -601,6 +603,8 @@ package body Scanner is end loop; end Append_Carries; + -- Add 1 to Carries. Overflow is not allowed and should be prevented by + -- construction. procedure Add_One_To_Carries is begin for I in Carries'Range loop @@ -611,6 +615,7 @@ package body Scanner is else Carries (I) := Pos_0; -- Continue propagation. + pragma Assert (I < Carries'Last); end if; end loop; end Add_One_To_Carries; @@ -697,9 +702,6 @@ package body Scanner is Append_Carries; end loop; - if Length = 0 then - Error_Msg_Scan ("empty bit string is not allowed"); - end if; Current_Token := Tok_Bit_String; Current_Context.Str_Len := Length; end Scan_Dec_Bit_String; @@ -766,7 +768,7 @@ package body Scanner is -- Put character in name buffer. FIXME: compute the hash at the same -- time ? Len := Len + 1; - Name_Buffer (Len) := C; + Nam_Buffer (Len) := C; -- Next character. Pos := Pos + 1; @@ -782,7 +784,7 @@ package body Scanner is Len := Len - 1; C := '_'; end if; - Name_Length := Len; + Nam_Length := Len; -- LRM93 13.2 -- At least one separator is required between an identifier or an @@ -794,6 +796,12 @@ package body Scanner is raise Internal_Error; when Other_Special_Character | Special_Character => if (C = '"' or C = '%') and then Len <= 2 then + if C = '%' and Vhdl_Std >= Vhdl_08 then + Error_Msg_Scan ("'%' not allowed in vhdl 2008 " + & "(was replacement character)"); + -- Continue as a bit string. + end if; + -- Good candidate for bit string. -- LRM93 13.7 @@ -812,8 +820,8 @@ package body Scanner is -- with the same meaning. declare Base : Nat32; - Cl : constant Character := Name_Buffer (Len); - Cf : constant Character := Name_Buffer (1); + Cl : constant Character := Nam_Buffer (Len); + Cf : constant Character := Nam_Buffer (1); begin if Cl = 'b' then Base := 1; @@ -865,7 +873,7 @@ package body Scanner is if not AMS_Vhdl then if Flags.Warn_Reserved_Word then Warning_Msg_Scan - ("using """ & Name_Buffer (1 .. Name_Length) + ("using """ & Nam_Buffer (1 .. Nam_Length) & """ AMS-VHDL reserved word as an identifier"); end if; Current_Token := Tok_Identifier; @@ -874,7 +882,7 @@ package body Scanner is if Vhdl_Std < Vhdl_00 then if Flags.Warn_Reserved_Word then Warning_Msg_Scan - ("using """ & Name_Buffer (1 .. Name_Length) + ("using """ & Nam_Buffer (1 .. Nam_Length) & """ vhdl00 reserved word as an identifier"); end if; Current_Token := Tok_Identifier; @@ -883,7 +891,7 @@ package body Scanner is if Vhdl_Std = Vhdl_87 then if Flags.Warn_Reserved_Word then Warning_Msg_Scan - ("using """ & Name_Buffer (1 .. Name_Length) + ("using """ & Nam_Buffer (1 .. Nam_Length) & """ vhdl93 reserved word as a vhdl87 identifier"); Warning_Msg_Scan ("(use option --std=93 to compile as vhdl93)"); @@ -962,8 +970,8 @@ package body Scanner is -- Moreover, every extended identifiers is distinct from any basic -- identifier. -- This is satisfied by storing '\' in the name table. - Name_Length := 1; - Name_Buffer (1) := '\'; + Nam_Length := 1; + Nam_Buffer (1) := '\'; loop -- Next character. Pos := Pos + 1; @@ -974,8 +982,8 @@ package body Scanner is -- of an extended literal, it must be doubled. -- LRM93 13.3.2 -- (a doubled backslash couting as one character) - Name_Length := Name_Length + 1; - Name_Buffer (Name_Length) := '\'; + Nam_Length := Nam_Length + 1; + Nam_Buffer (Nam_Length) := '\'; Pos := Pos + 1; @@ -992,14 +1000,14 @@ package body Scanner is when Invalid => Error_Msg_Scan ("invalid character in extended identifier"); end case; - Name_Length := Name_Length + 1; + Nam_Length := Nam_Length + 1; -- LRM93 13.3.2 -- Extended identifiers differing only in the use of corresponding -- upper and lower case letters are distinct. - Name_Buffer (Name_Length) := Source (Pos); + Nam_Buffer (Nam_Length) := Source (Pos); end loop; - if Name_Length <= 2 then + if Nam_Length <= 2 then Error_Msg_Scan ("empty extended identifier is not allowed"); end if; @@ -1039,36 +1047,36 @@ package body Scanner is use Name_Table; C : Character; begin - if Name_Length = 0 then + if Nam_Length = 0 then Error_Msg_Option ("identifier required"); return; end if; - if Name_Buffer (1) = '\' then + if Nam_Buffer (1) = '\' then -- Extended identifier. if Vhdl_Std = Vhdl_87 then Error_Msg_Option ("extended identifiers not allowed in vhdl87"); return; end if; - if Name_Length < 3 then + if Nam_Length < 3 then Error_Msg_Option ("extended identifier is too short"); return; end if; - if Name_Buffer (Name_Length) /= '\' then + if Nam_Buffer (Nam_Length) /= '\' then Error_Msg_Option ("extended identifier must finish with a '\'"); return; end if; - for I in 2 .. Name_Length - 1 loop - C := Name_Buffer (I); + for I in 2 .. Nam_Length - 1 loop + C := Nam_Buffer (I); case Characters_Kind (C) is when Format_Effector => Error_Msg_Option ("format effector in extended identifier"); return; when Graphic_Character => if C = '\' then - if Name_Buffer (I + 1) /= '\' - or else I = Name_Length - 1 + if Nam_Buffer (I + 1) /= '\' + or else I = Nam_Length - 1 then Error_Msg_Option ("anti-slash must be doubled " & "in extended identifier"); @@ -1081,14 +1089,14 @@ package body Scanner is end loop; else -- Identifier - for I in 1 .. Name_Length loop - C := Name_Buffer (I); + for I in 1 .. Nam_Length loop + C := Nam_Buffer (I); case Characters_Kind (C) is when Upper_Case_Letter => if Vhdl_Std = Vhdl_87 and C > 'Z' then Error_8bit; end if; - Name_Buffer (I) := Ada.Characters.Handling.To_Lower (C); + Nam_Buffer (I) := Ada.Characters.Handling.To_Lower (C); when Lower_Case_Letter | Digit => if Vhdl_Std = Vhdl_87 and C > 'z' then Error_8bit; @@ -1101,12 +1109,12 @@ package body Scanner is ("identifier cannot start with an underscore"); return; end if; - if Name_Buffer (I - 1) = '_' then + if Nam_Buffer (I - 1) = '_' then Error_Msg_Option ("two underscores can't be consecutive"); return; end if; - if I = Name_Length then + if I = Nam_Length then Error_Msg_Option ("identifier cannot finish with an underscore"); return; @@ -1145,7 +1153,7 @@ package body Scanner is C := Source (Pos); exit when C not in 'a' .. 'z' and C /= '_'; Len := Len + 1; - Name_Buffer (Len) := C; + Nam_Buffer (Len) := C; Pos := Pos + 1; end loop; @@ -1157,7 +1165,7 @@ package body Scanner is return False; end case; - Name_Length := Len; + Nam_Length := Len; return True; end Scan_Comment_Identifier; @@ -1614,7 +1622,15 @@ package body Scanner is & "must be preceded by a base"); -- Cannot easily continue. raise Compilation_Error; - when Quotation | '%' => + when '"' => + Scan_String; + return; + when '%' => + if Vhdl_Std >= Vhdl_08 then + Error_Msg_Scan + ("'%' not allowed in vhdl 2008 (was replacement character)"); + -- Continue as a string. + end if; Scan_String; return; when '[' => diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 47b9aa29d..472276956 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -3151,7 +3151,7 @@ package body Sem_Names is Set_Simple_Name_Identifier (Res, Name_Table.Get_Identifier); Attr_Type := Create_Unidim_Array_By_Length (String_Type_Definition, - Iir_Int64 (Name_Table.Name_Length), + Iir_Int64 (Name_Table.Nam_Length), Attr); Set_Simple_Name_Subtype (Res, Attr_Type); Set_Expr_Staticness (Res, Locally); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index eee425476..51d64d21b 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -171,7 +171,7 @@ package body Trans.Chap2 is Id := Create_Identifier; when Foreign_Vhpidirect => Id := Get_Identifier - (Name_Table.Name_Buffer (Foreign.Subprg_First + (Name_Table.Nam_Buffer (Foreign.Subprg_First .. Foreign.Subprg_Last)); end case; Storage := O_Storage_External; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 96608808e..9e721a932 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -358,9 +358,9 @@ package body Trans.Chap7 is Literal_List := Get_Enumeration_Literal_List (Character_Type_Definition); Image (Str_Ident); - for I in 1 .. Name_Length loop + for I in 1 .. Nam_Length loop Lit := Get_Nth_Element (Literal_List, - Character'Pos (Name_Buffer (I))); + Character'Pos (Nam_Buffer (I))); New_Array_Aggr_El (List, Get_Ortho_Expr (Lit)); end loop; diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb index c8da472c7..9a4b28552 100644 --- a/src/vhdl/translate/trans-helpers2.adb +++ b/src/vhdl/translate/trans-helpers2.adb @@ -97,7 +97,7 @@ package body Trans.Helpers2 is raise Internal_Error; end if; Image (Str); - return Create_String (Name_Buffer (1 .. Name_Length), Id, Storage); + return Create_String (Nam_Buffer (1 .. Nam_Length), Id, Storage); end Create_String; function Create_String_Len (Str : String; Id : O_Ident) return O_Cnode diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index fe7032c4a..76db3ccd1 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -867,14 +867,14 @@ package body Trans.Rtis is begin Id := Get_Identifier (Node); if Is_Character (Id) then - Name_Buffer (1) := '''; - Name_Buffer (2) := Get_Character (Id); - Name_Buffer (3) := '''; - Name_Length := 3; + Nam_Buffer (1) := '''; + Nam_Buffer (2) := Get_Character (Id); + Nam_Buffer (3) := '''; + Nam_Length := 3; else Image (Id); end if; - return Create_String (Name_Buffer (1 .. Name_Length), + return Create_String (Nam_Buffer (1 .. Nam_Length), Create_Identifier ("RTISTR")); end Generate_Name; @@ -2435,7 +2435,7 @@ package body Trans.Rtis is if Public then Image (Id); Name := Create_String - (Name_Buffer (1 .. Name_Length), + (Nam_Buffer (1 .. Nam_Length), Create_Identifier_Without_Prefix (Id, "__RTISTR")); Start_Const_Value (Info.Library_Rti_Const); Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Scalar); diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index e23357ee8..a79898c48 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -690,47 +690,47 @@ package body Trans is begin if Is_Character (Name) then P := Character'Pos (Name_Table.Get_Character (Name)); - Name_Buffer (1) := 'C'; - Name_Buffer (2) := N2hex (P / 16); - Name_Buffer (3) := N2hex (P mod 16); - Name_Length := 3; + Nam_Buffer (1) := 'C'; + Nam_Buffer (2) := N2hex (P / 16); + Nam_Buffer (3) := N2hex (P mod 16); + Nam_Length := 3; return; else Image (Name); end if; - if Name_Buffer (1) /= '\' then + if Nam_Buffer (1) /= '\' then return; end if; -- Extended identifier. -- Supress trailing backslash. - Name_Length := Name_Length - 1; + Nam_Length := Nam_Length - 1; -- Count number of characters in the extended string. - N_Len := Name_Length; - for I in 2 .. Name_Length loop - if Is_Extended_Char (Name_Buffer (I)) then + N_Len := Nam_Length; + for I in 2 .. Nam_Length loop + if Is_Extended_Char (Nam_Buffer (I)) then N_Len := N_Len + 2; end if; end loop; -- Convert. - Name_Buffer (1) := 'X'; + Nam_Buffer (1) := 'X'; P := N_Len; - for J in reverse 2 .. Name_Length loop - C := Name_Buffer (J); + for J in reverse 2 .. Nam_Length loop + C := Nam_Buffer (J); if Is_Extended_Char (C) then - Name_Buffer (P - 0) := N2hex (Character'Pos (C) mod 16); - Name_Buffer (P - 1) := N2hex (Character'Pos (C) / 16); - Name_Buffer (P - 2) := '_'; + Nam_Buffer (P - 0) := N2hex (Character'Pos (C) mod 16); + Nam_Buffer (P - 1) := N2hex (Character'Pos (C) / 16); + Nam_Buffer (P - 2) := '_'; P := P - 3; else - Name_Buffer (P) := C; + Nam_Buffer (P) := C; P := P - 1; end if; end loop; - Name_Buffer (N_Len + 1) := '_'; - Name_Buffer (N_Len + 2) := '_'; - Name_Length := N_Len + 2; + Nam_Buffer (N_Len + 1) := '_'; + Nam_Buffer (N_Len + 2) := '_'; + Nam_Length := N_Len + 2; end Name_Id_To_String; procedure Add_Name (Len : in out Natural; Name : Name_Id) @@ -738,7 +738,7 @@ package body Trans is use Name_Table; begin Name_Id_To_String (Name); - Add_String (Len, Name_Buffer (1 .. Name_Length)); + Add_String (Len, Nam_Buffer (1 .. Nam_Length)); end Add_Name; procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type; @@ -767,7 +767,7 @@ package body Trans is use Name_Table; begin Name_Id_To_String (Name); - Push_Identifier_Prefix (Mark, Name_Buffer (1 .. Name_Length), Val); + Push_Identifier_Prefix (Mark, Nam_Buffer (1 .. Nam_Length), Val); end Push_Identifier_Prefix; procedure Push_Identifier_Prefix_Uniq (Mark : out Id_Mark_Type) @@ -792,7 +792,7 @@ package body Trans is use Name_Table; begin Name_Id_To_String (Get_Identifier (Id)); - return Get_Identifier (Name_Buffer (1 .. Name_Length)); + return Get_Identifier (Nam_Buffer (1 .. Nam_Length)); end Create_Identifier_Without_Prefix; function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String) @@ -801,8 +801,8 @@ package body Trans is use Name_Table; begin Name_Id_To_String (Id); - Name_Buffer (Name_Length + 1 .. Name_Length + Str'Length) := Str; - return Get_Identifier (Name_Buffer (1 .. Name_Length + Str'Length)); + Nam_Buffer (Nam_Length + 1 .. Nam_Length + Str'Length) := Str; + return Get_Identifier (Nam_Buffer (1 .. Nam_Length + Str'Length)); end Create_Identifier_Without_Prefix; -- Create an identifier from IIR node ID with prefix. diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 164a2e5a4..38d8f9700 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -81,9 +81,9 @@ package body Translation is declare Id : constant String8_Id := Get_String8_Id (Expr); begin - Name_Length := Natural (Get_String_Length (Expr)); - for I in 1 .. Name_Length loop - Name_Buffer (I) := Str_Table.Char_String8 (Id, Pos32 (I)); + Nam_Length := Natural (Get_String_Length (Expr)); + for I in 1 .. Nam_Length loop + Nam_Buffer (I) := Str_Table.Char_String8 (Id, Pos32 (I)); end loop; end; when Iir_Kind_Simple_Aggregate => @@ -92,15 +92,15 @@ package body Translation is El : Iir; begin List := Get_Simple_Aggregate_List (Expr); - Name_Length := 0; + Nam_Length := 0; for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; if Get_Kind (El) /= Iir_Kind_Enumeration_Literal then raise Internal_Error; end if; - Name_Length := Name_Length + 1; - Name_Buffer (Name_Length) := + Nam_Length := Nam_Length + 1; + Nam_Buffer (Nam_Length) := Character'Val (Get_Enum_Pos (El)); end loop; end; @@ -108,19 +108,19 @@ package body Translation is if Get_Expr_Staticness (Expr) /= Locally then Error_Msg_Sem ("value of FOREIGN attribute must be locally static", Expr); - Name_Length := 0; + Nam_Length := 0; else raise Internal_Error; end if; end case; - if Name_Length = 0 then + if Nam_Length = 0 then return Foreign_Bad; end if; -- Only 'VHPIDIRECT' is recognized. - if Name_Length >= 10 - and then Name_Buffer (1 .. 10) = "VHPIDIRECT" + if Nam_Length >= 10 + and then Nam_Buffer (1 .. 10) = "VHPIDIRECT" then declare P : Natural; @@ -130,35 +130,35 @@ package body Translation is P := 11; -- Skip spaces. - while P <= Name_Length and then Name_Buffer (P) = ' ' loop + while P <= Nam_Length and then Nam_Buffer (P) = ' ' loop P := P + 1; end loop; - if P > Name_Length then + if P > Nam_Length then Error_Msg_Sem ("missing subprogram/library name after VHPIDIRECT", Spec); end if; -- Extract library. Lf := P; - while P < Name_Length and then Name_Buffer (P) /= ' ' loop + while P < Nam_Length and then Nam_Buffer (P) /= ' ' loop P := P + 1; end loop; Ll := P; -- Extract subprogram. P := P + 1; - while P <= Name_Length and then Name_Buffer (P) = ' ' loop + while P <= Nam_Length and then Nam_Buffer (P) = ' ' loop P := P + 1; end loop; Sf := P; - while P < Name_Length and then Name_Buffer (P) /= ' ' loop + while P < Nam_Length and then Nam_Buffer (P) /= ' ' loop P := P + 1; end loop; Sl := P; - if P < Name_Length then + if P < Nam_Length then Error_Msg_Sem ("garbage at end of VHPIDIRECT", Spec); end if; -- Accept empty library. - if Sf > Name_Length then + if Sf > Nam_Length then Sf := Lf; Sl := Ll; Lf := 0; @@ -172,8 +172,8 @@ package body Translation is Subprg_First => Sf, Subprg_Last => Sl); end; - elsif Name_Length = 14 - and then Name_Buffer (1 .. 14) = "GHDL intrinsic" + elsif Nam_Length = 14 + and then Nam_Buffer (1 .. 14) = "GHDL intrinsic" then return Foreign_Info_Type'(Kind => Foreign_Intrinsic); else |