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