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