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