1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- X R E F _ L I B -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1998-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 Osint; 27with Output; use Output; 28with Types; use Types; 29 30with Unchecked_Deallocation; 31 32with Ada.Strings.Fixed; use Ada.Strings.Fixed; 33with Ada.Text_IO; use Ada.Text_IO; 34 35with GNAT.Command_Line; use GNAT.Command_Line; 36with GNAT.IO_Aux; use GNAT.IO_Aux; 37 38package body Xref_Lib is 39 40 Type_Position : constant := 50; 41 -- Column for label identifying type of entity 42 43 --------------------- 44 -- Local Variables -- 45 --------------------- 46 47 Pipe : constant Character := '|'; 48 -- First character on xref lines in the .ali file 49 50 No_Xref_Information : exception; 51 -- Exception raised when there is no cross-referencing information in 52 -- the .ali files. 53 54 procedure Parse_EOL 55 (Source : not null access String; 56 Ptr : in out Positive; 57 Skip_Continuation_Line : Boolean := False); 58 -- On return Source (Ptr) is the first character of the next line 59 -- or EOF. Source.all must be terminated by EOF. 60 -- 61 -- If Skip_Continuation_Line is True, this subprogram skips as many 62 -- lines as required when the second or more lines starts with '.' 63 -- (continuation lines in ALI files). 64 65 function Current_Xref_File (File : ALI_File) return File_Reference; 66 -- Return the file matching the last 'X' line we found while parsing 67 -- the ALI file. 68 69 function File_Name (File : ALI_File; Num : Positive) return File_Reference; 70 -- Returns the dependency file name number Num 71 72 function Get_Full_Type (Decl : Declaration_Reference) return String; 73 -- Returns the full type corresponding to a type letter as found in 74 -- the .ali files. 75 76 procedure Open 77 (Name : String; 78 File : out ALI_File; 79 Dependencies : Boolean := False); 80 -- Open a new ALI file. If Dependencies is True, the insert every library 81 -- file 'with'ed in the files database (used for gnatxref) 82 83 procedure Parse_Identifier_Info 84 (Pattern : Search_Pattern; 85 File : in out ALI_File; 86 Local_Symbols : Boolean; 87 Der_Info : Boolean := False; 88 Type_Tree : Boolean := False; 89 Wide_Search : Boolean := True; 90 Labels_As_Ref : Boolean := True); 91 -- Output the file and the line where the identifier was referenced, 92 -- If Local_Symbols is False then only the publicly visible symbols 93 -- will be processed. 94 -- 95 -- If Labels_As_Ref is true, then the references to the entities after 96 -- the end statements ("end Foo") will be counted as actual references. 97 -- The entity will never be reported as unreferenced by gnatxref -u 98 99 procedure Parse_Token 100 (Source : not null access String; 101 Ptr : in out Positive; 102 Token_Ptr : out Positive); 103 -- Skips any separators and stores the start of the token in Token_Ptr. 104 -- Then stores the position of the next separator in Ptr. On return 105 -- Source (Token_Ptr .. Ptr - 1) is the token. Separators are space 106 -- and ASCII.HT. Parse_Token will never skip to the next line. 107 108 procedure Parse_Number 109 (Source : not null access String; 110 Ptr : in out Positive; 111 Number : out Natural); 112 -- Skips any separators and parses Source up to the first character that 113 -- is not a decimal digit. Returns value of parsed digits or 0 if none. 114 115 procedure Parse_X_Filename (File : in out ALI_File); 116 -- Reads and processes "X..." lines in the ALI file 117 -- and updates the File.X_File information. 118 119 procedure Skip_To_First_X_Line 120 (File : in out ALI_File; 121 D_Lines : Boolean; 122 W_Lines : Boolean); 123 -- Skip the lines in the ALI file until the first cross-reference line 124 -- (^X...) is found. Search is started from the beginning of the file. 125 -- If not such line is found, No_Xref_Information is raised. 126 -- If W_Lines is false, then the lines "^W" are not parsed. 127 -- If D_Lines is false, then the lines "^D" are not parsed. 128 129 ---------------- 130 -- Add_Entity -- 131 ---------------- 132 133 procedure Add_Entity 134 (Pattern : in out Search_Pattern; 135 Entity : String; 136 Glob : Boolean := False) 137 is 138 File_Start : Natural; 139 Line_Start : Natural; 140 Col_Start : Natural; 141 Line_Num : Natural := 0; 142 Col_Num : Natural := 0; 143 144 File_Ref : File_Reference := Empty_File; 145 pragma Warnings (Off, File_Ref); 146 147 begin 148 -- Find the end of the first item in Entity (pattern or file?) 149 -- If there is no ':', we only have a pattern 150 151 File_Start := Index (Entity, ":"); 152 153 -- If the regular expression is invalid, just consider it as a string 154 155 if File_Start = 0 then 156 begin 157 Pattern.Entity := Compile (Entity, Glob, False); 158 Pattern.Initialized := True; 159 160 exception 161 when Error_In_Regexp => 162 163 -- The basic idea is to insert a \ before every character 164 165 declare 166 Tmp_Regexp : String (1 .. 2 * Entity'Length); 167 Index : Positive := 1; 168 169 begin 170 for J in Entity'Range loop 171 Tmp_Regexp (Index) := '\'; 172 Tmp_Regexp (Index + 1) := Entity (J); 173 Index := Index + 2; 174 end loop; 175 176 Pattern.Entity := Compile (Tmp_Regexp, True, False); 177 Pattern.Initialized := True; 178 end; 179 end; 180 181 Set_Default_Match (True); 182 return; 183 end if; 184 185 -- If there is a dot in the pattern, then it is a file name 186 187 if (Glob and then 188 Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) 189 or else 190 (not Glob 191 and then Index (Entity (Entity'First .. File_Start - 1), 192 "\.") /= 0) 193 then 194 Pattern.Entity := Compile (".*", False); 195 Pattern.Initialized := True; 196 File_Start := Entity'First; 197 198 else 199 -- If the regular expression is invalid, just consider it as a string 200 201 begin 202 Pattern.Entity := 203 Compile (Entity (Entity'First .. File_Start - 1), Glob, False); 204 Pattern.Initialized := True; 205 206 exception 207 when Error_In_Regexp => 208 209 -- The basic idea is to insert a \ before every character 210 211 declare 212 Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First)); 213 Index : Positive := 1; 214 215 begin 216 for J in Entity'First .. File_Start - 1 loop 217 Tmp_Regexp (Index) := '\'; 218 Tmp_Regexp (Index + 1) := Entity (J); 219 Index := Index + 2; 220 end loop; 221 222 Pattern.Entity := Compile (Tmp_Regexp, True, False); 223 Pattern.Initialized := True; 224 end; 225 end; 226 227 File_Start := File_Start + 1; 228 end if; 229 230 -- Parse the file name 231 232 Line_Start := Index (Entity (File_Start .. Entity'Last), ":"); 233 234 -- Check if it was a disk:\directory item (for Windows) 235 236 if File_Start = Line_Start - 1 237 and then Line_Start < Entity'Last 238 and then Entity (Line_Start + 1) = '\' 239 then 240 Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); 241 end if; 242 243 if Line_Start = 0 then 244 Line_Start := Entity'Length + 1; 245 246 elsif Line_Start /= Entity'Last then 247 Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); 248 249 if Col_Start = 0 then 250 Col_Start := Entity'Last + 1; 251 end if; 252 253 if Col_Start > Line_Start + 1 then 254 begin 255 Line_Num := Natural'Value 256 (Entity (Line_Start + 1 .. Col_Start - 1)); 257 258 exception 259 when Constraint_Error => 260 raise Invalid_Argument; 261 end; 262 end if; 263 264 if Col_Start < Entity'Last then 265 begin 266 Col_Num := Natural'Value (Entity 267 (Col_Start + 1 .. Entity'Last)); 268 269 exception 270 when Constraint_Error => raise Invalid_Argument; 271 end; 272 end if; 273 end if; 274 275 File_Ref := 276 Add_To_Xref_File 277 (Entity (File_Start .. Line_Start - 1), Visited => True); 278 Pattern.File_Ref := File_Ref; 279 280 Add_Line (Pattern.File_Ref, Line_Num, Col_Num); 281 282 File_Ref := 283 Add_To_Xref_File 284 (ALI_File_Name (Entity (File_Start .. Line_Start - 1)), 285 Visited => False, 286 Emit_Warning => True); 287 end Add_Entity; 288 289 ------------------- 290 -- Add_Xref_File -- 291 ------------------- 292 293 procedure Add_Xref_File (File : String) is 294 File_Ref : File_Reference := Empty_File; 295 pragma Unreferenced (File_Ref); 296 297 Iterator : Expansion_Iterator; 298 299 procedure Add_Xref_File_Internal (File : String); 300 -- Do the actual addition of the file 301 302 ---------------------------- 303 -- Add_Xref_File_Internal -- 304 ---------------------------- 305 306 procedure Add_Xref_File_Internal (File : String) is 307 begin 308 -- Case where we have an ALI file, accept it even though this is 309 -- not official usage, since the intention is obvious 310 311 if Tail (File, 4) = "." & Osint.ALI_Suffix.all then 312 File_Ref := Add_To_Xref_File 313 (File, Visited => False, Emit_Warning => True); 314 315 -- Normal non-ali file case 316 317 else 318 File_Ref := Add_To_Xref_File (File, Visited => True); 319 320 File_Ref := Add_To_Xref_File 321 (ALI_File_Name (File), 322 Visited => False, Emit_Warning => True); 323 end if; 324 end Add_Xref_File_Internal; 325 326 -- Start of processing for Add_Xref_File 327 328 begin 329 -- Check if we need to do the expansion 330 331 if Ada.Strings.Fixed.Index (File, "*") /= 0 332 or else Ada.Strings.Fixed.Index (File, "?") /= 0 333 then 334 Start_Expansion (Iterator, File); 335 336 loop 337 declare 338 S : constant String := Expansion (Iterator); 339 340 begin 341 exit when S'Length = 0; 342 Add_Xref_File_Internal (S); 343 end; 344 end loop; 345 346 else 347 Add_Xref_File_Internal (File); 348 end if; 349 end Add_Xref_File; 350 351 ----------------------- 352 -- Current_Xref_File -- 353 ----------------------- 354 355 function Current_Xref_File (File : ALI_File) return File_Reference is 356 begin 357 return File.X_File; 358 end Current_Xref_File; 359 360 -------------------------- 361 -- Default_Project_File -- 362 -------------------------- 363 364 function Default_Project_File (Dir_Name : String) return String is 365 My_Dir : Dir_Type; 366 Dir_Ent : File_Name_String; 367 Last : Natural; 368 369 begin 370 Open (My_Dir, Dir_Name); 371 372 loop 373 Read (My_Dir, Dir_Ent, Last); 374 exit when Last = 0; 375 376 if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then 377 378 -- The first project file found is the good one 379 380 Close (My_Dir); 381 return Dir_Ent (1 .. Last); 382 end if; 383 end loop; 384 385 Close (My_Dir); 386 return String'(1 .. 0 => ' '); 387 388 exception 389 when Directory_Error => return String'(1 .. 0 => ' '); 390 end Default_Project_File; 391 392 --------------- 393 -- File_Name -- 394 --------------- 395 396 function File_Name 397 (File : ALI_File; 398 Num : Positive) return File_Reference 399 is 400 begin 401 return File.Dep.Table (Num); 402 end File_Name; 403 404 -------------------- 405 -- Find_ALI_Files -- 406 -------------------- 407 408 procedure Find_ALI_Files is 409 My_Dir : Rec_DIR; 410 Dir_Ent : File_Name_String; 411 Last : Natural; 412 413 File_Ref : File_Reference; 414 pragma Unreferenced (File_Ref); 415 416 function Open_Next_Dir return Boolean; 417 -- Tries to open the next object directory, and return False if 418 -- the directory cannot be opened. 419 420 ------------------- 421 -- Open_Next_Dir -- 422 ------------------- 423 424 function Open_Next_Dir return Boolean is 425 begin 426 -- Until we are able to open a new directory 427 428 loop 429 declare 430 Obj_Dir : constant String := Next_Obj_Dir; 431 432 begin 433 -- Case of no more Obj_Dir lines 434 435 if Obj_Dir'Length = 0 then 436 return False; 437 end if; 438 439 Open (My_Dir.Dir, Obj_Dir); 440 exit; 441 442 exception 443 444 -- Could not open the directory 445 446 when Directory_Error => null; 447 end; 448 end loop; 449 450 return True; 451 end Open_Next_Dir; 452 453 -- Start of processing for Find_ALI_Files 454 455 begin 456 Reset_Obj_Dir; 457 458 if Open_Next_Dir then 459 loop 460 Read (My_Dir.Dir, Dir_Ent, Last); 461 462 if Last = 0 then 463 Close (My_Dir.Dir); 464 465 if not Open_Next_Dir then 466 return; 467 end if; 468 469 elsif Last > 4 470 and then Dir_Ent (Last - 3 .. Last) = "." & Osint.ALI_Suffix.all 471 then 472 File_Ref := 473 Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False); 474 end if; 475 end loop; 476 end if; 477 end Find_ALI_Files; 478 479 ------------------- 480 -- Get_Full_Type -- 481 ------------------- 482 483 function Get_Full_Type (Decl : Declaration_Reference) return String is 484 485 function Param_String return String; 486 -- Return the string to display depending on whether Decl is a parameter 487 488 ------------------ 489 -- Param_String -- 490 ------------------ 491 492 function Param_String return String is 493 begin 494 if Is_Parameter (Decl) then 495 return "parameter "; 496 else 497 return ""; 498 end if; 499 end Param_String; 500 501 -- Start of processing for Get_Full_Type 502 503 begin 504 case Get_Type (Decl) is 505 when 'A' => return "array type"; 506 when 'B' => return "boolean type"; 507 when 'C' => return "class-wide type"; 508 when 'D' => return "decimal type"; 509 when 'E' => return "enumeration type"; 510 when 'F' => return "float type"; 511 when 'H' => return "abstract type"; 512 when 'I' => return "integer type"; 513 when 'M' => return "modular type"; 514 when 'O' => return "fixed type"; 515 when 'P' => return "access type"; 516 when 'R' => return "record type"; 517 when 'S' => return "string type"; 518 when 'T' => return "task type"; 519 when 'W' => return "protected type"; 520 521 when 'a' => return Param_String & "array object"; 522 when 'b' => return Param_String & "boolean object"; 523 when 'c' => return Param_String & "class-wide object"; 524 when 'd' => return Param_String & "decimal object"; 525 when 'e' => return Param_String & "enumeration object"; 526 when 'f' => return Param_String & "float object"; 527 when 'i' => return Param_String & "integer object"; 528 when 'j' => return Param_String & "class object"; 529 when 'm' => return Param_String & "modular object"; 530 when 'o' => return Param_String & "fixed object"; 531 when 'p' => return Param_String & "access object"; 532 when 'r' => return Param_String & "record object"; 533 when 's' => return Param_String & "string object"; 534 when 't' => return Param_String & "task object"; 535 when 'w' => return Param_String & "protected object"; 536 when 'x' => return Param_String & "abstract procedure"; 537 when 'y' => return Param_String & "abstract function"; 538 539 when 'h' => return "interface"; 540 when 'g' => return "macro"; 541 when 'G' => return "function macro"; 542 when 'J' => return "class"; 543 when 'K' => return "package"; 544 when 'k' => return "generic package"; 545 when 'L' => return "statement label"; 546 when 'l' => return "loop label"; 547 when 'N' => return "named number"; 548 when 'n' => return "enumeration literal"; 549 when 'q' => return "block label"; 550 when 'Q' => return "include file"; 551 when 'U' => return "procedure"; 552 when 'u' => return "generic procedure"; 553 when 'V' => return "function"; 554 when 'v' => return "generic function"; 555 when 'X' => return "exception"; 556 when 'Y' => return "entry"; 557 558 when '+' => return "private type"; 559 when '*' => return "private variable"; 560 561 -- The above should be the only possibilities, but for this kind 562 -- of informational output, we don't want to bomb if we find 563 -- something else, so just return three question marks when we 564 -- have an unknown Abbrev value 565 566 when others => 567 if Is_Parameter (Decl) then 568 return "parameter"; 569 else 570 return "??? (" & Get_Type (Decl) & ")"; 571 end if; 572 end case; 573 end Get_Full_Type; 574 575 -------------------------- 576 -- Skip_To_First_X_Line -- 577 -------------------------- 578 579 procedure Skip_To_First_X_Line 580 (File : in out ALI_File; 581 D_Lines : Boolean; 582 W_Lines : Boolean) 583 is 584 Ali : String_Access renames File.Buffer; 585 Token : Positive; 586 Ptr : Positive := Ali'First; 587 Num_Dependencies : Natural := 0; 588 File_Start : Positive; 589 File_End : Positive; 590 Gnatchop_Offset : Integer; 591 Gnatchop_Name : Positive; 592 593 File_Ref : File_Reference; 594 pragma Unreferenced (File_Ref); 595 596 begin 597 -- Read all the lines possibly processing with-clauses and dependency 598 -- information and exit on finding the first Xref line. 599 -- A fall-through of the loop means that there is no xref information 600 -- which is an error condition. 601 602 while Ali (Ptr) /= EOF loop 603 if D_Lines and then Ali (Ptr) = 'D' then 604 605 -- Found dependency information. Format looks like: 606 -- D src-nam time-stmp checksum [subunit-name] [line:file-name] 607 608 -- Skip the D and parse the filenam 609 610 Ptr := Ptr + 1; 611 Parse_Token (Ali, Ptr, Token); 612 File_Start := Token; 613 File_End := Ptr - 1; 614 615 Num_Dependencies := Num_Dependencies + 1; 616 Set_Last (File.Dep, Num_Dependencies); 617 618 Parse_Token (Ali, Ptr, Token); -- Skip time-stamp 619 Parse_Token (Ali, Ptr, Token); -- Skip checksum 620 Parse_Token (Ali, Ptr, Token); -- Read next entity on the line 621 622 if not (Ali (Token) in '0' .. '9') then 623 Parse_Token (Ali, Ptr, Token); -- Was a subunit name 624 end if; 625 626 -- Did we have a gnatchop-ed file with a pragma Source_Reference ? 627 628 Gnatchop_Offset := 0; 629 630 if Ali (Token) in '0' .. '9' then 631 Gnatchop_Name := Token; 632 while Ali (Gnatchop_Name) /= ':' loop 633 Gnatchop_Name := Gnatchop_Name + 1; 634 end loop; 635 636 Gnatchop_Offset := 637 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1)); 638 Token := Gnatchop_Name + 1; 639 end if; 640 641 File.Dep.Table (Num_Dependencies) := Add_To_Xref_File 642 (Ali (File_Start .. File_End), 643 Gnatchop_File => Ali (Token .. Ptr - 1), 644 Gnatchop_Offset => Gnatchop_Offset); 645 646 elsif W_Lines and then Ali (Ptr) = 'W' then 647 648 -- Found with-clause information. Format looks like: 649 -- "W debug%s debug.adb debug.ali" 650 651 -- Skip the W and parse the .ali filename (3rd token) 652 653 Parse_Token (Ali, Ptr, Token); 654 Parse_Token (Ali, Ptr, Token); 655 Parse_Token (Ali, Ptr, Token); 656 657 File_Ref := 658 Add_To_Xref_File (Ali (Token .. Ptr - 1), Visited => False); 659 660 elsif Ali (Ptr) = 'X' then 661 662 -- Found a cross-referencing line - stop processing 663 664 File.Current_Line := Ptr; 665 File.Xref_Line := Ptr; 666 return; 667 end if; 668 669 Parse_EOL (Ali, Ptr); 670 end loop; 671 672 raise No_Xref_Information; 673 end Skip_To_First_X_Line; 674 675 ---------- 676 -- Open -- 677 ---------- 678 679 procedure Open 680 (Name : String; 681 File : out ALI_File; 682 Dependencies : Boolean := False) 683 is 684 Ali : String_Access renames File.Buffer; 685 pragma Warnings (Off, Ali); 686 687 begin 688 if File.Buffer /= null then 689 Free (File.Buffer); 690 end if; 691 692 Init (File.Dep); 693 694 begin 695 Read_File (Name, Ali); 696 697 exception 698 when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => 699 raise No_Xref_Information; 700 end; 701 702 Skip_To_First_X_Line (File, D_Lines => True, W_Lines => Dependencies); 703 end Open; 704 705 --------------- 706 -- Parse_EOL -- 707 --------------- 708 709 procedure Parse_EOL 710 (Source : not null access String; 711 Ptr : in out Positive; 712 Skip_Continuation_Line : Boolean := False) 713 is 714 begin 715 loop 716 -- Skip to end of line 717 718 while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF 719 and then Source (Ptr) /= EOF 720 loop 721 Ptr := Ptr + 1; 722 end loop; 723 724 -- Skip CR or LF if not at end of file 725 726 if Source (Ptr) /= EOF then 727 Ptr := Ptr + 1; 728 end if; 729 730 -- Skip past CR/LF or LF/CR combination 731 732 if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF) 733 and then Source (Ptr) /= Source (Ptr - 1) 734 then 735 Ptr := Ptr + 1; 736 end if; 737 738 exit when not Skip_Continuation_Line or else Source (Ptr) /= '.'; 739 end loop; 740 end Parse_EOL; 741 742 --------------------------- 743 -- Parse_Identifier_Info -- 744 --------------------------- 745 746 procedure Parse_Identifier_Info 747 (Pattern : Search_Pattern; 748 File : in out ALI_File; 749 Local_Symbols : Boolean; 750 Der_Info : Boolean := False; 751 Type_Tree : Boolean := False; 752 Wide_Search : Boolean := True; 753 Labels_As_Ref : Boolean := True) 754 is 755 Ptr : Positive renames File.Current_Line; 756 Ali : String_Access renames File.Buffer; 757 758 E_Line : Natural; -- Line number of current entity 759 E_Col : Natural; -- Column number of current entity 760 E_Type : Character; -- Type of current entity 761 E_Name : Positive; -- Pointer to begin of entity name 762 E_Global : Boolean; -- True iff entity is global 763 764 R_Line : Natural; -- Line number of current reference 765 R_Col : Natural; -- Column number of current reference 766 R_Type : Character; -- Type of current reference 767 768 Decl_Ref : Declaration_Reference; 769 File_Ref : File_Reference := Current_Xref_File (File); 770 771 function Get_Symbol_Name (Eun, Line, Col : Natural) return String; 772 -- Returns the symbol name for the entity defined at the specified 773 -- line and column in the dependent unit number Eun. For this we need 774 -- to parse the ali file again because the parent entity is not in 775 -- the declaration table if it did not match the search pattern. 776 777 procedure Skip_To_Matching_Closing_Bracket; 778 -- When Ptr points to an opening square bracket, moves it to the 779 -- character following the matching closing bracket 780 781 --------------------- 782 -- Get_Symbol_Name -- 783 --------------------- 784 785 function Get_Symbol_Name (Eun, Line, Col : Natural) return String is 786 Ptr : Positive := 1; 787 E_Eun : Positive; -- Unit number of current entity 788 E_Line : Natural; -- Line number of current entity 789 E_Col : Natural; -- Column number of current entity 790 E_Name : Positive; -- Pointer to begin of entity name 791 792 begin 793 -- Look for the X lines corresponding to unit Eun 794 795 loop 796 if Ali (Ptr) = 'X' then 797 Ptr := Ptr + 1; 798 Parse_Number (Ali, Ptr, E_Eun); 799 exit when E_Eun = Eun; 800 end if; 801 802 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 803 end loop; 804 805 -- Here we are in the right Ali section, we now look for the entity 806 -- declared at position (Line, Col). 807 808 loop 809 Parse_Number (Ali, Ptr, E_Line); 810 exit when Ali (Ptr) = EOF; 811 Ptr := Ptr + 1; 812 Parse_Number (Ali, Ptr, E_Col); 813 exit when Ali (Ptr) = EOF; 814 Ptr := Ptr + 1; 815 816 if Line = E_Line and then Col = E_Col then 817 Parse_Token (Ali, Ptr, E_Name); 818 return Ali (E_Name .. Ptr - 1); 819 end if; 820 821 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 822 exit when Ali (Ptr) = EOF; 823 end loop; 824 825 -- We were not able to find the symbol, this should not happen but 826 -- since we don't want to stop here we return a string of three 827 -- question marks as the symbol name. 828 829 return "???"; 830 end Get_Symbol_Name; 831 832 -------------------------------------- 833 -- Skip_To_Matching_Closing_Bracket -- 834 -------------------------------------- 835 836 procedure Skip_To_Matching_Closing_Bracket is 837 Num_Brackets : Natural; 838 839 begin 840 Num_Brackets := 1; 841 while Num_Brackets /= 0 loop 842 Ptr := Ptr + 1; 843 if Ali (Ptr) = '[' then 844 Num_Brackets := Num_Brackets + 1; 845 elsif Ali (Ptr) = ']' then 846 Num_Brackets := Num_Brackets - 1; 847 end if; 848 end loop; 849 850 Ptr := Ptr + 1; 851 end Skip_To_Matching_Closing_Bracket; 852 853 -- Start of processing for Parse_Identifier_Info 854 855 begin 856 -- The identifier info looks like: 857 -- "38U9*Debug 12|36r6 36r19" 858 859 -- Extract the line, column and entity name information 860 861 Parse_Number (Ali, Ptr, E_Line); 862 863 if Ali (Ptr) > ' ' then 864 E_Type := Ali (Ptr); 865 Ptr := Ptr + 1; 866 end if; 867 868 -- Ignore some of the entities (labels,...) 869 870 case E_Type is 871 when 'l' | 'L' | 'q' => 872 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 873 return; 874 875 when others => 876 null; 877 end case; 878 879 Parse_Number (Ali, Ptr, E_Col); 880 881 E_Global := False; 882 if Ali (Ptr) >= ' ' then 883 E_Global := (Ali (Ptr) = '*'); 884 Ptr := Ptr + 1; 885 end if; 886 887 Parse_Token (Ali, Ptr, E_Name); 888 889 -- Exit if the symbol does not match 890 -- or if we have a local symbol and we do not want it 891 892 if (not Local_Symbols and not E_Global) 893 or else (Pattern.Initialized 894 and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity)) 895 or else (E_Name >= Ptr) 896 then 897 Decl_Ref := Add_Declaration 898 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type, 899 Remove_Only => True); 900 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 901 return; 902 end if; 903 904 -- Insert the declaration in the table 905 906 Decl_Ref := Add_Declaration 907 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); 908 909 if Ali (Ptr) = '[' then 910 Skip_To_Matching_Closing_Bracket; 911 end if; 912 913 -- Skip any renaming indication 914 915 if Ali (Ptr) = '=' then 916 declare 917 P_Line, P_Column : Natural; 918 pragma Warnings (Off, P_Line); 919 pragma Warnings (Off, P_Column); 920 begin 921 Ptr := Ptr + 1; 922 Parse_Number (Ali, Ptr, P_Line); 923 Ptr := Ptr + 1; 924 Parse_Number (Ali, Ptr, P_Column); 925 end; 926 end if; 927 928 while Ptr <= Ali'Last 929 and then (Ali (Ptr) = '<' 930 or else Ali (Ptr) = '(' 931 or else Ali (Ptr) = '{') 932 loop 933 -- Here we have a type derivation information. The format is 934 -- <3|12I45> which means that the current entity is derived from the 935 -- type defined in unit number 3, line 12 column 45. The pipe and 936 -- unit number is optional. It is specified only if the parent type 937 -- is not defined in the current unit. 938 939 -- We also have the format for generic instantiations, as in 940 -- 7a5*Uid(3|5I8[4|2]) 2|4r74 941 942 -- We could also have something like 943 -- 16I9*I<integer> 944 -- that indicates that I derives from the predefined type integer. 945 946 Ptr := Ptr + 1; 947 948 if Ali (Ptr) in '0' .. '9' then 949 Parse_Derived_Info : declare 950 P_Line : Natural; -- parent entity line 951 P_Column : Natural; -- parent entity column 952 P_Eun : Positive; -- parent entity file number 953 954 begin 955 Parse_Number (Ali, Ptr, P_Line); 956 957 -- If we have a pipe then the first number was the unit number 958 959 if Ali (Ptr) = '|' then 960 P_Eun := P_Line; 961 Ptr := Ptr + 1; 962 963 -- Now we have the line number 964 965 Parse_Number (Ali, Ptr, P_Line); 966 967 else 968 -- We don't have a unit number specified, so we set P_Eun to 969 -- the current unit. 970 971 for K in Dependencies_Tables.First .. Last (File.Dep) loop 972 P_Eun := K; 973 exit when File.Dep.Table (K) = File_Ref; 974 end loop; 975 end if; 976 977 -- Then parse the type and column number 978 979 Ptr := Ptr + 1; 980 Parse_Number (Ali, Ptr, P_Column); 981 982 -- Skip the information for generics instantiations 983 984 if Ali (Ptr) = '[' then 985 Skip_To_Matching_Closing_Bracket; 986 end if; 987 988 -- Skip '>', or ')' or '>' 989 990 Ptr := Ptr + 1; 991 992 -- The derived info is needed only is the derived info mode is 993 -- on or if we want to output the type hierarchy 994 995 if Der_Info or else Type_Tree then 996 declare 997 Symbol : constant String := 998 Get_Symbol_Name (P_Eun, P_Line, P_Column); 999 begin 1000 if Symbol /= "???" then 1001 Add_Parent 1002 (Decl_Ref, 1003 Symbol, 1004 P_Line, 1005 P_Column, 1006 File.Dep.Table (P_Eun)); 1007 end if; 1008 end; 1009 end if; 1010 1011 if Type_Tree 1012 and then (Pattern.File_Ref = Empty_File 1013 or else 1014 Pattern.File_Ref = Current_Xref_File (File)) 1015 then 1016 Search_Parent_Tree : declare 1017 Pattern : Search_Pattern; -- Parent type pattern 1018 File_Pos_Backup : Positive; 1019 1020 begin 1021 Add_Entity 1022 (Pattern, 1023 Get_Symbol_Name (P_Eun, P_Line, P_Column) 1024 & ':' & Get_Gnatchop_File (File.Dep.Table (P_Eun)) 1025 & ':' & Get_Line (Get_Parent (Decl_Ref)) 1026 & ':' & Get_Column (Get_Parent (Decl_Ref)), 1027 False); 1028 1029 -- No default match is needed to look for the parent type 1030 -- since we are using the fully qualified symbol name: 1031 -- symbol:file:line:column 1032 1033 Set_Default_Match (False); 1034 1035 -- The parent hierarchy is defined in the same unit as 1036 -- the derived type. So we want to revisit the unit. 1037 1038 File_Pos_Backup := File.Current_Line; 1039 1040 Skip_To_First_X_Line 1041 (File, D_Lines => False, W_Lines => False); 1042 1043 while File.Buffer (File.Current_Line) /= EOF loop 1044 Parse_X_Filename (File); 1045 Parse_Identifier_Info 1046 (Pattern => Pattern, 1047 File => File, 1048 Local_Symbols => False, 1049 Der_Info => Der_Info, 1050 Type_Tree => True, 1051 Wide_Search => False, 1052 Labels_As_Ref => Labels_As_Ref); 1053 end loop; 1054 1055 File.Current_Line := File_Pos_Backup; 1056 end Search_Parent_Tree; 1057 end if; 1058 end Parse_Derived_Info; 1059 1060 else 1061 while Ali (Ptr) /= '>' 1062 and then Ali (Ptr) /= ')' 1063 and then Ali (Ptr) /= '}' 1064 loop 1065 Ptr := Ptr + 1; 1066 end loop; 1067 Ptr := Ptr + 1; 1068 end if; 1069 end loop; 1070 1071 -- To find the body, we will have to parse the file too 1072 1073 if Wide_Search then 1074 declare 1075 File_Ref : File_Reference; 1076 pragma Unreferenced (File_Ref); 1077 File_Name : constant String := Get_Gnatchop_File (File.X_File); 1078 begin 1079 File_Ref := Add_To_Xref_File (ALI_File_Name (File_Name), False); 1080 end; 1081 end if; 1082 1083 -- Parse references to this entity. 1084 -- Ptr points to next reference with leading blanks 1085 1086 loop 1087 -- Process references on current line 1088 1089 while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop 1090 1091 -- For every reference read the line, type and column, 1092 -- optionally preceded by a file number and a pipe symbol. 1093 1094 Parse_Number (Ali, Ptr, R_Line); 1095 1096 if Ali (Ptr) = Pipe then 1097 Ptr := Ptr + 1; 1098 File_Ref := File_Name (File, R_Line); 1099 1100 Parse_Number (Ali, Ptr, R_Line); 1101 end if; 1102 1103 if Ali (Ptr) > ' ' then 1104 R_Type := Ali (Ptr); 1105 Ptr := Ptr + 1; 1106 end if; 1107 1108 -- Imported entities may have an indication specifying information 1109 -- about the corresponding external name: 1110 -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity 1111 -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity 1112 1113 if (R_Type = 'b' or else R_Type = 'i') 1114 and then Ali (Ptr) = '<' 1115 then 1116 while Ptr <= Ali'Last 1117 and then Ali (Ptr) /= '>' 1118 loop 1119 Ptr := Ptr + 1; 1120 end loop; 1121 Ptr := Ptr + 1; 1122 end if; 1123 1124 Parse_Number (Ali, Ptr, R_Col); 1125 1126 -- Insert the reference or body in the table 1127 1128 Add_Reference 1129 (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref); 1130 1131 -- Skip generic information, if any 1132 1133 if Ali (Ptr) = '[' then 1134 declare 1135 Num_Nested : Integer := 1; 1136 1137 begin 1138 Ptr := Ptr + 1; 1139 while Num_Nested /= 0 loop 1140 if Ali (Ptr) = ']' then 1141 Num_Nested := Num_Nested - 1; 1142 elsif Ali (Ptr) = '[' then 1143 Num_Nested := Num_Nested + 1; 1144 end if; 1145 1146 Ptr := Ptr + 1; 1147 end loop; 1148 end; 1149 end if; 1150 1151 end loop; 1152 1153 Parse_EOL (Ali, Ptr); 1154 1155 -- Loop until new line is no continuation line 1156 1157 exit when Ali (Ptr) /= '.'; 1158 Ptr := Ptr + 1; 1159 end loop; 1160 end Parse_Identifier_Info; 1161 1162 ------------------ 1163 -- Parse_Number -- 1164 ------------------ 1165 1166 procedure Parse_Number 1167 (Source : not null access String; 1168 Ptr : in out Positive; 1169 Number : out Natural) 1170 is 1171 begin 1172 -- Skip separators 1173 1174 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop 1175 Ptr := Ptr + 1; 1176 end loop; 1177 1178 Number := 0; 1179 while Source (Ptr) in '0' .. '9' loop 1180 Number := 1181 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); 1182 Ptr := Ptr + 1; 1183 end loop; 1184 end Parse_Number; 1185 1186 ----------------- 1187 -- Parse_Token -- 1188 ----------------- 1189 1190 procedure Parse_Token 1191 (Source : not null access String; 1192 Ptr : in out Positive; 1193 Token_Ptr : out Positive) 1194 is 1195 In_Quotes : Character := ASCII.NUL; 1196 1197 begin 1198 -- Skip separators 1199 1200 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop 1201 Ptr := Ptr + 1; 1202 end loop; 1203 1204 Token_Ptr := Ptr; 1205 1206 -- Find end-of-token 1207 1208 while (In_Quotes /= ASCII.NUL or else 1209 not (Source (Ptr) = ' ' 1210 or else Source (Ptr) = ASCII.HT 1211 or else Source (Ptr) = '<' 1212 or else Source (Ptr) = '{' 1213 or else Source (Ptr) = '[' 1214 or else Source (Ptr) = '=' 1215 or else Source (Ptr) = '(')) 1216 and then Source (Ptr) >= ' ' 1217 loop 1218 -- Double-quotes are used for operators 1219 -- Simple-quotes are used for character constants, for instance when 1220 -- they are found in an enumeration type "type A is ('+', '-');" 1221 1222 case Source (Ptr) is 1223 when '"' | ''' => 1224 if In_Quotes = Source (Ptr) then 1225 In_Quotes := ASCII.NUL; 1226 elsif In_Quotes = ASCII.NUL then 1227 In_Quotes := Source (Ptr); 1228 end if; 1229 1230 when others => 1231 null; 1232 end case; 1233 1234 Ptr := Ptr + 1; 1235 end loop; 1236 end Parse_Token; 1237 1238 ---------------------- 1239 -- Parse_X_Filename -- 1240 ---------------------- 1241 1242 procedure Parse_X_Filename (File : in out ALI_File) is 1243 Ali : String_Access renames File.Buffer; 1244 Ptr : Positive renames File.Current_Line; 1245 File_Nr : Natural; 1246 1247 begin 1248 while Ali (Ptr) = 'X' loop 1249 1250 -- The current line is the start of a new Xref file section, 1251 -- whose format looks like: 1252 1253 -- " X 1 debug.ads" 1254 1255 -- Skip the X and read the file number for the new X_File 1256 1257 Ptr := Ptr + 1; 1258 Parse_Number (Ali, Ptr, File_Nr); 1259 1260 if File_Nr > 0 then 1261 File.X_File := File.Dep.Table (File_Nr); 1262 end if; 1263 1264 Parse_EOL (Ali, Ptr); 1265 end loop; 1266 end Parse_X_Filename; 1267 1268 -------------------- 1269 -- Print_Gnatfind -- 1270 -------------------- 1271 1272 procedure Print_Gnatfind 1273 (References : Boolean; 1274 Full_Path_Name : Boolean) 1275 is 1276 Decls : constant Declaration_Array_Access := Get_Declarations; 1277 Decl : Declaration_Reference; 1278 Arr : Reference_Array_Access; 1279 1280 procedure Print_Ref 1281 (Ref : Reference; 1282 Msg : String := " "); 1283 -- Print a reference, according to the extended tag of the output 1284 1285 --------------- 1286 -- Print_Ref -- 1287 --------------- 1288 1289 procedure Print_Ref 1290 (Ref : Reference; 1291 Msg : String := " ") 1292 is 1293 F : String_Access := 1294 Osint.To_Host_File_Spec 1295 (Get_Gnatchop_File (Ref, Full_Path_Name)); 1296 1297 Buffer : constant String := 1298 F.all & 1299 ":" & Get_Line (Ref) & 1300 ":" & Get_Column (Ref) & 1301 ": "; 1302 1303 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; 1304 1305 begin 1306 Free (F); 1307 Num_Blanks := Integer'Max (0, Num_Blanks); 1308 Write_Line 1309 (Buffer 1310 & String'(1 .. Num_Blanks => ' ') 1311 & Msg & " " & Get_Symbol (Decl)); 1312 1313 if Get_Source_Line (Ref)'Length /= 0 then 1314 Write_Line (" " & Get_Source_Line (Ref)); 1315 end if; 1316 end Print_Ref; 1317 1318 -- Start of processing for Print_Gnatfind 1319 1320 begin 1321 for D in Decls'Range loop 1322 Decl := Decls (D); 1323 1324 if Match (Decl) then 1325 1326 -- Output the declaration 1327 1328 declare 1329 Parent : constant Declaration_Reference := Get_Parent (Decl); 1330 1331 F : String_Access := 1332 Osint.To_Host_File_Spec 1333 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1334 1335 Buffer : constant String := 1336 F.all & 1337 ":" & Get_Line (Decl) & 1338 ":" & Get_Column (Decl) & 1339 ": "; 1340 1341 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; 1342 1343 begin 1344 Free (F); 1345 Num_Blanks := Integer'Max (0, Num_Blanks); 1346 Write_Line 1347 (Buffer & String'(1 .. Num_Blanks => ' ') 1348 & "(spec) " & Get_Symbol (Decl)); 1349 1350 if Parent /= Empty_Declaration then 1351 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); 1352 Write_Line 1353 (Buffer & String'(1 .. Num_Blanks => ' ') 1354 & " derived from " & Get_Symbol (Parent) 1355 & " (" 1356 & F.all 1357 & ':' & Get_Line (Parent) 1358 & ':' & Get_Column (Parent) & ')'); 1359 Free (F); 1360 end if; 1361 end; 1362 1363 if Get_Source_Line (Decl)'Length /= 0 then 1364 Write_Line (" " & Get_Source_Line (Decl)); 1365 end if; 1366 1367 -- Output the body (sorted) 1368 1369 Arr := Get_References (Decl, Get_Bodies => True); 1370 1371 for R in Arr'Range loop 1372 Print_Ref (Arr (R), "(body)"); 1373 end loop; 1374 1375 Free (Arr); 1376 1377 if References then 1378 Arr := Get_References 1379 (Decl, Get_Writes => True, Get_Reads => True); 1380 1381 for R in Arr'Range loop 1382 Print_Ref (Arr (R)); 1383 end loop; 1384 1385 Free (Arr); 1386 end if; 1387 end if; 1388 end loop; 1389 end Print_Gnatfind; 1390 1391 ------------------ 1392 -- Print_Unused -- 1393 ------------------ 1394 1395 procedure Print_Unused (Full_Path_Name : Boolean) is 1396 Decls : constant Declaration_Array_Access := Get_Declarations; 1397 Decl : Declaration_Reference; 1398 Arr : Reference_Array_Access; 1399 F : String_Access; 1400 1401 begin 1402 for D in Decls'Range loop 1403 Decl := Decls (D); 1404 1405 if References_Count 1406 (Decl, Get_Reads => True, Get_Writes => True) = 0 1407 then 1408 F := Osint.To_Host_File_Spec 1409 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1410 Write_Str (Get_Symbol (Decl) 1411 & " (" 1412 & Get_Full_Type (Decl) 1413 & ") " 1414 & F.all 1415 & ':' 1416 & Get_Line (Decl) 1417 & ':' 1418 & Get_Column (Decl)); 1419 Free (F); 1420 1421 -- Print the body if any 1422 1423 Arr := Get_References (Decl, Get_Bodies => True); 1424 1425 for R in Arr'Range loop 1426 F := Osint.To_Host_File_Spec 1427 (Get_Gnatchop_File (Arr (R), Full_Path_Name)); 1428 Write_Str (' ' 1429 & F.all 1430 & ':' & Get_Line (Arr (R)) 1431 & ':' & Get_Column (Arr (R))); 1432 Free (F); 1433 end loop; 1434 1435 Write_Eol; 1436 Free (Arr); 1437 end if; 1438 end loop; 1439 end Print_Unused; 1440 1441 -------------- 1442 -- Print_Vi -- 1443 -------------- 1444 1445 procedure Print_Vi (Full_Path_Name : Boolean) is 1446 Tab : constant Character := ASCII.HT; 1447 Decls : constant Declaration_Array_Access := 1448 Get_Declarations (Sorted => False); 1449 Decl : Declaration_Reference; 1450 Arr : Reference_Array_Access; 1451 F : String_Access; 1452 1453 begin 1454 for D in Decls'Range loop 1455 Decl := Decls (D); 1456 1457 F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name)); 1458 Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl)); 1459 Free (F); 1460 1461 -- Print the body if any 1462 1463 Arr := Get_References (Decl, Get_Bodies => True); 1464 1465 for R in Arr'Range loop 1466 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); 1467 Write_Line 1468 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); 1469 Free (F); 1470 end loop; 1471 1472 Free (Arr); 1473 1474 -- Print the modifications 1475 1476 Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True); 1477 1478 for R in Arr'Range loop 1479 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); 1480 Write_Line 1481 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); 1482 Free (F); 1483 end loop; 1484 1485 Free (Arr); 1486 end loop; 1487 end Print_Vi; 1488 1489 ---------------- 1490 -- Print_Xref -- 1491 ---------------- 1492 1493 procedure Print_Xref (Full_Path_Name : Boolean) is 1494 Decls : constant Declaration_Array_Access := Get_Declarations; 1495 Decl : Declaration_Reference; 1496 1497 Margin : constant := 10; 1498 -- Column where file names start 1499 1500 procedure New_Line80; 1501 -- Go to start of new line 1502 1503 procedure Print80 (S : String); 1504 -- Print the text, respecting the 80 columns rule 1505 1506 procedure Print_Ref (Line, Column : String); 1507 -- The beginning of the output is aligned on a column multiple of 9 1508 1509 procedure Print_List 1510 (Decl : Declaration_Reference; 1511 Msg : String; 1512 Get_Reads : Boolean := False; 1513 Get_Writes : Boolean := False; 1514 Get_Bodies : Boolean := False); 1515 -- Print a list of references. If the list is not empty, Msg will 1516 -- be printed prior to the list. 1517 1518 ---------------- 1519 -- New_Line80 -- 1520 ---------------- 1521 1522 procedure New_Line80 is 1523 begin 1524 Write_Eol; 1525 Write_Str (String'(1 .. Margin - 1 => ' ')); 1526 end New_Line80; 1527 1528 ------------- 1529 -- Print80 -- 1530 ------------- 1531 1532 procedure Print80 (S : String) is 1533 Align : Natural := Margin - (Integer (Column) mod Margin); 1534 1535 begin 1536 if Align = Margin then 1537 Align := 0; 1538 end if; 1539 1540 Write_Str (String'(1 .. Align => ' ') & S); 1541 end Print80; 1542 1543 --------------- 1544 -- Print_Ref -- 1545 --------------- 1546 1547 procedure Print_Ref (Line, Column : String) is 1548 Line_Align : constant Integer := 4 - Line'Length; 1549 1550 S : constant String := String'(1 .. Line_Align => ' ') 1551 & Line & ':' & Column; 1552 1553 Align : Natural := Margin - (Integer (Output.Column) mod Margin); 1554 1555 begin 1556 if Align = Margin then 1557 Align := 0; 1558 end if; 1559 1560 if Integer (Output.Column) + Align + S'Length > 79 then 1561 New_Line80; 1562 Align := 0; 1563 end if; 1564 1565 Write_Str (String'(1 .. Align => ' ') & S); 1566 end Print_Ref; 1567 1568 ---------------- 1569 -- Print_List -- 1570 ---------------- 1571 1572 procedure Print_List 1573 (Decl : Declaration_Reference; 1574 Msg : String; 1575 Get_Reads : Boolean := False; 1576 Get_Writes : Boolean := False; 1577 Get_Bodies : Boolean := False) 1578 is 1579 Arr : Reference_Array_Access := 1580 Get_References 1581 (Decl, 1582 Get_Writes => Get_Writes, 1583 Get_Reads => Get_Reads, 1584 Get_Bodies => Get_Bodies); 1585 File : File_Reference := Empty_File; 1586 F : String_Access; 1587 1588 begin 1589 if Arr'Length /= 0 then 1590 Write_Eol; 1591 Write_Str (Msg); 1592 end if; 1593 1594 for R in Arr'Range loop 1595 if Get_File_Ref (Arr (R)) /= File then 1596 if File /= Empty_File then 1597 New_Line80; 1598 end if; 1599 1600 File := Get_File_Ref (Arr (R)); 1601 F := Osint.To_Host_File_Spec 1602 (Get_Gnatchop_File (Arr (R), Full_Path_Name)); 1603 1604 if F = null then 1605 Write_Str ("<unknown> "); 1606 else 1607 Write_Str (F.all & ' '); 1608 Free (F); 1609 end if; 1610 end if; 1611 1612 Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R))); 1613 end loop; 1614 1615 Free (Arr); 1616 end Print_List; 1617 1618 F : String_Access; 1619 1620 -- Start of processing for Print_Xref 1621 1622 begin 1623 for D in Decls'Range loop 1624 Decl := Decls (D); 1625 1626 Write_Str (Get_Symbol (Decl)); 1627 1628 -- Put the declaration type in column Type_Position, but if the 1629 -- declaration name is too long, put at least one space between its 1630 -- name and its type. 1631 1632 while Column < Type_Position - 1 loop 1633 Write_Char (' '); 1634 end loop; 1635 1636 Write_Char (' '); 1637 1638 Write_Line (Get_Full_Type (Decl)); 1639 1640 Write_Parent_Info : declare 1641 Parent : constant Declaration_Reference := Get_Parent (Decl); 1642 1643 begin 1644 if Parent /= Empty_Declaration then 1645 Write_Str (" Ptype: "); 1646 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); 1647 Print80 (F.all); 1648 Free (F); 1649 Print_Ref (Get_Line (Parent), Get_Column (Parent)); 1650 Print80 (" " & Get_Symbol (Parent)); 1651 Write_Eol; 1652 end if; 1653 end Write_Parent_Info; 1654 1655 Write_Str (" Decl: "); 1656 F := Osint.To_Host_File_Spec 1657 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1658 1659 if F = null then 1660 Print80 ("<unknown> "); 1661 else 1662 Print80 (F.all & ' '); 1663 Free (F); 1664 end if; 1665 1666 Print_Ref (Get_Line (Decl), Get_Column (Decl)); 1667 1668 Print_List 1669 (Decl, " Body: ", Get_Bodies => True); 1670 Print_List 1671 (Decl, " Modi: ", Get_Writes => True); 1672 Print_List 1673 (Decl, " Ref: ", Get_Reads => True); 1674 Write_Eol; 1675 end loop; 1676 end Print_Xref; 1677 1678 ------------ 1679 -- Search -- 1680 ------------ 1681 1682 procedure Search 1683 (Pattern : Search_Pattern; 1684 Local_Symbols : Boolean; 1685 Wide_Search : Boolean; 1686 Read_Only : Boolean; 1687 Der_Info : Boolean; 1688 Type_Tree : Boolean) 1689 is 1690 type String_Access is access String; 1691 procedure Free is new Unchecked_Deallocation (String, String_Access); 1692 1693 ALIfile : ALI_File; 1694 File_Ref : File_Reference; 1695 Strip_Num : Natural := 0; 1696 Ali_Name : String_Access; 1697 1698 begin 1699 -- If we want all the .ali files, then find them 1700 1701 if Wide_Search then 1702 Find_ALI_Files; 1703 end if; 1704 1705 loop 1706 -- Get the next unread ali file 1707 1708 File_Ref := Next_Unvisited_File; 1709 1710 exit when File_Ref = Empty_File; 1711 1712 -- Find the ALI file to use. Most of the time, it will be the unit 1713 -- name, with a different extension. However, when dealing with 1714 -- separates the ALI file is in fact the parent's ALI file (and this 1715 -- is recursive, in case the parent itself is a separate). 1716 1717 Strip_Num := 0; 1718 loop 1719 Free (Ali_Name); 1720 Ali_Name := new String' 1721 (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); 1722 1723 -- Stripped too many things... 1724 1725 if Ali_Name.all = "" then 1726 if Get_Emit_Warning (File_Ref) then 1727 Set_Standard_Error; 1728 Write_Line 1729 ("warning : file " & Get_File (File_Ref, With_Dir => True) 1730 & " not found"); 1731 Set_Standard_Output; 1732 end if; 1733 Free (Ali_Name); 1734 exit; 1735 1736 -- If not found, try the parent's ALI file (this is needed for 1737 -- separate units and subprograms). 1738 1739 -- Reset the cached directory first, in case the separate's 1740 -- ALI file is not in the same directory. 1741 1742 elsif not File_Exists (Ali_Name.all) then 1743 Strip_Num := Strip_Num + 1; 1744 Reset_Directory (File_Ref); 1745 1746 -- Else we finally found it 1747 1748 else 1749 exit; 1750 end if; 1751 end loop; 1752 1753 -- If we had to get the parent's ALI, insert it in the list as usual. 1754 -- This is to avoid parsing it twice in case it has already been 1755 -- parsed. 1756 1757 if Ali_Name /= null and then Strip_Num /= 0 then 1758 File_Ref := Add_To_Xref_File 1759 (File_Name => Ali_Name.all, 1760 Visited => False); 1761 1762 -- Now that we have a file name, parse it to find any reference to 1763 -- the entity. 1764 1765 elsif Ali_Name /= null 1766 and then (Read_Only or else Is_Writable_File (Ali_Name.all)) 1767 then 1768 begin 1769 Open (Ali_Name.all, ALIfile); 1770 1771 -- The cross-reference section in the ALI file may be followed 1772 -- by other sections, which can be identified by the starting 1773 -- character of every line, which should neither be 'X' nor a 1774 -- figure in '1' .. '9'. 1775 1776 -- The loop tests below also take into account the end-of-file 1777 -- possibility. 1778 1779 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop 1780 Parse_X_Filename (ALIfile); 1781 1782 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' 1783 loop 1784 Parse_Identifier_Info 1785 (Pattern, ALIfile, Local_Symbols, Der_Info, Type_Tree, 1786 Wide_Search, Labels_As_Ref => True); 1787 end loop; 1788 end loop; 1789 1790 exception 1791 when No_Xref_Information => 1792 if Get_Emit_Warning (File_Ref) then 1793 Set_Standard_Error; 1794 Write_Line 1795 ("warning : No cross-referencing information in " 1796 & Ali_Name.all); 1797 Set_Standard_Output; 1798 end if; 1799 end; 1800 end if; 1801 end loop; 1802 1803 Free (Ali_Name); 1804 end Search; 1805 1806 ----------------- 1807 -- Search_Xref -- 1808 ----------------- 1809 1810 procedure Search_Xref 1811 (Local_Symbols : Boolean; 1812 Read_Only : Boolean; 1813 Der_Info : Boolean) 1814 is 1815 ALIfile : ALI_File; 1816 File_Ref : File_Reference; 1817 Null_Pattern : Search_Pattern; 1818 1819 begin 1820 Null_Pattern.Initialized := False; 1821 1822 loop 1823 -- Find the next unvisited file 1824 1825 File_Ref := Next_Unvisited_File; 1826 exit when File_Ref = Empty_File; 1827 1828 -- Search the object directories for the .ali file 1829 1830 declare 1831 F : constant String := Get_File (File_Ref, With_Dir => True); 1832 1833 begin 1834 if Read_Only or else Is_Writable_File (F) then 1835 Open (F, ALIfile, True); 1836 1837 -- The cross-reference section in the ALI file may be followed 1838 -- by other sections, which can be identified by the starting 1839 -- character of every line, which should neither be 'X' nor a 1840 -- figure in '1' .. '9'. 1841 1842 -- The loop tests below also take into account the end-of-file 1843 -- possibility. 1844 1845 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop 1846 Parse_X_Filename (ALIfile); 1847 1848 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' 1849 loop 1850 Parse_Identifier_Info 1851 (Null_Pattern, ALIfile, Local_Symbols, Der_Info, 1852 Labels_As_Ref => False); 1853 end loop; 1854 end loop; 1855 end if; 1856 1857 exception 1858 when No_Xref_Information => null; 1859 end; 1860 end loop; 1861 end Search_Xref; 1862 1863end Xref_Lib; 1864