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