1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Csets; use Csets;
27 with Err_Vars; use Err_Vars;
29 with Osint; use Osint;
30 with Output; use Output;
31 with Scans; use Scans;
32 with Snames; use Snames;
34 with Stringt; use Stringt;
37 with GNAT.Heap_Sort_G;
43 type Token_Name_Array is array (Token_Type) of Name_Id;
44 Token_Names : constant Token_Name_Array :=
45 (Tok_Abort => Name_Abort,
47 Tok_Abstract => Name_Abstract,
48 Tok_Accept => Name_Accept,
49 Tok_Aliased => Name_Aliased,
51 Tok_Array => Name_Array,
54 Tok_Begin => Name_Begin,
55 Tok_Body => Name_Body,
56 Tok_Case => Name_Case,
57 Tok_Constant => Name_Constant,
58 Tok_Declare => Name_Declare,
59 Tok_Delay => Name_Delay,
60 Tok_Delta => Name_Delta,
61 Tok_Digits => Name_Digits,
62 Tok_Else => Name_Else,
63 Tok_Elsif => Name_Elsif,
65 Tok_Entry => Name_Entry,
66 Tok_Exception => Name_Exception,
67 Tok_Exit => Name_Exit,
69 Tok_Function => Name_Function,
70 Tok_Generic => Name_Generic,
71 Tok_Goto => Name_Goto,
74 Tok_Limited => Name_Limited,
75 Tok_Loop => Name_Loop,
78 Tok_Null => Name_Null,
81 Tok_Others => Name_Others,
83 Tok_Package => Name_Package,
84 Tok_Pragma => Name_Pragma,
85 Tok_Private => Name_Private,
86 Tok_Procedure => Name_Procedure,
87 Tok_Protected => Name_Protected,
88 Tok_Raise => Name_Raise,
89 Tok_Range => Name_Range,
90 Tok_Record => Name_Record,
92 Tok_Renames => Name_Renames,
93 Tok_Requeue => Name_Requeue,
94 Tok_Return => Name_Return,
95 Tok_Reverse => Name_Reverse,
96 Tok_Select => Name_Select,
97 Tok_Separate => Name_Separate,
98 Tok_Subtype => Name_Subtype,
99 Tok_Tagged => Name_Tagged,
100 Tok_Task => Name_Task,
101 Tok_Terminate => Name_Terminate,
102 Tok_Then => Name_Then,
103 Tok_Type => Name_Type,
104 Tok_Until => Name_Until,
106 Tok_When => Name_When,
107 Tok_While => Name_While,
108 Tok_With => Name_With,
112 Already_Initialized : Boolean := False;
113 -- Used to avoid repetition of the part of the initialisation that needs
114 -- to be done only once.
116 Empty_String : String_Id;
117 -- "", as a string_id
119 String_False : String_Id;
120 -- "false", as a string_id
126 -- Accesses to procedure specified by procedure Initialize
128 Error_Msg : Error_Msg_Proc;
134 Set_Ignore_Errors : Set_Ignore_Errors_Proc;
135 -- Indicate if error should be taken into account
137 Put_Char : Put_Char_Proc;
138 -- Output one character
140 New_EOL : New_EOL_Proc;
141 -- Output an end of line indication
143 -------------------------------
144 -- State of the Preprocessor --
145 -------------------------------
147 type Pp_State is record
149 -- The location of the #if statement.
150 -- Used to flag #if with no corresponding #end if, at the end.
152 Else_Ptr : Source_Ptr;
153 -- The location of the #else statement.
154 -- Used to detect multiple #else.
157 -- Set to True when the code should be deleted or commented out
159 Match_Seen : Boolean;
160 -- Set to True when a condition in an #if or an #elsif is True.
161 -- Also set to True if Deleting at the previous level is True.
162 -- Used to decide if Deleting should be set to True in a following
167 type Pp_Depth is new Nat;
169 Ground : constant Pp_Depth := 0;
171 package Pp_States is new Table.Table
172 (Table_Component_Type => Pp_State,
173 Table_Index_Type => Pp_Depth,
174 Table_Low_Bound => 1,
176 Table_Increment => 100,
177 Table_Name => "Prep.Pp_States");
178 -- A stack of the states of the preprocessor, for nested #if
180 type Operator is (None, Op_Or, Op_And);
186 function Deleting return Boolean;
187 -- Return True if code should be deleted or commented out
190 (Evaluate_It : Boolean;
191 Complemented : Boolean := False) return Boolean;
192 -- Evaluate a condition in an #if or an #elsif statement.
193 -- If Evaluate_It is False, the condition is effectively evaluated,
194 -- otherwise, only the syntax is checked.
196 procedure Go_To_End_Of_Line;
197 -- Advance the scan pointer until we reach an end of line or the end
200 function Matching_Strings (S1, S2 : String_Id) return Boolean;
201 -- Returns True if the two string parameters are equal (case insensitive)
203 ---------------------------------------
204 -- Change_Reserved_Keyword_To_Symbol --
205 ---------------------------------------
207 procedure Change_Reserved_Keyword_To_Symbol
208 (All_Keywords : Boolean := False)
210 New_Name : constant Name_Id := Token_Names (Token);
213 if New_Name /= No_Name then
215 when Tok_If | Tok_Else | Tok_Elsif | Tok_End |
216 Tok_And | Tok_Or | Tok_Then =>
218 Token := Tok_Identifier;
219 Token_Name := New_Name;
223 Token := Tok_Identifier;
224 Token_Name := New_Name;
227 end Change_Reserved_Keyword_To_Symbol;
229 ------------------------------------------
230 -- Check_Command_Line_Symbol_Definition --
231 ------------------------------------------
233 procedure Check_Command_Line_Symbol_Definition
234 (Definition : String;
235 Data : out Symbol_Data)
237 Index : Natural := 0;
238 Result : Symbol_Data;
241 -- Look for the character '='
243 for J in Definition'Range loop
244 if Definition (J) = '=' then
250 -- If no character '=', then the value is True
253 -- Put the symbol in the name buffer
255 Name_Len := Definition'Length;
256 Name_Buffer (1 .. Name_Len) := Definition;
257 Result := True_Value;
259 elsif Index = Definition'First then
260 Fail ("invalid symbol definition """ & Definition & """");
263 -- Put the symbol in the name buffer
265 Name_Len := Index - Definition'First;
266 Name_Buffer (1 .. Name_Len) :=
267 String'(Definition (Definition'First .. Index - 1));
269 -- Check the syntax of the value
271 if Definition (Index + 1) /= '"'
272 or else Definition (Definition'Last) /= '"'
274 for J in Index + 1 .. Definition'Last loop
275 case Definition (J) is
276 when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
280 Fail ("illegal value """
281 & Definition (Index + 1 .. Definition'Last)
287 -- And put the value in the result
289 Result.Is_A_String := False;
291 Store_String_Chars (Definition (Index + 1 .. Definition'Last));
292 Result.Value := End_String;
295 -- Now, check the syntax of the symbol (we don't allow accented and
298 if Name_Buffer (1) not in 'a' .. 'z'
299 and then Name_Buffer (1) not in 'A' .. 'Z'
302 & Name_Buffer (1 .. Name_Len)
303 & """ does not start with a letter");
306 for J in 2 .. Name_Len loop
307 case Name_Buffer (J) is
308 when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
314 & Name_Buffer (1 .. Name_Len)
315 & """ end with a '_'");
317 elsif Name_Buffer (J + 1) = '_' then
319 & Name_Buffer (1 .. Name_Len)
320 & """ contains consecutive '_'");
325 & Name_Buffer (1 .. Name_Len)
326 & """ contains illegal character(s)");
330 Result.On_The_Command_Line := True;
332 -- Put the symbol name in the result
335 Sym : constant String := Name_Buffer (1 .. Name_Len);
338 for Index in 1 .. Name_Len loop
339 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
342 Result.Symbol := Name_Find;
343 Name_Len := Sym'Length;
344 Name_Buffer (1 .. Name_Len) := Sym;
345 Result.Original := Name_Find;
349 end Check_Command_Line_Symbol_Definition;
355 function Deleting return Boolean is
357 -- Always return False when not inside an #if statement
359 if Pp_States.Last = Ground then
362 return Pp_States.Table (Pp_States.Last).Deleting;
371 (Evaluate_It : Boolean;
372 Complemented : Boolean := False) return Boolean
374 Evaluation : Boolean := Evaluate_It;
375 -- Is set to False after an "or else" when left term is True and
376 -- after an "and then" when left term is False.
378 Final_Result : Boolean := False;
380 Current_Result : Boolean := False;
383 Current_Operator : Operator := None;
386 Symbol_Name1 : Name_Id;
387 Symbol_Name2 : Name_Id;
388 Symbol_Pos1 : Source_Ptr;
389 Symbol_Pos2 : Source_Ptr;
390 Symbol_Value1 : String_Id;
391 Symbol_Value2 : String_Id;
394 -- Loop for each term
397 Change_Reserved_Keyword_To_Symbol;
399 Current_Result := False;
403 when Tok_Left_Paren =>
408 Current_Result := Expression (Evaluation);
410 if Token = Tok_Right_Paren then
414 Error_Msg ("`)` expected", Token_Ptr);
423 not Expression (Evaluation, Complemented => True);
425 when Tok_Identifier =>
426 Symbol_Name1 := Token_Name;
427 Symbol_Pos1 := Token_Ptr;
430 if Token = Tok_Apostrophe then
436 if Token = Tok_Identifier
437 and then Token_Name = Name_Defined
442 Error_Msg ("identifier `Defined` expected", Token_Ptr);
446 Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
449 elsif Token = Tok_Equal then
452 Change_Reserved_Keyword_To_Symbol;
454 if Token = Tok_Identifier then
458 Symbol_Name2 := Token_Name;
459 Symbol_Pos2 := Token_Ptr;
463 Symbol1 := Index_Of (Symbol_Name1);
465 if Symbol1 = No_Symbol then
466 if Undefined_Symbols_Are_False then
467 Symbol_Value1 := String_False;
470 Error_Msg_Name_1 := Symbol_Name1;
471 Error_Msg ("unknown symbol %", Symbol_Pos1);
472 Symbol_Value1 := No_String;
477 Mapping.Table (Symbol1).Value;
480 Symbol2 := Index_Of (Symbol_Name2);
482 if Symbol2 = No_Symbol then
483 if Undefined_Symbols_Are_False then
484 Symbol_Value2 := String_False;
487 Error_Msg_Name_1 := Symbol_Name2;
488 Error_Msg ("unknown symbol %", Symbol_Pos2);
489 Symbol_Value2 := No_String;
493 Symbol_Value2 := Mapping.Table (Symbol2).Value;
496 if Symbol_Value1 /= No_String
497 and then Symbol_Value2 /= No_String
499 Current_Result := Matching_Strings
500 (Symbol_Value1, Symbol_Value2);
504 elsif Token = Tok_String_Literal then
509 Symbol1 := Index_Of (Symbol_Name1);
511 if Symbol1 = No_Symbol then
512 if Undefined_Symbols_Are_False then
513 Symbol_Value1 := String_False;
516 Error_Msg_Name_1 := Symbol_Name1;
517 Error_Msg ("unknown symbol %", Symbol_Pos1);
518 Symbol_Value1 := No_String;
522 Symbol_Value1 := Mapping.Table (Symbol1).Value;
525 if Symbol_Value1 /= No_String then
537 ("symbol or literal string expected", Token_Ptr);
541 -- symbol (True or False)
544 Symbol1 := Index_Of (Symbol_Name1);
546 if Symbol1 = No_Symbol then
547 if Undefined_Symbols_Are_False then
548 Symbol_Value1 := String_False;
551 Error_Msg_Name_1 := Symbol_Name1;
552 Error_Msg ("unknown symbol %", Symbol_Pos1);
553 Symbol_Value1 := No_String;
557 Symbol_Value1 := Mapping.Table (Symbol1).Value;
560 if Symbol_Value1 /= No_String then
561 String_To_Name_Buffer (Symbol_Value1);
563 for Index in 1 .. Name_Len loop
564 Name_Buffer (Index) :=
565 Fold_Lower (Name_Buffer (Index));
568 if Name_Buffer (1 .. Name_Len) = "true" then
569 Current_Result := True;
571 elsif Name_Buffer (1 .. Name_Len) = "false" then
572 Current_Result := False;
575 Error_Msg_Name_1 := Symbol_Name1;
577 ("value of symbol % is not True or False",
585 Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
588 -- Update the cumulative final result
590 case Current_Operator is
592 Final_Result := Current_Result;
595 Final_Result := Final_Result or Current_Result;
598 Final_Result := Final_Result and Current_Result;
601 -- Check the next operator
603 if Token = Tok_And then
606 ("mixing NOT and AND is not allowed, parentheses are required",
609 elsif Current_Operator = Op_Or then
610 Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);
613 Current_Operator := Op_And;
616 if Token = Tok_Then then
619 if Final_Result = False then
624 elsif Token = Tok_Or then
627 ("mixing NOT and OR is not allowed, parentheses are required",
630 elsif Current_Operator = Op_And then
631 Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);
634 Current_Operator := Op_Or;
637 if Token = Tok_Else then
646 -- No operator: exit the term loop
655 -----------------------
656 -- Go_To_End_Of_Line --
657 -----------------------
659 procedure Go_To_End_Of_Line is
661 -- Scan until we get an end of line or we reach the end of the buffer
663 while Token /= Tok_End_Of_Line
664 and then Token /= Tok_EOF
668 end Go_To_End_Of_Line;
674 function Index_Of (Symbol : Name_Id) return Symbol_Id is
676 if Mapping.Table /= null then
677 for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop
678 if Mapping.Table (J).Symbol = Symbol then
691 procedure Initialize is
693 if not Already_Initialized then
695 Store_String_Chars ("True");
696 True_Value.Value := End_String;
699 Empty_String := End_String;
702 Store_String_Chars ("False");
703 String_False := End_String;
705 Already_Initialized := True;
713 procedure List_Symbols (Foreword : String) is
714 Order : array (0 .. Integer (Symbol_Table.Last (Mapping)))
716 -- After alphabetical sorting, this array stores the indices of
717 -- the symbols in the order they are displayed.
719 function Lt (Op1, Op2 : Natural) return Boolean;
720 -- Comparison routine for sort call
722 procedure Move (From : Natural; To : Natural);
723 -- Move routine for sort call
729 function Lt (Op1, Op2 : Natural) return Boolean is
730 S1 : constant String :=
731 Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
732 S2 : constant String :=
733 Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
743 procedure Move (From : Natural; To : Natural) is
745 Order (To) := Order (From);
748 package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
751 -- Maximum length of any symbol
753 -- Start of processing for List_Symbols_Case
756 if Symbol_Table.Last (Mapping) = 0 then
760 if Foreword'Length > 0 then
762 Write_Line (Foreword);
764 for J in Foreword'Range loop
769 -- Initialize the order
771 for J in Order'Range loop
772 Order (J) := Symbol_Id (J);
775 -- Sort alphabetically
777 Sort_Syms.Sort (Order'Last);
781 for J in 1 .. Symbol_Table.Last (Mapping) loop
782 Get_Name_String (Mapping.Table (J).Original);
783 Max_L := Integer'Max (Max_L, Name_Len);
787 Write_Str ("Symbol");
789 for J in 1 .. Max_L - 5 loop
793 Write_Line ("Value");
795 Write_Str ("------");
797 for J in 1 .. Max_L - 5 loop
801 Write_Line ("------");
803 for J in 1 .. Order'Last loop
805 Data : constant Symbol_Data := Mapping.Table (Order (J));
808 Get_Name_String (Data.Original);
809 Write_Str (Name_Buffer (1 .. Name_Len));
811 for K in Name_Len .. Max_L loop
815 String_To_Name_Buffer (Data.Value);
817 if Data.Is_A_String then
820 for J in 1 .. Name_Len loop
821 Write_Char (Name_Buffer (J));
823 if Name_Buffer (J) = '"' then
831 Write_Str (Name_Buffer (1 .. Name_Len));
841 ----------------------
842 -- Matching_Strings --
843 ----------------------
845 function Matching_Strings (S1, S2 : String_Id) return Boolean is
847 String_To_Name_Buffer (S1);
849 for Index in 1 .. Name_Len loop
850 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
854 String1 : constant String := Name_Buffer (1 .. Name_Len);
857 String_To_Name_Buffer (S2);
859 for Index in 1 .. Name_Len loop
860 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
863 return String1 = Name_Buffer (1 .. Name_Len);
865 end Matching_Strings;
871 procedure Parse_Def_File is
873 Symbol_Name : Name_Id;
874 Original_Name : Name_Id;
876 Value_Start : Source_Ptr;
877 Value_End : Source_Ptr;
887 exit Def_Line_Loop when Token = Tok_EOF;
889 if Token /= Tok_End_Of_Line then
890 Change_Reserved_Keyword_To_Symbol;
892 if Token /= Tok_Identifier then
893 Error_Msg ("identifier expected", Token_Ptr);
897 Symbol_Name := Token_Name;
900 for Ptr in Token_Ptr .. Scan_Ptr - 1 loop
901 Name_Len := Name_Len + 1;
902 Name_Buffer (Name_Len) := Sinput.Source (Ptr);
905 Original_Name := Name_Find;
908 if Token /= Tok_Colon_Equal then
909 Error_Msg ("`:=` expected", Token_Ptr);
915 if Token = Tok_String_Literal then
916 Data := (Symbol => Symbol_Name,
917 Original => Original_Name,
918 On_The_Command_Line => False,
920 Value => String_Literal_Id);
924 if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
925 Error_Msg ("extraneous text in definition", Token_Ptr);
929 elsif Token = Tok_End_Of_Line or else Token = Tok_EOF then
930 Data := (Symbol => Symbol_Name,
931 Original => Original_Name,
932 On_The_Command_Line => False,
933 Is_A_String => False,
934 Value => Empty_String);
937 Value_Start := Token_Ptr;
938 Value_End := Token_Ptr - 1;
939 Scan_Ptr := Token_Ptr;
943 Ch := Sinput.Source (Scan_Ptr);
946 when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
947 Value_End := Scan_Ptr;
948 Scan_Ptr := Scan_Ptr + 1;
950 when ' ' | HT | VT | CR | LF | FF =>
951 exit Value_Chars_Loop;
954 Error_Msg ("illegal character", Scan_Ptr);
957 end loop Value_Chars_Loop;
961 if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
962 Error_Msg ("extraneous text in definition", Token_Ptr);
968 while Value_Start <= Value_End loop
969 Store_String_Char (Sinput.Source (Value_Start));
970 Value_Start := Value_Start + 1;
973 Data := (Symbol => Symbol_Name,
974 Original => Original_Name,
975 On_The_Command_Line => False,
976 Is_A_String => False,
977 Value => End_String);
980 -- Now that we have the value, get the symbol index
982 Symbol := Index_Of (Symbol_Name);
984 if Symbol /= No_Symbol then
985 -- If we already have an entry for this symbol, replace it
986 -- with the new value, except if the symbol was declared
987 -- on the command line.
989 if Mapping.Table (Symbol).On_The_Command_Line then
994 -- As it is the first time we see this symbol, create a new
995 -- entry in the table.
997 if Mapping.Table = null then
998 Symbol_Table.Init (Mapping);
1001 Symbol_Table.Increment_Last (Mapping);
1002 Symbol := Symbol_Table.Last (Mapping);
1005 Mapping.Table (Symbol) := Data;
1009 Set_Ignore_Errors (To => True);
1011 while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
1015 Set_Ignore_Errors (To => False);
1020 end loop Def_Line_Loop;
1027 procedure Preprocess (Source_Modified : out Boolean) is
1028 Start_Of_Processing : Source_Ptr;
1030 Preprocessor_Line : Boolean := False;
1031 No_Error_Found : Boolean := True;
1032 Modified : Boolean := False;
1034 procedure Output (From, To : Source_Ptr);
1035 -- Output the characters with indices From .. To in the buffer
1036 -- to the output file.
1038 procedure Output_Line (From, To : Source_Ptr);
1039 -- Output a line or the end of a line from the buffer to the output
1040 -- file, followed by an end of line terminator. Depending on the value
1041 -- of Deleting and the switches, the line may be commented out, blank or
1042 -- not output at all.
1048 procedure Output (From, To : Source_Ptr) is
1050 for J in From .. To loop
1051 Put_Char (Sinput.Source (J));
1059 procedure Output_Line (From, To : Source_Ptr) is
1061 if Deleting or else Preprocessor_Line then
1062 if Blank_Deleted_Lines then
1065 elsif Comment_Deleted_Lines then
1084 -- Start of processing for Preprocess
1087 Start_Of_Processing := Scan_Ptr;
1089 -- We need to call Scan for the first time, because Initialize_Scanner
1090 -- is no longer doing it.
1094 Input_Line_Loop : loop
1095 exit Input_Line_Loop when Token = Tok_EOF;
1097 Preprocessor_Line := False;
1099 if Token /= Tok_End_Of_Line then
1101 -- Preprocessor line
1103 if Token = Tok_Special and then Special_Character = '#' then
1105 Preprocessor_Line := True;
1114 If_Ptr : constant Source_Ptr := Token_Ptr;
1118 Cond := Expression (not Deleting);
1120 -- Check for an eventual "then"
1122 if Token = Tok_Then then
1126 -- It is an error to have trailing characters after
1127 -- the condition or "then".
1129 if Token /= Tok_End_Of_Line
1130 and then Token /= Tok_EOF
1133 ("extraneous text on preprocessor line",
1135 No_Error_Found := False;
1140 -- Set the initial state of this new "#if". This
1141 -- must be done before incrementing the Last of
1142 -- the table, otherwise function Deleting does
1143 -- not report the correct value.
1145 New_State : constant Pp_State :=
1148 Deleting => Deleting
1150 Match_Seen => Deleting or else Cond);
1153 Pp_States.Increment_Last;
1154 Pp_States.Table (Pp_States.Last) := New_State;
1163 if Pp_States.Last = 0
1164 or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1166 Error_Msg ("no IF for this ELSIF", Token_Ptr);
1167 No_Error_Found := False;
1171 not Pp_States.Table (Pp_States.Last).Match_Seen;
1175 Cond := Expression (Cond);
1177 -- Check for an eventual "then"
1179 if Token = Tok_Then then
1183 -- It is an error to have trailing characters after
1184 -- the condition or "then".
1186 if Token /= Tok_End_Of_Line
1187 and then Token /= Tok_EOF
1190 ("extraneous text on preprocessor line",
1192 No_Error_Found := False;
1197 -- Depending on the value of the condition, set the
1198 -- new values of Deleting and Match_Seen.
1199 if Pp_States.Last > 0 then
1200 if Pp_States.Table (Pp_States.Last).Match_Seen then
1201 Pp_States.Table (Pp_States.Last).Deleting := True;
1204 Pp_States.Table (Pp_States.Last).Match_Seen :=
1206 Pp_States.Table (Pp_States.Last).Deleting :=
1215 if Pp_States.Last = 0 then
1216 Error_Msg ("no IF for this ELSE", Token_Ptr);
1217 No_Error_Found := False;
1220 Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1222 Error_Msg ("duplicate ELSE line", Token_Ptr);
1223 No_Error_Found := False;
1226 -- Set the possibly new values of Deleting and
1229 if Pp_States.Last > 0 then
1230 if Pp_States.Table (Pp_States.Last).Match_Seen then
1231 Pp_States.Table (Pp_States.Last).Deleting :=
1235 Pp_States.Table (Pp_States.Last).Match_Seen :=
1237 Pp_States.Table (Pp_States.Last).Deleting :=
1241 -- Set the Else_Ptr to check for illegal #elsif
1244 Pp_States.Table (Pp_States.Last).Else_Ptr :=
1250 -- It is an error to have characters after "#else"
1251 if Token /= Tok_End_Of_Line
1252 and then Token /= Tok_EOF
1255 ("extraneous text on preprocessor line",
1257 No_Error_Found := False;
1264 if Pp_States.Last = 0 then
1265 Error_Msg ("no IF for this END", Token_Ptr);
1266 No_Error_Found := False;
1271 if Token /= Tok_If then
1272 Error_Msg ("IF expected", Token_Ptr);
1273 No_Error_Found := False;
1278 if Token /= Tok_Semicolon then
1279 Error_Msg ("`;` Expected", Token_Ptr);
1280 No_Error_Found := False;
1285 -- It is an error to have character after
1287 if Token /= Tok_End_Of_Line
1288 and then Token /= Tok_EOF
1291 ("extraneous text on preprocessor line",
1293 No_Error_Found := False;
1298 -- In case of one of the errors above, skip the tokens
1299 -- until the end of line is reached.
1303 -- Decrement the depth of the #if stack
1305 if Pp_States.Last > 0 then
1306 Pp_States.Decrement_Last;
1309 -- Illegal preprocessor line
1312 No_Error_Found := False;
1314 if Pp_States.Last = 0 then
1315 Error_Msg ("IF expected", Token_Ptr);
1318 Pp_States.Table (Pp_States.Last).Else_Ptr = 0
1320 Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected",
1324 Error_Msg ("IF or `END IF` expected", Token_Ptr);
1327 -- Skip to the end of this illegal line
1332 -- Not a preprocessor line
1335 -- Do not report errors for those lines, even if there are
1336 -- Ada parsing errors.
1338 Set_Ignore_Errors (To => True);
1344 while Token /= Tok_End_Of_Line
1345 and then Token /= Tok_EOF
1347 if Token = Tok_Special
1348 and then Special_Character = '$'
1353 Dollar_Ptr : constant Source_Ptr := Token_Ptr;
1358 Change_Reserved_Keyword_To_Symbol;
1360 if Token = Tok_Identifier
1361 and then Token_Ptr = Dollar_Ptr + 1
1365 Symbol := Index_Of (Token_Name);
1367 -- If symbol exists, replace by its value
1369 if Symbol /= No_Symbol then
1370 Output (Start_Of_Processing, Dollar_Ptr - 1);
1371 Start_Of_Processing := Scan_Ptr;
1372 String_To_Name_Buffer
1373 (Mapping.Table (Symbol).Value);
1375 if Mapping.Table (Symbol).Is_A_String then
1377 -- Value is an Ada string
1381 for J in 1 .. Name_Len loop
1382 Put_Char (Name_Buffer (J));
1384 if Name_Buffer (J) = '"' then
1392 -- Value is a sequence of characters, not
1395 for J in 1 .. Name_Len loop
1396 Put_Char (Name_Buffer (J));
1408 Set_Ignore_Errors (To => False);
1412 pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF);
1414 -- At this point, the token is either end of line or EOF.
1415 -- The line to possibly output stops just before the token.
1417 Output_Line (Start_Of_Processing, Token_Ptr - 1);
1419 -- If we are at the end of a line, the scan pointer is at the first
1420 -- non blank character, not necessarily the first character of the
1421 -- line; so, we have to deduct Start_Of_Processing from the token
1424 if Token = Tok_End_Of_Line then
1425 if (Sinput.Source (Token_Ptr) = ASCII.CR
1426 and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
1428 (Sinput.Source (Token_Ptr) = ASCII.CR
1429 and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
1431 Start_Of_Processing := Token_Ptr + 2;
1433 Start_Of_Processing := Token_Ptr + 1;
1437 -- Now, scan the first token of the next line. If the token is EOF,
1438 -- the scan pointer will not move, and the token will still be EOF.
1440 Set_Ignore_Errors (To => True);
1442 Set_Ignore_Errors (To => False);
1443 end loop Input_Line_Loop;
1445 -- Report an error for any missing some "#end if;"
1447 for Level in reverse 1 .. Pp_States.Last loop
1448 Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr);
1449 No_Error_Found := False;
1452 Source_Modified := No_Error_Found and Modified;
1459 procedure Setup_Hooks
1460 (Error_Msg : Error_Msg_Proc;
1462 Set_Ignore_Errors : Set_Ignore_Errors_Proc;
1463 Put_Char : Put_Char_Proc;
1464 New_EOL : New_EOL_Proc)
1467 pragma Assert (Already_Initialized);
1469 Prep.Error_Msg := Error_Msg;
1471 Prep.Set_Ignore_Errors := Set_Ignore_Errors;
1472 Prep.Put_Char := Put_Char;
1473 Prep.New_EOL := New_EOL;