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