From cce685621b46adb534ec20fcf9a76606596288be Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 31 Oct 2006 18:51:38 +0100 Subject: [PATCH] clean.adb, [...]: Fix bad table increment values (much too small) 2006-10-31 Robert Dewar * clean.adb, gnatname.adb, gnatsym.adb, prep.adb, prep.ads, prepcomp.adb, prj.ads, prj-strt.adb, sem_maps.ads, vms_conv.adb: Fix bad table increment values (much too small) * table.adb (Realloc): Make sure we get at least some new elements Defends against silly small values for table increment From-SVN: r118249 --- gcc/ada/clean.adb | 4 +- gcc/ada/gnatname.adb | 12 +- gcc/ada/gnatsym.adb | 4 +- gcc/ada/prep.adb | 1154 +++++++++++++++++++++--------------------- gcc/ada/prep.ads | 4 +- gcc/ada/prepcomp.adb | 6 +- gcc/ada/prj-strt.adb | 4 +- gcc/ada/prj.ads | 22 +- gcc/ada/sem_maps.ads | 8 +- gcc/ada/table.adb | 13 +- gcc/ada/vms_conv.adb | 2 +- 11 files changed, 619 insertions(+), 614 deletions(-) diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 08459060345..0897c27e6c1 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -120,7 +120,7 @@ package body Clean is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Clean.Processed_Projects"); -- Table to keep track of what project files have been processed, when -- switch -r is specified. @@ -130,7 +130,7 @@ package body Clean is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Clean.Processed_Projects"); -- Table to store all the source files of a library unit: spec, body and -- subunits, to detect .dg files and delete them. diff --git a/gcc/ada/gnatname.adb b/gcc/ada/gnatname.adb index b746ba02f23..714ba42f589 100644 --- a/gcc/ada/gnatname.adb +++ b/gcc/ada/gnatname.adb @@ -66,7 +66,7 @@ procedure Gnatname is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Gnatname.Excluded_Patterns"); -- Table to accumulate the negative patterns @@ -75,7 +75,7 @@ procedure Gnatname is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Gnatname.Foreign_Patterns"); -- Table to accumulate the foreign patterns @@ -84,7 +84,7 @@ procedure Gnatname is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Gnatname.Patterns"); -- Table to accumulate the name patterns @@ -93,7 +93,7 @@ procedure Gnatname is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Gnatname.Source_Directories"); -- Table to accumulate the source directories specified directly with -d -- or indirectly with -D. @@ -102,8 +102,8 @@ procedure Gnatname is (Table_Component_Type => String_Access, Table_Index_Type => Natural, Table_Low_Bound => 0, - Table_Initial => 2, - Table_Increment => 50, + Table_Initial => 10, + Table_Increment => 100, Table_Name => "Gnatname.Preprocessor_Switches"); -- Table to store the preprocessor switches to be used in the call -- to the compiler. diff --git a/gcc/ada/gnatsym.adb b/gcc/ada/gnatsym.adb index f723d52a088..f05ad9c0f27 100644 --- a/gcc/ada/gnatsym.adb +++ b/gcc/ada/gnatsym.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -85,7 +85,7 @@ procedure Gnatsym is Table_Index_Type => Natural, Table_Low_Bound => 0, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Gnatsymb.Object_Files"); -- A table to store the object file names diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb index b2ec857b96d..09ba3bfb197 100644 --- a/gcc/ada/prep.adb +++ b/gcc/ada/prep.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -178,7 +178,7 @@ package body Prep is Table_Index_Type => Pp_Depth, Table_Low_Bound => 1, Table_Initial => 10, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Prep.Pp_States"); -- A stack of the states of the preprocessor, for nested #if @@ -675,768 +675,768 @@ package body Prep is end Index_Of; ---------------- - -- Preprocess -- + -- Initialize -- ---------------- - procedure Preprocess is - Start_Of_Processing : Source_Ptr; - Cond : Boolean; - Preprocessor_Line : Boolean := False; + procedure Initialize + (Error_Msg : Error_Msg_Proc; + Scan : Scan_Proc; + Set_Ignore_Errors : Set_Ignore_Errors_Proc; + Put_Char : Put_Char_Proc; + New_EOL : New_EOL_Proc) + is + begin + if not Already_Initialized then + Start_String; + Store_String_Chars ("True"); + True_Value.Value := End_String; - procedure Output (From, To : Source_Ptr); - -- Output the characters with indices From .. To in the buffer - -- to the output file. + Start_String; + Empty_String := End_String; - procedure Output_Line (From, To : Source_Ptr); - -- Output a line or the end of a line from the buffer to the output - -- file, followed by an end of line terminator. Depending on the value - -- of Deleting and the switches, the line may be commented out, blank or - -- not output at all. + Name_Len := 7; + Name_Buffer (1 .. Name_Len) := "defined"; + Name_Defined := Name_Find; - ------------ - -- Output -- - ------------ + Start_String; + Store_String_Chars ("False"); + String_False := End_String; - procedure Output (From, To : Source_Ptr) is - begin - for J in From .. To loop - Put_Char (Sinput.Source (J)); - end loop; - end Output; + Already_Initialized := True; + end if; - ----------------- - -- Output_Line -- - ----------------- + Prep.Error_Msg := Error_Msg; + Prep.Scan := Scan; + Prep.Set_Ignore_Errors := Set_Ignore_Errors; + Prep.Put_Char := Put_Char; + Prep.New_EOL := New_EOL; + end Initialize; + + ------------------ + -- List_Symbols -- + ------------------ + + procedure List_Symbols (Foreword : String) is + Order : array (0 .. Integer (Symbol_Table.Last (Mapping))) + of Symbol_Id; + -- After alphabetical sorting, this array stores thehe indices of + -- the symbols in the order they are displayed. + + function Lt (Op1, Op2 : Natural) return Boolean; + -- Comparison routine for sort call + + procedure Move (From : Natural; To : Natural); + -- Move routine for sort call + + -------- + -- Lt -- + -------- + + function Lt (Op1, Op2 : Natural) return Boolean is + S1 : constant String := + Get_Name_String (Mapping.Table (Order (Op1)).Symbol); + S2 : constant String := + Get_Name_String (Mapping.Table (Order (Op2)).Symbol); - procedure Output_Line (From, To : Source_Ptr) is begin - if Deleting or Preprocessor_Line then - if Blank_Deleted_Lines then - New_EOL.all; + return S1 < S2; + end Lt; - elsif Comment_Deleted_Lines then - Put_Char ('-'); - Put_Char ('-'); - Put_Char ('!'); + ---------- + -- Move -- + ---------- - if From < To then - Put_Char (' '); - Output (From, To); - end if; + procedure Move (From : Natural; To : Natural) is + begin + Order (To) := Order (From); + end Move; - New_EOL.all; - end if; + package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt); - else - Output (From, To); - New_EOL.all; - end if; - end Output_Line; + Max_L : Natural; + -- Maximum length of any symbol - -- Start of processing for Preprocess + -- Start of processing for List_Symbols_Case begin - Start_Of_Processing := Scan_Ptr; + if Symbol_Table.Last (Mapping) = 0 then + return; + end if; - -- We need to call Scan for the first time, because Initialize_Scanner - -- is no longer doing it. + if Foreword'Length > 0 then + Write_Eol; + Write_Line (Foreword); - Scan.all; + for J in Foreword'Range loop + Write_Char ('='); + end loop; + end if; - Input_Line_Loop : loop - exit Input_Line_Loop when Token = Tok_EOF; + -- Initialize the order - Preprocessor_Line := False; + for J in Order'Range loop + Order (J) := Symbol_Id (J); + end loop; - if Token /= Tok_End_Of_Line then + -- Sort alphabetically - -- Preprocessor line + Sort_Syms.Sort (Order'Last); - if Token = Tok_Special and then Special_Character = '#' then - Preprocessor_Line := True; - Scan.all; + Max_L := 7; - case Token is + for J in 1 .. Symbol_Table.Last (Mapping) loop + Get_Name_String (Mapping.Table (J).Original); + Max_L := Integer'Max (Max_L, Name_Len); + end loop; - -- #if + Write_Eol; + Write_Str ("Symbol"); - when Tok_If => - declare - If_Ptr : constant Source_Ptr := Token_Ptr; + for J in 1 .. Max_L - 5 loop + Write_Char (' '); + end loop; - begin - Scan.all; - Cond := Expression (not Deleting); + Write_Line ("Value"); - -- Check for an eventual "then" + Write_Str ("------"); - if Token = Tok_Then then - Scan.all; - end if; + for J in 1 .. Max_L - 5 loop + Write_Char (' '); + end loop; - -- It is an error to have trailing characters after - -- the condition or "then". + Write_Line ("------"); - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); - Go_To_End_Of_Line; - end if; + for J in 1 .. Order'Last loop + declare + Data : constant Symbol_Data := Mapping.Table (Order (J)); - declare - -- Set the initial state of this new "#if". - -- This must be done before incrementing the - -- Last of the table, otherwise function - -- Deleting does not report the correct value. + begin + Get_Name_String (Data.Original); + Write_Str (Name_Buffer (1 .. Name_Len)); - New_State : constant Pp_State := - (If_Ptr => If_Ptr, - Else_Ptr => 0, - Deleting => Deleting or (not Cond), - Match_Seen => Deleting or Cond); + for K in Name_Len .. Max_L loop + Write_Char (' '); + end loop; - begin - Pp_States.Increment_Last; - Pp_States.Table (Pp_States.Last) := New_State; - end; - end; + String_To_Name_Buffer (Data.Value); - -- #elsif + if Data.Is_A_String then + Write_Char ('"'); - when Tok_Elsif => - Cond := False; + for J in 1 .. Name_Len loop + Write_Char (Name_Buffer (J)); - if Pp_States.Last = 0 - or else Pp_States.Table (Pp_States.Last).Else_Ptr - /= 0 - then - Error_Msg ("no IF for this ELSIF", Token_Ptr); + if Name_Buffer (J) = '"' then + Write_Char ('"'); + end if; + end loop; - else - Cond := - not Pp_States.Table (Pp_States.Last).Match_Seen; - end if; + Write_Char ('"'); - Scan.all; - Cond := Expression (Cond); + else + Write_Str (Name_Buffer (1 .. Name_Len)); + end if; + end; - -- Check for an eventual "then" + Write_Eol; + end loop; - if Token = Tok_Then then - Scan.all; - end if; + Write_Eol; + end List_Symbols; - -- It is an error to have trailing characters after - -- the condition or "then". + ---------------------- + -- Matching_Strings -- + ---------------------- - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); + function Matching_Strings (S1, S2 : String_Id) return Boolean is + begin + String_To_Name_Buffer (S1); - Go_To_End_Of_Line; - end if; + for Index in 1 .. Name_Len loop + Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); + end loop; - -- Depending on the value of the condition, set the - -- new values of Deleting and Match_Seen. - if Pp_States.Last > 0 then - if Pp_States.Table (Pp_States.Last).Match_Seen then - Pp_States.Table (Pp_States.Last).Deleting := - True; - else - if Cond then - Pp_States.Table (Pp_States.Last).Match_Seen := - True; - Pp_States.Table (Pp_States.Last).Deleting := - False; - end if; - end if; - end if; + declare + String1 : constant String := Name_Buffer (1 .. Name_Len); - -- #else + begin + String_To_Name_Buffer (S2); - when Tok_Else => - if Pp_States.Last = 0 then - Error_Msg ("no IF for this ELSE", Token_Ptr); + for Index in 1 .. Name_Len loop + Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); + end loop; - elsif - Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 - then - Error_Msg ("duplicate ELSE line", Token_Ptr); - end if; + return String1 = Name_Buffer (1 .. Name_Len); + end; + end Matching_Strings; - -- Set the possibly new values of Deleting and - -- Match_Seen. + -------------------- + -- Parse_Def_File -- + -------------------- - if Pp_States.Last > 0 then - if Pp_States.Table (Pp_States.Last).Match_Seen then - Pp_States.Table (Pp_States.Last).Deleting := - True; + procedure Parse_Def_File is + Symbol : Symbol_Id; + Symbol_Name : Name_Id; + Original_Name : Name_Id; + Data : Symbol_Data; + Value_Start : Source_Ptr; + Value_End : Source_Ptr; + Ch : Character; - else - Pp_States.Table (Pp_States.Last).Match_Seen := - True; - Pp_States.Table (Pp_States.Last).Deleting := - False; - end if; + use ASCII; - -- Set the Else_Ptr to check for illegal #elsif - -- later. + begin + Def_Line_Loop : + loop + Scan.all; - Pp_States.Table (Pp_States.Last).Else_Ptr := - Token_Ptr; - end if; + exit Def_Line_Loop when Token = Tok_EOF; - Scan.all; + if Token /= Tok_End_Of_Line then + Change_Reserved_Keyword_To_Symbol; - -- It is an error to have characters after "#else" - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); - Go_To_End_Of_Line; - end if; + if Token /= Tok_Identifier then + Error_Msg ("identifier expected", Token_Ptr); + goto Cleanup; + end if; - -- #end if; + Symbol_Name := Token_Name; + Name_Len := 0; - when Tok_End => - if Pp_States.Last = 0 then - Error_Msg ("no IF for this END", Token_Ptr); - end if; + for Ptr in Token_Ptr .. Scan_Ptr - 1 loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Sinput.Source (Ptr); + end loop; - Scan.all; + Original_Name := Name_Find; + Scan.all; - if Token /= Tok_If then - Error_Msg ("IF expected", Token_Ptr); + if Token /= Tok_Colon_Equal then + Error_Msg ("`:=` expected", Token_Ptr); + goto Cleanup; + end if; - else - Scan.all; + Scan.all; - if Token /= Tok_Semicolon then - Error_Msg ("`;` Expected", Token_Ptr); + if Token = Tok_String_Literal then + Data := (Symbol => Symbol_Name, + Original => Original_Name, + On_The_Command_Line => False, + Is_A_String => True, + Value => String_Literal_Id); - else - Scan.all; + Scan.all; - -- It is an error to have character after - -- "#end if;". - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); - end if; - end if; - end if; + if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then + Error_Msg ("extraneous text in definition", Token_Ptr); + goto Cleanup; + end if; - -- In case of one of the errors above, skip the tokens - -- until the end of line is reached. + elsif Token = Tok_End_Of_Line or Token = Tok_EOF then + Data := (Symbol => Symbol_Name, + Original => Original_Name, + On_The_Command_Line => False, + Is_A_String => False, + Value => Empty_String); - Go_To_End_Of_Line; + else + Value_Start := Token_Ptr; + Value_End := Token_Ptr - 1; + Scan_Ptr := Token_Ptr; - -- Decrement the depth of the #if stack + Value_Chars_Loop : + loop + Ch := Sinput.Source (Scan_Ptr); - if Pp_States.Last > 0 then - Pp_States.Decrement_Last; - end if; + case Ch is + when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' => + Value_End := Scan_Ptr; + Scan_Ptr := Scan_Ptr + 1; - -- Illegal preprocessor line + when ' ' | HT | VT | CR | LF | FF => + exit Value_Chars_Loop; when others => - if Pp_States.Last = 0 then - Error_Msg ("IF expected", Token_Ptr); - - elsif - Pp_States.Table (Pp_States.Last).Else_Ptr = 0 - then - Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected", - Token_Ptr); - - else - Error_Msg ("IF or `END IF` expected", Token_Ptr); - end if; - - -- Skip to the end of this illegal line - - Go_To_End_Of_Line; + Error_Msg ("illegal character", Scan_Ptr); + goto Cleanup; end case; + end loop Value_Chars_Loop; - -- Not a preprocessor line - - else - -- Do not report errors for those lines, even if there are - -- Ada parsing errors. - - Set_Ignore_Errors (To => True); - - if Deleting then - Go_To_End_Of_Line; - - else - while Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - loop - if Token = Tok_Special - and then Special_Character = '$' - then - declare - Dollar_Ptr : constant Source_Ptr := Token_Ptr; - Symbol : Symbol_Id; - - begin - Scan.all; - Change_Reserved_Keyword_To_Symbol; - - if Token = Tok_Identifier - and then Token_Ptr = Dollar_Ptr + 1 - then - -- $symbol - - Symbol := Index_Of (Token_Name); - - -- If symbol exists, replace by its value + Scan.all; - if Symbol /= No_Symbol then - Output (Start_Of_Processing, Dollar_Ptr - 1); - Start_Of_Processing := Scan_Ptr; - String_To_Name_Buffer - (Mapping.Table (Symbol).Value); + if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then + Error_Msg ("extraneous text in definition", Token_Ptr); + goto Cleanup; + end if; - if Mapping.Table (Symbol).Is_A_String then + Start_String; - -- Value is an Ada string + while Value_Start <= Value_End loop + Store_String_Char (Sinput.Source (Value_Start)); + Value_Start := Value_Start + 1; + end loop; - Put_Char ('"'); + Data := (Symbol => Symbol_Name, + Original => Original_Name, + On_The_Command_Line => False, + Is_A_String => False, + Value => End_String); + end if; - for J in 1 .. Name_Len loop - Put_Char (Name_Buffer (J)); + -- Now that we have the value, get the symbol index - if Name_Buffer (J) = '"' then - Put_Char ('"'); - end if; - end loop; + Symbol := Index_Of (Symbol_Name); - Put_Char ('"'); + if Symbol /= No_Symbol then + -- If we already have an entry for this symbol, replace it + -- with the new value, except if the symbol was declared + -- on the command line. - else - -- Value is a sequence of characters, not - -- an Ada string. + if Mapping.Table (Symbol).On_The_Command_Line then + goto Continue; + end if; - for J in 1 .. Name_Len loop - Put_Char (Name_Buffer (J)); - end loop; - end if; - end if; - end if; - end; - end if; + else + -- As it is the first time we see this symbol, create a new + -- entry in the table. - Scan.all; - end loop; + if Mapping.Table = null then + Symbol_Table.Init (Mapping); end if; - Set_Ignore_Errors (To => False); + Symbol_Table.Increment_Last (Mapping); + Symbol := Symbol_Table.Last (Mapping); end if; - end if; - pragma Assert (Token = Tok_End_Of_Line or Token = Tok_EOF); + Mapping.Table (Symbol) := Data; + goto Continue; - -- At this point, the token is either end of line or EOF. - -- The line to possibly output stops just before the token. + <> + Set_Ignore_Errors (To => True); - Output_Line (Start_Of_Processing, Token_Ptr - 1); + while Token /= Tok_End_Of_Line and Token /= Tok_EOF loop + Scan.all; + end loop; - -- If we are at the end of a line, the scan pointer is at the first - -- non blank character, not necessarily the first character of the - -- line; so, we have to deduct Start_Of_Processing from the token - -- pointer. + Set_Ignore_Errors (To => False); - if Token = Tok_End_Of_Line then - if (Sinput.Source (Token_Ptr) = ASCII.CR - and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) - or else - (Sinput.Source (Token_Ptr) = ASCII.CR - and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) - then - Start_Of_Processing := Token_Ptr + 2; - else - Start_Of_Processing := Token_Ptr + 1; - end if; + <> + null; end if; + end loop Def_Line_Loop; + end Parse_Def_File; - -- Now, scan the first token of the next line. If the token is EOF, - -- the scan ponter will not move, and the token will still be EOF. + ---------------- + -- Preprocess -- + ---------------- - Set_Ignore_Errors (To => True); - Scan.all; - Set_Ignore_Errors (To => False); - end loop Input_Line_Loop; + procedure Preprocess is + Start_Of_Processing : Source_Ptr; + Cond : Boolean; + Preprocessor_Line : Boolean := False; - -- Report an error for any missing some "#end if;" + procedure Output (From, To : Source_Ptr); + -- Output the characters with indices From .. To in the buffer + -- to the output file. - for Level in reverse 1 .. Pp_States.Last loop - Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr); - end loop; - end Preprocess; + procedure Output_Line (From, To : Source_Ptr); + -- Output a line or the end of a line from the buffer to the output + -- file, followed by an end of line terminator. Depending on the value + -- of Deleting and the switches, the line may be commented out, blank or + -- not output at all. - ---------------- - -- Initialize -- - ---------------- + ------------ + -- Output -- + ------------ - procedure Initialize - (Error_Msg : Error_Msg_Proc; - Scan : Scan_Proc; - Set_Ignore_Errors : Set_Ignore_Errors_Proc; - Put_Char : Put_Char_Proc; - New_EOL : New_EOL_Proc) - is - begin - if not Already_Initialized then - Start_String; - Store_String_Chars ("True"); - True_Value.Value := End_String; + procedure Output (From, To : Source_Ptr) is + begin + for J in From .. To loop + Put_Char (Sinput.Source (J)); + end loop; + end Output; - Start_String; - Empty_String := End_String; + ----------------- + -- Output_Line -- + ----------------- - Name_Len := 7; - Name_Buffer (1 .. Name_Len) := "defined"; - Name_Defined := Name_Find; + procedure Output_Line (From, To : Source_Ptr) is + begin + if Deleting or Preprocessor_Line then + if Blank_Deleted_Lines then + New_EOL.all; - Start_String; - Store_String_Chars ("False"); - String_False := End_String; + elsif Comment_Deleted_Lines then + Put_Char ('-'); + Put_Char ('-'); + Put_Char ('!'); + + if From < To then + Put_Char (' '); + Output (From, To); + end if; - Already_Initialized := True; - end if; + New_EOL.all; + end if; - Prep.Error_Msg := Error_Msg; - Prep.Scan := Scan; - Prep.Set_Ignore_Errors := Set_Ignore_Errors; - Prep.Put_Char := Put_Char; - Prep.New_EOL := New_EOL; - end Initialize; + else + Output (From, To); + New_EOL.all; + end if; + end Output_Line; - ------------------ - -- List_Symbols -- - ------------------ + -- Start of processing for Preprocess - procedure List_Symbols (Foreword : String) is - Order : array (0 .. Integer (Symbol_Table.Last (Mapping))) - of Symbol_Id; - -- After alphabetical sorting, this array stores thehe indices of - -- the symbols in the order they are displayed. + begin + Start_Of_Processing := Scan_Ptr; - function Lt (Op1, Op2 : Natural) return Boolean; - -- Comparison routine for sort call + -- We need to call Scan for the first time, because Initialize_Scanner + -- is no longer doing it. - procedure Move (From : Natural; To : Natural); - -- Move routine for sort call + Scan.all; - -------- - -- Lt -- - -------- + Input_Line_Loop : loop + exit Input_Line_Loop when Token = Tok_EOF; - function Lt (Op1, Op2 : Natural) return Boolean is - S1 : constant String := - Get_Name_String (Mapping.Table (Order (Op1)).Symbol); - S2 : constant String := - Get_Name_String (Mapping.Table (Order (Op2)).Symbol); + Preprocessor_Line := False; - begin - return S1 < S2; - end Lt; + if Token /= Tok_End_Of_Line then - ---------- - -- Move -- - ---------- + -- Preprocessor line - procedure Move (From : Natural; To : Natural) is - begin - Order (To) := Order (From); - end Move; + if Token = Tok_Special and then Special_Character = '#' then + Preprocessor_Line := True; + Scan.all; - package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt); + case Token is - Max_L : Natural; - -- Maximum length of any symbol + -- #if - -- Start of processing for List_Symbols_Case + when Tok_If => + declare + If_Ptr : constant Source_Ptr := Token_Ptr; - begin - if Symbol_Table.Last (Mapping) = 0 then - return; - end if; + begin + Scan.all; + Cond := Expression (not Deleting); - if Foreword'Length > 0 then - Write_Eol; - Write_Line (Foreword); + -- Check for an eventual "then" - for J in Foreword'Range loop - Write_Char ('='); - end loop; - end if; + if Token = Tok_Then then + Scan.all; + end if; - -- Initialize the order + -- It is an error to have trailing characters after + -- the condition or "then". - for J in Order'Range loop - Order (J) := Symbol_Id (J); - end loop; + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + Go_To_End_Of_Line; + end if; - -- Sort alphabetically + declare + -- Set the initial state of this new "#if". + -- This must be done before incrementing the + -- Last of the table, otherwise function + -- Deleting does not report the correct value. - Sort_Syms.Sort (Order'Last); + New_State : constant Pp_State := + (If_Ptr => If_Ptr, + Else_Ptr => 0, + Deleting => Deleting or (not Cond), + Match_Seen => Deleting or Cond); - Max_L := 7; + begin + Pp_States.Increment_Last; + Pp_States.Table (Pp_States.Last) := New_State; + end; + end; - for J in 1 .. Symbol_Table.Last (Mapping) loop - Get_Name_String (Mapping.Table (J).Original); - Max_L := Integer'Max (Max_L, Name_Len); - end loop; + -- #elsif - Write_Eol; - Write_Str ("Symbol"); + when Tok_Elsif => + Cond := False; - for J in 1 .. Max_L - 5 loop - Write_Char (' '); - end loop; + if Pp_States.Last = 0 + or else Pp_States.Table (Pp_States.Last).Else_Ptr + /= 0 + then + Error_Msg ("no IF for this ELSIF", Token_Ptr); - Write_Line ("Value"); + else + Cond := + not Pp_States.Table (Pp_States.Last).Match_Seen; + end if; - Write_Str ("------"); + Scan.all; + Cond := Expression (Cond); - for J in 1 .. Max_L - 5 loop - Write_Char (' '); - end loop; + -- Check for an eventual "then" - Write_Line ("------"); + if Token = Tok_Then then + Scan.all; + end if; - for J in 1 .. Order'Last loop - declare - Data : constant Symbol_Data := Mapping.Table (Order (J)); + -- It is an error to have trailing characters after + -- the condition or "then". - begin - Get_Name_String (Data.Original); - Write_Str (Name_Buffer (1 .. Name_Len)); + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); - for K in Name_Len .. Max_L loop - Write_Char (' '); - end loop; + Go_To_End_Of_Line; + end if; - String_To_Name_Buffer (Data.Value); + -- Depending on the value of the condition, set the + -- new values of Deleting and Match_Seen. + if Pp_States.Last > 0 then + if Pp_States.Table (Pp_States.Last).Match_Seen then + Pp_States.Table (Pp_States.Last).Deleting := + True; + else + if Cond then + Pp_States.Table (Pp_States.Last).Match_Seen := + True; + Pp_States.Table (Pp_States.Last).Deleting := + False; + end if; + end if; + end if; - if Data.Is_A_String then - Write_Char ('"'); + -- #else - for J in 1 .. Name_Len loop - Write_Char (Name_Buffer (J)); + when Tok_Else => + if Pp_States.Last = 0 then + Error_Msg ("no IF for this ELSE", Token_Ptr); - if Name_Buffer (J) = '"' then - Write_Char ('"'); - end if; - end loop; + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 + then + Error_Msg ("duplicate ELSE line", Token_Ptr); + end if; - Write_Char ('"'); + -- Set the possibly new values of Deleting and + -- Match_Seen. - else - Write_Str (Name_Buffer (1 .. Name_Len)); - end if; - end; + if Pp_States.Last > 0 then + if Pp_States.Table (Pp_States.Last).Match_Seen then + Pp_States.Table (Pp_States.Last).Deleting := + True; - Write_Eol; - end loop; + else + Pp_States.Table (Pp_States.Last).Match_Seen := + True; + Pp_States.Table (Pp_States.Last).Deleting := + False; + end if; - Write_Eol; - end List_Symbols; + -- Set the Else_Ptr to check for illegal #elsif + -- later. - ---------------------- - -- Matching_Strings -- - ---------------------- + Pp_States.Table (Pp_States.Last).Else_Ptr := + Token_Ptr; + end if; - function Matching_Strings (S1, S2 : String_Id) return Boolean is - begin - String_To_Name_Buffer (S1); + Scan.all; - for Index in 1 .. Name_Len loop - Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); - end loop; + -- It is an error to have characters after "#else" + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + Go_To_End_Of_Line; + end if; - declare - String1 : constant String := Name_Buffer (1 .. Name_Len); + -- #end if; + + when Tok_End => + if Pp_States.Last = 0 then + Error_Msg ("no IF for this END", Token_Ptr); + end if; - begin - String_To_Name_Buffer (S2); + Scan.all; - for Index in 1 .. Name_Len loop - Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); - end loop; + if Token /= Tok_If then + Error_Msg ("IF expected", Token_Ptr); - return String1 = Name_Buffer (1 .. Name_Len); - end; - end Matching_Strings; + else + Scan.all; - -------------------- - -- Parse_Def_File -- - -------------------- + if Token /= Tok_Semicolon then + Error_Msg ("`;` Expected", Token_Ptr); - procedure Parse_Def_File is - Symbol : Symbol_Id; - Symbol_Name : Name_Id; - Original_Name : Name_Id; - Data : Symbol_Data; - Value_Start : Source_Ptr; - Value_End : Source_Ptr; - Ch : Character; + else + Scan.all; - use ASCII; + -- It is an error to have character after + -- "#end if;". + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + end if; + end if; + end if; - begin - Def_Line_Loop : - loop - Scan.all; + -- In case of one of the errors above, skip the tokens + -- until the end of line is reached. - exit Def_Line_Loop when Token = Tok_EOF; + Go_To_End_Of_Line; - if Token /= Tok_End_Of_Line then - Change_Reserved_Keyword_To_Symbol; + -- Decrement the depth of the #if stack - if Token /= Tok_Identifier then - Error_Msg ("identifier expected", Token_Ptr); - goto Cleanup; - end if; + if Pp_States.Last > 0 then + Pp_States.Decrement_Last; + end if; - Symbol_Name := Token_Name; - Name_Len := 0; + -- Illegal preprocessor line - for Ptr in Token_Ptr .. Scan_Ptr - 1 loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Sinput.Source (Ptr); - end loop; + when others => + if Pp_States.Last = 0 then + Error_Msg ("IF expected", Token_Ptr); - Original_Name := Name_Find; - Scan.all; + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr = 0 + then + Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected", + Token_Ptr); - if Token /= Tok_Colon_Equal then - Error_Msg ("`:=` expected", Token_Ptr); - goto Cleanup; - end if; + else + Error_Msg ("IF or `END IF` expected", Token_Ptr); + end if; - Scan.all; + -- Skip to the end of this illegal line - if Token = Tok_String_Literal then - Data := (Symbol => Symbol_Name, - Original => Original_Name, - On_The_Command_Line => False, - Is_A_String => True, - Value => String_Literal_Id); + Go_To_End_Of_Line; + end case; - Scan.all; + -- Not a preprocessor line - if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then - Error_Msg ("extraneous text in definition", Token_Ptr); - goto Cleanup; - end if; + else + -- Do not report errors for those lines, even if there are + -- Ada parsing errors. - elsif Token = Tok_End_Of_Line or Token = Tok_EOF then - Data := (Symbol => Symbol_Name, - Original => Original_Name, - On_The_Command_Line => False, - Is_A_String => False, - Value => Empty_String); + Set_Ignore_Errors (To => True); - else - Value_Start := Token_Ptr; - Value_End := Token_Ptr - 1; - Scan_Ptr := Token_Ptr; + if Deleting then + Go_To_End_Of_Line; - Value_Chars_Loop : - loop - Ch := Sinput.Source (Scan_Ptr); + else + while Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + loop + if Token = Tok_Special + and then Special_Character = '$' + then + declare + Dollar_Ptr : constant Source_Ptr := Token_Ptr; + Symbol : Symbol_Id; - case Ch is - when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' => - Value_End := Scan_Ptr; - Scan_Ptr := Scan_Ptr + 1; + begin + Scan.all; + Change_Reserved_Keyword_To_Symbol; - when ' ' | HT | VT | CR | LF | FF => - exit Value_Chars_Loop; + if Token = Tok_Identifier + and then Token_Ptr = Dollar_Ptr + 1 + then + -- $symbol - when others => - Error_Msg ("illegal character", Scan_Ptr); - goto Cleanup; - end case; - end loop Value_Chars_Loop; + Symbol := Index_Of (Token_Name); - Scan.all; + -- If symbol exists, replace by its value - if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then - Error_Msg ("extraneous text in definition", Token_Ptr); - goto Cleanup; - end if; + if Symbol /= No_Symbol then + Output (Start_Of_Processing, Dollar_Ptr - 1); + Start_Of_Processing := Scan_Ptr; + String_To_Name_Buffer + (Mapping.Table (Symbol).Value); - Start_String; + if Mapping.Table (Symbol).Is_A_String then - while Value_Start <= Value_End loop - Store_String_Char (Sinput.Source (Value_Start)); - Value_Start := Value_Start + 1; - end loop; + -- Value is an Ada string - Data := (Symbol => Symbol_Name, - Original => Original_Name, - On_The_Command_Line => False, - Is_A_String => False, - Value => End_String); - end if; + Put_Char ('"'); - -- Now that we have the value, get the symbol index + for J in 1 .. Name_Len loop + Put_Char (Name_Buffer (J)); - Symbol := Index_Of (Symbol_Name); + if Name_Buffer (J) = '"' then + Put_Char ('"'); + end if; + end loop; - if Symbol /= No_Symbol then - -- If we already have an entry for this symbol, replace it - -- with the new value, except if the symbol was declared - -- on the command line. + Put_Char ('"'); - if Mapping.Table (Symbol).On_The_Command_Line then - goto Continue; - end if; + else + -- Value is a sequence of characters, not + -- an Ada string. - else - -- As it is the first time we see this symbol, create a new - -- entry in the table. + for J in 1 .. Name_Len loop + Put_Char (Name_Buffer (J)); + end loop; + end if; + end if; + end if; + end; + end if; - if Mapping.Table = null then - Symbol_Table.Init (Mapping); + Scan.all; + end loop; end if; - Symbol_Table.Increment_Last (Mapping); - Symbol := Symbol_Table.Last (Mapping); + Set_Ignore_Errors (To => False); end if; + end if; - Mapping.Table (Symbol) := Data; - goto Continue; + pragma Assert (Token = Tok_End_Of_Line or Token = Tok_EOF); - <> - Set_Ignore_Errors (To => True); + -- At this point, the token is either end of line or EOF. + -- The line to possibly output stops just before the token. - while Token /= Tok_End_Of_Line and Token /= Tok_EOF loop - Scan.all; - end loop; + Output_Line (Start_Of_Processing, Token_Ptr - 1); - Set_Ignore_Errors (To => False); + -- If we are at the end of a line, the scan pointer is at the first + -- non blank character, not necessarily the first character of the + -- line; so, we have to deduct Start_Of_Processing from the token + -- pointer. - <> - null; + if Token = Tok_End_Of_Line then + if (Sinput.Source (Token_Ptr) = ASCII.CR + and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) + or else + (Sinput.Source (Token_Ptr) = ASCII.CR + and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) + then + Start_Of_Processing := Token_Ptr + 2; + else + Start_Of_Processing := Token_Ptr + 1; + end if; end if; - end loop Def_Line_Loop; - end Parse_Def_File; + + -- Now, scan the first token of the next line. If the token is EOF, + -- the scan ponter will not move, and the token will still be EOF. + + Set_Ignore_Errors (To => True); + Scan.all; + Set_Ignore_Errors (To => False); + end loop Input_Line_Loop; + + -- Report an error for any missing some "#end if;" + + for Level in reverse 1 .. Pp_States.Last loop + Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr); + end loop; + end Preprocess; end Prep; diff --git a/gcc/ada/prep.ads b/gcc/ada/prep.ads index a9f92f77510..ab45ef2804b 100644 --- a/gcc/ada/prep.ads +++ b/gcc/ada/prep.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -71,7 +71,7 @@ package Prep is Table_Index_Type => Symbol_Id, Table_Low_Bound => 1, Table_Initial => 10, - Table_Increment => 10); + Table_Increment => 100); -- The table of all symbols Mapping : Symbol_Table.Instance; diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index 7fd1984cc55..763654ca3eb 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -105,7 +105,7 @@ package body Prepcomp is Table_Index_Type => Int, Table_Low_Bound => 1, Table_Initial => 5, - Table_Increment => 5, + Table_Increment => 100, Table_Name => "Prepcomp.Preproc_Data_Table"); -- Table to store the specific preprocessing data @@ -117,8 +117,8 @@ package body Prepcomp is (Table_Component_Type => Source_File_Index, Table_Index_Type => Int, Table_Low_Bound => 1, - Table_Initial => 5, - Table_Increment => 5, + Table_Initial => 10, + Table_Increment => 100, Table_Name => "Prepcomp.Dependencies"); -- Table to store the dependencies on preprocessing files diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index b1388079719..0fdc21cc1d5 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -45,7 +45,7 @@ package body Prj.Strt is -- been used (to avoid duplicate case labels). Choices_Initial : constant := 10; - Choices_Increment : constant := 50; + Choices_Increment : constant := 100; Choice_Node_Low_Bound : constant := 0; Choice_Node_High_Bound : constant := 099_999_999; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 474920460e1..416635f537a 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -316,7 +316,7 @@ package Prj is type String_Element is record Value : Name_Id := No_Name; Index : Int := 0; - Display_Value : Name_Id := No_Name; + Display_Value : Name_Id := No_Name; Location : Source_Ptr := No_Location; Flag : Boolean := False; Next : String_List_Id := Nil_String; @@ -840,13 +840,13 @@ package Prj is (Specification, Body_Part); type File_Name_Data is record - Name : Name_Id := No_Name; - Index : Int := 0; - Display_Name : Name_Id := No_Name; - Path : Name_Id := No_Name; - Display_Path : Name_Id := No_Name; + Name : Name_Id := No_Name; + Index : Int := 0; + Display_Name : Name_Id := No_Name; + Path : Name_Id := No_Name; + Display_Path : Name_Id := No_Name; Project : Project_Id := No_Project; - Needs_Pragma : Boolean := False; + Needs_Pragma : Boolean := False; end record; -- File and Path name of a spec or body @@ -1057,7 +1057,7 @@ private Table_Index_Type => Natural, Table_Low_Bound => 1, Table_Initial => 50, - Table_Increment => 50); + Table_Increment => 100); -- Table storing all the temp path file names. -- Used by Delete_All_Path_Files. @@ -1066,7 +1066,7 @@ private Table_Index_Type => Natural, Table_Low_Bound => 1, Table_Initial => 50, - Table_Increment => 50); + Table_Increment => 100); -- A table to store the source dirs before creating the source path file package Object_Path_Table is new GNAT.Dynamic_Tables @@ -1074,7 +1074,7 @@ private Table_Index_Type => Natural, Table_Low_Bound => 1, Table_Initial => 50, - Table_Increment => 50); + Table_Increment => 100); -- A table to store the object dirs, before creating the object path file type Private_Project_Tree_Data is record diff --git a/gcc/ada/sem_maps.ads b/gcc/ada/sem_maps.ads index eb126790665..d6f51859651 100644 --- a/gcc/ada/sem_maps.ads +++ b/gcc/ada/sem_maps.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -140,7 +140,7 @@ private Table_Index_Type => Map, Table_Low_Bound => 0, Table_Initial => 100, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Maps_Table"); -- All headers for hash tables are allocated in one global table. Each @@ -151,7 +151,7 @@ private Table_Index_Type => Header_Index, Table_Low_Bound => 0, Table_Initial => 1000, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Headers_Table"); -- All associations are allocated in one global table. Each map stores @@ -162,7 +162,7 @@ private Table_Index_Type => Assoc_Index, Table_Low_Bound => 1, Table_Initial => 1000, - Table_Increment => 10, + Table_Increment => 100, Table_Name => "Associations_Table"); end Sem_Maps; diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index b99e6254e9d..7897378a1d0 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -163,7 +163,7 @@ package body Table is ---------------- procedure Reallocate is - New_Size : Memory.size_t; + New_Size : Memory.size_t; begin if Max < Last_Val then @@ -174,10 +174,15 @@ package body Table is Length := Int'Max (Length, Table_Initial); - -- Now increment table length until it is sufficiently large + -- Now increment table length until it is sufficiently large. Use + -- the increment value or 10, which ever is larger (the reason + -- for the use of 10 here is to ensure that the table does really + -- increase in size (which would not be the case for a table of + -- length 10 increased by 3% for instance). while Max < Last_Val loop - Length := Length * (100 + Table_Increment) / 100; + Length := Int'Max (Length * (100 + Table_Increment) / 100, + Length + 10); Max := Min + Length - 1; end loop; diff --git a/gcc/ada/vms_conv.adb b/gcc/ada/vms_conv.adb index e626ca9ea6d..c5e53d7e113 100644 --- a/gcc/ada/vms_conv.adb +++ b/gcc/ada/vms_conv.adb @@ -78,7 +78,7 @@ package body VMS_Conv is Table_Index_Type => Integer, Table_Low_Bound => 1, Table_Initial => 4096, - Table_Increment => 2, + Table_Increment => 100, Table_Name => "Buffer"); function Init_Object_Dirs return Argument_List; -- 2.30.2