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-2004 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with ALI; use ALI; 28with ALI.Util; use ALI.Util; 29with Binderr; use Binderr; 30with Butil; use Butil; 31with Csets; use Csets; 32with Fname; use Fname; 33with Gnatvsn; use Gnatvsn; 34with GNAT.OS_Lib; use GNAT.OS_Lib; 35with Namet; use Namet; 36with Opt; use Opt; 37with Osint; use Osint; 38with Osint.L; use Osint.L; 39with Output; use Output; 40with Targparm; use Targparm; 41with Types; use Types; 42 43procedure Gnatls is 44 pragma Ident (Gnat_Static_Version_String); 45 46 Max_Column : constant := 80; 47 48 type File_Status is ( 49 OK, -- matching timestamp 50 Checksum_OK, -- only matching checksum 51 Not_Found, -- file not found on source PATH 52 Not_Same, -- neither checksum nor timestamp matching 53 Not_First_On_PATH); -- matching file hidden by Not_Same file on path 54 55 type Dir_Data; 56 type Dir_Ref is access Dir_Data; 57 58 type Dir_Data is record 59 Value : String_Access; 60 Next : Dir_Ref; 61 end record; 62 -- ??? comment needed 63 64 First_Source_Dir : Dir_Ref; 65 Last_Source_Dir : Dir_Ref; 66 -- The list of source directories from the command line. 67 -- These directories are added using Osint.Add_Src_Search_Dir 68 -- after those of the GNAT Project File, if any. 69 70 First_Lib_Dir : Dir_Ref; 71 Last_Lib_Dir : Dir_Ref; 72 -- The list of object directories from the command line. 73 -- These directories are added using Osint.Add_Lib_Search_Dir 74 -- after those of the GNAT Project File, if any. 75 76 Main_File : File_Name_Type; 77 Ali_File : File_Name_Type; 78 Text : Text_Buffer_Ptr; 79 Next_Arg : Positive; 80 81 Too_Long : Boolean := False; 82 -- When True, lines are too long for multi-column output and each 83 -- item of information is on a different line. 84 85 Selective_Output : Boolean := False; 86 Print_Usage : Boolean := False; 87 Print_Unit : Boolean := True; 88 Print_Source : Boolean := True; 89 Print_Object : Boolean := True; 90 -- Flags controlling the form of the outpout 91 92 Dependable : Boolean := False; -- flag -d 93 Also_Predef : Boolean := False; 94 95 Unit_Start : Integer; 96 Unit_End : Integer; 97 Source_Start : Integer; 98 Source_End : Integer; 99 Object_Start : Integer; 100 Object_End : Integer; 101 -- Various column starts and ends 102 103 Spaces : constant String (1 .. Max_Column) := (others => ' '); 104 105 RTS_Specified : String_Access := null; 106 -- Used to detect multiple use of --RTS= switch 107 108 ----------------------- 109 -- Local Subprograms -- 110 ----------------------- 111 112 procedure Add_Lib_Dir (Dir : String; And_Save : Boolean); 113 -- Add an object directory, using Osint.Add_Lib_Search_Dir 114 -- if And_Save is False or keeping in the list First_Lib_Dir, 115 -- Last_Lib_Dir if And_Save is True. 116 117 procedure Add_Source_Dir (Dir : String; And_Save : Boolean); 118 -- Add a source directory, using Osint.Add_Src_Search_Dir 119 -- if And_Save is False or keeping in the list First_Source_Dir, 120 -- Last_Source_Dir if And_Save is True. 121 122 procedure Find_General_Layout; 123 -- Determine the structure of the output (multi columns or not, etc) 124 125 procedure Find_Status 126 (FS : in out File_Name_Type; 127 Stamp : Time_Stamp_Type; 128 Checksum : Word; 129 Status : out File_Status); 130 -- Determine the file status (Status) of the file represented by FS 131 -- with the expected Stamp and checksum given as argument. FS will be 132 -- updated to the full file name if available. 133 134 function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id; 135 -- Give the Sdep entry corresponding to the unit U in ali record A. 136 137 procedure Output_Object (O : File_Name_Type); 138 -- Print out the name of the object when requested 139 140 procedure Output_Source (Sdep_I : Sdep_Id); 141 -- Print out the name and status of the source corresponding to this 142 -- sdep entry 143 144 procedure Output_Status (FS : File_Status; Verbose : Boolean); 145 -- Print out FS either in a coded form if verbose is false or in an 146 -- expanded form otherwise. 147 148 procedure Output_Unit (U_Id : Unit_Id); 149 -- Print out information on the unit when requested 150 151 procedure Reset_Print; 152 -- Reset Print flags properly when selective output is chosen 153 154 procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean); 155 -- Scan and process lser specific arguments. Argv is a single argument. 156 157 procedure Usage; 158 -- Print usage message. 159 160 ----------------- 161 -- Add_Lib_Dir -- 162 ----------------- 163 164 procedure Add_Lib_Dir (Dir : String; And_Save : Boolean) is 165 begin 166 if And_Save then 167 if First_Lib_Dir = null then 168 First_Lib_Dir := 169 new Dir_Data' 170 (Value => new String'(Dir), 171 Next => null); 172 Last_Lib_Dir := First_Lib_Dir; 173 174 else 175 Last_Lib_Dir.Next := 176 new Dir_Data' 177 (Value => new String'(Dir), 178 Next => null); 179 Last_Lib_Dir := Last_Lib_Dir.Next; 180 end if; 181 182 else 183 Add_Lib_Search_Dir (Dir); 184 end if; 185 end Add_Lib_Dir; 186 187 -- ----------------- 188 -- Add_Source_Dir -- 189 -------------------- 190 191 procedure Add_Source_Dir (Dir : String; And_Save : Boolean) is 192 begin 193 if And_Save then 194 if First_Source_Dir = null then 195 First_Source_Dir := 196 new Dir_Data' 197 (Value => new String'(Dir), 198 Next => null); 199 Last_Source_Dir := First_Source_Dir; 200 201 else 202 Last_Source_Dir.Next := 203 new Dir_Data' 204 (Value => new String'(Dir), 205 Next => null); 206 Last_Source_Dir := Last_Source_Dir.Next; 207 end if; 208 209 else 210 Add_Src_Search_Dir (Dir); 211 end if; 212 end Add_Source_Dir; 213 214 ------------------------------ 215 -- Corresponding_Sdep_Entry -- 216 ------------------------------ 217 218 function Corresponding_Sdep_Entry 219 (A : ALI_Id; 220 U : Unit_Id) return Sdep_Id 221 is 222 begin 223 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop 224 if Sdep.Table (D).Sfile = Units.Table (U).Sfile then 225 return D; 226 end if; 227 end loop; 228 229 Error_Msg_Name_1 := Units.Table (U).Uname; 230 Error_Msg_Name_2 := ALIs.Table (A).Afile; 231 Write_Eol; 232 Error_Msg ("wrong ALI format, can't find dependency line for & in %"); 233 Exit_Program (E_Fatal); 234 end Corresponding_Sdep_Entry; 235 236 ------------------------- 237 -- Find_General_Layout -- 238 ------------------------- 239 240 procedure Find_General_Layout is 241 Max_Unit_Length : Integer := 11; 242 Max_Src_Length : Integer := 11; 243 Max_Obj_Length : Integer := 11; 244 245 Len : Integer; 246 FS : File_Name_Type; 247 248 begin 249 -- Compute maximum of each column 250 251 for Id in ALIs.First .. ALIs.Last loop 252 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname); 253 if Also_Predef or else not Is_Internal_Unit then 254 255 if Print_Unit then 256 Len := Name_Len - 1; 257 Max_Unit_Length := Integer'Max (Max_Unit_Length, Len); 258 end if; 259 260 if Print_Source then 261 FS := Full_Source_Name (ALIs.Table (Id).Sfile); 262 263 if FS = No_File then 264 Get_Name_String (ALIs.Table (Id).Sfile); 265 Name_Len := Name_Len + 13; 266 else 267 Get_Name_String (FS); 268 end if; 269 270 Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1); 271 end if; 272 273 if Print_Object then 274 Get_Name_String (ALIs.Table (Id).Ofile_Full_Name); 275 Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1); 276 end if; 277 end if; 278 end loop; 279 280 -- Verify is output is not wider than maximum number of columns 281 282 Too_Long := Verbose_Mode or else 283 (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column; 284 285 -- Set start and end of columns. 286 287 Object_Start := 1; 288 Object_End := Object_Start - 1; 289 290 if Print_Object then 291 Object_End := Object_Start + Max_Obj_Length; 292 end if; 293 294 Unit_Start := Object_End + 1; 295 Unit_End := Unit_Start - 1; 296 297 if Print_Unit then 298 Unit_End := Unit_Start + Max_Unit_Length; 299 end if; 300 301 Source_Start := Unit_End + 1; 302 303 if Source_Start > Spaces'Last then 304 Source_Start := Spaces'Last; 305 end if; 306 307 Source_End := Source_Start - 1; 308 309 if Print_Source then 310 Source_End := Source_Start + Max_Src_Length; 311 end if; 312 end Find_General_Layout; 313 314 ----------------- 315 -- Find_Status -- 316 ----------------- 317 318 procedure Find_Status 319 (FS : in out File_Name_Type; 320 Stamp : Time_Stamp_Type; 321 Checksum : Word; 322 Status : out File_Status) 323 is 324 Tmp1 : File_Name_Type; 325 Tmp2 : File_Name_Type; 326 327 begin 328 Tmp1 := Full_Source_Name (FS); 329 330 if Tmp1 = No_File then 331 Status := Not_Found; 332 333 elsif File_Stamp (Tmp1) = Stamp then 334 FS := Tmp1; 335 Status := OK; 336 337 elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then 338 FS := Tmp1; 339 Status := Checksum_OK; 340 341 else 342 Tmp2 := Matching_Full_Source_Name (FS, Stamp); 343 344 if Tmp2 = No_File then 345 Status := Not_Same; 346 FS := Tmp1; 347 348 else 349 Status := Not_First_On_PATH; 350 FS := Tmp2; 351 end if; 352 end if; 353 end Find_Status; 354 355 ------------------- 356 -- Output_Object -- 357 ------------------- 358 359 procedure Output_Object (O : File_Name_Type) is 360 Object_Name : String_Access; 361 362 begin 363 if Print_Object then 364 Get_Name_String (O); 365 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); 366 Write_Str (Object_Name.all); 367 368 if Print_Source or else Print_Unit then 369 if Too_Long then 370 Write_Eol; 371 Write_Str (" "); 372 else 373 Write_Str (Spaces 374 (Object_Start + Object_Name'Length .. Object_End)); 375 end if; 376 end if; 377 end if; 378 end Output_Object; 379 380 ------------------- 381 -- Output_Source -- 382 ------------------- 383 384 procedure Output_Source (Sdep_I : Sdep_Id) is 385 Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp; 386 Checksum : constant Word := Sdep.Table (Sdep_I).Checksum; 387 FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile; 388 Status : File_Status; 389 Object_Name : String_Access; 390 391 begin 392 if Print_Source then 393 Find_Status (FS, Stamp, Checksum, Status); 394 Get_Name_String (FS); 395 396 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); 397 398 if Verbose_Mode then 399 Write_Str (" Source => "); 400 Write_Str (Object_Name.all); 401 402 if not Too_Long then 403 Write_Str 404 (Spaces (Source_Start + Object_Name'Length .. Source_End)); 405 end if; 406 407 Output_Status (Status, Verbose => True); 408 Write_Eol; 409 Write_Str (" "); 410 411 else 412 if not Selective_Output then 413 Output_Status (Status, Verbose => False); 414 end if; 415 416 Write_Str (Object_Name.all); 417 end if; 418 end if; 419 end Output_Source; 420 421 ------------------- 422 -- Output_Status -- 423 ------------------- 424 425 procedure Output_Status (FS : File_Status; Verbose : Boolean) is 426 begin 427 if Verbose then 428 case FS is 429 when OK => 430 Write_Str (" unchanged"); 431 432 when Checksum_OK => 433 Write_Str (" slightly modified"); 434 435 when Not_Found => 436 Write_Str (" file not found"); 437 438 when Not_Same => 439 Write_Str (" modified"); 440 441 when Not_First_On_PATH => 442 Write_Str (" unchanged version not first on PATH"); 443 end case; 444 445 else 446 case FS is 447 when OK => 448 Write_Str (" OK "); 449 450 when Checksum_OK => 451 Write_Str (" MOK "); 452 453 when Not_Found => 454 Write_Str (" ??? "); 455 456 when Not_Same => 457 Write_Str (" DIF "); 458 459 when Not_First_On_PATH => 460 Write_Str (" HID "); 461 end case; 462 end if; 463 end Output_Status; 464 465 ----------------- 466 -- Output_Unit -- 467 ----------------- 468 469 procedure Output_Unit (U_Id : Unit_Id) is 470 Kind : Character; 471 U : Unit_Record renames Units.Table (U_Id); 472 473 begin 474 if Print_Unit then 475 Get_Name_String (U.Uname); 476 Kind := Name_Buffer (Name_Len); 477 Name_Len := Name_Len - 2; 478 479 if not Verbose_Mode then 480 Write_Str (Name_Buffer (1 .. Name_Len)); 481 482 else 483 Write_Str ("Unit => "); 484 Write_Eol; Write_Str (" Name => "); 485 Write_Str (Name_Buffer (1 .. Name_Len)); 486 Write_Eol; Write_Str (" Kind => "); 487 488 if Units.Table (U_Id).Unit_Kind = 'p' then 489 Write_Str ("package "); 490 else 491 Write_Str ("subprogram "); 492 end if; 493 494 if Kind = 's' then 495 Write_Str ("spec"); 496 else 497 Write_Str ("body"); 498 end if; 499 end if; 500 501 if Verbose_Mode then 502 if U.Preelab or 503 U.No_Elab or 504 U.Pure or 505 U.Elaborate_Body or 506 U.Remote_Types or 507 U.Shared_Passive or 508 U.RCI or 509 U.Predefined 510 then 511 Write_Eol; Write_Str (" Flags =>"); 512 513 if U.Preelab then 514 Write_Str (" Preelaborable"); 515 end if; 516 517 if U.No_Elab then 518 Write_Str (" No_Elab_Code"); 519 end if; 520 521 if U.Pure then 522 Write_Str (" Pure"); 523 end if; 524 525 if U.Elaborate_Body then 526 Write_Str (" Elaborate Body"); 527 end if; 528 529 if U.Remote_Types then 530 Write_Str (" Remote_Types"); 531 end if; 532 533 if U.Shared_Passive then 534 Write_Str (" Shared_Passive"); 535 end if; 536 537 if U.Predefined then 538 Write_Str (" Predefined"); 539 end if; 540 541 if U.RCI then 542 Write_Str (" Remote_Call_Interface"); 543 end if; 544 end if; 545 end if; 546 547 if Print_Source then 548 if Too_Long then 549 Write_Eol; Write_Str (" "); 550 else 551 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End)); 552 end if; 553 end if; 554 end if; 555 end Output_Unit; 556 557 ----------------- 558 -- Reset_Print -- 559 ----------------- 560 561 procedure Reset_Print is 562 begin 563 if not Selective_Output then 564 Selective_Output := True; 565 Print_Source := False; 566 Print_Object := False; 567 Print_Unit := False; 568 end if; 569 end Reset_Print; 570 571 ------------------- 572 -- Scan_Ls_Arg -- 573 ------------------- 574 575 procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean) is 576 begin 577 pragma Assert (Argv'First = 1); 578 579 if Argv'Length = 0 then 580 return; 581 end if; 582 583 if Argv (1) = '-' then 584 585 if Argv'Length = 1 then 586 Fail ("switch character cannot be followed by a blank"); 587 588 -- Processing for -I- 589 590 elsif Argv (2 .. Argv'Last) = "I-" then 591 Opt.Look_In_Primary_Dir := False; 592 593 -- Forbid -?- or -??- where ? is any character 594 595 elsif (Argv'Length = 3 and then Argv (3) = '-') 596 or else (Argv'Length = 4 and then Argv (4) = '-') 597 then 598 Fail ("Trailing ""-"" at the end of ", Argv, " forbidden."); 599 600 -- Processing for -Idir 601 602 elsif Argv (2) = 'I' then 603 Add_Source_Dir (Argv (3 .. Argv'Last), And_Save); 604 Add_Lib_Dir (Argv (3 .. Argv'Last), And_Save); 605 606 -- Processing for -aIdir (to gcc this is like a -I switch) 607 608 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then 609 Add_Source_Dir (Argv (4 .. Argv'Last), And_Save); 610 611 -- Processing for -aOdir 612 613 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then 614 Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save); 615 616 -- Processing for -aLdir (to gnatbind this is like a -aO switch) 617 618 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then 619 Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save); 620 621 -- Processing for -nostdinc 622 623 elsif Argv (2 .. Argv'Last) = "nostdinc" then 624 Opt.No_Stdinc := True; 625 626 -- Processing for one character switches 627 628 elsif Argv'Length = 2 then 629 case Argv (2) is 630 when 'a' => Also_Predef := True; 631 when 'h' => Print_Usage := True; 632 when 'u' => Reset_Print; Print_Unit := True; 633 when 's' => Reset_Print; Print_Source := True; 634 when 'o' => Reset_Print; Print_Object := True; 635 when 'v' => Verbose_Mode := True; 636 when 'd' => Dependable := True; 637 638 when others => null; 639 end case; 640 641 -- Processing for --RTS=path 642 643 elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then 644 if Argv'Length <= 6 or else Argv (6) /= '='then 645 Osint.Fail ("missing path for --RTS"); 646 647 else 648 -- Check that it is the first time we see this switch or, if 649 -- it is not the first time, the same path is specified. 650 651 if RTS_Specified = null then 652 RTS_Specified := new String'(Argv (7 .. Argv'Last)); 653 654 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then 655 Osint.Fail ("--RTS cannot be specified multiple times"); 656 end if; 657 658 -- Valid --RTS switch 659 660 Opt.No_Stdinc := True; 661 Opt.RTS_Switch := True; 662 663 declare 664 Src_Path_Name : constant String_Ptr := 665 String_Ptr 666 (Get_RTS_Search_Dir 667 (Argv (7 .. Argv'Last), Include)); 668 Lib_Path_Name : constant String_Ptr := 669 String_Ptr 670 (Get_RTS_Search_Dir 671 (Argv (7 .. Argv'Last), Objects)); 672 673 begin 674 if Src_Path_Name /= null 675 and then Lib_Path_Name /= null 676 then 677 Add_Search_Dirs (Src_Path_Name, Include); 678 Add_Search_Dirs (Lib_Path_Name, Objects); 679 680 elsif Src_Path_Name = null 681 and then Lib_Path_Name = null 682 then 683 Osint.Fail ("RTS path not valid: missing " & 684 "adainclude and adalib directories"); 685 686 elsif Src_Path_Name = null then 687 Osint.Fail ("RTS path not valid: missing " & 688 "adainclude directory"); 689 690 elsif Lib_Path_Name = null then 691 Osint.Fail ("RTS path not valid: missing " & 692 "adalib directory"); 693 end if; 694 end; 695 end if; 696 end if; 697 698 -- If not a switch, it must be a file name 699 700 else 701 Add_File (Argv); 702 end if; 703 end Scan_Ls_Arg; 704 705 ----------- 706 -- Usage -- 707 ----------- 708 709 procedure Usage is 710 711 -- Start of processing for Usage 712 713 begin 714 -- Usage line 715 716 Write_Str ("Usage: "); 717 Osint.Write_Program_Name; 718 Write_Str (" switches [list of object files]"); 719 Write_Eol; 720 Write_Eol; 721 722 -- GNATLS switches 723 724 Write_Str ("switches:"); 725 Write_Eol; 726 727 -- Line for -a 728 729 Write_Str (" -a also output relevant predefined units"); 730 Write_Eol; 731 732 -- Line for -u 733 734 Write_Str (" -u output only relevant unit names"); 735 Write_Eol; 736 737 -- Line for -h 738 739 Write_Str (" -h output this help message"); 740 Write_Eol; 741 742 -- Line for -s 743 744 Write_Str (" -s output only relevant source names"); 745 Write_Eol; 746 747 -- Line for -o 748 749 Write_Str (" -o output only relevant object names"); 750 Write_Eol; 751 752 -- Line for -d 753 754 Write_Str (" -d output sources on which specified units depend"); 755 Write_Eol; 756 757 -- Line for -v 758 759 Write_Str (" -v verbose output, full path and unit information"); 760 Write_Eol; 761 Write_Eol; 762 763 -- Line for -aI switch 764 765 Write_Str (" -aIdir specify source files search path"); 766 Write_Eol; 767 768 -- Line for -aO switch 769 770 Write_Str (" -aOdir specify object files search path"); 771 Write_Eol; 772 773 -- Line for -I switch 774 775 Write_Str (" -Idir like -aIdir -aOdir"); 776 Write_Eol; 777 778 -- Line for -I- switch 779 780 Write_Str (" -I- do not look for sources & object files"); 781 Write_Str (" in the default directory"); 782 Write_Eol; 783 784 -- Line for -nostdinc 785 786 Write_Str (" -nostdinc do not look for source files"); 787 Write_Str (" in the system default directory"); 788 Write_Eol; 789 790 -- Line for --RTS 791 792 Write_Str (" --RTS=dir specify the default source and object search" 793 & " path"); 794 Write_Eol; 795 796 -- File Status explanation 797 798 Write_Eol; 799 Write_Str (" file status can be:"); 800 Write_Eol; 801 802 for ST in File_Status loop 803 Write_Str (" "); 804 Output_Status (ST, Verbose => False); 805 Write_Str (" ==> "); 806 Output_Status (ST, Verbose => True); 807 Write_Eol; 808 end loop; 809 810 end Usage; 811 812 -- Start of processing for Gnatls 813 814begin 815 -- Initialize standard packages 816 817 Namet.Initialize; 818 Csets.Initialize; 819 820 -- Use low level argument routines to avoid dragging in the secondary stack 821 822 Next_Arg := 1; 823 824 Scan_Args : while Next_Arg < Arg_Count loop 825 declare 826 Next_Argv : String (1 .. Len_Arg (Next_Arg)); 827 begin 828 Fill_Arg (Next_Argv'Address, Next_Arg); 829 Scan_Ls_Arg (Next_Argv, And_Save => True); 830 end; 831 832 Next_Arg := Next_Arg + 1; 833 end loop Scan_Args; 834 835 -- Add the source and object directories specified on the 836 -- command line, if any, to the searched directories. 837 838 while First_Source_Dir /= null loop 839 Add_Src_Search_Dir (First_Source_Dir.Value.all); 840 First_Source_Dir := First_Source_Dir.Next; 841 end loop; 842 843 while First_Lib_Dir /= null loop 844 Add_Lib_Search_Dir (First_Lib_Dir.Value.all); 845 First_Lib_Dir := First_Lib_Dir.Next; 846 end loop; 847 848 -- Finally, add the default directories and obtain target parameters 849 850 Osint.Add_Default_Search_Dirs; 851 852 if Verbose_Mode then 853 Targparm.Get_Target_Parameters; 854 855 -- WARNING: the output of gnatls -v is used during the compilation 856 -- and installation of GLADE to recreate sdefault.adb and locate 857 -- the libgnat.a to use. Any change in the output of gnatls -v must 858 -- be synchronized with the GLADE Dist/config.sdefault shell script. 859 860 Write_Eol; 861 Write_Str ("GNATLS "); 862 Write_Str (Gnat_Version_String); 863 Write_Str (" Copyright 1997-2004 Free Software Foundation, Inc."); 864 Write_Eol; 865 Write_Eol; 866 Write_Str ("Source Search Path:"); 867 Write_Eol; 868 869 for J in 1 .. Nb_Dir_In_Src_Search_Path loop 870 Write_Str (" "); 871 872 if Dir_In_Src_Search_Path (J)'Length = 0 then 873 Write_Str ("<Current_Directory>"); 874 else 875 Write_Str (To_Host_Dir_Spec 876 (Dir_In_Src_Search_Path (J).all, True).all); 877 end if; 878 879 Write_Eol; 880 end loop; 881 882 Write_Eol; 883 Write_Eol; 884 Write_Str ("Object Search Path:"); 885 Write_Eol; 886 887 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop 888 Write_Str (" "); 889 890 if Dir_In_Obj_Search_Path (J)'Length = 0 then 891 Write_Str ("<Current_Directory>"); 892 else 893 Write_Str (To_Host_Dir_Spec 894 (Dir_In_Obj_Search_Path (J).all, True).all); 895 end if; 896 897 Write_Eol; 898 end loop; 899 900 Write_Eol; 901 end if; 902 903 -- Output usage information when requested 904 905 if Print_Usage then 906 Usage; 907 end if; 908 909 if not More_Lib_Files then 910 if not Print_Usage and then not Verbose_Mode then 911 Usage; 912 end if; 913 914 Exit_Program (E_Fatal); 915 end if; 916 917 Initialize_ALI; 918 Initialize_ALI_Source; 919 920 -- Print out all library for which no ALI files can be located 921 922 while More_Lib_Files loop 923 Main_File := Next_Main_Lib_File; 924 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File)); 925 926 if Ali_File = No_File then 927 Write_Str ("Can't find library info for "); 928 Get_Name_String (Main_File); 929 Write_Char ('"'); 930 Write_Str (Name_Buffer (1 .. Name_Len)); 931 Write_Char ('"'); 932 Write_Eol; 933 934 else 935 Ali_File := Strip_Directory (Ali_File); 936 937 if Get_Name_Table_Info (Ali_File) = 0 then 938 Text := Read_Library_Info (Ali_File, True); 939 940 declare 941 Discard : ALI_Id; 942 pragma Unreferenced (Discard); 943 begin 944 Discard := 945 Scan_ALI 946 (Ali_File, Text, Ignore_ED => False, Err => False); 947 end; 948 949 Free (Text); 950 end if; 951 end if; 952 end loop; 953 954 Find_General_Layout; 955 for Id in ALIs.First .. ALIs.Last loop 956 declare 957 Last_U : Unit_Id; 958 959 begin 960 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname); 961 962 if Also_Predef or else not Is_Internal_Unit then 963 Output_Object (ALIs.Table (Id).Ofile_Full_Name); 964 965 -- In verbose mode print all main units in the ALI file, otherwise 966 -- just print the first one to ease columnwise printout 967 968 if Verbose_Mode then 969 Last_U := ALIs.Table (Id).Last_Unit; 970 else 971 Last_U := ALIs.Table (Id).First_Unit; 972 end if; 973 974 for U in ALIs.Table (Id).First_Unit .. Last_U loop 975 if U /= ALIs.Table (Id).First_Unit 976 and then Selective_Output 977 and then Print_Unit 978 then 979 Write_Eol; 980 end if; 981 982 Output_Unit (U); 983 984 -- Output source now, unless if it will be done as part of 985 -- outputing dependencies. 986 987 if not (Dependable and then Print_Source) then 988 Output_Source (Corresponding_Sdep_Entry (Id, U)); 989 end if; 990 end loop; 991 992 -- Print out list of dependable units 993 994 if Dependable and then Print_Source then 995 if Verbose_Mode then 996 Write_Str ("depends upon"); 997 Write_Eol; 998 Write_Str (" "); 999 1000 else 1001 Write_Eol; 1002 end if; 1003 1004 for D in 1005 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep 1006 loop 1007 if Also_Predef 1008 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile) 1009 then 1010 if Verbose_Mode then 1011 Write_Str (" "); 1012 Output_Source (D); 1013 1014 elsif Too_Long then 1015 Write_Str (" "); 1016 Output_Source (D); 1017 Write_Eol; 1018 1019 else 1020 Write_Str (Spaces (1 .. Source_Start - 2)); 1021 Output_Source (D); 1022 Write_Eol; 1023 end if; 1024 end if; 1025 end loop; 1026 end if; 1027 1028 Write_Eol; 1029 end if; 1030 end; 1031 end loop; 1032 1033 -- All done. Set proper exit status 1034 1035 Namet.Finalize; 1036 Exit_Program (E_Success); 1037end Gnatls; 1038