|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- P R E P --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2002-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Csets; use Csets;
|
|
|
27 with Err_Vars; use Err_Vars;
|
|
|
28 with Opt; use Opt;
|
|
|
29 with Osint; use Osint;
|
|
|
30 with Output; use Output;
|
|
|
31 with Scans; use Scans;
|
|
|
32 with Snames; use Snames;
|
|
|
33 with Sinput;
|
|
|
34 with Stringt; use Stringt;
|
|
|
35 with Table;
|
|
|
36 with Uintp; use Uintp;
|
|
|
37
|
|
|
38 with GNAT.Heap_Sort_G;
|
|
|
39
|
|
|
40 package body Prep is
|
|
|
41
|
|
|
42 use Symbol_Table;
|
|
|
43
|
|
|
44 type Token_Name_Array is array (Token_Type) of Name_Id;
|
|
|
45 Token_Names : constant Token_Name_Array :=
|
|
|
46 (Tok_Abort => Name_Abort,
|
|
|
47 Tok_Abs => Name_Abs,
|
|
|
48 Tok_Abstract => Name_Abstract,
|
|
|
49 Tok_Accept => Name_Accept,
|
|
|
50 Tok_Aliased => Name_Aliased,
|
|
|
51 Tok_All => Name_All,
|
|
|
52 Tok_Array => Name_Array,
|
|
|
53 Tok_And => Name_And,
|
|
|
54 Tok_At => Name_At,
|
|
|
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,
|
|
|
65 Tok_End => Name_End,
|
|
|
66 Tok_Entry => Name_Entry,
|
|
|
67 Tok_Exception => Name_Exception,
|
|
|
68 Tok_Exit => Name_Exit,
|
|
|
69 Tok_For => Name_For,
|
|
|
70 Tok_Function => Name_Function,
|
|
|
71 Tok_Generic => Name_Generic,
|
|
|
72 Tok_Goto => Name_Goto,
|
|
|
73 Tok_If => Name_If,
|
|
|
74 Tok_Is => Name_Is,
|
|
|
75 Tok_Limited => Name_Limited,
|
|
|
76 Tok_Loop => Name_Loop,
|
|
|
77 Tok_Mod => Name_Mod,
|
|
|
78 Tok_New => Name_New,
|
|
|
79 Tok_Null => Name_Null,
|
|
|
80 Tok_Of => Name_Of,
|
|
|
81 Tok_Or => Name_Or,
|
|
|
82 Tok_Others => Name_Others,
|
|
|
83 Tok_Out => Name_Out,
|
|
|
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,
|
|
|
92 Tok_Rem => Name_Rem,
|
|
|
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,
|
|
|
106 Tok_Use => Name_Use,
|
|
|
107 Tok_When => Name_When,
|
|
|
108 Tok_While => Name_While,
|
|
|
109 Tok_With => Name_With,
|
|
|
110 Tok_Xor => Name_Xor,
|
|
|
111 others => No_Name);
|
|
|
112
|
|
|
113 Already_Initialized : Boolean := False;
|
|
|
114 -- Used to avoid repetition of the part of the initialisation that needs
|
|
|
115 -- to be done only once.
|
|
|
116
|
|
|
117 Empty_String : String_Id;
|
|
|
118 -- "", as a string_id
|
|
|
119
|
|
|
120 String_False : String_Id;
|
|
|
121 -- "false", as a string_id
|
|
|
122
|
|
|
123 --------------
|
|
|
124 -- Behavior --
|
|
|
125 --------------
|
|
|
126
|
|
|
127 -- Accesses to procedure specified by procedure Initialize
|
|
|
128
|
|
|
129 Error_Msg : Error_Msg_Proc;
|
|
|
130 -- Report an error
|
|
|
131
|
|
|
132 Scan : Scan_Proc;
|
|
|
133 -- Scan one token
|
|
|
134
|
|
|
135 Set_Ignore_Errors : Set_Ignore_Errors_Proc;
|
|
|
136 -- Indicate if error should be taken into account
|
|
|
137
|
|
|
138 Put_Char : Put_Char_Proc;
|
|
|
139 -- Output one character
|
|
|
140
|
|
|
141 New_EOL : New_EOL_Proc;
|
|
|
142 -- Output an end of line indication
|
|
|
143
|
|
|
144 -------------------------------
|
|
|
145 -- State of the Preprocessor --
|
|
|
146 -------------------------------
|
|
|
147
|
|
|
148 type Pp_State is record
|
|
|
149 If_Ptr : Source_Ptr;
|
|
|
150 -- The location of the #if statement (used to flag #if with no
|
|
|
151 -- corresponding #end if, at the end).
|
|
|
152
|
|
|
153 Else_Ptr : Source_Ptr;
|
|
|
154 -- The location of the #else statement (used to detect multiple #else's)
|
|
|
155
|
|
|
156 Deleting : Boolean;
|
|
|
157 -- Set to True when the code should be deleted or commented out
|
|
|
158
|
|
|
159 Match_Seen : Boolean;
|
|
|
160 -- Set to True when a condition in an #if or an #elsif is True. Also set
|
|
|
161 -- to True if Deleting at the previous level is True. Used to decide if
|
|
|
162 -- Deleting should be set to True in a following #elsif or #else.
|
|
|
163
|
|
|
164 end record;
|
|
|
165
|
|
|
166 type Pp_Depth is new Nat;
|
|
|
167
|
|
|
168 Ground : constant Pp_Depth := 0;
|
|
|
169
|
|
|
170 package Pp_States is new Table.Table
|
|
|
171 (Table_Component_Type => Pp_State,
|
|
|
172 Table_Index_Type => Pp_Depth,
|
|
|
173 Table_Low_Bound => 1,
|
|
|
174 Table_Initial => 10,
|
|
|
175 Table_Increment => 100,
|
|
|
176 Table_Name => "Prep.Pp_States");
|
|
|
177 -- A stack of the states of the preprocessor, for nested #if
|
|
|
178
|
|
|
179 type Operator is (None, Op_Or, Op_And);
|
|
|
180
|
|
|
181 -----------------
|
|
|
182 -- Subprograms --
|
|
|
183 -----------------
|
|
|
184
|
|
|
185 function Deleting return Boolean;
|
|
|
186 -- Return True if code should be deleted or commented out
|
|
|
187
|
|
|
188 function Expression
|
|
|
189 (Evaluate_It : Boolean;
|
|
|
190 Complemented : Boolean := False) return Boolean;
|
|
|
191 -- Evaluate a condition in an #if or an #elsif statement. If Evaluate_It
|
|
|
192 -- is False, the condition is effectively evaluated, otherwise, only the
|
|
|
193 -- syntax is checked.
|
|
|
194
|
|
|
195 procedure Go_To_End_Of_Line;
|
|
|
196 -- Advance the scan pointer until we reach an end of line or the end of the
|
|
|
197 -- buffer.
|
|
|
198
|
|
|
199 function Matching_Strings (S1, S2 : String_Id) return Boolean;
|
|
|
200 -- Returns True if the two string parameters are equal (case insensitive)
|
|
|
201
|
|
|
202 ---------------------------------------
|
|
|
203 -- Change_Reserved_Keyword_To_Symbol --
|
|
|
204 ---------------------------------------
|
|
|
205
|
|
|
206 procedure Change_Reserved_Keyword_To_Symbol
|
|
|
207 (All_Keywords : Boolean := False)
|
|
|
208 is
|
|
|
209 New_Name : constant Name_Id := Token_Names (Token);
|
|
|
210
|
|
|
211 begin
|
|
|
212 if New_Name /= No_Name then
|
|
|
213 case Token is
|
|
|
214 when Tok_And
|
|
|
215 | Tok_Else
|
|
|
216 | Tok_Elsif
|
|
|
217 | Tok_End
|
|
|
218 | Tok_If
|
|
|
219 | Tok_Or
|
|
|
220 | Tok_Then
|
|
|
221 =>
|
|
|
222 if All_Keywords then
|
|
|
223 Token := Tok_Identifier;
|
|
|
224 Token_Name := New_Name;
|
|
|
225 end if;
|
|
|
226
|
|
|
227 when others =>
|
|
|
228 Token := Tok_Identifier;
|
|
|
229 Token_Name := New_Name;
|
|
|
230 end case;
|
|
|
231 end if;
|
|
|
232 end Change_Reserved_Keyword_To_Symbol;
|
|
|
233
|
|
|
234 ------------------------------------------
|
|
|
235 -- Check_Command_Line_Symbol_Definition --
|
|
|
236 ------------------------------------------
|
|
|
237
|
|
|
238 procedure Check_Command_Line_Symbol_Definition
|
|
|
239 (Definition : String;
|
|
|
240 Data : out Symbol_Data)
|
|
|
241 is
|
|
|
242 Index : Natural := 0;
|
|
|
243 Result : Symbol_Data;
|
|
|
244
|
|
|
245 begin
|
|
|
246 -- Look for the character '='
|
|
|
247
|
|
|
248 for J in Definition'Range loop
|
|
|
249 if Definition (J) = '=' then
|
|
|
250 Index := J;
|
|
|
251 exit;
|
|
|
252 end if;
|
|
|
253 end loop;
|
|
|
254
|
|
|
255 -- If no character '=', then the value is True
|
|
|
256
|
|
|
257 if Index = 0 then
|
|
|
258
|
|
|
259 -- Put the symbol in the name buffer
|
|
|
260
|
|
|
261 Name_Len := Definition'Length;
|
|
|
262 Name_Buffer (1 .. Name_Len) := Definition;
|
|
|
263 Result := True_Value;
|
|
|
264
|
|
|
265 elsif Index = Definition'First then
|
|
|
266 Fail ("invalid symbol definition """ & Definition & """");
|
|
|
267
|
|
|
268 else
|
|
|
269 -- Put the symbol in the name buffer
|
|
|
270
|
|
|
271 Name_Len := Index - Definition'First;
|
|
|
272 Name_Buffer (1 .. Name_Len) :=
|
|
|
273 String'(Definition (Definition'First .. Index - 1));
|
|
|
274
|
|
|
275 -- Check the syntax of the value
|
|
|
276
|
|
|
277 if Definition (Index + 1) /= '"'
|
|
|
278 or else Definition (Definition'Last) /= '"'
|
|
|
279 then
|
|
|
280 for J in Index + 1 .. Definition'Last loop
|
|
|
281 case Definition (J) is
|
|
|
282 when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
|
|
|
283 null;
|
|
|
284
|
|
|
285 when others =>
|
|
|
286 Fail ("illegal value """
|
|
|
287 & Definition (Index + 1 .. Definition'Last)
|
|
|
288 & """");
|
|
|
289 end case;
|
|
|
290 end loop;
|
|
|
291 end if;
|
|
|
292
|
|
|
293 -- Even if the value is a string, we still set Is_A_String to False,
|
|
|
294 -- to avoid adding additional quotes in the preprocessed sources when
|
|
|
295 -- replacing $<symbol>.
|
|
|
296
|
|
|
297 Result.Is_A_String := False;
|
|
|
298
|
|
|
299 -- Put the value in the result
|
|
|
300
|
|
|
301 Start_String;
|
|
|
302 Store_String_Chars (Definition (Index + 1 .. Definition'Last));
|
|
|
303 Result.Value := End_String;
|
|
|
304 end if;
|
|
|
305
|
|
|
306 -- Now, check the syntax of the symbol (we don't allow accented or
|
|
|
307 -- wide characters).
|
|
|
308
|
|
|
309 if Name_Buffer (1) not in 'a' .. 'z'
|
|
|
310 and then Name_Buffer (1) not in 'A' .. 'Z'
|
|
|
311 then
|
|
|
312 Fail ("symbol """
|
|
|
313 & Name_Buffer (1 .. Name_Len)
|
|
|
314 & """ does not start with a letter");
|
|
|
315 end if;
|
|
|
316
|
|
|
317 for J in 2 .. Name_Len loop
|
|
|
318 case Name_Buffer (J) is
|
|
|
319 when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
|
|
|
320 null;
|
|
|
321
|
|
|
322 when '_' =>
|
|
|
323 if J = Name_Len then
|
|
|
324 Fail ("symbol """
|
|
|
325 & Name_Buffer (1 .. Name_Len)
|
|
|
326 & """ end with a '_'");
|
|
|
327
|
|
|
328 elsif Name_Buffer (J + 1) = '_' then
|
|
|
329 Fail ("symbol """
|
|
|
330 & Name_Buffer (1 .. Name_Len)
|
|
|
331 & """ contains consecutive '_'");
|
|
|
332 end if;
|
|
|
333
|
|
|
334 when others =>
|
|
|
335 Fail ("symbol """
|
|
|
336 & Name_Buffer (1 .. Name_Len)
|
|
|
337 & """ contains illegal character(s)");
|
|
|
338 end case;
|
|
|
339 end loop;
|
|
|
340
|
|
|
341 Result.On_The_Command_Line := True;
|
|
|
342
|
|
|
343 -- Put the symbol name in the result
|
|
|
344
|
|
|
345 declare
|
|
|
346 Sym : constant String := Name_Buffer (1 .. Name_Len);
|
|
|
347
|
|
|
348 begin
|
|
|
349 for Index in 1 .. Name_Len loop
|
|
|
350 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
|
|
|
351 end loop;
|
|
|
352
|
|
|
353 Result.Symbol := Name_Find;
|
|
|
354 Name_Len := Sym'Length;
|
|
|
355 Name_Buffer (1 .. Name_Len) := Sym;
|
|
|
356 Result.Original := Name_Find;
|
|
|
357 end;
|
|
|
358
|
|
|
359 Data := Result;
|
|
|
360 end Check_Command_Line_Symbol_Definition;
|
|
|
361
|
|
|
362 --------------
|
|
|
363 -- Deleting --
|
|
|
364 --------------
|
|
|
365
|
|
|
366 function Deleting return Boolean is
|
|
|
367 begin
|
|
|
368 -- Always return False when not inside an #if statement
|
|
|
369
|
|
|
370 if Opt.No_Deletion or else Pp_States.Last = Ground then
|
|
|
371 return False;
|
|
|
372 else
|
|
|
373 return Pp_States.Table (Pp_States.Last).Deleting;
|
|
|
374 end if;
|
|
|
375 end Deleting;
|
|
|
376
|
|
|
377 ----------------
|
|
|
378 -- Expression --
|
|
|
379 ----------------
|
|
|
380
|
|
|
381 function Expression
|
|
|
382 (Evaluate_It : Boolean;
|
|
|
383 Complemented : Boolean := False) return Boolean
|
|
|
384 is
|
|
|
385 Evaluation : Boolean := Evaluate_It;
|
|
|
386 -- Is set to False after an "or else" when left term is True and after
|
|
|
387 -- an "and then" when left term is False.
|
|
|
388
|
|
|
389 Final_Result : Boolean := False;
|
|
|
390
|
|
|
391 Current_Result : Boolean := False;
|
|
|
392 -- Value of a term
|
|
|
393
|
|
|
394 Current_Operator : Operator := None;
|
|
|
395 Symbol1 : Symbol_Id;
|
|
|
396 Symbol2 : Symbol_Id;
|
|
|
397 Symbol_Name1 : Name_Id;
|
|
|
398 Symbol_Name2 : Name_Id;
|
|
|
399 Symbol_Pos1 : Source_Ptr;
|
|
|
400 Symbol_Pos2 : Source_Ptr;
|
|
|
401 Symbol_Value1 : String_Id;
|
|
|
402 Symbol_Value2 : String_Id;
|
|
|
403
|
|
|
404 Relop : Token_Type;
|
|
|
405
|
|
|
406 begin
|
|
|
407 -- Loop for each term
|
|
|
408
|
|
|
409 loop
|
|
|
410 Change_Reserved_Keyword_To_Symbol;
|
|
|
411
|
|
|
412 Current_Result := False;
|
|
|
413
|
|
|
414 -- Scan current term, starting with Token
|
|
|
415
|
|
|
416 case Token is
|
|
|
417
|
|
|
418 -- Handle parenthesized expression
|
|
|
419
|
|
|
420 when Tok_Left_Paren =>
|
|
|
421 Scan.all;
|
|
|
422 Current_Result := Expression (Evaluation);
|
|
|
423
|
|
|
424 if Token = Tok_Right_Paren then
|
|
|
425 Scan.all;
|
|
|
426
|
|
|
427 else
|
|
|
428 Error_Msg -- CODEFIX
|
|
|
429 ("`)` expected", Token_Ptr);
|
|
|
430 end if;
|
|
|
431
|
|
|
432 -- Handle not expression
|
|
|
433
|
|
|
434 when Tok_Not =>
|
|
|
435 Scan.all;
|
|
|
436 Current_Result :=
|
|
|
437 not Expression (Evaluation, Complemented => True);
|
|
|
438
|
|
|
439 -- Handle sequence starting with identifier
|
|
|
440
|
|
|
441 when Tok_Identifier =>
|
|
|
442 Symbol_Name1 := Token_Name;
|
|
|
443 Symbol_Pos1 := Token_Ptr;
|
|
|
444 Scan.all;
|
|
|
445
|
|
|
446 if Token = Tok_Apostrophe then
|
|
|
447
|
|
|
448 -- symbol'Defined
|
|
|
449
|
|
|
450 Scan.all;
|
|
|
451
|
|
|
452 if Token = Tok_Identifier
|
|
|
453 and then Token_Name = Name_Defined
|
|
|
454 then
|
|
|
455 Scan.all;
|
|
|
456
|
|
|
457 else
|
|
|
458 Error_Msg ("identifier `Defined` expected", Token_Ptr);
|
|
|
459 end if;
|
|
|
460
|
|
|
461 if Evaluation then
|
|
|
462 Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
|
|
|
463 end if;
|
|
|
464
|
|
|
465 -- Handle relational operator
|
|
|
466
|
|
|
467 elsif Token = Tok_Equal
|
|
|
468 or else Token = Tok_Less
|
|
|
469 or else Token = Tok_Less_Equal
|
|
|
470 or else Token = Tok_Greater
|
|
|
471 or else Token = Tok_Greater_Equal
|
|
|
472 then
|
|
|
473 Relop := Token;
|
|
|
474 Scan.all;
|
|
|
475 Change_Reserved_Keyword_To_Symbol;
|
|
|
476
|
|
|
477 if Token = Tok_Integer_Literal then
|
|
|
478
|
|
|
479 -- symbol = integer
|
|
|
480 -- symbol < integer
|
|
|
481 -- symbol <= integer
|
|
|
482 -- symbol > integer
|
|
|
483 -- symbol >= integer
|
|
|
484
|
|
|
485 declare
|
|
|
486 Value : constant Int := UI_To_Int (Int_Literal_Value);
|
|
|
487 Data : Symbol_Data;
|
|
|
488
|
|
|
489 Symbol_Value : Int;
|
|
|
490 -- Value of symbol as Int
|
|
|
491
|
|
|
492 begin
|
|
|
493 if Evaluation then
|
|
|
494 Symbol1 := Index_Of (Symbol_Name1);
|
|
|
495
|
|
|
496 if Symbol1 = No_Symbol then
|
|
|
497 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
498 Error_Msg ("unknown symbol %", Symbol_Pos1);
|
|
|
499 Symbol_Value1 := No_String;
|
|
|
500
|
|
|
501 else
|
|
|
502 Data := Mapping.Table (Symbol1);
|
|
|
503
|
|
|
504 if Data.Is_A_String then
|
|
|
505 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
506 Error_Msg
|
|
|
507 ("symbol % value is not integer",
|
|
|
508 Symbol_Pos1);
|
|
|
509
|
|
|
510 else
|
|
|
511 begin
|
|
|
512 String_To_Name_Buffer (Data.Value);
|
|
|
513 Symbol_Value :=
|
|
|
514 Int'Value (Name_Buffer (1 .. Name_Len));
|
|
|
515
|
|
|
516 case Relop is
|
|
|
517 when Tok_Equal =>
|
|
|
518 Current_Result :=
|
|
|
519 Symbol_Value = Value;
|
|
|
520
|
|
|
521 when Tok_Less =>
|
|
|
522 Current_Result :=
|
|
|
523 Symbol_Value < Value;
|
|
|
524
|
|
|
525 when Tok_Less_Equal =>
|
|
|
526 Current_Result :=
|
|
|
527 Symbol_Value <= Value;
|
|
|
528
|
|
|
529 when Tok_Greater =>
|
|
|
530 Current_Result :=
|
|
|
531 Symbol_Value > Value;
|
|
|
532
|
|
|
533 when Tok_Greater_Equal =>
|
|
|
534 Current_Result :=
|
|
|
535 Symbol_Value >= Value;
|
|
|
536
|
|
|
537 when others =>
|
|
|
538 null;
|
|
|
539 end case;
|
|
|
540
|
|
|
541 exception
|
|
|
542 when Constraint_Error =>
|
|
|
543 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
544 Error_Msg
|
|
|
545 ("symbol % value is not an integer",
|
|
|
546 Symbol_Pos1);
|
|
|
547 end;
|
|
|
548 end if;
|
|
|
549 end if;
|
|
|
550 end if;
|
|
|
551
|
|
|
552 Scan.all;
|
|
|
553 end;
|
|
|
554
|
|
|
555 -- Error if relational operator other than = if not numbers
|
|
|
556
|
|
|
557 elsif Relop /= Tok_Equal then
|
|
|
558 Error_Msg ("number expected", Token_Ptr);
|
|
|
559
|
|
|
560 -- Equality comparison of two strings
|
|
|
561
|
|
|
562 elsif Token = Tok_Identifier then
|
|
|
563
|
|
|
564 -- symbol = symbol
|
|
|
565
|
|
|
566 Symbol_Name2 := Token_Name;
|
|
|
567 Symbol_Pos2 := Token_Ptr;
|
|
|
568 Scan.all;
|
|
|
569
|
|
|
570 if Evaluation then
|
|
|
571 Symbol1 := Index_Of (Symbol_Name1);
|
|
|
572
|
|
|
573 if Symbol1 = No_Symbol then
|
|
|
574 if Undefined_Symbols_Are_False then
|
|
|
575 Symbol_Value1 := String_False;
|
|
|
576
|
|
|
577 else
|
|
|
578 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
579 Error_Msg ("unknown symbol %", Symbol_Pos1);
|
|
|
580 Symbol_Value1 := No_String;
|
|
|
581 end if;
|
|
|
582
|
|
|
583 else
|
|
|
584 Symbol_Value1 :=
|
|
|
585 Mapping.Table (Symbol1).Value;
|
|
|
586 end if;
|
|
|
587
|
|
|
588 Symbol2 := Index_Of (Symbol_Name2);
|
|
|
589
|
|
|
590 if Symbol2 = No_Symbol then
|
|
|
591 if Undefined_Symbols_Are_False then
|
|
|
592 Symbol_Value2 := String_False;
|
|
|
593
|
|
|
594 else
|
|
|
595 Error_Msg_Name_1 := Symbol_Name2;
|
|
|
596 Error_Msg ("unknown symbol %", Symbol_Pos2);
|
|
|
597 Symbol_Value2 := No_String;
|
|
|
598 end if;
|
|
|
599
|
|
|
600 else
|
|
|
601 Symbol_Value2 := Mapping.Table (Symbol2).Value;
|
|
|
602 end if;
|
|
|
603
|
|
|
604 if Symbol_Value1 /= No_String
|
|
|
605 and then
|
|
|
606 Symbol_Value2 /= No_String
|
|
|
607 then
|
|
|
608 Current_Result :=
|
|
|
609 Matching_Strings (Symbol_Value1, Symbol_Value2);
|
|
|
610 end if;
|
|
|
611 end if;
|
|
|
612
|
|
|
613 elsif Token = Tok_String_Literal then
|
|
|
614
|
|
|
615 -- symbol = "value"
|
|
|
616
|
|
|
617 if Evaluation then
|
|
|
618 Symbol1 := Index_Of (Symbol_Name1);
|
|
|
619
|
|
|
620 if Symbol1 = No_Symbol then
|
|
|
621 if Undefined_Symbols_Are_False then
|
|
|
622 Symbol_Value1 := String_False;
|
|
|
623
|
|
|
624 else
|
|
|
625 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
626 Error_Msg ("unknown symbol %", Symbol_Pos1);
|
|
|
627 Symbol_Value1 := No_String;
|
|
|
628 end if;
|
|
|
629
|
|
|
630 else
|
|
|
631 Symbol_Value1 := Mapping.Table (Symbol1).Value;
|
|
|
632 end if;
|
|
|
633
|
|
|
634 if Symbol_Value1 /= No_String then
|
|
|
635 Current_Result :=
|
|
|
636 Matching_Strings
|
|
|
637 (Symbol_Value1,
|
|
|
638 String_Literal_Id);
|
|
|
639 end if;
|
|
|
640 end if;
|
|
|
641
|
|
|
642 Scan.all;
|
|
|
643
|
|
|
644 else
|
|
|
645 Error_Msg
|
|
|
646 ("literal integer, symbol or literal string expected",
|
|
|
647 Token_Ptr);
|
|
|
648 end if;
|
|
|
649
|
|
|
650 -- Handle True or False
|
|
|
651
|
|
|
652 else
|
|
|
653 if Evaluation then
|
|
|
654 Symbol1 := Index_Of (Symbol_Name1);
|
|
|
655
|
|
|
656 if Symbol1 = No_Symbol then
|
|
|
657 if Undefined_Symbols_Are_False then
|
|
|
658 Symbol_Value1 := String_False;
|
|
|
659
|
|
|
660 else
|
|
|
661 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
662 Error_Msg ("unknown symbol %", Symbol_Pos1);
|
|
|
663 Symbol_Value1 := No_String;
|
|
|
664 end if;
|
|
|
665
|
|
|
666 else
|
|
|
667 Symbol_Value1 := Mapping.Table (Symbol1).Value;
|
|
|
668 end if;
|
|
|
669
|
|
|
670 if Symbol_Value1 /= No_String then
|
|
|
671 String_To_Name_Buffer (Symbol_Value1);
|
|
|
672
|
|
|
673 for Index in 1 .. Name_Len loop
|
|
|
674 Name_Buffer (Index) :=
|
|
|
675 Fold_Lower (Name_Buffer (Index));
|
|
|
676 end loop;
|
|
|
677
|
|
|
678 if Name_Buffer (1 .. Name_Len) = "true" then
|
|
|
679 Current_Result := True;
|
|
|
680
|
|
|
681 elsif Name_Buffer (1 .. Name_Len) = "false" then
|
|
|
682 Current_Result := False;
|
|
|
683
|
|
|
684 else
|
|
|
685 Error_Msg_Name_1 := Symbol_Name1;
|
|
|
686 Error_Msg
|
|
|
687 ("value of symbol % is not True or False",
|
|
|
688 Symbol_Pos1);
|
|
|
689 end if;
|
|
|
690 end if;
|
|
|
691 end if;
|
|
|
692 end if;
|
|
|
693
|
|
|
694 -- Unrecognized sequence
|
|
|
695
|
|
|
696 when others =>
|
|
|
697 Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
|
|
|
698 end case;
|
|
|
699
|
|
|
700 -- Update the cumulative final result
|
|
|
701
|
|
|
702 case Current_Operator is
|
|
|
703 when None =>
|
|
|
704 Final_Result := Current_Result;
|
|
|
705
|
|
|
706 when Op_Or =>
|
|
|
707 Final_Result := Final_Result or Current_Result;
|
|
|
708
|
|
|
709 when Op_And =>
|
|
|
710 Final_Result := Final_Result and Current_Result;
|
|
|
711 end case;
|
|
|
712
|
|
|
713 -- Handle AND
|
|
|
714
|
|
|
715 if Token = Tok_And then
|
|
|
716 if Complemented then
|
|
|
717 Error_Msg
|
|
|
718 ("mixing NOT and AND is not allowed, parentheses are required",
|
|
|
719 Token_Ptr);
|
|
|
720
|
|
|
721 elsif Current_Operator = Op_Or then
|
|
|
722 Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);
|
|
|
723 end if;
|
|
|
724
|
|
|
725 Current_Operator := Op_And;
|
|
|
726 Scan.all;
|
|
|
727
|
|
|
728 if Token = Tok_Then then
|
|
|
729 Scan.all;
|
|
|
730
|
|
|
731 if Final_Result = False then
|
|
|
732 Evaluation := False;
|
|
|
733 end if;
|
|
|
734 end if;
|
|
|
735
|
|
|
736 -- Handle OR
|
|
|
737
|
|
|
738 elsif Token = Tok_Or then
|
|
|
739 if Complemented then
|
|
|
740 Error_Msg
|
|
|
741 ("mixing NOT and OR is not allowed, parentheses are required",
|
|
|
742 Token_Ptr);
|
|
|
743
|
|
|
744 elsif Current_Operator = Op_And then
|
|
|
745 Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);
|
|
|
746 end if;
|
|
|
747
|
|
|
748 Current_Operator := Op_Or;
|
|
|
749 Scan.all;
|
|
|
750
|
|
|
751 if Token = Tok_Else then
|
|
|
752 Scan.all;
|
|
|
753
|
|
|
754 if Final_Result then
|
|
|
755 Evaluation := False;
|
|
|
756 end if;
|
|
|
757 end if;
|
|
|
758
|
|
|
759 -- No AND/OR operator, so exit from the loop through terms
|
|
|
760
|
|
|
761 else
|
|
|
762 exit;
|
|
|
763 end if;
|
|
|
764 end loop;
|
|
|
765
|
|
|
766 return Final_Result;
|
|
|
767 end Expression;
|
|
|
768
|
|
|
769 -----------------------
|
|
|
770 -- Go_To_End_Of_Line --
|
|
|
771 -----------------------
|
|
|
772
|
|
|
773 procedure Go_To_End_Of_Line is
|
|
|
774 begin
|
|
|
775 -- Scan until we get an end of line or we reach the end of the buffer
|
|
|
776
|
|
|
777 while Token /= Tok_End_Of_Line
|
|
|
778 and then Token /= Tok_EOF
|
|
|
779 loop
|
|
|
780 Scan.all;
|
|
|
781 end loop;
|
|
|
782 end Go_To_End_Of_Line;
|
|
|
783
|
|
|
784 --------------
|
|
|
785 -- Index_Of --
|
|
|
786 --------------
|
|
|
787
|
|
|
788 function Index_Of (Symbol : Name_Id) return Symbol_Id is
|
|
|
789 begin
|
|
|
790 if Mapping.Table /= null then
|
|
|
791 for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop
|
|
|
792 if Mapping.Table (J).Symbol = Symbol then
|
|
|
793 return J;
|
|
|
794 end if;
|
|
|
795 end loop;
|
|
|
796 end if;
|
|
|
797
|
|
|
798 return No_Symbol;
|
|
|
799 end Index_Of;
|
|
|
800
|
|
|
801 ----------------
|
|
|
802 -- Initialize --
|
|
|
803 ----------------
|
|
|
804
|
|
|
805 procedure Initialize is
|
|
|
806 begin
|
|
|
807 if not Already_Initialized then
|
|
|
808 Start_String;
|
|
|
809 Store_String_Chars ("True");
|
|
|
810 True_Value.Value := End_String;
|
|
|
811
|
|
|
812 Start_String;
|
|
|
813 Empty_String := End_String;
|
|
|
814
|
|
|
815 Start_String;
|
|
|
816 Store_String_Chars ("False");
|
|
|
817 String_False := End_String;
|
|
|
818
|
|
|
819 Already_Initialized := True;
|
|
|
820 end if;
|
|
|
821 end Initialize;
|
|
|
822
|
|
|
823 ------------------
|
|
|
824 -- List_Symbols --
|
|
|
825 ------------------
|
|
|
826
|
|
|
827 procedure List_Symbols (Foreword : String) is
|
|
|
828 Order : array (0 .. Integer (Symbol_Table.Last (Mapping)))
|
|
|
829 of Symbol_Id;
|
|
|
830 -- After alphabetical sorting, this array stores the indexes of the
|
|
|
831 -- symbols in the order they are displayed.
|
|
|
832
|
|
|
833 function Lt (Op1, Op2 : Natural) return Boolean;
|
|
|
834 -- Comparison routine for sort call
|
|
|
835
|
|
|
836 procedure Move (From : Natural; To : Natural);
|
|
|
837 -- Move routine for sort call
|
|
|
838
|
|
|
839 --------
|
|
|
840 -- Lt --
|
|
|
841 --------
|
|
|
842
|
|
|
843 function Lt (Op1, Op2 : Natural) return Boolean is
|
|
|
844 S1 : constant String :=
|
|
|
845 Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
|
|
|
846 S2 : constant String :=
|
|
|
847 Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
|
|
|
848 begin
|
|
|
849 return S1 < S2;
|
|
|
850 end Lt;
|
|
|
851
|
|
|
852 ----------
|
|
|
853 -- Move --
|
|
|
854 ----------
|
|
|
855
|
|
|
856 procedure Move (From : Natural; To : Natural) is
|
|
|
857 begin
|
|
|
858 Order (To) := Order (From);
|
|
|
859 end Move;
|
|
|
860
|
|
|
861 package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
|
|
|
862
|
|
|
863 Max_L : Natural;
|
|
|
864 -- Maximum length of any symbol
|
|
|
865
|
|
|
866 -- Start of processing for List_Symbols_Case
|
|
|
867
|
|
|
868 begin
|
|
|
869 if Symbol_Table.Last (Mapping) = 0 then
|
|
|
870 return;
|
|
|
871 end if;
|
|
|
872
|
|
|
873 if Foreword'Length > 0 then
|
|
|
874 Write_Eol;
|
|
|
875 Write_Line (Foreword);
|
|
|
876
|
|
|
877 for J in Foreword'Range loop
|
|
|
878 Write_Char ('=');
|
|
|
879 end loop;
|
|
|
880 end if;
|
|
|
881
|
|
|
882 -- Initialize the order
|
|
|
883
|
|
|
884 for J in Order'Range loop
|
|
|
885 Order (J) := Symbol_Id (J);
|
|
|
886 end loop;
|
|
|
887
|
|
|
888 -- Sort alphabetically
|
|
|
889
|
|
|
890 Sort_Syms.Sort (Order'Last);
|
|
|
891
|
|
|
892 Max_L := 7;
|
|
|
893
|
|
|
894 for J in 1 .. Symbol_Table.Last (Mapping) loop
|
|
|
895 Get_Name_String (Mapping.Table (J).Original);
|
|
|
896 Max_L := Integer'Max (Max_L, Name_Len);
|
|
|
897 end loop;
|
|
|
898
|
|
|
899 Write_Eol;
|
|
|
900 Write_Str ("Symbol");
|
|
|
901
|
|
|
902 for J in 1 .. Max_L - 5 loop
|
|
|
903 Write_Char (' ');
|
|
|
904 end loop;
|
|
|
905
|
|
|
906 Write_Line ("Value");
|
|
|
907
|
|
|
908 Write_Str ("------");
|
|
|
909
|
|
|
910 for J in 1 .. Max_L - 5 loop
|
|
|
911 Write_Char (' ');
|
|
|
912 end loop;
|
|
|
913
|
|
|
914 Write_Line ("------");
|
|
|
915
|
|
|
916 for J in 1 .. Order'Last loop
|
|
|
917 declare
|
|
|
918 Data : constant Symbol_Data := Mapping.Table (Order (J));
|
|
|
919
|
|
|
920 begin
|
|
|
921 Get_Name_String (Data.Original);
|
|
|
922 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
923
|
|
|
924 for K in Name_Len .. Max_L loop
|
|
|
925 Write_Char (' ');
|
|
|
926 end loop;
|
|
|
927
|
|
|
928 String_To_Name_Buffer (Data.Value);
|
|
|
929
|
|
|
930 if Data.Is_A_String then
|
|
|
931 Write_Char ('"');
|
|
|
932
|
|
|
933 for J in 1 .. Name_Len loop
|
|
|
934 Write_Char (Name_Buffer (J));
|
|
|
935
|
|
|
936 if Name_Buffer (J) = '"' then
|
|
|
937 Write_Char ('"');
|
|
|
938 end if;
|
|
|
939 end loop;
|
|
|
940
|
|
|
941 Write_Char ('"');
|
|
|
942
|
|
|
943 else
|
|
|
944 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
945 end if;
|
|
|
946 end;
|
|
|
947
|
|
|
948 Write_Eol;
|
|
|
949 end loop;
|
|
|
950
|
|
|
951 Write_Eol;
|
|
|
952 end List_Symbols;
|
|
|
953
|
|
|
954 ----------------------
|
|
|
955 -- Matching_Strings --
|
|
|
956 ----------------------
|
|
|
957
|
|
|
958 function Matching_Strings (S1, S2 : String_Id) return Boolean is
|
|
|
959 begin
|
|
|
960 String_To_Name_Buffer (S1);
|
|
|
961
|
|
|
962 for Index in 1 .. Name_Len loop
|
|
|
963 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
|
|
|
964 end loop;
|
|
|
965
|
|
|
966 declare
|
|
|
967 String1 : constant String := Name_Buffer (1 .. Name_Len);
|
|
|
968
|
|
|
969 begin
|
|
|
970 String_To_Name_Buffer (S2);
|
|
|
971
|
|
|
972 for Index in 1 .. Name_Len loop
|
|
|
973 Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
|
|
|
974 end loop;
|
|
|
975
|
|
|
976 return String1 = Name_Buffer (1 .. Name_Len);
|
|
|
977 end;
|
|
|
978 end Matching_Strings;
|
|
|
979
|
|
|
980 --------------------
|
|
|
981 -- Parse_Def_File --
|
|
|
982 --------------------
|
|
|
983
|
|
|
984 -- This procedure REALLY needs some more comments ???
|
|
|
985
|
|
|
986 procedure Parse_Def_File is
|
|
|
987 Symbol : Symbol_Id;
|
|
|
988 Symbol_Name : Name_Id;
|
|
|
989 Original_Name : Name_Id;
|
|
|
990 Data : Symbol_Data;
|
|
|
991 Value_Start : Source_Ptr;
|
|
|
992 Value_End : Source_Ptr;
|
|
|
993 Ch : Character;
|
|
|
994
|
|
|
995 use ASCII;
|
|
|
996
|
|
|
997 begin
|
|
|
998 Def_Line_Loop :
|
|
|
999 loop
|
|
|
1000 Scan.all;
|
|
|
1001
|
|
|
1002 exit Def_Line_Loop when Token = Tok_EOF;
|
|
|
1003
|
|
|
1004 if Token /= Tok_End_Of_Line then
|
|
|
1005 Change_Reserved_Keyword_To_Symbol;
|
|
|
1006
|
|
|
1007 if Token /= Tok_Identifier then
|
|
|
1008 Error_Msg ("identifier expected", Token_Ptr);
|
|
|
1009 goto Cleanup;
|
|
|
1010 end if;
|
|
|
1011
|
|
|
1012 Symbol_Name := Token_Name;
|
|
|
1013 Name_Len := 0;
|
|
|
1014
|
|
|
1015 for Ptr in Token_Ptr .. Scan_Ptr - 1 loop
|
|
|
1016 Name_Len := Name_Len + 1;
|
|
|
1017 Name_Buffer (Name_Len) := Sinput.Source (Ptr);
|
|
|
1018 end loop;
|
|
|
1019
|
|
|
1020 Original_Name := Name_Find;
|
|
|
1021 Scan.all;
|
|
|
1022
|
|
|
1023 if Token /= Tok_Colon_Equal then
|
|
|
1024 Error_Msg -- CODEFIX
|
|
|
1025 ("`:=` expected", Token_Ptr);
|
|
|
1026 goto Cleanup;
|
|
|
1027 end if;
|
|
|
1028
|
|
|
1029 Scan.all;
|
|
|
1030
|
|
|
1031 if Token = Tok_Integer_Literal then
|
|
|
1032 declare
|
|
|
1033 Ptr : Source_Ptr := Token_Ptr;
|
|
|
1034
|
|
|
1035 begin
|
|
|
1036 Start_String;
|
|
|
1037 while Ptr < Scan_Ptr loop
|
|
|
1038 Store_String_Char (Sinput.Source (Ptr));
|
|
|
1039 Ptr := Ptr + 1;
|
|
|
1040 end loop;
|
|
|
1041
|
|
|
1042 Data := (Symbol => Symbol_Name,
|
|
|
1043 Original => Original_Name,
|
|
|
1044 On_The_Command_Line => False,
|
|
|
1045 Is_A_String => False,
|
|
|
1046 Value => End_String);
|
|
|
1047 end;
|
|
|
1048
|
|
|
1049 Scan.all;
|
|
|
1050
|
|
|
1051 if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
|
|
|
1052 Error_Msg ("extraneous text in definition", Token_Ptr);
|
|
|
1053 goto Cleanup;
|
|
|
1054 end if;
|
|
|
1055
|
|
|
1056 elsif Token = Tok_String_Literal then
|
|
|
1057 Data := (Symbol => Symbol_Name,
|
|
|
1058 Original => Original_Name,
|
|
|
1059 On_The_Command_Line => False,
|
|
|
1060 Is_A_String => True,
|
|
|
1061 Value => String_Literal_Id);
|
|
|
1062
|
|
|
1063 Scan.all;
|
|
|
1064
|
|
|
1065 if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
|
|
|
1066 Error_Msg ("extraneous text in definition", Token_Ptr);
|
|
|
1067 goto Cleanup;
|
|
|
1068 end if;
|
|
|
1069
|
|
|
1070 elsif Token = Tok_End_Of_Line or else Token = Tok_EOF then
|
|
|
1071 Data := (Symbol => Symbol_Name,
|
|
|
1072 Original => Original_Name,
|
|
|
1073 On_The_Command_Line => False,
|
|
|
1074 Is_A_String => False,
|
|
|
1075 Value => Empty_String);
|
|
|
1076
|
|
|
1077 else
|
|
|
1078 Value_Start := Token_Ptr;
|
|
|
1079 Value_End := Token_Ptr - 1;
|
|
|
1080 Scan_Ptr := Token_Ptr;
|
|
|
1081
|
|
|
1082 Value_Chars_Loop :
|
|
|
1083 loop
|
|
|
1084 Ch := Sinput.Source (Scan_Ptr);
|
|
|
1085
|
|
|
1086 case Ch is
|
|
|
1087 when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
|
|
|
1088 Value_End := Scan_Ptr;
|
|
|
1089 Scan_Ptr := Scan_Ptr + 1;
|
|
|
1090
|
|
|
1091 when ' ' | HT | VT | CR | LF | FF =>
|
|
|
1092 exit Value_Chars_Loop;
|
|
|
1093
|
|
|
1094 when others =>
|
|
|
1095 Error_Msg ("illegal character", Scan_Ptr);
|
|
|
1096 goto Cleanup;
|
|
|
1097 end case;
|
|
|
1098 end loop Value_Chars_Loop;
|
|
|
1099
|
|
|
1100 Scan.all;
|
|
|
1101
|
|
|
1102 if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
|
|
|
1103 Error_Msg ("extraneous text in definition", Token_Ptr);
|
|
|
1104 goto Cleanup;
|
|
|
1105 end if;
|
|
|
1106
|
|
|
1107 Start_String;
|
|
|
1108
|
|
|
1109 while Value_Start <= Value_End loop
|
|
|
1110 Store_String_Char (Sinput.Source (Value_Start));
|
|
|
1111 Value_Start := Value_Start + 1;
|
|
|
1112 end loop;
|
|
|
1113
|
|
|
1114 Data := (Symbol => Symbol_Name,
|
|
|
1115 Original => Original_Name,
|
|
|
1116 On_The_Command_Line => False,
|
|
|
1117 Is_A_String => False,
|
|
|
1118 Value => End_String);
|
|
|
1119 end if;
|
|
|
1120
|
|
|
1121 -- Now that we have the value, get the symbol index
|
|
|
1122
|
|
|
1123 Symbol := Index_Of (Symbol_Name);
|
|
|
1124
|
|
|
1125 if Symbol /= No_Symbol then
|
|
|
1126
|
|
|
1127 -- If we already have an entry for this symbol, replace it
|
|
|
1128 -- with the new value, except if the symbol was declared on
|
|
|
1129 -- the command line.
|
|
|
1130
|
|
|
1131 if Mapping.Table (Symbol).On_The_Command_Line then
|
|
|
1132 goto Continue;
|
|
|
1133 end if;
|
|
|
1134
|
|
|
1135 else
|
|
|
1136 -- As it is the first time we see this symbol, create a new
|
|
|
1137 -- entry in the table.
|
|
|
1138
|
|
|
1139 if Mapping.Table = null then
|
|
|
1140 Symbol_Table.Init (Mapping);
|
|
|
1141 end if;
|
|
|
1142
|
|
|
1143 Symbol_Table.Increment_Last (Mapping);
|
|
|
1144 Symbol := Symbol_Table.Last (Mapping);
|
|
|
1145 end if;
|
|
|
1146
|
|
|
1147 Mapping.Table (Symbol) := Data;
|
|
|
1148 goto Continue;
|
|
|
1149
|
|
|
1150 <<Cleanup>>
|
|
|
1151 Set_Ignore_Errors (To => True);
|
|
|
1152
|
|
|
1153 while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
|
|
|
1154 Scan.all;
|
|
|
1155 end loop;
|
|
|
1156
|
|
|
1157 Set_Ignore_Errors (To => False);
|
|
|
1158
|
|
|
1159 <<Continue>>
|
|
|
1160 null;
|
|
|
1161 end if;
|
|
|
1162 end loop Def_Line_Loop;
|
|
|
1163 end Parse_Def_File;
|
|
|
1164
|
|
|
1165 ----------------
|
|
|
1166 -- Preprocess --
|
|
|
1167 ----------------
|
|
|
1168
|
|
|
1169 procedure Preprocess (Source_Modified : out Boolean) is
|
|
|
1170 Start_Of_Processing : Source_Ptr;
|
|
|
1171 Cond : Boolean;
|
|
|
1172 Preprocessor_Line : Boolean := False;
|
|
|
1173 No_Error_Found : Boolean := True;
|
|
|
1174 Modified : Boolean := False;
|
|
|
1175
|
|
|
1176 procedure Output (From, To : Source_Ptr);
|
|
|
1177 -- Output the characters with indexes From .. To in the buffer to the
|
|
|
1178 -- output file.
|
|
|
1179
|
|
|
1180 procedure Output_Line (From, To : Source_Ptr);
|
|
|
1181 -- Output a line or the end of a line from the buffer to the output
|
|
|
1182 -- file, followed by an end of line terminator. Depending on the value
|
|
|
1183 -- of Deleting and the switches, the line may be commented out, blank or
|
|
|
1184 -- not output at all.
|
|
|
1185
|
|
|
1186 ------------
|
|
|
1187 -- Output --
|
|
|
1188 ------------
|
|
|
1189
|
|
|
1190 procedure Output (From, To : Source_Ptr) is
|
|
|
1191 begin
|
|
|
1192 for J in From .. To loop
|
|
|
1193 Put_Char (Sinput.Source (J));
|
|
|
1194 end loop;
|
|
|
1195 end Output;
|
|
|
1196
|
|
|
1197 -----------------
|
|
|
1198 -- Output_Line --
|
|
|
1199 -----------------
|
|
|
1200
|
|
|
1201 procedure Output_Line (From, To : Source_Ptr) is
|
|
|
1202 begin
|
|
|
1203 if Deleting or else Preprocessor_Line then
|
|
|
1204 if Blank_Deleted_Lines then
|
|
|
1205 New_EOL.all;
|
|
|
1206
|
|
|
1207 elsif Comment_Deleted_Lines then
|
|
|
1208 Put_Char ('-');
|
|
|
1209 Put_Char ('-');
|
|
|
1210 Put_Char ('!');
|
|
|
1211
|
|
|
1212 if From < To then
|
|
|
1213 Put_Char (' ');
|
|
|
1214 Output (From, To);
|
|
|
1215 end if;
|
|
|
1216
|
|
|
1217 New_EOL.all;
|
|
|
1218 end if;
|
|
|
1219
|
|
|
1220 else
|
|
|
1221 Output (From, To);
|
|
|
1222 New_EOL.all;
|
|
|
1223 end if;
|
|
|
1224 end Output_Line;
|
|
|
1225
|
|
|
1226 -- Start of processing for Preprocess
|
|
|
1227
|
|
|
1228 begin
|
|
|
1229 Start_Of_Processing := Scan_Ptr;
|
|
|
1230
|
|
|
1231 -- First a call to Scan, because Initialize_Scanner is not doing it
|
|
|
1232
|
|
|
1233 Scan.all;
|
|
|
1234
|
|
|
1235 Input_Line_Loop : loop
|
|
|
1236 exit Input_Line_Loop when Token = Tok_EOF;
|
|
|
1237
|
|
|
1238 Preprocessor_Line := False;
|
|
|
1239
|
|
|
1240 if Token /= Tok_End_Of_Line then
|
|
|
1241
|
|
|
1242 -- Preprocessor line
|
|
|
1243
|
|
|
1244 if Token = Tok_Special and then Special_Character = '#' then
|
|
|
1245 Modified := True;
|
|
|
1246 Preprocessor_Line := True;
|
|
|
1247 Scan.all;
|
|
|
1248
|
|
|
1249 case Token is
|
|
|
1250
|
|
|
1251 -- #if
|
|
|
1252
|
|
|
1253 when Tok_If =>
|
|
|
1254 declare
|
|
|
1255 If_Ptr : constant Source_Ptr := Token_Ptr;
|
|
|
1256
|
|
|
1257 begin
|
|
|
1258 Scan.all;
|
|
|
1259 Cond := Expression (not Deleting);
|
|
|
1260
|
|
|
1261 -- Check for an eventual "then"
|
|
|
1262
|
|
|
1263 if Token = Tok_Then then
|
|
|
1264 Scan.all;
|
|
|
1265 end if;
|
|
|
1266
|
|
|
1267 -- It is an error to have trailing characters after
|
|
|
1268 -- the condition or "then".
|
|
|
1269
|
|
|
1270 if Token /= Tok_End_Of_Line
|
|
|
1271 and then Token /= Tok_EOF
|
|
|
1272 then
|
|
|
1273 Error_Msg
|
|
|
1274 ("extraneous text on preprocessor line",
|
|
|
1275 Token_Ptr);
|
|
|
1276 No_Error_Found := False;
|
|
|
1277 Go_To_End_Of_Line;
|
|
|
1278 end if;
|
|
|
1279
|
|
|
1280 declare
|
|
|
1281 -- Set the initial state of this new "#if". This
|
|
|
1282 -- must be done before incrementing the Last of
|
|
|
1283 -- the table, otherwise function Deleting does
|
|
|
1284 -- not report the correct value.
|
|
|
1285
|
|
|
1286 New_State : constant Pp_State :=
|
|
|
1287 (If_Ptr => If_Ptr,
|
|
|
1288 Else_Ptr => 0,
|
|
|
1289 Deleting => Deleting
|
|
|
1290 or else not Cond,
|
|
|
1291 Match_Seen => Deleting or else Cond);
|
|
|
1292
|
|
|
1293 begin
|
|
|
1294 Pp_States.Increment_Last;
|
|
|
1295 Pp_States.Table (Pp_States.Last) := New_State;
|
|
|
1296 end;
|
|
|
1297 end;
|
|
|
1298
|
|
|
1299 -- #elsif
|
|
|
1300
|
|
|
1301 when Tok_Elsif =>
|
|
|
1302 Cond := False;
|
|
|
1303
|
|
|
1304 if Pp_States.Last = 0
|
|
|
1305 or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
|
|
|
1306 then
|
|
|
1307 Error_Msg ("no IF for this ELSIF", Token_Ptr);
|
|
|
1308 No_Error_Found := False;
|
|
|
1309
|
|
|
1310 else
|
|
|
1311 Cond :=
|
|
|
1312 not Pp_States.Table (Pp_States.Last).Match_Seen;
|
|
|
1313 end if;
|
|
|
1314
|
|
|
1315 Scan.all;
|
|
|
1316 Cond := Expression (Cond);
|
|
|
1317
|
|
|
1318 -- Check for an eventual "then"
|
|
|
1319
|
|
|
1320 if Token = Tok_Then then
|
|
|
1321 Scan.all;
|
|
|
1322 end if;
|
|
|
1323
|
|
|
1324 -- It is an error to have trailing characters after the
|
|
|
1325 -- condition or "then".
|
|
|
1326
|
|
|
1327 if Token /= Tok_End_Of_Line
|
|
|
1328 and then Token /= Tok_EOF
|
|
|
1329 then
|
|
|
1330 Error_Msg
|
|
|
1331 ("extraneous text on preprocessor line",
|
|
|
1332 Token_Ptr);
|
|
|
1333 No_Error_Found := False;
|
|
|
1334
|
|
|
1335 Go_To_End_Of_Line;
|
|
|
1336 end if;
|
|
|
1337
|
|
|
1338 -- Depending on the value of the condition, set the new
|
|
|
1339 -- values of Deleting and Match_Seen.
|
|
|
1340
|
|
|
1341 if Pp_States.Last > 0 then
|
|
|
1342 if Pp_States.Table (Pp_States.Last).Match_Seen then
|
|
|
1343 Pp_States.Table (Pp_States.Last).Deleting := True;
|
|
|
1344 else
|
|
|
1345 if Cond then
|
|
|
1346 Pp_States.Table (Pp_States.Last).Match_Seen :=
|
|
|
1347 True;
|
|
|
1348 Pp_States.Table (Pp_States.Last).Deleting :=
|
|
|
1349 False;
|
|
|
1350 end if;
|
|
|
1351 end if;
|
|
|
1352 end if;
|
|
|
1353
|
|
|
1354 -- #else
|
|
|
1355
|
|
|
1356 when Tok_Else =>
|
|
|
1357 if Pp_States.Last = 0 then
|
|
|
1358 Error_Msg ("no IF for this ELSE", Token_Ptr);
|
|
|
1359 No_Error_Found := False;
|
|
|
1360
|
|
|
1361 elsif
|
|
|
1362 Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
|
|
|
1363 then
|
|
|
1364 Error_Msg -- CODEFIX
|
|
|
1365 ("duplicate ELSE line", Token_Ptr);
|
|
|
1366 No_Error_Found := False;
|
|
|
1367 end if;
|
|
|
1368
|
|
|
1369 -- Set the possibly new values of Deleting and Match_Seen
|
|
|
1370
|
|
|
1371 if Pp_States.Last > 0 then
|
|
|
1372 if Pp_States.Table (Pp_States.Last).Match_Seen then
|
|
|
1373 Pp_States.Table (Pp_States.Last).Deleting :=
|
|
|
1374 True;
|
|
|
1375
|
|
|
1376 else
|
|
|
1377 Pp_States.Table (Pp_States.Last).Match_Seen :=
|
|
|
1378 True;
|
|
|
1379 Pp_States.Table (Pp_States.Last).Deleting :=
|
|
|
1380 False;
|
|
|
1381 end if;
|
|
|
1382
|
|
|
1383 -- Set the Else_Ptr to check for illegal #elsif later
|
|
|
1384
|
|
|
1385 Pp_States.Table (Pp_States.Last).Else_Ptr :=
|
|
|
1386 Token_Ptr;
|
|
|
1387 end if;
|
|
|
1388
|
|
|
1389 Scan.all;
|
|
|
1390
|
|
|
1391 -- Error of character present after "#else"
|
|
|
1392
|
|
|
1393 if Token /= Tok_End_Of_Line
|
|
|
1394 and then Token /= Tok_EOF
|
|
|
1395 then
|
|
|
1396 Error_Msg
|
|
|
1397 ("extraneous text on preprocessor line",
|
|
|
1398 Token_Ptr);
|
|
|
1399 No_Error_Found := False;
|
|
|
1400 Go_To_End_Of_Line;
|
|
|
1401 end if;
|
|
|
1402
|
|
|
1403 -- #end if;
|
|
|
1404
|
|
|
1405 when Tok_End =>
|
|
|
1406 if Pp_States.Last = 0 then
|
|
|
1407 Error_Msg ("no IF for this END", Token_Ptr);
|
|
|
1408 No_Error_Found := False;
|
|
|
1409 end if;
|
|
|
1410
|
|
|
1411 Scan.all;
|
|
|
1412
|
|
|
1413 if Token /= Tok_If then
|
|
|
1414 Error_Msg -- CODEFIX
|
|
|
1415 ("IF expected", Token_Ptr);
|
|
|
1416 No_Error_Found := False;
|
|
|
1417
|
|
|
1418 else
|
|
|
1419 Scan.all;
|
|
|
1420
|
|
|
1421 if Token /= Tok_Semicolon then
|
|
|
1422 Error_Msg -- CODEFIX
|
|
|
1423 ("`;` Expected", Token_Ptr);
|
|
|
1424 No_Error_Found := False;
|
|
|
1425
|
|
|
1426 else
|
|
|
1427 Scan.all;
|
|
|
1428
|
|
|
1429 -- Error of character present after "#end if;"
|
|
|
1430
|
|
|
1431 if Token /= Tok_End_Of_Line
|
|
|
1432 and then Token /= Tok_EOF
|
|
|
1433 then
|
|
|
1434 Error_Msg
|
|
|
1435 ("extraneous text on preprocessor line",
|
|
|
1436 Token_Ptr);
|
|
|
1437 No_Error_Found := False;
|
|
|
1438 end if;
|
|
|
1439 end if;
|
|
|
1440 end if;
|
|
|
1441
|
|
|
1442 -- In case of one of the errors above, skip the tokens
|
|
|
1443 -- until the end of line is reached.
|
|
|
1444
|
|
|
1445 Go_To_End_Of_Line;
|
|
|
1446
|
|
|
1447 -- Decrement the depth of the #if stack
|
|
|
1448
|
|
|
1449 if Pp_States.Last > 0 then
|
|
|
1450 Pp_States.Decrement_Last;
|
|
|
1451 end if;
|
|
|
1452
|
|
|
1453 -- Illegal preprocessor line
|
|
|
1454
|
|
|
1455 when others =>
|
|
|
1456 No_Error_Found := False;
|
|
|
1457
|
|
|
1458 if Pp_States.Last = 0 then
|
|
|
1459 Error_Msg -- CODEFIX
|
|
|
1460 ("IF expected", Token_Ptr);
|
|
|
1461
|
|
|
1462 elsif
|
|
|
1463 Pp_States.Table (Pp_States.Last).Else_Ptr = 0
|
|
|
1464 then
|
|
|
1465 Error_Msg
|
|
|
1466 ("IF, ELSIF, ELSE, or `END IF` expected",
|
|
|
1467 Token_Ptr);
|
|
|
1468
|
|
|
1469 else
|
|
|
1470 Error_Msg ("IF or `END IF` expected", Token_Ptr);
|
|
|
1471 end if;
|
|
|
1472
|
|
|
1473 -- Skip to the end of this illegal line
|
|
|
1474
|
|
|
1475 Go_To_End_Of_Line;
|
|
|
1476 end case;
|
|
|
1477
|
|
|
1478 -- Not a preprocessor line
|
|
|
1479
|
|
|
1480 else
|
|
|
1481 -- Do not report errors for those lines, even if there are
|
|
|
1482 -- Ada parsing errors.
|
|
|
1483
|
|
|
1484 Set_Ignore_Errors (To => True);
|
|
|
1485
|
|
|
1486 if Deleting then
|
|
|
1487 Go_To_End_Of_Line;
|
|
|
1488
|
|
|
1489 else
|
|
|
1490 while Token /= Tok_End_Of_Line
|
|
|
1491 and then Token /= Tok_EOF
|
|
|
1492 loop
|
|
|
1493 if Token = Tok_Special
|
|
|
1494 and then Special_Character = '$'
|
|
|
1495 then
|
|
|
1496 Modified := True;
|
|
|
1497
|
|
|
1498 declare
|
|
|
1499 Dollar_Ptr : constant Source_Ptr := Token_Ptr;
|
|
|
1500 Symbol : Symbol_Id;
|
|
|
1501
|
|
|
1502 begin
|
|
|
1503 Scan.all;
|
|
|
1504 Change_Reserved_Keyword_To_Symbol;
|
|
|
1505
|
|
|
1506 if Token = Tok_Identifier
|
|
|
1507 and then Token_Ptr = Dollar_Ptr + 1
|
|
|
1508 then
|
|
|
1509 -- $symbol
|
|
|
1510
|
|
|
1511 Symbol := Index_Of (Token_Name);
|
|
|
1512
|
|
|
1513 -- If symbol exists, replace by its value
|
|
|
1514
|
|
|
1515 if Symbol /= No_Symbol then
|
|
|
1516 Output (Start_Of_Processing, Dollar_Ptr - 1);
|
|
|
1517 Start_Of_Processing := Scan_Ptr;
|
|
|
1518 String_To_Name_Buffer
|
|
|
1519 (Mapping.Table (Symbol).Value);
|
|
|
1520
|
|
|
1521 if Mapping.Table (Symbol).Is_A_String then
|
|
|
1522
|
|
|
1523 -- Value is an Ada string
|
|
|
1524
|
|
|
1525 Put_Char ('"');
|
|
|
1526
|
|
|
1527 for J in 1 .. Name_Len loop
|
|
|
1528 Put_Char (Name_Buffer (J));
|
|
|
1529
|
|
|
1530 if Name_Buffer (J) = '"' then
|
|
|
1531 Put_Char ('"');
|
|
|
1532 end if;
|
|
|
1533 end loop;
|
|
|
1534
|
|
|
1535 Put_Char ('"');
|
|
|
1536
|
|
|
1537 else
|
|
|
1538 -- Value is a sequence of characters, not
|
|
|
1539 -- an Ada string.
|
|
|
1540
|
|
|
1541 for J in 1 .. Name_Len loop
|
|
|
1542 Put_Char (Name_Buffer (J));
|
|
|
1543 end loop;
|
|
|
1544 end if;
|
|
|
1545 end if;
|
|
|
1546 end if;
|
|
|
1547 end;
|
|
|
1548 end if;
|
|
|
1549
|
|
|
1550 Scan.all;
|
|
|
1551 end loop;
|
|
|
1552 end if;
|
|
|
1553
|
|
|
1554 Set_Ignore_Errors (To => False);
|
|
|
1555 end if;
|
|
|
1556 end if;
|
|
|
1557
|
|
|
1558 pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF);
|
|
|
1559
|
|
|
1560 -- At this point, the token is either end of line or EOF. The line to
|
|
|
1561 -- possibly output stops just before the token.
|
|
|
1562
|
|
|
1563 Output_Line (Start_Of_Processing, Token_Ptr - 1);
|
|
|
1564
|
|
|
1565 -- If we are at the end of a line, the scan pointer is at the first
|
|
|
1566 -- non-blank character (may not be the first character of the line),
|
|
|
1567 -- so we have to deduct Start_Of_Processing from the token pointer.
|
|
|
1568
|
|
|
1569 if Token = Tok_End_Of_Line then
|
|
|
1570 if Sinput.Source (Token_Ptr) = ASCII.CR
|
|
|
1571 and then Sinput.Source (Token_Ptr + 1) = ASCII.LF
|
|
|
1572 then
|
|
|
1573 Start_Of_Processing := Token_Ptr + 2;
|
|
|
1574 else
|
|
|
1575 Start_Of_Processing := Token_Ptr + 1;
|
|
|
1576 end if;
|
|
|
1577 end if;
|
|
|
1578
|
|
|
1579 -- Now, scan the first token of the next line. If the token is EOF,
|
|
|
1580 -- the scan pointer will not move, and the token will still be EOF.
|
|
|
1581
|
|
|
1582 Set_Ignore_Errors (To => True);
|
|
|
1583 Scan.all;
|
|
|
1584 Set_Ignore_Errors (To => False);
|
|
|
1585 end loop Input_Line_Loop;
|
|
|
1586
|
|
|
1587 -- Report an error for any missing some "#end if;"
|
|
|
1588
|
|
|
1589 for Level in reverse 1 .. Pp_States.Last loop
|
|
|
1590 Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr);
|
|
|
1591 No_Error_Found := False;
|
|
|
1592 end loop;
|
|
|
1593
|
|
|
1594 Source_Modified := No_Error_Found and Modified;
|
|
|
1595 end Preprocess;
|
|
|
1596
|
|
|
1597 -----------------
|
|
|
1598 -- Setup_Hooks --
|
|
|
1599 -----------------
|
|
|
1600
|
|
|
1601 procedure Setup_Hooks
|
|
|
1602 (Error_Msg : Error_Msg_Proc;
|
|
|
1603 Scan : Scan_Proc;
|
|
|
1604 Set_Ignore_Errors : Set_Ignore_Errors_Proc;
|
|
|
1605 Put_Char : Put_Char_Proc;
|
|
|
1606 New_EOL : New_EOL_Proc)
|
|
|
1607 is
|
|
|
1608 begin
|
|
|
1609 pragma Assert (Already_Initialized);
|
|
|
1610
|
|
|
1611 Prep.Error_Msg := Error_Msg;
|
|
|
1612 Prep.Scan := Scan;
|
|
|
1613 Prep.Set_Ignore_Errors := Set_Ignore_Errors;
|
|
|
1614 Prep.Put_Char := Put_Char;
|
|
|
1615 Prep.New_EOL := New_EOL;
|
|
|
1616 end Setup_Hooks;
|
|
|
1617
|
|
|
1618 end Prep;
|
