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 -- Skip to end of line 727 728 while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF 729 and then Source (Ptr) /= EOF 730 loop 731 Ptr := Ptr + 1; 732 end loop; 733 734 -- Skip CR or LF if not at end of file 735 736 if Source (Ptr) /= EOF then 737 Ptr := Ptr + 1; 738 end if; 739 740 -- Skip past CR/LF or LF/CR combination 741 742 if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF) 743 and then Source (Ptr) /= Source (Ptr - 1) 744 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 787 procedure Skip_To_Matching_Closing_Bracket; 788 -- When Ptr points to an opening square bracket, moves it to the 789 -- character following the matching closing bracket 790 791 --------------------- 792 -- Get_Symbol_Name -- 793 --------------------- 794 795 function Get_Symbol_Name (Eun, Line, Col : Natural) return String is 796 Ptr : Positive := 1; 797 E_Eun : Positive; -- Unit number of current entity 798 E_Line : Natural; -- Line number of current entity 799 E_Col : Natural; -- Column number of current entity 800 E_Name : Positive; -- Pointer to begin of entity name 801 802 begin 803 -- Look for the X lines corresponding to unit Eun 804 805 loop 806 if Ali (Ptr) = 'X' then 807 Ptr := Ptr + 1; 808 Parse_Number (Ali, Ptr, E_Eun); 809 exit when E_Eun = Eun; 810 end if; 811 812 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 813 end loop; 814 815 -- Here we are in the right Ali section, we now look for the entity 816 -- declared at position (Line, Col). 817 818 loop 819 Parse_Number (Ali, Ptr, E_Line); 820 exit when Ali (Ptr) = EOF; 821 Ptr := Ptr + 1; 822 Parse_Number (Ali, Ptr, E_Col); 823 exit when Ali (Ptr) = EOF; 824 Ptr := Ptr + 1; 825 826 if Line = E_Line and then Col = E_Col then 827 Parse_Token (Ali, Ptr, E_Name); 828 return Ali (E_Name .. Ptr - 1); 829 end if; 830 831 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 832 exit when Ali (Ptr) = EOF; 833 end loop; 834 835 -- We were not able to find the symbol, this should not happen but 836 -- since we don't want to stop here we return a string of three 837 -- question marks as the symbol name. 838 839 return "???"; 840 end Get_Symbol_Name; 841 842 -------------------------------------- 843 -- Skip_To_Matching_Closing_Bracket -- 844 -------------------------------------- 845 846 procedure Skip_To_Matching_Closing_Bracket is 847 Num_Brackets : Natural; 848 849 begin 850 Num_Brackets := 1; 851 while Num_Brackets /= 0 loop 852 Ptr := Ptr + 1; 853 if Ali (Ptr) = '[' then 854 Num_Brackets := Num_Brackets + 1; 855 elsif Ali (Ptr) = ']' then 856 Num_Brackets := Num_Brackets - 1; 857 end if; 858 end loop; 859 860 Ptr := Ptr + 1; 861 end Skip_To_Matching_Closing_Bracket; 862 863 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); 864 865 -- Start of processing for Parse_Identifier_Info 866 867 begin 868 -- The identifier info looks like: 869 -- "38U9*Debug 12|36r6 36r19" 870 871 -- Extract the line, column and entity name information 872 873 Parse_Number (Ali, Ptr, E_Line); 874 875 if Ali (Ptr) > ' ' then 876 E_Type := Ali (Ptr); 877 Ptr := Ptr + 1; 878 end if; 879 880 -- Ignore some of the entities (labels,...) 881 882 case E_Type is 883 when 'l' | 'L' | 'q' => 884 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 885 return; 886 887 when others => 888 null; 889 end case; 890 891 Parse_Number (Ali, Ptr, E_Col); 892 893 E_Global := False; 894 if Ali (Ptr) >= ' ' then 895 E_Global := (Ali (Ptr) = '*'); 896 Ptr := Ptr + 1; 897 end if; 898 899 Parse_Token (Ali, Ptr, E_Name); 900 901 -- Exit if the symbol does not match or if we have a local symbol and we 902 -- do not want it or if the file is unknown. 903 904 if File.X_File = Empty_File then 905 return; 906 end if; 907 908 if (not Local_Symbols and not E_Global) 909 or else (Pattern.Initialized 910 and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity)) 911 or else (E_Name >= Ptr) 912 then 913 Decl_Ref := Add_Declaration 914 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type, 915 Remove_Only => True); 916 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 917 return; 918 end if; 919 920 -- Insert the declaration in the table 921 922 Decl_Ref := Add_Declaration 923 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); 924 925 if Ali (Ptr) = '[' then 926 Skip_To_Matching_Closing_Bracket; 927 end if; 928 929 -- Skip any renaming indication 930 931 if Ali (Ptr) = '=' then 932 declare 933 P_Line, P_Column : Natural; 934 pragma Warnings (Off, P_Line); 935 pragma Warnings (Off, P_Column); 936 begin 937 Ptr := Ptr + 1; 938 Parse_Number (Ali, Ptr, P_Line); 939 Ptr := Ptr + 1; 940 Parse_Number (Ali, Ptr, P_Column); 941 end; 942 end if; 943 944 while Ptr <= Ali'Last 945 and then (Ali (Ptr) = '<' 946 or else Ali (Ptr) = '(' 947 or else Ali (Ptr) = '{') 948 loop 949 -- Here we have a type derivation information. The format is 950 -- <3|12I45> which means that the current entity is derived from the 951 -- type defined in unit number 3, line 12 column 45. The pipe and 952 -- unit number is optional. It is specified only if the parent type 953 -- is not defined in the current unit. 954 955 -- We also have the format for generic instantiations, as in 956 -- 7a5*Uid(3|5I8[4|2]) 2|4r74 957 958 -- We could also have something like 959 -- 16I9*I<integer> 960 -- that indicates that I derives from the predefined type integer. 961 962 Ptr := Ptr + 1; 963 964 if Ali (Ptr) in '0' .. '9' then 965 Parse_Derived_Info : declare 966 P_Line : Natural; -- parent entity line 967 P_Column : Natural; -- parent entity column 968 P_Eun : Positive; -- parent entity file number 969 970 begin 971 Parse_Number (Ali, Ptr, P_Line); 972 973 -- If we have a pipe then the first number was the unit number 974 975 if Ali (Ptr) = '|' then 976 P_Eun := P_Line; 977 Ptr := Ptr + 1; 978 979 -- Now we have the line number 980 981 Parse_Number (Ali, Ptr, P_Line); 982 983 else 984 -- We don't have a unit number specified, so we set P_Eun to 985 -- the current unit. 986 987 for K in Table'Range loop 988 P_Eun := K; 989 exit when Table (K) = File_Ref; 990 end loop; 991 end if; 992 993 -- Then parse the type and column number 994 995 Ptr := Ptr + 1; 996 Parse_Number (Ali, Ptr, P_Column); 997 998 -- Skip the information for generics instantiations 999 1000 if Ali (Ptr) = '[' then 1001 Skip_To_Matching_Closing_Bracket; 1002 end if; 1003 1004 -- Skip '>', or ')' or '>' 1005 1006 Ptr := Ptr + 1; 1007 1008 -- The derived info is needed only is the derived info mode is 1009 -- on or if we want to output the type hierarchy 1010 1011 if Der_Info or else Type_Tree then 1012 declare 1013 Symbol : constant String := 1014 Get_Symbol_Name (P_Eun, P_Line, P_Column); 1015 begin 1016 if Symbol /= "???" then 1017 Add_Parent 1018 (Decl_Ref, 1019 Symbol, 1020 P_Line, 1021 P_Column, 1022 Table (P_Eun)); 1023 end if; 1024 end; 1025 end if; 1026 1027 if Type_Tree 1028 and then (Pattern.File_Ref = Empty_File 1029 or else 1030 Pattern.File_Ref = Current_Xref_File (File)) 1031 then 1032 Search_Parent_Tree : declare 1033 Pattern : Search_Pattern; -- Parent type pattern 1034 File_Pos_Backup : Positive; 1035 1036 begin 1037 Add_Entity 1038 (Pattern, 1039 Get_Symbol_Name (P_Eun, P_Line, P_Column) 1040 & ':' & Get_Gnatchop_File (Table (P_Eun)) 1041 & ':' & Get_Line (Get_Parent (Decl_Ref)) 1042 & ':' & Get_Column (Get_Parent (Decl_Ref)), 1043 False); 1044 1045 -- No default match is needed to look for the parent type 1046 -- since we are using the fully qualified symbol name: 1047 -- symbol:file:line:column 1048 1049 Set_Default_Match (False); 1050 1051 -- The parent hierarchy is defined in the same unit as 1052 -- the derived type. So we want to revisit the unit. 1053 1054 File_Pos_Backup := File.Current_Line; 1055 1056 Skip_To_First_X_Line 1057 (File, D_Lines => False, W_Lines => False); 1058 1059 while File.Buffer (File.Current_Line) /= EOF loop 1060 Parse_X_Filename (File); 1061 Parse_Identifier_Info 1062 (Pattern => Pattern, 1063 File => File, 1064 Local_Symbols => False, 1065 Der_Info => Der_Info, 1066 Type_Tree => True, 1067 Wide_Search => False, 1068 Labels_As_Ref => Labels_As_Ref); 1069 end loop; 1070 1071 File.Current_Line := File_Pos_Backup; 1072 end Search_Parent_Tree; 1073 end if; 1074 end Parse_Derived_Info; 1075 1076 else 1077 while Ali (Ptr) /= '>' 1078 and then Ali (Ptr) /= ')' 1079 and then Ali (Ptr) /= '}' 1080 loop 1081 Ptr := Ptr + 1; 1082 end loop; 1083 Ptr := Ptr + 1; 1084 end if; 1085 end loop; 1086 1087 -- To find the body, we will have to parse the file too 1088 1089 if Wide_Search then 1090 declare 1091 File_Name : constant String := Get_Gnatchop_File (File.X_File); 1092 Ignored : File_Reference; 1093 begin 1094 Ignored := Add_To_Xref_File (ALI_File_Name (File_Name), False); 1095 end; 1096 end if; 1097 1098 -- Parse references to this entity. 1099 -- Ptr points to next reference with leading blanks 1100 1101 loop 1102 -- Process references on current line 1103 1104 while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop 1105 1106 -- For every reference read the line, type and column, 1107 -- optionally preceded by a file number and a pipe symbol. 1108 1109 Parse_Number (Ali, Ptr, R_Line); 1110 1111 if Ali (Ptr) = Pipe then 1112 Ptr := Ptr + 1; 1113 File_Ref := File_Name (File, R_Line); 1114 1115 Parse_Number (Ali, Ptr, R_Line); 1116 end if; 1117 1118 if Ali (Ptr) > ' ' then 1119 R_Type := Ali (Ptr); 1120 Ptr := Ptr + 1; 1121 end if; 1122 1123 -- Imported entities may have an indication specifying information 1124 -- about the corresponding external name: 1125 -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity 1126 -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity 1127 1128 if (R_Type = 'b' or else R_Type = 'i') 1129 and then Ali (Ptr) = '<' 1130 then 1131 while Ptr <= Ali'Last 1132 and then Ali (Ptr) /= '>' 1133 loop 1134 Ptr := Ptr + 1; 1135 end loop; 1136 Ptr := Ptr + 1; 1137 end if; 1138 1139 Parse_Number (Ali, Ptr, R_Col); 1140 1141 -- Insert the reference or body in the table 1142 1143 Add_Reference 1144 (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref); 1145 1146 -- Skip generic information, if any 1147 1148 if Ali (Ptr) = '[' then 1149 declare 1150 Num_Nested : Integer := 1; 1151 1152 begin 1153 Ptr := Ptr + 1; 1154 while Num_Nested /= 0 loop 1155 if Ali (Ptr) = ']' then 1156 Num_Nested := Num_Nested - 1; 1157 elsif Ali (Ptr) = '[' then 1158 Num_Nested := Num_Nested + 1; 1159 end if; 1160 1161 Ptr := Ptr + 1; 1162 end loop; 1163 end; 1164 end if; 1165 1166 end loop; 1167 1168 Parse_EOL (Ali, Ptr); 1169 1170 -- Loop until new line is no continuation line 1171 1172 exit when Ali (Ptr) /= '.'; 1173 Ptr := Ptr + 1; 1174 end loop; 1175 end Parse_Identifier_Info; 1176 1177 ------------------ 1178 -- Parse_Number -- 1179 ------------------ 1180 1181 procedure Parse_Number 1182 (Source : not null access String; 1183 Ptr : in out Positive; 1184 Number : out Natural) 1185 is 1186 begin 1187 -- Skip separators 1188 1189 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop 1190 Ptr := Ptr + 1; 1191 end loop; 1192 1193 Number := 0; 1194 while Source (Ptr) in '0' .. '9' loop 1195 Number := 1196 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); 1197 Ptr := Ptr + 1; 1198 end loop; 1199 end Parse_Number; 1200 1201 ----------------- 1202 -- Parse_Token -- 1203 ----------------- 1204 1205 procedure Parse_Token 1206 (Source : not null access String; 1207 Ptr : in out Positive; 1208 Token_Ptr : out Positive) 1209 is 1210 In_Quotes : Character := ASCII.NUL; 1211 1212 begin 1213 -- Skip separators 1214 1215 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop 1216 Ptr := Ptr + 1; 1217 end loop; 1218 1219 Token_Ptr := Ptr; 1220 1221 -- Find end-of-token 1222 1223 while (In_Quotes /= ASCII.NUL or else 1224 not (Source (Ptr) = ' ' 1225 or else Source (Ptr) = ASCII.HT 1226 or else Source (Ptr) = '<' 1227 or else Source (Ptr) = '{' 1228 or else Source (Ptr) = '[' 1229 or else Source (Ptr) = '=' 1230 or else Source (Ptr) = '(')) 1231 and then Source (Ptr) >= ' ' 1232 loop 1233 -- Double-quotes are used for operators 1234 -- Simple-quotes are used for character constants, for instance when 1235 -- they are found in an enumeration type "type A is ('+', '-');" 1236 1237 case Source (Ptr) is 1238 when '"' | ''' => 1239 if In_Quotes = Source (Ptr) then 1240 In_Quotes := ASCII.NUL; 1241 elsif In_Quotes = ASCII.NUL then 1242 In_Quotes := Source (Ptr); 1243 end if; 1244 1245 when others => 1246 null; 1247 end case; 1248 1249 Ptr := Ptr + 1; 1250 end loop; 1251 end Parse_Token; 1252 1253 ---------------------- 1254 -- Parse_X_Filename -- 1255 ---------------------- 1256 1257 procedure Parse_X_Filename (File : in out ALI_File) is 1258 Ali : String_Access renames File.Buffer; 1259 Ptr : Positive renames File.Current_Line; 1260 File_Nr : Natural; 1261 1262 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); 1263 1264 begin 1265 while Ali (Ptr) = 'X' loop 1266 1267 -- The current line is the start of a new Xref file section, 1268 -- whose format looks like: 1269 1270 -- " X 1 debug.ads" 1271 1272 -- Skip the X and read the file number for the new X_File 1273 1274 Ptr := Ptr + 1; 1275 Parse_Number (Ali, Ptr, File_Nr); 1276 1277 -- If the referenced file is unknown, we simply ignore it 1278 1279 if File_Nr in Table'Range then 1280 File.X_File := Table (File_Nr); 1281 else 1282 File.X_File := Empty_File; 1283 end if; 1284 1285 Parse_EOL (Ali, Ptr); 1286 end loop; 1287 end Parse_X_Filename; 1288 1289 -------------------- 1290 -- Print_Gnatfind -- 1291 -------------------- 1292 1293 procedure Print_Gnatfind 1294 (References : Boolean; 1295 Full_Path_Name : Boolean) 1296 is 1297 Decls : constant Declaration_Array_Access := Get_Declarations; 1298 Decl : Declaration_Reference; 1299 Arr : Reference_Array_Access; 1300 1301 procedure Print_Ref 1302 (Ref : Reference; 1303 Msg : String := " "); 1304 -- Print a reference, according to the extended tag of the output 1305 1306 --------------- 1307 -- Print_Ref -- 1308 --------------- 1309 1310 procedure Print_Ref 1311 (Ref : Reference; 1312 Msg : String := " ") 1313 is 1314 F : String_Access := 1315 Osint.To_Host_File_Spec 1316 (Get_Gnatchop_File (Ref, Full_Path_Name)); 1317 1318 Buffer : constant String := 1319 F.all & 1320 ":" & Get_Line (Ref) & 1321 ":" & Get_Column (Ref) & 1322 ": "; 1323 1324 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; 1325 1326 begin 1327 Free (F); 1328 Num_Blanks := Integer'Max (0, Num_Blanks); 1329 Write_Line 1330 (Buffer 1331 & String'(1 .. Num_Blanks => ' ') 1332 & Msg & " " & Get_Symbol (Decl)); 1333 1334 if Get_Source_Line (Ref)'Length /= 0 then 1335 Write_Line (" " & Get_Source_Line (Ref)); 1336 end if; 1337 end Print_Ref; 1338 1339 -- Start of processing for Print_Gnatfind 1340 1341 begin 1342 for D in Decls'Range loop 1343 Decl := Decls (D); 1344 1345 if Match (Decl) then 1346 1347 -- Output the declaration 1348 1349 declare 1350 Parent : constant Declaration_Reference := Get_Parent (Decl); 1351 1352 F : String_Access := 1353 Osint.To_Host_File_Spec 1354 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1355 1356 Buffer : constant String := 1357 F.all & 1358 ":" & Get_Line (Decl) & 1359 ":" & Get_Column (Decl) & 1360 ": "; 1361 1362 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; 1363 1364 begin 1365 Free (F); 1366 Num_Blanks := Integer'Max (0, Num_Blanks); 1367 Write_Line 1368 (Buffer & String'(1 .. Num_Blanks => ' ') 1369 & "(spec) " & Get_Symbol (Decl)); 1370 1371 if Parent /= Empty_Declaration then 1372 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); 1373 Write_Line 1374 (Buffer & String'(1 .. Num_Blanks => ' ') 1375 & " derived from " & Get_Symbol (Parent) 1376 & " (" 1377 & F.all 1378 & ':' & Get_Line (Parent) 1379 & ':' & Get_Column (Parent) & ')'); 1380 Free (F); 1381 end if; 1382 end; 1383 1384 if Get_Source_Line (Decl)'Length /= 0 then 1385 Write_Line (" " & Get_Source_Line (Decl)); 1386 end if; 1387 1388 -- Output the body (sorted) 1389 1390 Arr := Get_References (Decl, Get_Bodies => True); 1391 1392 for R in Arr'Range loop 1393 Print_Ref (Arr (R), "(body)"); 1394 end loop; 1395 1396 Free (Arr); 1397 1398 if References then 1399 Arr := Get_References 1400 (Decl, Get_Writes => True, Get_Reads => True); 1401 1402 for R in Arr'Range loop 1403 Print_Ref (Arr (R)); 1404 end loop; 1405 1406 Free (Arr); 1407 end if; 1408 end if; 1409 end loop; 1410 end Print_Gnatfind; 1411 1412 ------------------ 1413 -- Print_Unused -- 1414 ------------------ 1415 1416 procedure Print_Unused (Full_Path_Name : Boolean) is 1417 Decls : constant Declaration_Array_Access := Get_Declarations; 1418 Decl : Declaration_Reference; 1419 Arr : Reference_Array_Access; 1420 F : String_Access; 1421 1422 begin 1423 for D in Decls'Range loop 1424 Decl := Decls (D); 1425 1426 if References_Count 1427 (Decl, Get_Reads => True, Get_Writes => True) = 0 1428 then 1429 F := Osint.To_Host_File_Spec 1430 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1431 Write_Str (Get_Symbol (Decl) 1432 & " (" 1433 & Get_Full_Type (Decl) 1434 & ") " 1435 & F.all 1436 & ':' 1437 & Get_Line (Decl) 1438 & ':' 1439 & Get_Column (Decl)); 1440 Free (F); 1441 1442 -- Print the body if any 1443 1444 Arr := Get_References (Decl, Get_Bodies => True); 1445 1446 for R in Arr'Range loop 1447 F := Osint.To_Host_File_Spec 1448 (Get_Gnatchop_File (Arr (R), Full_Path_Name)); 1449 Write_Str (' ' 1450 & F.all 1451 & ':' & Get_Line (Arr (R)) 1452 & ':' & Get_Column (Arr (R))); 1453 Free (F); 1454 end loop; 1455 1456 Write_Eol; 1457 Free (Arr); 1458 end if; 1459 end loop; 1460 end Print_Unused; 1461 1462 -------------- 1463 -- Print_Vi -- 1464 -------------- 1465 1466 procedure Print_Vi (Full_Path_Name : Boolean) is 1467 Tab : constant Character := ASCII.HT; 1468 Decls : constant Declaration_Array_Access := 1469 Get_Declarations (Sorted => False); 1470 Decl : Declaration_Reference; 1471 Arr : Reference_Array_Access; 1472 F : String_Access; 1473 1474 begin 1475 for D in Decls'Range loop 1476 Decl := Decls (D); 1477 1478 F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name)); 1479 Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl)); 1480 Free (F); 1481 1482 -- Print the body if any 1483 1484 Arr := Get_References (Decl, Get_Bodies => True); 1485 1486 for R in Arr'Range loop 1487 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); 1488 Write_Line 1489 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); 1490 Free (F); 1491 end loop; 1492 1493 Free (Arr); 1494 1495 -- Print the modifications 1496 1497 Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True); 1498 1499 for R in Arr'Range loop 1500 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); 1501 Write_Line 1502 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); 1503 Free (F); 1504 end loop; 1505 1506 Free (Arr); 1507 end loop; 1508 end Print_Vi; 1509 1510 ---------------- 1511 -- Print_Xref -- 1512 ---------------- 1513 1514 procedure Print_Xref (Full_Path_Name : Boolean) is 1515 Decls : constant Declaration_Array_Access := Get_Declarations; 1516 Decl : Declaration_Reference; 1517 1518 Margin : constant := 10; 1519 -- Column where file names start 1520 1521 procedure New_Line80; 1522 -- Go to start of new line 1523 1524 procedure Print80 (S : String); 1525 -- Print the text, respecting the 80 columns rule 1526 1527 procedure Print_Ref (Line, Column : String); 1528 -- The beginning of the output is aligned on a column multiple of 9 1529 1530 procedure Print_List 1531 (Decl : Declaration_Reference; 1532 Msg : String; 1533 Get_Reads : Boolean := False; 1534 Get_Writes : Boolean := False; 1535 Get_Bodies : Boolean := False); 1536 -- Print a list of references. If the list is not empty, Msg will 1537 -- be printed prior to the list. 1538 1539 ---------------- 1540 -- New_Line80 -- 1541 ---------------- 1542 1543 procedure New_Line80 is 1544 begin 1545 Write_Eol; 1546 Write_Str (String'(1 .. Margin - 1 => ' ')); 1547 end New_Line80; 1548 1549 ------------- 1550 -- Print80 -- 1551 ------------- 1552 1553 procedure Print80 (S : String) is 1554 Align : Natural := Margin - (Integer (Column) mod Margin); 1555 1556 begin 1557 if Align = Margin then 1558 Align := 0; 1559 end if; 1560 1561 Write_Str (String'(1 .. Align => ' ') & S); 1562 end Print80; 1563 1564 --------------- 1565 -- Print_Ref -- 1566 --------------- 1567 1568 procedure Print_Ref (Line, Column : String) is 1569 Line_Align : constant Integer := 4 - Line'Length; 1570 1571 S : constant String := String'(1 .. Line_Align => ' ') 1572 & Line & ':' & Column; 1573 1574 Align : Natural := Margin - (Integer (Output.Column) mod Margin); 1575 1576 begin 1577 if Align = Margin then 1578 Align := 0; 1579 end if; 1580 1581 if Integer (Output.Column) + Align + S'Length > 79 then 1582 New_Line80; 1583 Align := 0; 1584 end if; 1585 1586 Write_Str (String'(1 .. Align => ' ') & S); 1587 end Print_Ref; 1588 1589 ---------------- 1590 -- Print_List -- 1591 ---------------- 1592 1593 procedure Print_List 1594 (Decl : Declaration_Reference; 1595 Msg : String; 1596 Get_Reads : Boolean := False; 1597 Get_Writes : Boolean := False; 1598 Get_Bodies : Boolean := False) 1599 is 1600 Arr : Reference_Array_Access := 1601 Get_References 1602 (Decl, 1603 Get_Writes => Get_Writes, 1604 Get_Reads => Get_Reads, 1605 Get_Bodies => Get_Bodies); 1606 File : File_Reference := Empty_File; 1607 F : String_Access; 1608 1609 begin 1610 if Arr'Length /= 0 then 1611 Write_Eol; 1612 Write_Str (Msg); 1613 end if; 1614 1615 for R in Arr'Range loop 1616 if Get_File_Ref (Arr (R)) /= File then 1617 if File /= Empty_File then 1618 New_Line80; 1619 end if; 1620 1621 File := Get_File_Ref (Arr (R)); 1622 F := Osint.To_Host_File_Spec 1623 (Get_Gnatchop_File (Arr (R), Full_Path_Name)); 1624 1625 if F = null then 1626 Write_Str ("<unknown> "); 1627 else 1628 Write_Str (F.all & ' '); 1629 Free (F); 1630 end if; 1631 end if; 1632 1633 Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R))); 1634 end loop; 1635 1636 Free (Arr); 1637 end Print_List; 1638 1639 F : String_Access; 1640 1641 -- Start of processing for Print_Xref 1642 1643 begin 1644 for D in Decls'Range loop 1645 Decl := Decls (D); 1646 1647 Write_Str (Get_Symbol (Decl)); 1648 1649 -- Put the declaration type in column Type_Position, but if the 1650 -- declaration name is too long, put at least one space between its 1651 -- name and its type. 1652 1653 while Column < Type_Position - 1 loop 1654 Write_Char (' '); 1655 end loop; 1656 1657 Write_Char (' '); 1658 1659 Write_Line (Get_Full_Type (Decl)); 1660 1661 Write_Parent_Info : declare 1662 Parent : constant Declaration_Reference := Get_Parent (Decl); 1663 1664 begin 1665 if Parent /= Empty_Declaration then 1666 Write_Str (" Ptype: "); 1667 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); 1668 Print80 (F.all); 1669 Free (F); 1670 Print_Ref (Get_Line (Parent), Get_Column (Parent)); 1671 Print80 (" " & Get_Symbol (Parent)); 1672 Write_Eol; 1673 end if; 1674 end Write_Parent_Info; 1675 1676 Write_Str (" Decl: "); 1677 F := Osint.To_Host_File_Spec 1678 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1679 1680 if F = null then 1681 Print80 ("<unknown> "); 1682 else 1683 Print80 (F.all & ' '); 1684 Free (F); 1685 end if; 1686 1687 Print_Ref (Get_Line (Decl), Get_Column (Decl)); 1688 1689 Print_List 1690 (Decl, " Body: ", Get_Bodies => True); 1691 Print_List 1692 (Decl, " Modi: ", Get_Writes => True); 1693 Print_List 1694 (Decl, " Ref: ", Get_Reads => True); 1695 Write_Eol; 1696 end loop; 1697 end Print_Xref; 1698 1699 ------------ 1700 -- Search -- 1701 ------------ 1702 1703 procedure Search 1704 (Pattern : Search_Pattern; 1705 Local_Symbols : Boolean; 1706 Wide_Search : Boolean; 1707 Read_Only : Boolean; 1708 Der_Info : Boolean; 1709 Type_Tree : Boolean) 1710 is 1711 type String_Access is access String; 1712 procedure Free is new Unchecked_Deallocation (String, String_Access); 1713 1714 ALIfile : ALI_File; 1715 File_Ref : File_Reference; 1716 Strip_Num : Natural := 0; 1717 Ali_Name : String_Access; 1718 1719 begin 1720 -- If we want all the .ali files, then find them 1721 1722 if Wide_Search then 1723 Find_ALI_Files; 1724 end if; 1725 1726 loop 1727 -- Get the next unread ali file 1728 1729 File_Ref := Next_Unvisited_File; 1730 1731 exit when File_Ref = Empty_File; 1732 1733 -- Find the ALI file to use. Most of the time, it will be the unit 1734 -- name, with a different extension. However, when dealing with 1735 -- separates the ALI file is in fact the parent's ALI file (and this 1736 -- is recursive, in case the parent itself is a separate). 1737 1738 Strip_Num := 0; 1739 loop 1740 Free (Ali_Name); 1741 Ali_Name := new String' 1742 (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); 1743 1744 -- Stripped too many things... 1745 1746 if Ali_Name.all = "" then 1747 if Get_Emit_Warning (File_Ref) then 1748 Set_Standard_Error; 1749 Write_Line 1750 ("warning : file " & Get_File (File_Ref, With_Dir => True) 1751 & " not found"); 1752 Set_Standard_Output; 1753 end if; 1754 Free (Ali_Name); 1755 exit; 1756 1757 -- If not found, try the parent's ALI file (this is needed for 1758 -- separate units and subprograms). 1759 1760 -- Reset the cached directory first, in case the separate's 1761 -- ALI file is not in the same directory. 1762 1763 elsif not File_Exists (Ali_Name.all) then 1764 Strip_Num := Strip_Num + 1; 1765 Reset_Directory (File_Ref); 1766 1767 -- Else we finally found it 1768 1769 else 1770 exit; 1771 end if; 1772 end loop; 1773 1774 -- If we had to get the parent's ALI, insert it in the list as usual. 1775 -- This is to avoid parsing it twice in case it has already been 1776 -- parsed. 1777 1778 if Ali_Name /= null and then Strip_Num /= 0 then 1779 File_Ref := Add_To_Xref_File 1780 (File_Name => Ali_Name.all, 1781 Visited => False); 1782 1783 -- Now that we have a file name, parse it to find any reference to 1784 -- the entity. 1785 1786 elsif Ali_Name /= null 1787 and then (Read_Only or else Is_Writable_File (Ali_Name.all)) 1788 then 1789 begin 1790 Open (Ali_Name.all, ALIfile); 1791 1792 -- The cross-reference section in the ALI file may be followed 1793 -- by other sections, which can be identified by the starting 1794 -- character of every line, which should neither be 'X' nor a 1795 -- figure in '1' .. '9'. 1796 1797 -- The loop tests below also take into account the end-of-file 1798 -- possibility. 1799 1800 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop 1801 Parse_X_Filename (ALIfile); 1802 1803 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' 1804 loop 1805 Parse_Identifier_Info 1806 (Pattern, ALIfile, Local_Symbols, Der_Info, Type_Tree, 1807 Wide_Search, Labels_As_Ref => True); 1808 end loop; 1809 end loop; 1810 1811 exception 1812 when No_Xref_Information => 1813 if Get_Emit_Warning (File_Ref) then 1814 Set_Standard_Error; 1815 Write_Line 1816 ("warning : No cross-referencing information in " 1817 & Ali_Name.all); 1818 Set_Standard_Output; 1819 end if; 1820 end; 1821 end if; 1822 end loop; 1823 1824 Free (Ali_Name); 1825 end Search; 1826 1827 ----------------- 1828 -- Search_Xref -- 1829 ----------------- 1830 1831 procedure Search_Xref 1832 (Local_Symbols : Boolean; 1833 Read_Only : Boolean; 1834 Der_Info : Boolean) 1835 is 1836 ALIfile : ALI_File; 1837 File_Ref : File_Reference; 1838 Null_Pattern : Search_Pattern; 1839 1840 begin 1841 Null_Pattern.Initialized := False; 1842 1843 loop 1844 -- Find the next unvisited file 1845 1846 File_Ref := Next_Unvisited_File; 1847 exit when File_Ref = Empty_File; 1848 1849 -- Search the object directories for the .ali file 1850 1851 declare 1852 F : constant String := Get_File (File_Ref, With_Dir => True); 1853 1854 begin 1855 if Read_Only or else Is_Writable_File (F) then 1856 Open (F, ALIfile, True); 1857 1858 -- The cross-reference section in the ALI file may be followed 1859 -- by other sections, which can be identified by the starting 1860 -- character of every line, which should neither be 'X' nor a 1861 -- figure in '1' .. '9'. 1862 1863 -- The loop tests below also take into account the end-of-file 1864 -- possibility. 1865 1866 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop 1867 Parse_X_Filename (ALIfile); 1868 1869 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' 1870 loop 1871 Parse_Identifier_Info 1872 (Null_Pattern, ALIfile, Local_Symbols, Der_Info, 1873 Labels_As_Ref => False); 1874 end loop; 1875 end loop; 1876 end if; 1877 1878 exception 1879 when No_Xref_Information => null; 1880 end; 1881 end loop; 1882 end Search_Xref; 1883 1884end Xref_Lib; 1885