1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2023, 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
;
36 with Uintp
; use Uintp
;
38 with GNAT
.Heap_Sort_G
;
44 type Token_Name_Array
is array (Token_Type
) of Name_Id
;
45 Token_Names
: constant Token_Name_Array
:=
46 (Tok_Abort
=> Name_Abort
,
48 Tok_Abstract
=> Name_Abstract
,
49 Tok_Accept
=> Name_Accept
,
50 Tok_Aliased
=> Name_Aliased
,
52 Tok_Array
=> Name_Array
,
55 Tok_Begin
=> Name_Begin
,
56 Tok_Body
=> Name_Body
,
57 Tok_Case
=> Name_Case
,
58 Tok_Constant
=> Name_Constant
,
59 Tok_Declare
=> Name_Declare
,
60 Tok_Delay
=> Name_Delay
,
61 Tok_Delta
=> Name_Delta
,
62 Tok_Digits
=> Name_Digits
,
63 Tok_Else
=> Name_Else
,
64 Tok_Elsif
=> Name_Elsif
,
66 Tok_Entry
=> Name_Entry
,
67 Tok_Exception
=> Name_Exception
,
68 Tok_Exit
=> Name_Exit
,
70 Tok_Function
=> Name_Function
,
71 Tok_Generic
=> Name_Generic
,
72 Tok_Goto
=> Name_Goto
,
75 Tok_Limited
=> Name_Limited
,
76 Tok_Loop
=> Name_Loop
,
79 Tok_Null
=> Name_Null
,
82 Tok_Others
=> Name_Others
,
84 Tok_Package
=> Name_Package
,
85 Tok_Pragma
=> Name_Pragma
,
86 Tok_Private
=> Name_Private
,
87 Tok_Procedure
=> Name_Procedure
,
88 Tok_Protected
=> Name_Protected
,
89 Tok_Raise
=> Name_Raise
,
90 Tok_Range
=> Name_Range
,
91 Tok_Record
=> Name_Record
,
93 Tok_Renames
=> Name_Renames
,
94 Tok_Requeue
=> Name_Requeue
,
95 Tok_Return
=> Name_Return
,
96 Tok_Reverse
=> Name_Reverse
,
97 Tok_Select
=> Name_Select
,
98 Tok_Separate
=> Name_Separate
,
99 Tok_Subtype
=> Name_Subtype
,
100 Tok_Tagged
=> Name_Tagged
,
101 Tok_Task
=> Name_Task
,
102 Tok_Terminate
=> Name_Terminate
,
103 Tok_Then
=> Name_Then
,
104 Tok_Type
=> Name_Type
,
105 Tok_Until
=> Name_Until
,
107 Tok_When
=> Name_When
,
108 Tok_While
=> Name_While
,
109 Tok_With
=> Name_With
,
113 Already_Initialized
: Boolean := False;
114 -- Used to avoid repetition of the part of the initialisation that needs
115 -- to be done only once.
117 String_False
: String_Id
;
118 -- "false", as a string_id
124 -- Accesses to procedure specified by procedure Initialize
126 Error_Msg
: Error_Msg_Proc
;
132 Set_Ignore_Errors
: Set_Ignore_Errors_Proc
;
133 -- Indicate if error should be taken into account
135 Put_Char
: Put_Char_Proc
;
136 -- Output one character
138 New_EOL
: New_EOL_Proc
;
139 -- Output an end of line indication
141 -------------------------------
142 -- State of the Preprocessor --
143 -------------------------------
145 type Pp_State
is record
147 -- The location of the #if statement (used to flag #if with no
148 -- corresponding #end if, at the end).
150 Else_Ptr
: Source_Ptr
;
151 -- The location of the #else statement (used to detect multiple #else's)
154 -- Set to True when the code should be deleted or commented out
156 Match_Seen
: Boolean;
157 -- Set to True when a condition in an #if or an #elsif is True. Also set
158 -- to True if Deleting at the previous level is True. Used to decide if
159 -- Deleting should be set to True in a following #elsif or #else.
163 type Pp_Depth
is new Nat
;
165 Ground
: constant Pp_Depth
:= 0;
167 package Pp_States
is new Table
.Table
168 (Table_Component_Type
=> Pp_State
,
169 Table_Index_Type
=> Pp_Depth
,
170 Table_Low_Bound
=> 1,
172 Table_Increment
=> 100,
173 Table_Name
=> "Prep.Pp_States");
174 -- A stack of the states of the preprocessor, for nested #if
176 type Operator
is (None
, Op_Or
, Op_And
);
182 function Deleting
return Boolean;
183 -- Return True if code should be deleted or commented out
186 (Evaluate_It
: Boolean;
187 Complemented
: Boolean := False) return Boolean;
188 -- Evaluate a condition in an #if or an #elsif statement. If Evaluate_It
189 -- is False, the condition is effectively evaluated, otherwise, only the
190 -- syntax is checked.
192 procedure Go_To_End_Of_Line
;
193 -- Advance the scan pointer until we reach an end of line or the end of the
196 function Matching_Strings
(S1
, S2
: String_Id
) return Boolean;
197 -- Returns True if the two string parameters are equal (case insensitive)
199 ---------------------------------------
200 -- Change_Reserved_Keyword_To_Symbol --
201 ---------------------------------------
203 procedure Change_Reserved_Keyword_To_Symbol
204 (All_Keywords
: Boolean := False)
206 New_Name
: constant Name_Id
:= Token_Names
(Token
);
209 if New_Name
/= No_Name
then
220 Token
:= Tok_Identifier
;
221 Token_Name
:= New_Name
;
225 Token
:= Tok_Identifier
;
226 Token_Name
:= New_Name
;
229 end Change_Reserved_Keyword_To_Symbol
;
231 ------------------------------------------
232 -- Check_Command_Line_Symbol_Definition --
233 ------------------------------------------
235 procedure Check_Command_Line_Symbol_Definition
236 (Definition
: String;
237 Data
: out Symbol_Data
)
239 Index
: Natural := 0;
240 Result
: Symbol_Data
;
243 -- Look for the character '='
245 for J
in Definition
'Range loop
246 if Definition
(J
) = '=' then
252 -- If no character '=', then the value is True
256 -- Put the symbol in the name buffer
258 Name_Len
:= Definition
'Length;
259 Name_Buffer
(1 .. Name_Len
) := Definition
;
260 Result
:= True_Value
;
262 elsif Index
= Definition
'First then
263 Fail
("invalid symbol definition """ & Definition
& """");
266 -- Put the symbol in the name buffer
268 Name_Len
:= Index
- Definition
'First;
269 Name_Buffer
(1 .. Name_Len
) :=
270 String'(Definition (Definition'First .. Index - 1));
272 -- Check the syntax of the value
274 if Definition (Index + 1) /= '"'
275 or else Definition (Definition'Last) /= '"'
277 for J in Index + 1 .. Definition'Last loop
278 case Definition (J) is
279 when '_
' | '.' | '0' .. '9' | 'a
' .. 'z
' | 'A
' .. 'Z
' =>
283 Fail ("illegal value """
284 & Definition (Index + 1 .. Definition'Last)
290 -- Even if the value is a string, we still set Is_A_String to False,
291 -- to avoid adding additional quotes in the preprocessed sources when
292 -- replacing $<symbol>.
294 Result.Is_A_String := False;
296 -- Put the value in the result
299 Store_String_Chars (Definition (Index + 1 .. Definition'Last));
300 Result.Value := End_String;
303 -- Now, check the syntax of the symbol (we don't allow accented or
306 if Name_Buffer (1) not in 'a
' .. 'z
'
307 and then Name_Buffer (1) not in 'A
' .. 'Z
'
310 & Name_Buffer (1 .. Name_Len)
311 & """ does not start with a letter");
314 for J in 2 .. Name_Len loop
315 case Name_Buffer (J) is
316 when 'a
' .. 'z
' | 'A
' .. 'Z
' | '0' .. '9' =>
322 & Name_Buffer (1 .. Name_Len)
323 & """ end with a '_
'");
325 elsif Name_Buffer (J + 1) = '_
' then
327 & Name_Buffer (1 .. Name_Len)
328 & """ contains consecutive '_
'");
333 & Name_Buffer (1 .. Name_Len)
334 & """ contains illegal character(s)");
338 Result.On_The_Command_Line := True;
340 -- Put the symbol name in the result
343 Sym : constant String := Name_Buffer (1 .. Name_Len);
346 for Index in 1 .. Name_Len loop
347 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
350 Result.Symbol := Name_Find;
351 Name_Len := Sym'Length;
352 Name_Buffer (1 .. Name_Len) := Sym;
353 Result.Original := Name_Find;
357 end Check_Command_Line_Symbol_Definition;
363 function Deleting return Boolean is
365 -- Always return False when not inside an #if statement
367 if Opt.No_Deletion or else Pp_States.Last = Ground then
370 return Pp_States.Table (Pp_States.Last).Deleting;
379 (Evaluate_It : Boolean;
380 Complemented : Boolean := False) return Boolean
382 Evaluation : Boolean := Evaluate_It;
383 -- Is set to False after an "or else" when left term is True and after
384 -- an "and then" when left term is False.
386 Final_Result : Boolean := False;
388 Current_Result : Boolean := False;
391 Current_Operator : Operator := None;
394 Symbol_Name1 : Name_Id;
395 Symbol_Name2 : Name_Id;
396 Symbol_Pos1 : Source_Ptr;
397 Symbol_Pos2 : Source_Ptr;
398 Symbol_Value1 : String_Id;
399 Symbol_Value2 : String_Id;
404 -- Loop for each term
407 Change_Reserved_Keyword_To_Symbol;
409 Current_Result := False;
411 -- Scan current term, starting with Token
415 -- Handle parenthesized expression
417 when Tok_Left_Paren =>
419 Current_Result := Expression (Evaluation);
421 if Token = Tok_Right_Paren then
426 ("`)` expected", Token_Ptr);
429 -- Handle not expression
434 not Expression (Evaluation, Complemented => True);
436 -- Handle sequence starting with identifier
438 when Tok_Identifier =>
439 Symbol_Name1 := Token_Name;
440 Symbol_Pos1 := Token_Ptr;
443 if Token = Tok_Apostrophe then
449 if Token = Tok_Identifier
450 and then Token_Name = Name_Defined
455 Error_Msg ("identifier `Defined` expected", Token_Ptr);
459 Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
462 -- Handle relational operator
464 elsif Token in Tok_Equal | Tok_Less | Tok_Less_Equal |
465 Tok_Greater | Tok_Greater_Equal
469 Change_Reserved_Keyword_To_Symbol;
471 if Token = Tok_Integer_Literal then
480 Value : constant Int := UI_To_Int (Int_Literal_Value);
484 -- Value of symbol as Int
488 Symbol1 := Index_Of (Symbol_Name1);
490 if Symbol1 = No_Symbol then
491 Error_Msg_Name_1 := Symbol_Name1;
492 Error_Msg ("unknown symbol %", Symbol_Pos1);
493 Symbol_Value1 := No_String;
496 Data := Mapping.Table (Symbol1);
498 if Data.Is_A_String then
499 Error_Msg_Name_1 := Symbol_Name1;
501 ("symbol % value is not integer",
506 String_To_Name_Buffer (Data.Value);
508 Int'Value (Name_Buffer (1 .. Name_Len));
513 Symbol_Value = Value;
517 Symbol_Value < Value;
519 when Tok_Less_Equal =>
521 Symbol_Value <= Value;
525 Symbol_Value > Value;
527 when Tok_Greater_Equal =>
529 Symbol_Value >= Value;
536 when Constraint_Error =>
537 Error_Msg_Name_1 := Symbol_Name1;
539 ("symbol % value is not an integer",
549 -- Error if relational operator other than = if not numbers
551 elsif Relop /= Tok_Equal then
552 Error_Msg ("number expected", Token_Ptr);
554 -- Equality comparison of two strings
556 elsif Token = Tok_Identifier then
560 Symbol_Name2 := Token_Name;
561 Symbol_Pos2 := Token_Ptr;
565 Symbol1 := Index_Of (Symbol_Name1);
567 if Symbol1 = No_Symbol then
568 if Undefined_Symbols_Are_False then
569 Symbol_Value1 := String_False;
572 Error_Msg_Name_1 := Symbol_Name1;
573 Error_Msg ("unknown symbol %", Symbol_Pos1);
574 Symbol_Value1 := No_String;
579 Mapping.Table (Symbol1).Value;
582 Symbol2 := Index_Of (Symbol_Name2);
584 if Symbol2 = No_Symbol then
585 if Undefined_Symbols_Are_False then
586 Symbol_Value2 := String_False;
589 Error_Msg_Name_1 := Symbol_Name2;
590 Error_Msg ("unknown symbol %", Symbol_Pos2);
591 Symbol_Value2 := No_String;
595 Symbol_Value2 := Mapping.Table (Symbol2).Value;
598 if Symbol_Value1 /= No_String
600 Symbol_Value2 /= No_String
603 Matching_Strings (Symbol_Value1, Symbol_Value2);
607 elsif Token = Tok_String_Literal then
612 Symbol1 := Index_Of (Symbol_Name1);
614 if Symbol1 = No_Symbol then
615 if Undefined_Symbols_Are_False then
616 Symbol_Value1 := String_False;
619 Error_Msg_Name_1 := Symbol_Name1;
620 Error_Msg ("unknown symbol %", Symbol_Pos1);
621 Symbol_Value1 := No_String;
625 Symbol_Value1 := Mapping.Table (Symbol1).Value;
628 if Symbol_Value1 /= No_String then
640 ("literal integer, symbol or literal string expected",
644 -- Handle True or False
648 Symbol1 := Index_Of (Symbol_Name1);
650 if Symbol1 = No_Symbol then
651 if Undefined_Symbols_Are_False then
652 Symbol_Value1 := String_False;
655 Error_Msg_Name_1 := Symbol_Name1;
656 Error_Msg ("unknown symbol %", Symbol_Pos1);
657 Symbol_Value1 := No_String;
661 Symbol_Value1 := Mapping.Table (Symbol1).Value;
664 if Symbol_Value1 /= No_String then
665 String_To_Name_Buffer (Symbol_Value1);
667 for Index in 1 .. Name_Len loop
668 Name_Buffer (Index) :=
669 Fold_Lower (Name_Buffer (Index));
672 if Name_Buffer (1 .. Name_Len) = "true" then
673 Current_Result := True;
675 elsif Name_Buffer (1 .. Name_Len) = "false" then
676 Current_Result := False;
679 Error_Msg_Name_1 := Symbol_Name1;
681 ("value of symbol % is not True or False",
688 -- Unrecognized sequence
691 Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
694 -- Update the cumulative final result
696 case Current_Operator is
698 Final_Result := Current_Result;
701 Final_Result := Final_Result or Current_Result;
704 Final_Result := Final_Result and Current_Result;
709 if Token = Tok_And then
712 ("mixing NOT and AND is not allowed, parentheses are required",
715 elsif Current_Operator = Op_Or then
716 Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);
719 Current_Operator := Op_And;
722 if Token = Tok_Then then
725 if Final_Result = False then
732 elsif Token = Tok_Or then
735 ("mixing NOT and OR is not allowed, parentheses are required",
738 elsif Current_Operator = Op_And then
739 Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);
742 Current_Operator := Op_Or;
745 if Token = Tok_Else then
753 -- No AND/OR operator, so exit from the loop through terms
763 -----------------------
764 -- Go_To_End_Of_Line --
765 -----------------------
767 procedure Go_To_End_Of_Line is
769 -- Scan until we get an end of line or we reach the end of the buffer
771 while Token not in Tok_End_Of_Line | Tok_EOF loop
774 end Go_To_End_Of_Line;
780 function Index_Of (Symbol : Name_Id) return Symbol_Id is
782 if Mapping.Table /= null then
783 for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop
784 if Mapping.Table (J).Symbol = Symbol then
797 procedure Initialize is
799 if not Already_Initialized then
801 Store_String_Chars ("True");
802 True_Value.Value := End_String;
805 Store_String_Chars ("False");
806 String_False := End_String;
808 Already_Initialized := True;
816 procedure List_Symbols (Foreword : String) is
817 Order : array (0 .. Integer (Symbol_Table.Last (Mapping)))
819 -- After alphabetical sorting, this array stores the indexes of the
820 -- symbols in the order they are displayed.
822 function Lt (Op1, Op2 : Natural) return Boolean;
823 -- Comparison routine for sort call
825 procedure Move (From : Natural; To : Natural);
826 -- Move routine for sort call
832 function Lt (Op1, Op2 : Natural) return Boolean is
833 S1 : constant String :=
834 Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
835 S2 : constant String :=
836 Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
845 procedure Move (From : Natural; To : Natural) is
847 Order (To) := Order (From);
850 package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
853 -- Maximum length of any symbol
855 -- Start of processing for List_Symbols_Case
858 if Symbol_Table.Last (Mapping) = 0 then
862 if Foreword'Length > 0 then
864 Write_Line (Foreword);
866 for J in Foreword'Range loop
871 -- Initialize the order
873 for J in Order'Range loop
874 Order (J) := Symbol_Id (J);
877 -- Sort alphabetically
879 Sort_Syms.Sort (Order'Last);
883 for J in 1 .. Symbol_Table.Last (Mapping) loop
884 Get_Name_String (Mapping.Table (J).Original);
885 Max_L := Integer'Max (Max_L, Name_Len);
889 Write_Str ("Symbol");
891 for J in 1 .. Max_L - 5 loop
895 Write_Line ("Value");
897 Write_Str ("------");
899 for J in 1 .. Max_L - 5 loop
903 Write_Line ("------");
905 for J in 1 .. Order'Last loop
907 Data : constant Symbol_Data := Mapping.Table (Order (J));
910 Get_Name_String (Data.Original);
911 Write_Str (Name_Buffer (1 .. Name_Len));
913 for K in Name_Len .. Max_L loop
917 String_To_Name_Buffer (Data.Value);
919 if Data.Is_A_String then
922 for J in 1 .. Name_Len loop
923 Write_Char (Name_Buffer (J));
925 if Name_Buffer (J) = '"' then
933 Write_Str (Name_Buffer (1 .. Name_Len));
943 ----------------------
944 -- Matching_Strings --
945 ----------------------
947 function Matching_Strings (S1, S2 : String_Id) return Boolean is
949 String_To_Name_Buffer (S1);
951 for Index in 1 .. Name_Len loop
952 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
956 String1 : constant String := Name_Buffer (1 .. Name_Len);
959 String_To_Name_Buffer (S2);
961 for Index in 1 .. Name_Len loop
962 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
965 return String1 = Name_Buffer (1 .. Name_Len);
967 end Matching_Strings;
973 -- This procedure REALLY needs some more comments ???
975 procedure Parse_Def_File is
977 Symbol_Name : Name_Id;
978 Original_Name : Name_Id;
980 Value_Start : Source_Ptr;
981 Value_End : Source_Ptr;
991 exit Def_Line_Loop when Token = Tok_EOF;
993 if Token /= Tok_End_Of_Line then
994 Change_Reserved_Keyword_To_Symbol;
996 if Token /= Tok_Identifier then
997 Error_Msg ("identifier expected", Token_Ptr);
1001 Symbol_Name := Token_Name;
1004 for Ptr in Token_Ptr .. Scan_Ptr - 1 loop
1005 Name_Len := Name_Len + 1;
1006 Name_Buffer (Name_Len) := Sinput.Source (Ptr);
1009 Original_Name := Name_Find;
1012 if Token /= Tok_Colon_Equal then
1013 Error_Msg -- CODEFIX
1014 ("`:=` expected", Token_Ptr);
1020 if Token = Tok_Integer_Literal then
1022 Ptr : Source_Ptr := Token_Ptr;
1026 while Ptr < Scan_Ptr loop
1027 Store_String_Char (Sinput.Source (Ptr));
1031 Data := (Symbol => Symbol_Name,
1032 Original => Original_Name,
1033 On_The_Command_Line => False,
1034 Is_A_String => False,
1035 Value => End_String);
1040 if Token not in Tok_End_Of_Line | Tok_EOF then
1041 Error_Msg ("extraneous text in definition", Token_Ptr);
1045 elsif Token = Tok_String_Literal then
1046 Data := (Symbol => Symbol_Name,
1047 Original => Original_Name,
1048 On_The_Command_Line => False,
1049 Is_A_String => True,
1050 Value => String_Literal_Id);
1054 if Token not in Tok_End_Of_Line | Tok_EOF then
1055 Error_Msg ("extraneous text in definition", Token_Ptr);
1059 elsif Token in Tok_End_Of_Line | Tok_EOF then
1060 Data := (Symbol => Symbol_Name,
1061 Original => Original_Name,
1062 On_The_Command_Line => False,
1063 Is_A_String => False,
1064 Value => Null_String_Id);
1067 Value_Start := Token_Ptr;
1068 Value_End := Token_Ptr - 1;
1069 Scan_Ptr := Token_Ptr;
1073 Ch := Sinput.Source (Scan_Ptr);
1076 when '_
' | '.' | '0' .. '9' | 'a
' .. 'z
' | 'A
' .. 'Z
' =>
1077 Value_End := Scan_Ptr;
1078 Scan_Ptr := Scan_Ptr + 1;
1080 when ' ' | HT | VT | CR | LF | FF =>
1081 exit Value_Chars_Loop;
1084 Error_Msg ("illegal character", Scan_Ptr);
1087 end loop Value_Chars_Loop;
1091 if Token not in Tok_End_Of_Line | Tok_EOF then
1092 Error_Msg ("extraneous text in definition", Token_Ptr);
1098 while Value_Start <= Value_End loop
1099 Store_String_Char (Sinput.Source (Value_Start));
1100 Value_Start := Value_Start + 1;
1103 Data := (Symbol => Symbol_Name,
1104 Original => Original_Name,
1105 On_The_Command_Line => False,
1106 Is_A_String => False,
1107 Value => End_String);
1110 -- Now that we have the value, get the symbol index
1112 Symbol := Index_Of (Symbol_Name);
1114 if Symbol /= No_Symbol then
1116 -- If we already have an entry for this symbol, replace it
1117 -- with the new value, except if the symbol was declared on
1118 -- the command line.
1120 if Mapping.Table (Symbol).On_The_Command_Line then
1125 -- As it is the first time we see this symbol, create a new
1126 -- entry in the table.
1128 if Mapping.Table = null then
1129 Symbol_Table.Init (Mapping);
1132 Symbol_Table.Increment_Last (Mapping);
1133 Symbol := Symbol_Table.Last (Mapping);
1136 Mapping.Table (Symbol) := Data;
1140 Set_Ignore_Errors (To => True);
1142 while Token not in Tok_End_Of_Line | Tok_EOF loop
1146 Set_Ignore_Errors (To => False);
1151 end loop Def_Line_Loop;
1158 procedure Preprocess (Source_Modified : out Boolean) is
1159 Start_Of_Processing : Source_Ptr;
1161 Preprocessor_Line : Boolean := False;
1162 No_Error_Found : Boolean := True;
1163 Modified : Boolean := False;
1165 procedure Output (From, To : Source_Ptr);
1166 -- Output the characters with indexes From .. To in the buffer to the
1169 procedure Output_Line (From, To : Source_Ptr);
1170 -- Output a line or the end of a line from the buffer to the output
1171 -- file, followed by an end of line terminator. Depending on the value
1172 -- of Deleting and the switches, the line may be commented out, blank or
1173 -- not output at all.
1179 procedure Output (From, To : Source_Ptr) is
1181 for J in From .. To loop
1182 Put_Char (Sinput.Source (J));
1190 procedure Output_Line (From, To : Source_Ptr) is
1192 if Deleting or else Preprocessor_Line then
1193 if Blank_Deleted_Lines then
1196 elsif Comment_Deleted_Lines then
1215 -- Start of processing for Preprocess
1218 Start_Of_Processing := Scan_Ptr;
1220 -- First a call to Scan, because Initialize_Scanner is not doing it
1224 Input_Line_Loop : loop
1225 exit Input_Line_Loop when Token = Tok_EOF;
1227 Preprocessor_Line := False;
1229 if Token /= Tok_End_Of_Line then
1231 -- Preprocessor line
1233 if Token = Tok_Special and then Special_Character = '#
' then
1235 Preprocessor_Line := True;
1244 If_Ptr : constant Source_Ptr := Token_Ptr;
1248 Cond := Expression (not Deleting);
1250 -- Check for an eventual "then"
1252 if Token = Tok_Then then
1256 -- It is an error to have trailing characters after
1257 -- the condition or "then".
1259 if Token not in Tok_End_Of_Line | Tok_EOF then
1261 ("extraneous text on preprocessor line",
1263 No_Error_Found := False;
1268 -- Set the initial state of this new "#if". This
1269 -- must be done before incrementing the Last of
1270 -- the table, otherwise function Deleting does
1271 -- not report the correct value.
1273 New_State : constant Pp_State :=
1276 Deleting => Deleting
1278 Match_Seen => Deleting or else Cond);
1281 Pp_States.Increment_Last;
1282 Pp_States.Table (Pp_States.Last) := New_State;
1291 if Pp_States.Last = 0
1292 or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1294 Error_Msg ("no IF for this ELSIF", Token_Ptr);
1295 No_Error_Found := False;
1299 not Pp_States.Table (Pp_States.Last).Match_Seen;
1303 Cond := Expression (Cond);
1305 -- Check for an eventual "then"
1307 if Token = Tok_Then then
1311 -- It is an error to have trailing characters after the
1312 -- condition or "then".
1314 if Token not in Tok_End_Of_Line | Tok_EOF then
1316 ("extraneous text on preprocessor line",
1318 No_Error_Found := False;
1323 -- Depending on the value of the condition, set the new
1324 -- values of Deleting and Match_Seen.
1326 if Pp_States.Last > 0 then
1327 if Pp_States.Table (Pp_States.Last).Match_Seen then
1328 Pp_States.Table (Pp_States.Last).Deleting := True;
1331 Pp_States.Table (Pp_States.Last).Match_Seen :=
1333 Pp_States.Table (Pp_States.Last).Deleting :=
1342 if Pp_States.Last = 0 then
1343 Error_Msg ("no IF for this ELSE", Token_Ptr);
1344 No_Error_Found := False;
1347 Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1349 Error_Msg -- CODEFIX
1350 ("duplicate ELSE line", Token_Ptr);
1351 No_Error_Found := False;
1354 -- Set the possibly new values of Deleting and Match_Seen
1356 if Pp_States.Last > 0 then
1357 if Pp_States.Table (Pp_States.Last).Match_Seen then
1358 Pp_States.Table (Pp_States.Last).Deleting :=
1362 Pp_States.Table (Pp_States.Last).Match_Seen :=
1364 Pp_States.Table (Pp_States.Last).Deleting :=
1368 -- Set the Else_Ptr to check for illegal #elsif later
1370 Pp_States.Table (Pp_States.Last).Else_Ptr :=
1376 -- Error of character present after "#else"
1378 if Token not in Tok_End_Of_Line | Tok_EOF then
1380 ("extraneous text on preprocessor line",
1382 No_Error_Found := False;
1389 if Pp_States.Last = 0 then
1390 Error_Msg ("no IF for this END", Token_Ptr);
1391 No_Error_Found := False;
1396 -- Ignore all recoverable errors if Relaxed_RM_Semantics
1398 if Relaxed_RM_Semantics then
1401 elsif Token /= Tok_If then
1402 Error_Msg -- CODEFIX
1403 ("IF expected", Token_Ptr);
1404 No_Error_Found := False;
1409 if Token /= Tok_Semicolon then
1410 Error_Msg -- CODEFIX
1411 ("`;` Expected", Token_Ptr);
1412 No_Error_Found := False;
1417 -- Error of character present after "#end if;"
1419 if Token not in Tok_End_Of_Line | Tok_EOF then
1421 ("extraneous text on preprocessor line",
1423 No_Error_Found := False;
1428 -- In case of one of the errors above, skip the tokens
1429 -- until the end of line is reached.
1433 -- Decrement the depth of the #if stack
1435 if Pp_States.Last > 0 then
1436 Pp_States.Decrement_Last;
1439 -- Illegal preprocessor line
1442 if Pp_States.Last = 0 then
1443 Error_Msg -- CODEFIX
1444 ("IF expected", Token_Ptr);
1445 No_Error_Found := False;
1447 elsif Relaxed_RM_Semantics
1448 and then Get_Name_String (Token_Name) = "endif"
1450 -- In relaxed mode, accept "endif" instead of
1453 -- Decrement the depth of the #if stack
1455 if Pp_States.Last > 0 then
1456 Pp_States.Decrement_Last;
1458 elsif Pp_States.Table (Pp_States.Last).Else_Ptr = 0 then
1460 ("IF, ELSIF, ELSE, or `END IF` expected",
1462 No_Error_Found := False;
1465 Error_Msg ("IF or `END IF` expected", Token_Ptr);
1466 No_Error_Found := False;
1469 -- Skip to the end of this illegal line
1474 -- Not a preprocessor line
1477 -- Do not report errors for those lines, even if there are
1478 -- Ada parsing errors.
1480 Set_Ignore_Errors (To => True);
1486 while Token not in Tok_End_Of_Line | Tok_EOF loop
1487 if Token = Tok_Special
1488 and then Special_Character = '$
'
1493 Dollar_Ptr : constant Source_Ptr := Token_Ptr;
1498 Change_Reserved_Keyword_To_Symbol;
1500 if Token = Tok_Identifier
1501 and then Token_Ptr = Dollar_Ptr + 1
1505 Symbol := Index_Of (Token_Name);
1507 -- If symbol exists, replace by its value
1509 if Symbol /= No_Symbol then
1510 Output (Start_Of_Processing, Dollar_Ptr - 1);
1511 Start_Of_Processing := Scan_Ptr;
1512 String_To_Name_Buffer
1513 (Mapping.Table (Symbol).Value);
1515 if Mapping.Table (Symbol).Is_A_String then
1517 -- Value is an Ada string
1521 for J in 1 .. Name_Len loop
1522 Put_Char (Name_Buffer (J));
1524 if Name_Buffer (J) = '"' then
1532 -- Value is a sequence of characters, not
1535 for J in 1 .. Name_Len loop
1536 Put_Char (Name_Buffer (J));
1548 Set_Ignore_Errors (To => False);
1552 pragma Assert (Token in Tok_End_Of_Line | Tok_EOF);
1554 -- At this point, the token is either end of line or EOF. The line to
1555 -- possibly output stops just before the token.
1557 Output_Line (Start_Of_Processing, Token_Ptr - 1);
1559 -- If we are at the end of a line, the scan pointer is at the first
1560 -- non-blank character (may not be the first character of the line),
1561 -- so we have to deduct Start_Of_Processing from the token pointer.
1563 if Token = Tok_End_Of_Line then
1564 if Sinput.Source (Token_Ptr) = ASCII.CR
1565 and then Sinput.Source (Token_Ptr + 1) = ASCII.LF
1567 Start_Of_Processing := Token_Ptr + 2;
1569 Start_Of_Processing := Token_Ptr + 1;
1573 -- Now, scan the first token of the next line. If the token is EOF,
1574 -- the scan pointer will not move, and the token will still be EOF.
1576 Set_Ignore_Errors (To => True);
1578 Set_Ignore_Errors (To => False);
1579 end loop Input_Line_Loop;
1581 -- Report an error for any missing some "#end if;"
1583 for Level in reverse 1 .. Pp_States.Last loop
1584 Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr);
1585 No_Error_Found := False;
1588 Source_Modified := No_Error_Found and Modified;
1595 procedure Setup_Hooks
1596 (Error_Msg : Error_Msg_Proc;
1598 Set_Ignore_Errors : Set_Ignore_Errors_Proc;
1599 Put_Char : Put_Char_Proc;
1600 New_EOL : New_EOL_Proc)
1603 pragma Assert (Already_Initialized);
1605 Prep.Error_Msg := Error_Msg;
1607 Prep.Set_Ignore_Errors := Set_Ignore_Errors;
1608 Prep.Put_Char := Put_Char;
1609 Prep.New_EOL := New_EOL;