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