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