Skip to content

R
riscv-gcc-1
Commit cce68562 by Robert Dewar Committed by Arnaud Charlet
Options

clean.adb, [...]: Fix bad table increment values (much too small) 

2006-10-31  Robert Dewar  <dewar@adacore.com>

	* 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
parent c064e066
Showing with 619 additions and 614 deletions
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.
......
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.
......
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
......
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.
<<Cleanup>>
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;
<<Continue>>
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);
<<Cleanup>>
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.
<<Continue>>
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;
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;
......
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
......
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;
......
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
......
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;
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;
......
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment