1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T L S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-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 ALI; use ALI; 27with ALI.Util; use ALI.Util; 28with Binderr; use Binderr; 29with Butil; use Butil; 30with Csets; use Csets; 31with Fname; use Fname; 32with Gnatvsn; use Gnatvsn; 33with GNAT.OS_Lib; use GNAT.OS_Lib; 34with Namet; use Namet; 35with Opt; use Opt; 36with Osint; use Osint; 37with Osint.L; use Osint.L; 38with Output; use Output; 39with Prj.Env; use Prj.Env; 40with Rident; use Rident; 41with Sdefault; 42with Snames; 43with Switch; use Switch; 44with Types; use Types; 45 46with GNAT.Case_Util; use GNAT.Case_Util; 47 48procedure Gnatls is 49 pragma Ident (Gnat_Static_Version_String); 50 51 -- NOTE : The following string may be used by other tools, such as GPS. So 52 -- it can only be modified if these other uses are checked and coordinated. 53 54 Project_Search_Path : constant String := "Project Search Path:"; 55 -- Label displayed in verbose mode before the directories in the project 56 -- search path. Do not modify without checking NOTE above. 57 58 Prj_Path : Prj.Env.Project_Search_Path; 59 60 Max_Column : constant := 80; 61 62 No_Obj : aliased String := "<no_obj>"; 63 64 type File_Status is ( 65 OK, -- matching timestamp 66 Checksum_OK, -- only matching checksum 67 Not_Found, -- file not found on source PATH 68 Not_Same, -- neither checksum nor timestamp matching 69 Not_First_On_PATH); -- matching file hidden by Not_Same file on path 70 71 type Dir_Data; 72 type Dir_Ref is access Dir_Data; 73 74 type Dir_Data is record 75 Value : String_Access; 76 Next : Dir_Ref; 77 end record; 78 -- Simply linked list of dirs 79 80 First_Source_Dir : Dir_Ref; 81 Last_Source_Dir : Dir_Ref; 82 -- The list of source directories from the command line. 83 -- These directories are added using Osint.Add_Src_Search_Dir 84 -- after those of the GNAT Project File, if any. 85 86 First_Lib_Dir : Dir_Ref; 87 Last_Lib_Dir : Dir_Ref; 88 -- The list of object directories from the command line. 89 -- These directories are added using Osint.Add_Lib_Search_Dir 90 -- after those of the GNAT Project File, if any. 91 92 Main_File : File_Name_Type; 93 Ali_File : File_Name_Type; 94 Text : Text_Buffer_Ptr; 95 Next_Arg : Positive; 96 97 Too_Long : Boolean := False; 98 -- When True, lines are too long for multi-column output and each 99 -- item of information is on a different line. 100 101 Selective_Output : Boolean := False; 102 Print_Usage : Boolean := False; 103 Print_Unit : Boolean := True; 104 Print_Source : Boolean := True; 105 Print_Object : Boolean := True; 106 -- Flags controlling the form of the output 107 108 Also_Predef : Boolean := False; -- -a 109 Dependable : Boolean := False; -- -d 110 License : Boolean := False; -- -l 111 Very_Verbose_Mode : Boolean := False; -- -V 112 -- Command line flags 113 114 Unit_Start : Integer; 115 Unit_End : Integer; 116 Source_Start : Integer; 117 Source_End : Integer; 118 Object_Start : Integer; 119 Object_End : Integer; 120 -- Various column starts and ends 121 122 Spaces : constant String (1 .. Max_Column) := (others => ' '); 123 124 RTS_Specified : String_Access := null; 125 -- Used to detect multiple use of --RTS= switch 126 127 ----------------------- 128 -- Local Subprograms -- 129 ----------------------- 130 131 procedure Add_Lib_Dir (Dir : String); 132 -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir 133 134 procedure Add_Source_Dir (Dir : String); 135 -- Add a source directory in the list First_Source_Dir-Last_Source_Dir 136 137 procedure Find_General_Layout; 138 -- Determine the structure of the output (multi columns or not, etc) 139 140 procedure Find_Status 141 (FS : in out File_Name_Type; 142 Stamp : Time_Stamp_Type; 143 Checksum : Word; 144 Status : out File_Status); 145 -- Determine the file status (Status) of the file represented by FS 146 -- with the expected Stamp and checksum given as argument. FS will be 147 -- updated to the full file name if available. 148 149 function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id; 150 -- Give the Sdep entry corresponding to the unit U in ali record A 151 152 procedure Output_Object (O : File_Name_Type); 153 -- Print out the name of the object when requested 154 155 procedure Output_Source (Sdep_I : Sdep_Id); 156 -- Print out the name and status of the source corresponding to this 157 -- sdep entry. 158 159 procedure Output_Status (FS : File_Status; Verbose : Boolean); 160 -- Print out FS either in a coded form if verbose is false or in an 161 -- expanded form otherwise. 162 163 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id); 164 -- Print out information on the unit when requested 165 166 procedure Reset_Print; 167 -- Reset Print flags properly when selective output is chosen 168 169 procedure Scan_Ls_Arg (Argv : String); 170 -- Scan and process lser specific arguments. Argv is a single argument 171 172 procedure Search_RTS (Name : String); 173 -- Find include and objects path for the RTS name. 174 175 procedure Usage; 176 -- Print usage message 177 178 procedure Output_License_Information; 179 -- Output license statement, and if not found, output reference to 180 -- COPYING. 181 182 function Image (Restriction : Restriction_Id) return String; 183 -- Returns the capitalized image of Restriction 184 185 ------------------------------------------ 186 -- GNATDIST specific output subprograms -- 187 ------------------------------------------ 188 189 package GNATDIST is 190 191 -- Any modification to this subunit requires synchronization with the 192 -- GNATDIST sources. 193 194 procedure Output_ALI (A : ALI_Id); 195 -- Comment required saying what this routine does ??? 196 197 procedure Output_No_ALI (Afile : File_Name_Type); 198 -- Comments required saying what this routine does ??? 199 200 end GNATDIST; 201 202 ----------------- 203 -- Add_Lib_Dir -- 204 ----------------- 205 206 procedure Add_Lib_Dir (Dir : String) is 207 begin 208 if First_Lib_Dir = null then 209 First_Lib_Dir := 210 new Dir_Data' 211 (Value => new String'(Dir), 212 Next => null); 213 Last_Lib_Dir := First_Lib_Dir; 214 215 else 216 Last_Lib_Dir.Next := 217 new Dir_Data' 218 (Value => new String'(Dir), 219 Next => null); 220 Last_Lib_Dir := Last_Lib_Dir.Next; 221 end if; 222 end Add_Lib_Dir; 223 224 -------------------- 225 -- Add_Source_Dir -- 226 -------------------- 227 228 procedure Add_Source_Dir (Dir : String) is 229 begin 230 if First_Source_Dir = null then 231 First_Source_Dir := 232 new Dir_Data' 233 (Value => new String'(Dir), 234 Next => null); 235 Last_Source_Dir := First_Source_Dir; 236 237 else 238 Last_Source_Dir.Next := 239 new Dir_Data' 240 (Value => new String'(Dir), 241 Next => null); 242 Last_Source_Dir := Last_Source_Dir.Next; 243 end if; 244 end Add_Source_Dir; 245 246 ------------------------------ 247 -- Corresponding_Sdep_Entry -- 248 ------------------------------ 249 250 function Corresponding_Sdep_Entry 251 (A : ALI_Id; 252 U : Unit_Id) return Sdep_Id 253 is 254 begin 255 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop 256 if Sdep.Table (D).Sfile = Units.Table (U).Sfile then 257 return D; 258 end if; 259 end loop; 260 261 Error_Msg_Unit_1 := Units.Table (U).Uname; 262 Error_Msg_File_1 := ALIs.Table (A).Afile; 263 Write_Eol; 264 Error_Msg ("wrong ALI format, can't find dependency line for $ in {"); 265 Exit_Program (E_Fatal); 266 return No_Sdep_Id; 267 end Corresponding_Sdep_Entry; 268 269 ------------------------- 270 -- Find_General_Layout -- 271 ------------------------- 272 273 procedure Find_General_Layout is 274 Max_Unit_Length : Integer := 11; 275 Max_Src_Length : Integer := 11; 276 Max_Obj_Length : Integer := 11; 277 278 Len : Integer; 279 FS : File_Name_Type; 280 281 begin 282 -- Compute maximum of each column 283 284 for Id in ALIs.First .. ALIs.Last loop 285 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname); 286 if Also_Predef or else not Is_Internal_Unit then 287 288 if Print_Unit then 289 Len := Name_Len - 1; 290 Max_Unit_Length := Integer'Max (Max_Unit_Length, Len); 291 end if; 292 293 if Print_Source then 294 FS := Full_Source_Name (ALIs.Table (Id).Sfile); 295 296 if FS = No_File then 297 Get_Name_String (ALIs.Table (Id).Sfile); 298 Name_Len := Name_Len + 13; 299 else 300 Get_Name_String (FS); 301 end if; 302 303 Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1); 304 end if; 305 306 if Print_Object then 307 if ALIs.Table (Id).No_Object then 308 Max_Obj_Length := 309 Integer'Max (Max_Obj_Length, No_Obj'Length); 310 else 311 Get_Name_String (ALIs.Table (Id).Ofile_Full_Name); 312 Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1); 313 end if; 314 end if; 315 end if; 316 end loop; 317 318 -- Verify is output is not wider than maximum number of columns 319 320 Too_Long := 321 Verbose_Mode 322 or else 323 (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column; 324 325 -- Set start and end of columns 326 327 Object_Start := 1; 328 Object_End := Object_Start - 1; 329 330 if Print_Object then 331 Object_End := Object_Start + Max_Obj_Length; 332 end if; 333 334 Unit_Start := Object_End + 1; 335 Unit_End := Unit_Start - 1; 336 337 if Print_Unit then 338 Unit_End := Unit_Start + Max_Unit_Length; 339 end if; 340 341 Source_Start := Unit_End + 1; 342 343 if Source_Start > Spaces'Last then 344 Source_Start := Spaces'Last; 345 end if; 346 347 Source_End := Source_Start - 1; 348 349 if Print_Source then 350 Source_End := Source_Start + Max_Src_Length; 351 end if; 352 end Find_General_Layout; 353 354 ----------------- 355 -- Find_Status -- 356 ----------------- 357 358 procedure Find_Status 359 (FS : in out File_Name_Type; 360 Stamp : Time_Stamp_Type; 361 Checksum : Word; 362 Status : out File_Status) 363 is 364 Tmp1 : File_Name_Type; 365 Tmp2 : File_Name_Type; 366 367 begin 368 Tmp1 := Full_Source_Name (FS); 369 370 if Tmp1 = No_File then 371 Status := Not_Found; 372 373 elsif File_Stamp (Tmp1) = Stamp then 374 FS := Tmp1; 375 Status := OK; 376 377 elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then 378 FS := Tmp1; 379 Status := Checksum_OK; 380 381 else 382 Tmp2 := Matching_Full_Source_Name (FS, Stamp); 383 384 if Tmp2 = No_File then 385 Status := Not_Same; 386 FS := Tmp1; 387 388 else 389 Status := Not_First_On_PATH; 390 FS := Tmp2; 391 end if; 392 end if; 393 end Find_Status; 394 395 -------------- 396 -- GNATDIST -- 397 -------------- 398 399 package body GNATDIST is 400 401 N_Flags : Natural; 402 N_Indents : Natural := 0; 403 404 type Token_Type is 405 (T_No_ALI, 406 T_ALI, 407 T_Unit, 408 T_With, 409 T_Source, 410 T_Afile, 411 T_Ofile, 412 T_Sfile, 413 T_Name, 414 T_Main, 415 T_Kind, 416 T_Flags, 417 T_Preelaborated, 418 T_Pure, 419 T_Has_RACW, 420 T_Remote_Types, 421 T_Shared_Passive, 422 T_RCI, 423 T_Predefined, 424 T_Internal, 425 T_Is_Generic, 426 T_Procedure, 427 T_Function, 428 T_Package, 429 T_Subprogram, 430 T_Spec, 431 T_Body); 432 433 Image : constant array (Token_Type) of String_Access := 434 (T_No_ALI => new String'("No_ALI"), 435 T_ALI => new String'("ALI"), 436 T_Unit => new String'("Unit"), 437 T_With => new String'("With"), 438 T_Source => new String'("Source"), 439 T_Afile => new String'("Afile"), 440 T_Ofile => new String'("Ofile"), 441 T_Sfile => new String'("Sfile"), 442 T_Name => new String'("Name"), 443 T_Main => new String'("Main"), 444 T_Kind => new String'("Kind"), 445 T_Flags => new String'("Flags"), 446 T_Preelaborated => new String'("Preelaborated"), 447 T_Pure => new String'("Pure"), 448 T_Has_RACW => new String'("Has_RACW"), 449 T_Remote_Types => new String'("Remote_Types"), 450 T_Shared_Passive => new String'("Shared_Passive"), 451 T_RCI => new String'("RCI"), 452 T_Predefined => new String'("Predefined"), 453 T_Internal => new String'("Internal"), 454 T_Is_Generic => new String'("Is_Generic"), 455 T_Procedure => new String'("procedure"), 456 T_Function => new String'("function"), 457 T_Package => new String'("package"), 458 T_Subprogram => new String'("subprogram"), 459 T_Spec => new String'("spec"), 460 T_Body => new String'("body")); 461 462 procedure Output_Name (N : Name_Id); 463 -- Remove any encoding info (%b and %s) and output N 464 465 procedure Output_Afile (A : File_Name_Type); 466 procedure Output_Ofile (O : File_Name_Type); 467 procedure Output_Sfile (S : File_Name_Type); 468 -- Output various names. Check that the name is different from no name. 469 -- Otherwise, skip the output. 470 471 procedure Output_Token (T : Token_Type); 472 -- Output token using specific format. That is several indentations and: 473 -- 474 -- T_No_ALI .. T_With : <token> & " =>" & NL 475 -- T_Source .. T_Kind : <token> & " => " 476 -- T_Flags : <token> & " =>" 477 -- T_Preelab .. T_Body : " " & <token> 478 479 procedure Output_Sdep (S : Sdep_Id); 480 procedure Output_Unit (U : Unit_Id); 481 procedure Output_With (W : With_Id); 482 -- Output this entry as a global section (like ALIs) 483 484 ------------------ 485 -- Output_Afile -- 486 ------------------ 487 488 procedure Output_Afile (A : File_Name_Type) is 489 begin 490 if A /= No_File then 491 Output_Token (T_Afile); 492 Write_Name (A); 493 Write_Eol; 494 end if; 495 end Output_Afile; 496 497 ---------------- 498 -- Output_ALI -- 499 ---------------- 500 501 procedure Output_ALI (A : ALI_Id) is 502 begin 503 Output_Token (T_ALI); 504 N_Indents := N_Indents + 1; 505 506 Output_Afile (ALIs.Table (A).Afile); 507 Output_Ofile (ALIs.Table (A).Ofile_Full_Name); 508 Output_Sfile (ALIs.Table (A).Sfile); 509 510 -- Output Main 511 512 if ALIs.Table (A).Main_Program /= None then 513 Output_Token (T_Main); 514 515 if ALIs.Table (A).Main_Program = Proc then 516 Output_Token (T_Procedure); 517 else 518 Output_Token (T_Function); 519 end if; 520 521 Write_Eol; 522 end if; 523 524 -- Output Units 525 526 for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop 527 Output_Unit (U); 528 end loop; 529 530 -- Output Sdeps 531 532 for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop 533 Output_Sdep (S); 534 end loop; 535 536 N_Indents := N_Indents - 1; 537 end Output_ALI; 538 539 ------------------- 540 -- Output_No_ALI -- 541 ------------------- 542 543 procedure Output_No_ALI (Afile : File_Name_Type) is 544 begin 545 Output_Token (T_No_ALI); 546 N_Indents := N_Indents + 1; 547 Output_Afile (Afile); 548 N_Indents := N_Indents - 1; 549 end Output_No_ALI; 550 551 ----------------- 552 -- Output_Name -- 553 ----------------- 554 555 procedure Output_Name (N : Name_Id) is 556 begin 557 -- Remove any encoding info (%s or %b) 558 559 Get_Name_String (N); 560 561 if Name_Len > 2 562 and then Name_Buffer (Name_Len - 1) = '%' 563 then 564 Name_Len := Name_Len - 2; 565 end if; 566 567 Output_Token (T_Name); 568 Write_Str (Name_Buffer (1 .. Name_Len)); 569 Write_Eol; 570 end Output_Name; 571 572 ------------------ 573 -- Output_Ofile -- 574 ------------------ 575 576 procedure Output_Ofile (O : File_Name_Type) is 577 begin 578 if O /= No_File then 579 Output_Token (T_Ofile); 580 Write_Name (O); 581 Write_Eol; 582 end if; 583 end Output_Ofile; 584 585 ----------------- 586 -- Output_Sdep -- 587 ----------------- 588 589 procedure Output_Sdep (S : Sdep_Id) is 590 begin 591 Output_Token (T_Source); 592 Write_Name (Sdep.Table (S).Sfile); 593 Write_Eol; 594 end Output_Sdep; 595 596 ------------------ 597 -- Output_Sfile -- 598 ------------------ 599 600 procedure Output_Sfile (S : File_Name_Type) is 601 FS : File_Name_Type := S; 602 603 begin 604 if FS /= No_File then 605 606 -- We want to output the full source name 607 608 FS := Full_Source_Name (FS); 609 610 -- There is no full source name. This occurs for instance when a 611 -- withed unit has a spec file but no body file. This situation is 612 -- not a problem for GNATDIST since the unit may be located on a 613 -- partition we do not want to build. However, we need to locate 614 -- the spec file and to find its full source name. Replace the 615 -- body file name with the spec file name used to compile the 616 -- current unit when possible. 617 618 if FS = No_File then 619 Get_Name_String (S); 620 621 if Name_Len > 4 622 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" 623 then 624 Name_Buffer (Name_Len) := 's'; 625 FS := Full_Source_Name (Name_Find); 626 end if; 627 end if; 628 end if; 629 630 if FS /= No_File then 631 Output_Token (T_Sfile); 632 Write_Name (FS); 633 Write_Eol; 634 end if; 635 end Output_Sfile; 636 637 ------------------ 638 -- Output_Token -- 639 ------------------ 640 641 procedure Output_Token (T : Token_Type) is 642 begin 643 if T in T_No_ALI .. T_Flags then 644 for J in 1 .. N_Indents loop 645 Write_Str (" "); 646 end loop; 647 648 Write_Str (Image (T).all); 649 650 for J in Image (T)'Length .. 12 loop 651 Write_Char (' '); 652 end loop; 653 654 Write_Str ("=>"); 655 656 if T in T_No_ALI .. T_With then 657 Write_Eol; 658 elsif T in T_Source .. T_Name then 659 Write_Char (' '); 660 end if; 661 662 elsif T in T_Preelaborated .. T_Body then 663 if T in T_Preelaborated .. T_Is_Generic then 664 if N_Flags = 0 then 665 Output_Token (T_Flags); 666 end if; 667 668 N_Flags := N_Flags + 1; 669 end if; 670 671 Write_Char (' '); 672 Write_Str (Image (T).all); 673 674 else 675 Write_Str (Image (T).all); 676 end if; 677 end Output_Token; 678 679 ----------------- 680 -- Output_Unit -- 681 ----------------- 682 683 procedure Output_Unit (U : Unit_Id) is 684 begin 685 Output_Token (T_Unit); 686 N_Indents := N_Indents + 1; 687 688 -- Output Name 689 690 Output_Name (Name_Id (Units.Table (U).Uname)); 691 692 -- Output Kind 693 694 Output_Token (T_Kind); 695 696 if Units.Table (U).Unit_Kind = 'p' then 697 Output_Token (T_Package); 698 else 699 Output_Token (T_Subprogram); 700 end if; 701 702 if Name_Buffer (Name_Len) = 's' then 703 Output_Token (T_Spec); 704 else 705 Output_Token (T_Body); 706 end if; 707 708 Write_Eol; 709 710 -- Output source file name 711 712 Output_Sfile (Units.Table (U).Sfile); 713 714 -- Output Flags 715 716 N_Flags := 0; 717 718 if Units.Table (U).Preelab then 719 Output_Token (T_Preelaborated); 720 end if; 721 722 if Units.Table (U).Pure then 723 Output_Token (T_Pure); 724 end if; 725 726 if Units.Table (U).Has_RACW then 727 Output_Token (T_Has_RACW); 728 end if; 729 730 if Units.Table (U).Remote_Types then 731 Output_Token (T_Remote_Types); 732 end if; 733 734 if Units.Table (U).Shared_Passive then 735 Output_Token (T_Shared_Passive); 736 end if; 737 738 if Units.Table (U).RCI then 739 Output_Token (T_RCI); 740 end if; 741 742 if Units.Table (U).Predefined then 743 Output_Token (T_Predefined); 744 end if; 745 746 if Units.Table (U).Internal then 747 Output_Token (T_Internal); 748 end if; 749 750 if Units.Table (U).Is_Generic then 751 Output_Token (T_Is_Generic); 752 end if; 753 754 if N_Flags > 0 then 755 Write_Eol; 756 end if; 757 758 -- Output Withs 759 760 for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop 761 Output_With (W); 762 end loop; 763 764 N_Indents := N_Indents - 1; 765 end Output_Unit; 766 767 ----------------- 768 -- Output_With -- 769 ----------------- 770 771 procedure Output_With (W : With_Id) is 772 begin 773 Output_Token (T_With); 774 N_Indents := N_Indents + 1; 775 776 Output_Name (Name_Id (Withs.Table (W).Uname)); 777 778 -- Output Kind 779 780 Output_Token (T_Kind); 781 782 if Name_Buffer (Name_Len) = 's' then 783 Output_Token (T_Spec); 784 else 785 Output_Token (T_Body); 786 end if; 787 788 Write_Eol; 789 790 Output_Afile (Withs.Table (W).Afile); 791 Output_Sfile (Withs.Table (W).Sfile); 792 793 N_Indents := N_Indents - 1; 794 end Output_With; 795 796 end GNATDIST; 797 798 ----------- 799 -- Image -- 800 ----------- 801 802 function Image (Restriction : Restriction_Id) return String is 803 Result : String := Restriction'Img; 804 Skip : Boolean := True; 805 806 begin 807 for J in Result'Range loop 808 if Skip then 809 Skip := False; 810 Result (J) := To_Upper (Result (J)); 811 812 elsif Result (J) = '_' then 813 Skip := True; 814 815 else 816 Result (J) := To_Lower (Result (J)); 817 end if; 818 end loop; 819 820 return Result; 821 end Image; 822 823 -------------------------------- 824 -- Output_License_Information -- 825 -------------------------------- 826 827 procedure Output_License_Information is 828 begin 829 case Build_Type is 830 when others => 831 Write_Str ("Please refer to file COPYING in your distribution" 832 & " for license terms."); 833 Write_Eol; 834 end case; 835 836 Exit_Program (E_Success); 837 end Output_License_Information; 838 839 ------------------- 840 -- Output_Object -- 841 ------------------- 842 843 procedure Output_Object (O : File_Name_Type) is 844 Object_Name : String_Access; 845 846 begin 847 if Print_Object then 848 if O /= No_File then 849 Get_Name_String (O); 850 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); 851 else 852 Object_Name := No_Obj'Unchecked_Access; 853 end if; 854 855 Write_Str (Object_Name.all); 856 857 if Print_Source or else Print_Unit then 858 if Too_Long then 859 Write_Eol; 860 Write_Str (" "); 861 else 862 Write_Str (Spaces 863 (Object_Start + Object_Name'Length .. Object_End)); 864 end if; 865 end if; 866 end if; 867 end Output_Object; 868 869 ------------------- 870 -- Output_Source -- 871 ------------------- 872 873 procedure Output_Source (Sdep_I : Sdep_Id) is 874 Stamp : Time_Stamp_Type; 875 Checksum : Word; 876 FS : File_Name_Type; 877 Status : File_Status; 878 Object_Name : String_Access; 879 880 begin 881 if Sdep_I = No_Sdep_Id then 882 return; 883 end if; 884 885 Stamp := Sdep.Table (Sdep_I).Stamp; 886 Checksum := Sdep.Table (Sdep_I).Checksum; 887 FS := Sdep.Table (Sdep_I).Sfile; 888 889 if Print_Source then 890 Find_Status (FS, Stamp, Checksum, Status); 891 Get_Name_String (FS); 892 893 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); 894 895 if Verbose_Mode then 896 Write_Str (" Source => "); 897 Write_Str (Object_Name.all); 898 899 if not Too_Long then 900 Write_Str 901 (Spaces (Source_Start + Object_Name'Length .. Source_End)); 902 end if; 903 904 Output_Status (Status, Verbose => True); 905 Write_Eol; 906 Write_Str (" "); 907 908 else 909 if not Selective_Output then 910 Output_Status (Status, Verbose => False); 911 end if; 912 913 Write_Str (Object_Name.all); 914 end if; 915 end if; 916 end Output_Source; 917 918 ------------------- 919 -- Output_Status -- 920 ------------------- 921 922 procedure Output_Status (FS : File_Status; Verbose : Boolean) is 923 begin 924 if Verbose then 925 case FS is 926 when OK => 927 Write_Str (" unchanged"); 928 929 when Checksum_OK => 930 Write_Str (" slightly modified"); 931 932 when Not_Found => 933 Write_Str (" file not found"); 934 935 when Not_Same => 936 Write_Str (" modified"); 937 938 when Not_First_On_PATH => 939 Write_Str (" unchanged version not first on PATH"); 940 end case; 941 942 else 943 case FS is 944 when OK => 945 Write_Str (" OK "); 946 947 when Checksum_OK => 948 Write_Str (" MOK "); 949 950 when Not_Found => 951 Write_Str (" ??? "); 952 953 when Not_Same => 954 Write_Str (" DIF "); 955 956 when Not_First_On_PATH => 957 Write_Str (" HID "); 958 end case; 959 end if; 960 end Output_Status; 961 962 ----------------- 963 -- Output_Unit -- 964 ----------------- 965 966 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is 967 Kind : Character; 968 U : Unit_Record renames Units.Table (U_Id); 969 970 begin 971 if Print_Unit then 972 Get_Name_String (U.Uname); 973 Kind := Name_Buffer (Name_Len); 974 Name_Len := Name_Len - 2; 975 976 if not Verbose_Mode then 977 Write_Str (Name_Buffer (1 .. Name_Len)); 978 979 else 980 Write_Str ("Unit => "); 981 Write_Eol; 982 Write_Str (" Name => "); 983 Write_Str (Name_Buffer (1 .. Name_Len)); 984 Write_Eol; 985 Write_Str (" Kind => "); 986 987 if Units.Table (U_Id).Unit_Kind = 'p' then 988 Write_Str ("package "); 989 else 990 Write_Str ("subprogram "); 991 end if; 992 993 if Kind = 's' then 994 Write_Str ("spec"); 995 else 996 Write_Str ("body"); 997 end if; 998 end if; 999 1000 if Verbose_Mode then 1001 if U.Preelab or else 1002 U.No_Elab or else 1003 U.Pure or else 1004 U.Dynamic_Elab or else 1005 U.Has_RACW or else 1006 U.Remote_Types or else 1007 U.Shared_Passive or else 1008 U.RCI or else 1009 U.Predefined or else 1010 U.Internal or else 1011 U.Is_Generic or else 1012 U.Init_Scalars or else 1013 U.SAL_Interface or else 1014 U.Body_Needed_For_SAL or else 1015 U.Elaborate_Body 1016 then 1017 Write_Eol; 1018 Write_Str (" Flags =>"); 1019 1020 if U.Preelab then 1021 Write_Str (" Preelaborable"); 1022 end if; 1023 1024 if U.No_Elab then 1025 Write_Str (" No_Elab_Code"); 1026 end if; 1027 1028 if U.Pure then 1029 Write_Str (" Pure"); 1030 end if; 1031 1032 if U.Dynamic_Elab then 1033 Write_Str (" Dynamic_Elab"); 1034 end if; 1035 1036 if U.Has_RACW then 1037 Write_Str (" Has_RACW"); 1038 end if; 1039 1040 if U.Remote_Types then 1041 Write_Str (" Remote_Types"); 1042 end if; 1043 1044 if U.Shared_Passive then 1045 Write_Str (" Shared_Passive"); 1046 end if; 1047 1048 if U.RCI then 1049 Write_Str (" RCI"); 1050 end if; 1051 1052 if U.Predefined then 1053 Write_Str (" Predefined"); 1054 end if; 1055 1056 if U.Internal then 1057 Write_Str (" Internal"); 1058 end if; 1059 1060 if U.Is_Generic then 1061 Write_Str (" Is_Generic"); 1062 end if; 1063 1064 if U.Init_Scalars then 1065 Write_Str (" Init_Scalars"); 1066 end if; 1067 1068 if U.SAL_Interface then 1069 Write_Str (" SAL_Interface"); 1070 end if; 1071 1072 if U.Body_Needed_For_SAL then 1073 Write_Str (" Body_Needed_For_SAL"); 1074 end if; 1075 1076 if U.Elaborate_Body then 1077 Write_Str (" Elaborate Body"); 1078 end if; 1079 1080 if U.Remote_Types then 1081 Write_Str (" Remote_Types"); 1082 end if; 1083 1084 if U.Shared_Passive then 1085 Write_Str (" Shared_Passive"); 1086 end if; 1087 1088 if U.Predefined then 1089 Write_Str (" Predefined"); 1090 end if; 1091 end if; 1092 1093 declare 1094 Restrictions : constant Restrictions_Info := 1095 ALIs.Table (ALI).Restrictions; 1096 1097 begin 1098 -- If the source was compiled with pragmas Restrictions, 1099 -- Display these restrictions. 1100 1101 if Restrictions.Set /= (All_Restrictions => False) then 1102 Write_Eol; 1103 Write_Str (" pragma Restrictions =>"); 1104 1105 -- For boolean restrictions, just display the name of the 1106 -- restriction; for valued restrictions, also display the 1107 -- restriction value. 1108 1109 for Restriction in All_Restrictions loop 1110 if Restrictions.Set (Restriction) then 1111 Write_Eol; 1112 Write_Str (" "); 1113 Write_Str (Image (Restriction)); 1114 1115 if Restriction in All_Parameter_Restrictions then 1116 Write_Str (" =>"); 1117 Write_Str (Restrictions.Value (Restriction)'Img); 1118 end if; 1119 end if; 1120 end loop; 1121 end if; 1122 1123 -- If the unit violates some Restrictions, display the list of 1124 -- these restrictions. 1125 1126 if Restrictions.Violated /= (All_Restrictions => False) then 1127 Write_Eol; 1128 Write_Str (" Restrictions violated =>"); 1129 1130 -- For boolean restrictions, just display the name of the 1131 -- restriction. For valued restrictions, also display the 1132 -- restriction value. 1133 1134 for Restriction in All_Restrictions loop 1135 if Restrictions.Violated (Restriction) then 1136 Write_Eol; 1137 Write_Str (" "); 1138 Write_Str (Image (Restriction)); 1139 1140 if Restriction in All_Parameter_Restrictions then 1141 if Restrictions.Count (Restriction) > 0 then 1142 Write_Str (" =>"); 1143 1144 if Restrictions.Unknown (Restriction) then 1145 Write_Str (" at least"); 1146 end if; 1147 1148 Write_Str (Restrictions.Count (Restriction)'Img); 1149 end if; 1150 end if; 1151 end if; 1152 end loop; 1153 end if; 1154 end; 1155 end if; 1156 1157 if Print_Source then 1158 if Too_Long then 1159 Write_Eol; 1160 Write_Str (" "); 1161 else 1162 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End)); 1163 end if; 1164 end if; 1165 end if; 1166 end Output_Unit; 1167 1168 ----------------- 1169 -- Reset_Print -- 1170 ----------------- 1171 1172 procedure Reset_Print is 1173 begin 1174 if not Selective_Output then 1175 Selective_Output := True; 1176 Print_Source := False; 1177 Print_Object := False; 1178 Print_Unit := False; 1179 end if; 1180 end Reset_Print; 1181 1182 ---------------- 1183 -- Search_RTS -- 1184 ---------------- 1185 1186 procedure Search_RTS (Name : String) is 1187 Src_Path : String_Ptr; 1188 Lib_Path : String_Ptr; 1189 -- Paths for source and include subdirs 1190 1191 Rts_Full_Path : String_Access; 1192 -- Full path for RTS project 1193 1194 begin 1195 -- Try to find the RTS 1196 1197 Src_Path := Get_RTS_Search_Dir (Name, Include); 1198 Lib_Path := Get_RTS_Search_Dir (Name, Objects); 1199 1200 -- For non-project RTS, both the include and the objects directories 1201 -- must be present. 1202 1203 if Src_Path /= null and then Lib_Path /= null then 1204 Add_Search_Dirs (Src_Path, Include); 1205 Add_Search_Dirs (Lib_Path, Objects); 1206 return; 1207 end if; 1208 1209 if Lib_Path /= null then 1210 Osint.Fail ("RTS path not valid: missing adainclude directory"); 1211 elsif Src_Path /= null then 1212 Osint.Fail ("RTS path not valid: missing adalib directory"); 1213 end if; 1214 1215 -- Try to find the RTS on the project path. First setup the project path 1216 1217 Initialize_Default_Project_Path 1218 (Prj_Path, Target_Name => Sdefault.Target_Name.all); 1219 1220 Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name); 1221 1222 if Rts_Full_Path /= null then 1223 1224 -- Directory name was found on the project path. Look for the 1225 -- include subdirectory(s). 1226 1227 Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include); 1228 1229 if Src_Path /= null then 1230 Add_Search_Dirs (Src_Path, Include); 1231 1232 -- Add the lib subdirectory if it exists 1233 1234 Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects); 1235 1236 if Lib_Path /= null then 1237 Add_Search_Dirs (Lib_Path, Objects); 1238 end if; 1239 1240 return; 1241 end if; 1242 end if; 1243 1244 Osint.Fail 1245 ("RTS path not valid: missing adainclude and adalib directories"); 1246 end Search_RTS; 1247 1248 ------------------- 1249 -- Scan_Ls_Arg -- 1250 ------------------- 1251 1252 procedure Scan_Ls_Arg (Argv : String) is 1253 FD : File_Descriptor; 1254 Len : Integer; 1255 OK : Boolean; 1256 1257 begin 1258 pragma Assert (Argv'First = 1); 1259 1260 if Argv'Length = 0 then 1261 return; 1262 end if; 1263 1264 OK := True; 1265 if Argv (1) = '-' then 1266 if Argv'Length = 1 then 1267 Fail ("switch character cannot be followed by a blank"); 1268 1269 -- Processing for -I- 1270 1271 elsif Argv (2 .. Argv'Last) = "I-" then 1272 Opt.Look_In_Primary_Dir := False; 1273 1274 -- Forbid -?- or -??- where ? is any character 1275 1276 elsif (Argv'Length = 3 and then Argv (3) = '-') 1277 or else (Argv'Length = 4 and then Argv (4) = '-') 1278 then 1279 Fail ("Trailing ""-"" at the end of " & Argv & " forbidden."); 1280 1281 -- Processing for -Idir 1282 1283 elsif Argv (2) = 'I' then 1284 Add_Source_Dir (Argv (3 .. Argv'Last)); 1285 Add_Lib_Dir (Argv (3 .. Argv'Last)); 1286 1287 -- Processing for -aIdir (to gcc this is like a -I switch) 1288 1289 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then 1290 Add_Source_Dir (Argv (4 .. Argv'Last)); 1291 1292 -- Processing for -aOdir 1293 1294 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then 1295 Add_Lib_Dir (Argv (4 .. Argv'Last)); 1296 1297 -- Processing for -aLdir (to gnatbind this is like a -aO switch) 1298 1299 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then 1300 Add_Lib_Dir (Argv (4 .. Argv'Last)); 1301 1302 -- Processing for -aP<dir> 1303 1304 elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then 1305 Add_Directories (Prj_Path, Argv (4 .. Argv'Last)); 1306 1307 -- Processing for -nostdinc 1308 1309 elsif Argv (2 .. Argv'Last) = "nostdinc" then 1310 Opt.No_Stdinc := True; 1311 1312 -- Processing for one character switches 1313 1314 elsif Argv'Length = 2 then 1315 case Argv (2) is 1316 when 'a' => Also_Predef := True; 1317 when 'h' => Print_Usage := True; 1318 when 'u' => Reset_Print; Print_Unit := True; 1319 when 's' => Reset_Print; Print_Source := True; 1320 when 'o' => Reset_Print; Print_Object := True; 1321 when 'v' => Verbose_Mode := True; 1322 when 'd' => Dependable := True; 1323 when 'l' => License := True; 1324 when 'V' => Very_Verbose_Mode := True; 1325 1326 when others => OK := False; 1327 end case; 1328 1329 -- Processing for -files=file 1330 1331 elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then 1332 FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text); 1333 1334 if FD = Invalid_FD then 1335 Osint.Fail ("could not find text file """ & 1336 Argv (8 .. Argv'Last) & '"'); 1337 end if; 1338 1339 Len := Integer (File_Length (FD)); 1340 1341 declare 1342 Buffer : String (1 .. Len + 1); 1343 Index : Positive := 1; 1344 Last : Positive; 1345 1346 begin 1347 -- Read the file 1348 1349 Len := Read (FD, Buffer (1)'Address, Len); 1350 Buffer (Buffer'Last) := ASCII.NUL; 1351 Close (FD); 1352 1353 -- Scan the file line by line 1354 1355 while Index < Buffer'Last loop 1356 1357 -- Find the end of line 1358 1359 Last := Index; 1360 while Last <= Buffer'Last 1361 and then Buffer (Last) /= ASCII.LF 1362 and then Buffer (Last) /= ASCII.CR 1363 loop 1364 Last := Last + 1; 1365 end loop; 1366 1367 -- Ignore empty lines 1368 1369 if Last > Index then 1370 Add_File (Buffer (Index .. Last - 1)); 1371 end if; 1372 1373 -- Find the beginning of the next line 1374 1375 Index := Last; 1376 while Buffer (Index) = ASCII.CR or else 1377 Buffer (Index) = ASCII.LF 1378 loop 1379 Index := Index + 1; 1380 end loop; 1381 end loop; 1382 end; 1383 1384 -- Processing for --RTS=path 1385 1386 elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then 1387 if Argv'Length <= 6 or else Argv (6) /= '='then 1388 Osint.Fail ("missing path for --RTS"); 1389 1390 else 1391 -- Check that it is the first time we see this switch or, if 1392 -- it is not the first time, the same path is specified. 1393 1394 if RTS_Specified = null then 1395 RTS_Specified := new String'(Argv (7 .. Argv'Last)); 1396 1397 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then 1398 Osint.Fail ("--RTS cannot be specified multiple times"); 1399 end if; 1400 1401 -- Valid --RTS switch 1402 1403 Opt.No_Stdinc := True; 1404 Opt.RTS_Switch := True; 1405 end if; 1406 1407 else 1408 OK := False; 1409 end if; 1410 1411 -- If not a switch, it must be a file name 1412 1413 else 1414 Add_File (Argv); 1415 end if; 1416 1417 if not OK then 1418 Write_Str ("warning: unknown switch """); 1419 Write_Str (Argv); 1420 Write_Line (""""); 1421 end if; 1422 1423 end Scan_Ls_Arg; 1424 1425 ----------- 1426 -- Usage -- 1427 ----------- 1428 1429 procedure Usage is 1430 begin 1431 -- Usage line 1432 1433 Write_Str ("Usage: "); 1434 Osint.Write_Program_Name; 1435 Write_Str (" switches [list of object files]"); 1436 Write_Eol; 1437 Write_Eol; 1438 1439 -- GNATLS switches 1440 1441 Write_Str ("switches:"); 1442 Write_Eol; 1443 1444 Display_Usage_Version_And_Help; 1445 1446 -- Line for -a 1447 1448 Write_Str (" -a also output relevant predefined units"); 1449 Write_Eol; 1450 1451 -- Line for -u 1452 1453 Write_Str (" -u output only relevant unit names"); 1454 Write_Eol; 1455 1456 -- Line for -h 1457 1458 Write_Str (" -h output this help message"); 1459 Write_Eol; 1460 1461 -- Line for -s 1462 1463 Write_Str (" -s output only relevant source names"); 1464 Write_Eol; 1465 1466 -- Line for -o 1467 1468 Write_Str (" -o output only relevant object names"); 1469 Write_Eol; 1470 1471 -- Line for -d 1472 1473 Write_Str (" -d output sources on which specified units " & 1474 "depend"); 1475 Write_Eol; 1476 1477 -- Line for -l 1478 1479 Write_Str (" -l output license information"); 1480 Write_Eol; 1481 1482 -- Line for -v 1483 1484 Write_Str (" -v verbose output, full path and unit " & 1485 "information"); 1486 Write_Eol; 1487 Write_Eol; 1488 1489 -- Line for -files= 1490 1491 Write_Str (" -files=fil files are listed in text file 'fil'"); 1492 Write_Eol; 1493 1494 -- Line for -aI switch 1495 1496 Write_Str (" -aIdir specify source files search path"); 1497 Write_Eol; 1498 1499 -- Line for -aO switch 1500 1501 Write_Str (" -aOdir specify object files search path"); 1502 Write_Eol; 1503 1504 -- Line for -aP switch 1505 1506 Write_Str (" -aPdir specify project search path"); 1507 Write_Eol; 1508 1509 -- Line for -I switch 1510 1511 Write_Str (" -Idir like -aIdir -aOdir"); 1512 Write_Eol; 1513 1514 -- Line for -I- switch 1515 1516 Write_Str (" -I- do not look for sources & object files"); 1517 Write_Str (" in the default directory"); 1518 Write_Eol; 1519 1520 -- Line for -nostdinc 1521 1522 Write_Str (" -nostdinc do not look for source files"); 1523 Write_Str (" in the system default directory"); 1524 Write_Eol; 1525 1526 -- Line for --RTS 1527 1528 Write_Str (" --RTS=dir specify the default source and object search" 1529 & " path"); 1530 Write_Eol; 1531 1532 -- File Status explanation 1533 1534 Write_Eol; 1535 Write_Str (" file status can be:"); 1536 Write_Eol; 1537 1538 for ST in File_Status loop 1539 Write_Str (" "); 1540 Output_Status (ST, Verbose => False); 1541 Write_Str (" ==> "); 1542 Output_Status (ST, Verbose => True); 1543 Write_Eol; 1544 end loop; 1545 end Usage; 1546 1547 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); 1548 1549-- Start of processing for Gnatls 1550 1551begin 1552 -- Initialize standard packages 1553 1554 Csets.Initialize; 1555 Snames.Initialize; 1556 1557 -- First check for --version or --help 1558 1559 Check_Version_And_Help ("GNATLS", "1992"); 1560 1561 -- Loop to scan out arguments 1562 1563 Next_Arg := 1; 1564 Scan_Args : while Next_Arg < Arg_Count loop 1565 declare 1566 Next_Argv : String (1 .. Len_Arg (Next_Arg)); 1567 begin 1568 Fill_Arg (Next_Argv'Address, Next_Arg); 1569 Scan_Ls_Arg (Next_Argv); 1570 end; 1571 1572 Next_Arg := Next_Arg + 1; 1573 end loop Scan_Args; 1574 1575 -- If -l (output license information) is given, it must be the only switch 1576 1577 if License and then Arg_Count /= 2 then 1578 Set_Standard_Error; 1579 Write_Str ("Can't use -l with another switch"); 1580 Write_Eol; 1581 Usage; 1582 Exit_Program (E_Fatal); 1583 end if; 1584 1585 -- Handle --RTS switch 1586 1587 if RTS_Specified /= null then 1588 Search_RTS (RTS_Specified.all); 1589 end if; 1590 1591 -- Add the source and object directories specified on the command line, if 1592 -- any, to the searched directories. 1593 1594 while First_Source_Dir /= null loop 1595 Add_Src_Search_Dir (First_Source_Dir.Value.all); 1596 First_Source_Dir := First_Source_Dir.Next; 1597 end loop; 1598 1599 while First_Lib_Dir /= null loop 1600 Add_Lib_Search_Dir (First_Lib_Dir.Value.all); 1601 First_Lib_Dir := First_Lib_Dir.Next; 1602 end loop; 1603 1604 -- Finally, add the default directories and obtain target parameters 1605 1606 Osint.Add_Default_Search_Dirs; 1607 1608 if Verbose_Mode then 1609 Write_Eol; 1610 Display_Version ("GNATLS", "1997"); 1611 Write_Eol; 1612 Write_Str ("Source Search Path:"); 1613 Write_Eol; 1614 1615 for J in 1 .. Nb_Dir_In_Src_Search_Path loop 1616 Write_Str (" "); 1617 1618 if Dir_In_Src_Search_Path (J)'Length = 0 then 1619 Write_Str ("<Current_Directory>"); 1620 else 1621 Write_Str (To_Host_Dir_Spec 1622 (Dir_In_Src_Search_Path (J).all, True).all); 1623 end if; 1624 1625 Write_Eol; 1626 end loop; 1627 1628 Write_Eol; 1629 Write_Eol; 1630 Write_Str ("Object Search Path:"); 1631 Write_Eol; 1632 1633 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop 1634 Write_Str (" "); 1635 1636 if Dir_In_Obj_Search_Path (J)'Length = 0 then 1637 Write_Str ("<Current_Directory>"); 1638 else 1639 Write_Str (To_Host_Dir_Spec 1640 (Dir_In_Obj_Search_Path (J).all, True).all); 1641 end if; 1642 1643 Write_Eol; 1644 end loop; 1645 1646 Write_Eol; 1647 Write_Eol; 1648 Write_Str (Project_Search_Path); 1649 Write_Eol; 1650 Write_Str (" <Current_Directory>"); 1651 Write_Eol; 1652 1653 Initialize_Default_Project_Path 1654 (Prj_Path, Target_Name => Sdefault.Target_Name.all); 1655 1656 declare 1657 Project_Path : String_Access; 1658 First : Natural; 1659 Last : Natural; 1660 1661 begin 1662 Get_Path (Prj_Path, Project_Path); 1663 1664 if Project_Path.all /= "" then 1665 First := Project_Path'First; 1666 loop 1667 while First <= Project_Path'Last 1668 and then (Project_Path (First) = Path_Separator) 1669 loop 1670 First := First + 1; 1671 end loop; 1672 1673 exit when First > Project_Path'Last; 1674 1675 Last := First; 1676 while Last < Project_Path'Last 1677 and then Project_Path (Last + 1) /= Path_Separator 1678 loop 1679 Last := Last + 1; 1680 end loop; 1681 1682 if First /= Last or else Project_Path (First) /= '.' then 1683 1684 -- If the directory is ".", skip it as it is the current 1685 -- directory and it is already the first directory in the 1686 -- project path. 1687 1688 Write_Str (" "); 1689 Write_Str 1690 (Normalize_Pathname 1691 (To_Host_Dir_Spec 1692 (Project_Path (First .. Last), True).all)); 1693 Write_Eol; 1694 end if; 1695 1696 First := Last + 1; 1697 end loop; 1698 end if; 1699 end; 1700 1701 Write_Eol; 1702 end if; 1703 1704 -- Output usage information when requested 1705 1706 if Print_Usage then 1707 Usage; 1708 end if; 1709 1710 -- Output license information when requested 1711 1712 if License then 1713 Output_License_Information; 1714 Exit_Program (E_Success); 1715 end if; 1716 1717 if not More_Lib_Files then 1718 if not Print_Usage and then not Verbose_Mode then 1719 Usage; 1720 end if; 1721 1722 Exit_Program (E_Fatal); 1723 end if; 1724 1725 Initialize_ALI; 1726 Initialize_ALI_Source; 1727 1728 -- Print out all library for which no ALI files can be located 1729 1730 while More_Lib_Files loop 1731 Main_File := Next_Main_Lib_File; 1732 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File)); 1733 1734 if Ali_File = No_File then 1735 if Very_Verbose_Mode then 1736 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File)); 1737 1738 else 1739 Set_Standard_Error; 1740 Write_Str ("Can't find library info for "); 1741 Get_Name_String (Main_File); 1742 Write_Char ('"'); -- " 1743 Write_Str (Name_Buffer (1 .. Name_Len)); 1744 Write_Char ('"'); -- " 1745 Write_Eol; 1746 end if; 1747 1748 else 1749 Ali_File := Strip_Directory (Ali_File); 1750 1751 if Get_Name_Table_Info (Ali_File) = 0 then 1752 Text := Read_Library_Info (Ali_File, True); 1753 1754 declare 1755 Discard : ALI_Id; 1756 pragma Unreferenced (Discard); 1757 begin 1758 Discard := 1759 Scan_ALI 1760 (Ali_File, 1761 Text, 1762 Ignore_ED => False, 1763 Err => False, 1764 Ignore_Errors => True); 1765 end; 1766 1767 Free (Text); 1768 end if; 1769 end if; 1770 end loop; 1771 1772 -- Reset default output file descriptor, if needed 1773 1774 Set_Standard_Output; 1775 1776 if Very_Verbose_Mode then 1777 for A in ALIs.First .. ALIs.Last loop 1778 GNATDIST.Output_ALI (A); 1779 end loop; 1780 1781 return; 1782 end if; 1783 1784 Find_General_Layout; 1785 1786 for Id in ALIs.First .. ALIs.Last loop 1787 declare 1788 Last_U : Unit_Id; 1789 1790 begin 1791 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname); 1792 1793 if Also_Predef or else not Is_Internal_Unit then 1794 if ALIs.Table (Id).No_Object then 1795 Output_Object (No_File); 1796 else 1797 Output_Object (ALIs.Table (Id).Ofile_Full_Name); 1798 end if; 1799 1800 -- In verbose mode print all main units in the ALI file, otherwise 1801 -- just print the first one to ease columnwise printout 1802 1803 if Verbose_Mode then 1804 Last_U := ALIs.Table (Id).Last_Unit; 1805 else 1806 Last_U := ALIs.Table (Id).First_Unit; 1807 end if; 1808 1809 for U in ALIs.Table (Id).First_Unit .. Last_U loop 1810 if U /= ALIs.Table (Id).First_Unit 1811 and then Selective_Output 1812 and then Print_Unit 1813 then 1814 Write_Eol; 1815 end if; 1816 1817 Output_Unit (Id, U); 1818 1819 -- Output source now, unless if it will be done as part of 1820 -- outputing dependencies. 1821 1822 if not (Dependable and then Print_Source) then 1823 Output_Source (Corresponding_Sdep_Entry (Id, U)); 1824 end if; 1825 end loop; 1826 1827 -- Print out list of units on which this unit depends (D lines) 1828 1829 if Dependable and then Print_Source then 1830 if Verbose_Mode then 1831 Write_Str ("depends upon"); 1832 Write_Eol; 1833 Write_Str (" "); 1834 else 1835 Write_Eol; 1836 end if; 1837 1838 for D in 1839 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep 1840 loop 1841 if Also_Predef 1842 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile) 1843 then 1844 if Verbose_Mode then 1845 Write_Str (" "); 1846 Output_Source (D); 1847 1848 elsif Too_Long then 1849 Write_Str (" "); 1850 Output_Source (D); 1851 Write_Eol; 1852 1853 else 1854 Write_Str (Spaces (1 .. Source_Start - 2)); 1855 Output_Source (D); 1856 Write_Eol; 1857 end if; 1858 end if; 1859 end loop; 1860 end if; 1861 1862 Write_Eol; 1863 end if; 1864 end; 1865 end loop; 1866 1867 -- All done. Set proper exit status 1868 1869 Namet.Finalize; 1870 Exit_Program (E_Success); 1871end Gnatls; 1872