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