-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2003, 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- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Sinput;
with Stringt; use Stringt;
with Table;
-with Types; use Types;
with GNAT.Heap_Sort_G;
-- Behaviour --
---------------
- -- Accesses to procedure specified by procedure Initialize.
+ -- Accesses to procedure specified by procedure Initialize
Error_Msg : Error_Msg_Proc;
-- Report an error
-- Used to detect multiple #else.
Deleting : Boolean;
- -- Set to True when the code should be deleted or commented out.
+ -- Set to True when the code should be deleted or commented out
Match_Seen : Boolean;
-- Set to True when a condition in an #if or an #elsif is True.
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
then
for J in Index + 1 .. Definition'Last loop
case Definition (J) is
- when '_' | '.' | '0' .. '9' |
- 'a' .. 'z' | 'A' .. 'Z' =>
+ when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
null;
when others =>
-- Put the symbol name in the result
declare
- Sym : constant String :=
- Name_Buffer (1 .. Name_Len);
+ Sym : constant String := Name_Buffer (1 .. Name_Len);
begin
for Index in 1 .. Name_Len loop
----------------
function Expression (Evaluate_It : Boolean) return Boolean is
- Evaluation : Boolean := Evaluate_It;
+ Evaluation : Boolean := Evaluate_It;
-- Is set to False after an "or else" when left term is True and
-- after an "and then" when left term is False.
- Final_Result : Boolean := False;
+ Final_Result : Boolean := False;
- Current_Result : Boolean := False;
+ Current_Result : Boolean := False;
-- Value of a term
Current_Operator : Operator := None;
Scan.all;
if Token = Tok_Apostrophe then
+
-- symbol'Defined
Scan.all;
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;
- procedure Output_Line (From, To : Source_Ptr) is
- begin
- if Deleting or Preprocessor_Line then
- if Blank_Deleted_Lines then
- New_EOL.all;
+ ------------------
+ -- List_Symbols --
+ ------------------
- elsif Comment_Deleted_Lines then
- Put_Char ('-');
- Put_Char ('-');
- Put_Char ('!');
+ 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.
- if From < To then
- Put_Char (' ');
- Output (From, To);
- end if;
+ function Lt (Op1, Op2 : Natural) return Boolean;
+ -- Comparison routine for sort call
- New_EOL.all;
- end if;
+ procedure Move (From : Natural; To : Natural);
+ -- Move routine for sort call
- else
- Output (From, To);
- New_EOL.all;
- end if;
- end Output_Line;
+ --------
+ -- Lt --
+ --------
- -- Start of processing for Preprocess
+ 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);
- begin
- Start_Of_Processing := Scan_Ptr;
+ begin
+ return S1 < S2;
+ end Lt;
- -- We need to call Scan for the first time, because Initialyze_Scanner
- -- is no longer doing it.
+ ----------
+ -- Move --
+ ----------
- Scan.all;
+ procedure Move (From : Natural; To : Natural) is
+ begin
+ Order (To) := Order (From);
+ end Move;
- Input_Line_Loop :
- loop
- exit Input_Line_Loop when Token = Tok_EOF;
+ package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
- Preprocessor_Line := False;
+ Max_L : Natural;
+ -- Maximum length of any symbol
- if Token /= Tok_End_Of_Line then
+ -- Start of processing for List_Symbols_Case
- -- Preprocessor line
+ begin
+ if Symbol_Table.Last (Mapping) = 0 then
+ return;
+ end if;
- if Token = Tok_Special and then Special_Character = '#' then
- Preprocessor_Line := True;
- Scan.all;
+ if Foreword'Length > 0 then
+ Write_Eol;
+ Write_Line (Foreword);
- case Token is
+ for J in Foreword'Range loop
+ Write_Char ('=');
+ end loop;
+ end if;
- when Tok_If =>
- -- #if
+ -- Initialize the order
- declare
- If_Ptr : constant Source_Ptr := Token_Ptr;
+ for J in Order'Range loop
+ Order (J) := Symbol_Id (J);
+ end loop;
- begin
- Scan.all;
- Cond := Expression (not Deleting);
+ -- Sort alphabetically
- -- Check for an eventual "then"
+ Sort_Syms.Sort (Order'Last);
- if Token = Tok_Then then
- Scan.all;
- end if;
+ Max_L := 7;
- -- It is an error to have trailing characters after
- -- the condition or "then".
+ 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 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;
+ Write_Eol;
+ Write_Str ("Symbol");
- 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.
+ for J in 1 .. Max_L - 5 loop
+ Write_Char (' ');
+ end loop;
- New_State : constant Pp_State :=
- (If_Ptr => If_Ptr,
- Else_Ptr => 0,
- Deleting => Deleting or (not Cond),
- Match_Seen => Deleting or Cond);
+ Write_Line ("Value");
- begin
- Pp_States.Increment_Last;
- Pp_States.Table (Pp_States.Last) := New_State;
- end;
- end;
+ Write_Str ("------");
- when Tok_Elsif =>
- -- #elsif
+ for J in 1 .. Max_L - 5 loop
+ Write_Char (' ');
+ end loop;
- Cond := False;
+ Write_Line ("------");
- 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);
+ for J in 1 .. Order'Last loop
+ declare
+ Data : constant Symbol_Data := Mapping.Table (Order (J));
- else
- Cond :=
- not Pp_States.Table (Pp_States.Last).Match_Seen;
- end if;
+ begin
+ Get_Name_String (Data.Original);
+ Write_Str (Name_Buffer (1 .. Name_Len));
- Scan.all;
- Cond := Expression (Cond);
+ for K in Name_Len .. Max_L loop
+ Write_Char (' ');
+ end loop;
- -- Check for an eventual "then"
+ String_To_Name_Buffer (Data.Value);
- if Token = Tok_Then then
- Scan.all;
- end if;
+ if Data.Is_A_String then
+ Write_Char ('"');
- -- It is an error to have trailing characters after
- -- the condition or "then".
+ for J in 1 .. Name_Len loop
+ Write_Char (Name_Buffer (J));
- if Token /= Tok_End_Of_Line
- and then Token /= Tok_EOF
- then
- Error_Msg
- ("extraneous text on preprocessor line",
- Token_Ptr);
+ if Name_Buffer (J) = '"' then
+ Write_Char ('"');
+ end if;
+ end loop;
- Go_To_End_Of_Line;
- end if;
+ Write_Char ('"');
- -- 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;
+ else
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ end if;
+ end;
- when Tok_Else =>
- -- #else
+ Write_Eol;
+ end loop;
- if Pp_States.Last = 0 then
- Error_Msg ("no IF for this ELSE", Token_Ptr);
-
- elsif
- Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
- then
- Error_Msg ("duplicate ELSE line", Token_Ptr);
- end if;
-
- -- Set the possibly 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
- 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);
- when Tok_End =>
- -- #end if;
+ begin
+ String_To_Name_Buffer (S2);
- if Pp_States.Last = 0 then
- Error_Msg ("no IF for this END", Token_Ptr);
- end if;
+ for Index in 1 .. Name_Len loop
+ Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
+ end loop;
- Scan.all;
+ return String1 = Name_Buffer (1 .. Name_Len);
+ end;
+ end Matching_Strings;
- if Token /= Tok_If then
- Error_Msg ("IF expected", Token_Ptr);
+ --------------------
+ -- Parse_Def_File --
+ --------------------
- else
- Scan.all;
+ 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;
- if Token /= Tok_Semicolon then
- Error_Msg ("`;` Expected", Token_Ptr);
+ use ASCII;
- else
- Scan.all;
+ begin
+ Def_Line_Loop :
+ loop
+ 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;
+ exit Def_Line_Loop when Token = Tok_EOF;
- -- In case of one of the errors above, skip the tokens
- -- until the end of line is reached.
+ if Token /= Tok_End_Of_Line then
+ Change_Reserved_Keyword_To_Symbol;
- Go_To_End_Of_Line;
+ if Token /= Tok_Identifier then
+ Error_Msg ("identifier expected", Token_Ptr);
+ goto Cleanup;
+ end if;
- -- Decrement the depth of the #if stack.
+ Symbol_Name := Token_Name;
+ Name_Len := 0;
- if Pp_States.Last > 0 then
- Pp_States.Decrement_Last;
- 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;
- when others =>
- -- Illegal preprocessor line
+ Original_Name := Name_Find;
+ Scan.all;
- if Pp_States.Last = 0 then
- Error_Msg ("IF expected", Token_Ptr);
+ if Token /= Tok_Colon_Equal then
+ Error_Msg ("`:=` expected", Token_Ptr);
+ goto Cleanup;
+ end if;
- elsif
- Pp_States.Table (Pp_States.Last).Else_Ptr = 0
- then
- Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected",
- Token_Ptr);
+ Scan.all;
- else
- Error_Msg ("IF or `END IF` expected", Token_Ptr);
- end if;
+ 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);
- -- Skip to the end of this illegal line
+ Scan.all;
- Go_To_End_Of_Line;
- end case;
+ if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
+ Error_Msg ("extraneous text in definition", Token_Ptr);
+ goto Cleanup;
+ end if;
- -- Not a preprocessor line
+ 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);
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;
+ Value_Start := Token_Ptr;
+ Value_End := Token_Ptr - 1;
+ Scan_Ptr := Token_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;
+ Value_Chars_Loop :
+ loop
+ Ch := Sinput.Source (Scan_Ptr);
- begin
- Scan.all;
- Change_Reserved_Keyword_To_Symbol;
+ case Ch is
+ when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
+ Value_End := Scan_Ptr;
+ Scan_Ptr := Scan_Ptr + 1;
- if Token = Tok_Identifier
- and then Token_Ptr = Dollar_Ptr + 1
- then
- -- $symbol
+ when ' ' | HT | VT | CR | LF | FF =>
+ exit Value_Chars_Loop;
- Symbol := Index_Of (Token_Name);
+ when others =>
+ Error_Msg ("illegal character", Scan_Ptr);
+ goto Cleanup;
+ end case;
+ end loop Value_Chars_Loop;
- -- If there is such a symbol, replace it 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);
- -- At this point, the token is either end of line or EOF.
- -- The line to possibly output stops just before the token.
+ Mapping.Table (Symbol) := Data;
+ goto Continue;
- Output_Line (Start_Of_Processing, Token_Ptr - 1);
+ <<Cleanup>>
+ Set_Ignore_Errors (To => True);
- -- 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.
+ while Token /= Tok_End_Of_Line and Token /= Tok_EOF loop
+ Scan.all;
+ end loop;
- 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;
+ Set_Ignore_Errors (To => False);
- else
- Start_Of_Processing := Token_Ptr + 1;
- end if;
+ <<Continue>>
+ null;
end if;
+ end loop Def_Line_Loop;
+ end Parse_Def_File;
- -- Now, we 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 --
+ ----------------
- Scan.all;
- 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;
+
+ -----------------
+ -- Output_Line --
+ -----------------
+
+ 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;
- Empty_String := End_String;
+ elsif Comment_Deleted_Lines then
+ Put_Char ('-');
+ Put_Char ('-');
+ Put_Char ('!');
- Name_Len := 7;
- Name_Buffer (1 .. Name_Len) := "defined";
- Name_Defined := Name_Find;
+ if From < To then
+ Put_Char (' ');
+ Output (From, To);
+ end if;
- Start_String;
- Store_String_Chars ("False");
- String_False := End_String;
+ New_EOL.all;
+ end if;
- Already_Initialized := True;
- end if;
+ else
+ Output (From, To);
+ New_EOL.all;
+ end if;
+ end 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;
+ -- Start of processing for Preprocess
- ------------------
- -- List_Symbols --
- ------------------
+ begin
+ Start_Of_Processing := Scan_Ptr;
- 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.
+ -- We need to call Scan for the first time, because Initialize_Scanner
+ -- is no longer doing it.
- function Lt (Op1, Op2 : Natural) return Boolean;
- -- Comparison routine for sort call
+ Scan.all;
- procedure Move (From : Natural; To : Natural);
- -- Move routine for sort call
+ Input_Line_Loop : loop
+ exit Input_Line_Loop when Token = Tok_EOF;
- --------
- -- Lt --
- --------
+ Preprocessor_Line := False;
- 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);
+ if Token /= Tok_End_Of_Line then
- begin
- return S1 < S2;
- end Lt;
+ -- Preprocessor line
- ----------
- -- Move --
- ----------
+ if Token = Tok_Special and then Special_Character = '#' then
+ Preprocessor_Line := True;
+ Scan.all;
- procedure Move (From : Natural; To : Natural) is
- begin
- Order (To) := Order (From);
- end Move;
+ case Token is
- package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
+ -- #if
- Max_L : Natural;
- -- Maximum length of any symbol
+ when Tok_If =>
+ declare
+ If_Ptr : constant Source_Ptr := Token_Ptr;
- -- Start of processing for List_Symbols_Case
+ begin
+ Scan.all;
+ Cond := Expression (not Deleting);
- begin
- if Symbol_Table.Last (Mapping) = 0 then
- return;
- end if;
+ -- Check for an eventual "then"
- if Foreword'Length > 0 then
- Write_Eol;
- Write_Line (Foreword);
+ if Token = Tok_Then then
+ Scan.all;
+ end if;
- for J in Foreword'Range loop
- Write_Char ('=');
- end loop;
- end if;
+ -- It is an error to have trailing characters after
+ -- the condition or "then".
- -- Initialize the order
+ 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 Order'Range loop
- Order (J) := Symbol_Id (J);
- end loop;
+ 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 alphabetically
+ New_State : constant Pp_State :=
+ (If_Ptr => If_Ptr,
+ Else_Ptr => 0,
+ Deleting => Deleting or (not Cond),
+ Match_Seen => Deleting or Cond);
- Sort_Syms.Sort (Order'Last);
+ begin
+ Pp_States.Increment_Last;
+ Pp_States.Table (Pp_States.Last) := New_State;
+ end;
+ end;
- Max_L := 7;
+ -- #elsif
- 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;
+ when Tok_Elsif =>
+ Cond := False;
- Write_Eol;
- Write_Str ("Symbol");
+ 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);
- for J in 1 .. Max_L - 5 loop
- Write_Char (' ');
- end loop;
+ else
+ Cond :=
+ not Pp_States.Table (Pp_States.Last).Match_Seen;
+ end if;
- Write_Line ("Value");
+ Scan.all;
+ Cond := Expression (Cond);
- Write_Str ("------");
+ -- Check for an eventual "then"
- for J in 1 .. Max_L - 5 loop
- Write_Char (' ');
- end loop;
+ if Token = Tok_Then then
+ Scan.all;
+ end if;
- Write_Line ("------");
+ -- It is an error to have trailing characters after
+ -- the condition or "then".
- for J in 1 .. Order'Last loop
- declare
- Data : constant Symbol_Data := Mapping.Table (Order (J));
+ if Token /= Tok_End_Of_Line
+ and then Token /= Tok_EOF
+ then
+ Error_Msg
+ ("extraneous text on preprocessor line",
+ Token_Ptr);
- begin
- Get_Name_String (Data.Original);
- Write_Str (Name_Buffer (1 .. Name_Len));
+ Go_To_End_Of_Line;
+ end if;
- for K in Name_Len .. Max_L loop
- Write_Char (' ');
- 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;
- String_To_Name_Buffer (Data.Value);
+ -- #else
- if Data.Is_A_String then
- Write_Char ('"');
+ when Tok_Else =>
+ if Pp_States.Last = 0 then
+ Error_Msg ("no IF for this ELSE", Token_Ptr);
- for J in 1 .. Name_Len loop
- Write_Char (Name_Buffer (J));
+ elsif
+ Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
+ then
+ Error_Msg ("duplicate ELSE line", Token_Ptr);
+ end if;
- if Name_Buffer (J) = '"' then
- Write_Char ('"');
- end if;
- end loop;
+ -- Set the possibly new values of Deleting and
+ -- Match_Seen.
- Write_Char ('"');
+ 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
- Write_Str (Name_Buffer (1 .. Name_Len));
- end if;
- end;
+ else
+ Pp_States.Table (Pp_States.Last).Match_Seen :=
+ True;
+ Pp_States.Table (Pp_States.Last).Deleting :=
+ False;
+ end if;
- Write_Eol;
- end loop;
+ -- Set the Else_Ptr to check for illegal #elsif
+ -- later.
- Write_Eol;
- end List_Symbols;
+ Pp_States.Table (Pp_States.Last).Else_Ptr :=
+ Token_Ptr;
+ end if;
- ----------------------
- -- Matching_Strings --
- ----------------------
+ Scan.all;
- function Matching_Strings (S1, S2 : String_Id) return Boolean is
- begin
- String_To_Name_Buffer (S1);
+ -- 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;
- for Index in 1 .. Name_Len loop
- Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
- end loop;
+ -- #end if;
- declare
- String1 : constant String := Name_Buffer (1 .. Name_Len);
+ 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;
OSDN Git Service
