projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Delete all lines containing "$Revision:".
[gcc.git] / gcc / ada / gnatls.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T L S --
6 -- --
7 -- B o d y --
8 -- --
9 -- --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
11 -- --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
22 -- --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
25 -- --
26 ------------------------------------------------------------------------------
27
28 with ALI; use ALI;
29 with ALI.Util; use ALI.Util;
30 with Binderr; use Binderr;
31 with Butil; use Butil;
32 with Fname; use Fname;
33 with Gnatvsn; use Gnatvsn;
34 with GNAT.OS_Lib; use GNAT.OS_Lib;
35 with Namet; use Namet;
36 with Opt; use Opt;
37 with Osint; use Osint;
38 with Osint.L; use Osint.L;
39 with Output; use Output;
40 with Targparm; use Targparm;
41 with Types; use Types;
42
43 procedure Gnatls is
44 pragma Ident (Gnat_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
79 Text : Text_Buffer_Ptr;
80 Id : ALI_Id;
81
82 Next_Arg : Positive;
83
84 Too_Long : Boolean := False;
85 -- When True, lines are too long for multi-column output and each
86 -- item of information is on a different line.
87
88 Selective_Output : Boolean := False;
89 Print_Usage : Boolean := False;
90 Print_Unit : Boolean := True;
91 Print_Source : Boolean := True;
92 Print_Object : Boolean := True;
93 -- Flags controlling the form of the outpout
94
95 Dependable : Boolean := False; -- flag -d
96 Also_Predef : Boolean := False;
97
98 Unit_Start : Integer;
99 Unit_End : Integer;
100 Source_Start : Integer;
101 Source_End : Integer;
102 Object_Start : Integer;
103 Object_End : Integer;
104 -- Various column starts and ends
105
106 Spaces : constant String (1 .. Max_Column) := (others => ' ');
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)
221 return Sdep_Id
222 is
223 begin
224 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
225 if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
226 return D;
227 end if;
228 end loop;
229
230 Error_Msg_Name_1 := Units.Table (U).Uname;
231 Error_Msg_Name_2 := ALIs.Table (A).Afile;
232 Write_Eol;
233 Error_Msg ("wrong ALI format, can't find dependency line for & in %");
234 Exit_Program (E_Fatal);
235 end Corresponding_Sdep_Entry;
236
237 -------------------------
238 -- Find_General_Layout --
239 -------------------------
240
241 procedure Find_General_Layout is
242 Max_Unit_Length : Integer := 11;
243 Max_Src_Length : Integer := 11;
244 Max_Obj_Length : Integer := 11;
245
246 Len : Integer;
247 FS : File_Name_Type;
248
249 begin
250 -- Compute maximum of each column
251
252 for Id in ALIs.First .. ALIs.Last loop
253
254 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
255 if Also_Predef or else not Is_Internal_Unit then
256
257 if Print_Unit then
258 Len := Name_Len - 1;
259 Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
260 end if;
261
262 if Print_Source then
263 FS := Full_Source_Name (ALIs.Table (Id).Sfile);
264
265 if FS = No_File then
266 Get_Name_String (ALIs.Table (Id).Sfile);
267 Name_Len := Name_Len + 13;
268 else
269 Get_Name_String (FS);
270 end if;
271
272 Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
273 end if;
274
275 if Print_Object then
276 Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
277 Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
278 end if;
279 end if;
280 end loop;
281
282 -- Verify is output is not wider than maximum number of columns
283
284 Too_Long := Verbose_Mode or else
285 (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
286
287 -- Set start and end of columns.
288
289 Object_Start := 1;
290 Object_End := Object_Start - 1;
291
292 if Print_Object then
293 Object_End := Object_Start + Max_Obj_Length;
294 end if;
295
296 Unit_Start := Object_End + 1;
297 Unit_End := Unit_Start - 1;
298
299 if Print_Unit then
300 Unit_End := Unit_Start + Max_Unit_Length;
301 end if;
302
303 Source_Start := Unit_End + 1;
304
305 if Source_Start > Spaces'Last then
306 Source_Start := Spaces'Last;
307 end if;
308
309 Source_End := Source_Start - 1;
310
311 if Print_Source then
312 Source_End := Source_Start + Max_Src_Length;
313 end if;
314 end Find_General_Layout;
315
316 -----------------
317 -- Find_Status --
318 -----------------
319
320 procedure Find_Status
321 (FS : in out File_Name_Type;
322 Stamp : Time_Stamp_Type;
323 Checksum : Word;
324 Status : out File_Status)
325 is
326 Tmp1 : File_Name_Type;
327 Tmp2 : File_Name_Type;
328
329 begin
330 Tmp1 := Full_Source_Name (FS);
331
332 if Tmp1 = No_File then
333 Status := Not_Found;
334
335 elsif File_Stamp (Tmp1) = Stamp then
336 FS := Tmp1;
337 Status := OK;
338
339 elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
340 FS := Tmp1;
341 Status := Checksum_OK;
342
343 else
344 Tmp2 := Matching_Full_Source_Name (FS, Stamp);
345
346 if Tmp2 = No_File then
347 Status := Not_Same;
348 FS := Tmp1;
349
350 else
351 Status := Not_First_On_PATH;
352 FS := Tmp2;
353 end if;
354 end if;
355 end Find_Status;
356
357 -------------------
358 -- Output_Object --
359 -------------------
360
361 procedure Output_Object (O : File_Name_Type) is
362 Object_Name : String_Access;
363
364 begin
365 if Print_Object then
366 Get_Name_String (O);
367 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
368 Write_Str (Object_Name.all);
369
370 if Print_Source or else Print_Unit then
371 if Too_Long then
372 Write_Eol;
373 Write_Str (" ");
374 else
375 Write_Str (Spaces
376 (Object_Start + Object_Name'Length .. Object_End));
377 end if;
378 end if;
379 end if;
380 end Output_Object;
381
382 -------------------
383 -- Output_Source --
384 -------------------
385
386 procedure Output_Source (Sdep_I : Sdep_Id) is
387 Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
388 Checksum : constant Word := Sdep.Table (Sdep_I).Checksum;
389 FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
390 Status : File_Status;
391 Object_Name : String_Access;
392
393 begin
394 if Print_Source then
395 Find_Status (FS, Stamp, Checksum, Status);
396 Get_Name_String (FS);
397
398 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
399
400 if Verbose_Mode then
401 Write_Str (" Source => ");
402 Write_Str (Object_Name.all);
403
404 if not Too_Long then
405 Write_Str
406 (Spaces (Source_Start + Object_Name'Length .. Source_End));
407 end if;
408
409 Output_Status (Status, Verbose => True);
410 Write_Eol;
411 Write_Str (" ");
412
413 else
414 if not Selective_Output then
415 Output_Status (Status, Verbose => False);
416 end if;
417
418 Write_Str (Object_Name.all);
419 end if;
420 end if;
421 end Output_Source;
422
423 -------------------
424 -- Output_Status --
425 -------------------
426
427 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
428 begin
429 if Verbose then
430 case FS is
431 when OK =>
432 Write_Str (" unchanged");
433
434 when Checksum_OK =>
435 Write_Str (" slightly modified");
436
437 when Not_Found =>
438 Write_Str (" file not found");
439
440 when Not_Same =>
441 Write_Str (" modified");
442
443 when Not_First_On_PATH =>
444 Write_Str (" unchanged version not first on PATH");
445 end case;
446
447 else
448 case FS is
449 when OK =>
450 Write_Str (" OK ");
451
452 when Checksum_OK =>
453 Write_Str (" MOK ");
454
455 when Not_Found =>
456 Write_Str (" ??? ");
457
458 when Not_Same =>
459 Write_Str (" DIF ");
460
461 when Not_First_On_PATH =>
462 Write_Str (" HID ");
463 end case;
464 end if;
465 end Output_Status;
466
467 -----------------
468 -- Output_Unit --
469 -----------------
470
471 procedure Output_Unit (U_Id : Unit_Id) is
472 Kind : Character;
473 U : Unit_Record renames Units.Table (U_Id);
474
475 begin
476 if Print_Unit then
477 Get_Name_String (U.Uname);
478 Kind := Name_Buffer (Name_Len);
479 Name_Len := Name_Len - 2;
480
481 if not Verbose_Mode then
482 Write_Str (Name_Buffer (1 .. Name_Len));
483
484 else
485 Write_Str ("Unit => ");
486 Write_Eol; Write_Str (" Name => ");
487 Write_Str (Name_Buffer (1 .. Name_Len));
488 Write_Eol; Write_Str (" Kind => ");
489
490 if Units.Table (U_Id).Unit_Kind = 'p' then
491 Write_Str ("package ");
492 else
493 Write_Str ("subprogram ");
494 end if;
495
496 if Kind = 's' then
497 Write_Str ("spec");
498 else
499 Write_Str ("body");
500 end if;
501 end if;
502
503 if Verbose_Mode then
504 if U.Preelab or
505 U.No_Elab or
506 U.Pure or
507 U.Elaborate_Body or
508 U.Remote_Types or
509 U.Shared_Passive or
510 U.RCI or
511 U.Predefined
512 then
513 Write_Eol; Write_Str (" Flags =>");
514
515 if U.Preelab then
516 Write_Str (" Preelaborable");
517 end if;
518
519 if U.No_Elab then
520 Write_Str (" No_Elab_Code");
521 end if;
522
523 if U.Pure then
524 Write_Str (" Pure");
525 end if;
526
527 if U.Elaborate_Body then
528 Write_Str (" Elaborate Body");
529 end if;
530
531 if U.Remote_Types then
532 Write_Str (" Remote_Types");
533 end if;
534
535 if U.Shared_Passive then
536 Write_Str (" Shared_Passive");
537 end if;
538
539 if U.Predefined then
540 Write_Str (" Predefined");
541 end if;
542
543 if U.RCI then
544 Write_Str (" Remote_Call_Interface");
545 end if;
546 end if;
547 end if;
548
549 if Print_Source then
550 if Too_Long then
551 Write_Eol; Write_Str (" ");
552 else
553 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
554 end if;
555 end if;
556 end if;
557 end Output_Unit;
558
559 -----------------
560 -- Reset_Print --
561 -----------------
562
563 procedure Reset_Print is
564 begin
565 if not Selective_Output then
566 Selective_Output := True;
567 Print_Source := False;
568 Print_Object := False;
569 Print_Unit := False;
570 end if;
571 end Reset_Print;
572
573 -------------------
574 -- Scan_Ls_Arg --
575 -------------------
576
577 procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean) is
578 begin
579 pragma Assert (Argv'First = 1);
580
581 if Argv'Length = 0 then
582 return;
583 end if;
584
585 if Argv (1) = '-' then
586
587 if Argv'Length = 1 then
588 Fail ("switch character cannot be followed by a blank");
589
590 -- Processing for -I-
591
592 elsif Argv (2 .. Argv'Last) = "I-" then
593 Opt.Look_In_Primary_Dir := False;
594
595 -- Forbid -?- or -??- where ? is any character
596
597 elsif (Argv'Length = 3 and then Argv (3) = '-')
598 or else (Argv'Length = 4 and then Argv (4) = '-')
599 then
600 Fail ("Trailing ""-"" at the end of ", Argv, " forbidden.");
601
602 -- Processing for -Idir
603
604 elsif Argv (2) = 'I' then
605 Add_Source_Dir (Argv (3 .. Argv'Last), And_Save);
606 Add_Lib_Dir (Argv (3 .. Argv'Last), And_Save);
607
608 -- Processing for -aIdir (to gcc this is like a -I switch)
609
610 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
611 Add_Source_Dir (Argv (4 .. Argv'Last), And_Save);
612
613 -- Processing for -aOdir
614
615 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
616 Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
617
618 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
619
620 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
621 Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
622
623 -- Processing for -nostdinc
624
625 elsif Argv (2 .. Argv'Last) = "nostdinc" then
626 Opt.No_Stdinc := True;
627
628 -- Processing for one character switches
629
630 elsif Argv'Length = 2 then
631 case Argv (2) is
632 when 'a' => Also_Predef := True;
633 when 'h' => Print_Usage := True;
634 when 'u' => Reset_Print; Print_Unit := True;
635 when 's' => Reset_Print; Print_Source := True;
636 when 'o' => Reset_Print; Print_Object := True;
637 when 'v' => Verbose_Mode := True;
638 when 'd' => Dependable := True;
639
640 when others => null;
641 end case;
642
643 -- Processing for --RTS=path
644
645 elsif Argv (1 .. 5) = "--RTS" then
646
647 if Argv (6) /= '=' or else
648 (Argv (6) = '='
649 and then Argv'Length = 6)
650 then
651 Osint.Fail ("missing path for --RTS");
652
653 else
654 -- Valid --RTS switch
655
656 Opt.No_Stdinc := True;
657 Opt.RTS_Switch := True;
658
659 declare
660 Src_Path_Name : String_Ptr :=
661 String_Ptr
662 (Get_RTS_Search_Dir
663 (Argv (7 .. Argv'Last), Include));
664 Lib_Path_Name : String_Ptr :=
665 String_Ptr
666 (Get_RTS_Search_Dir
667 (Argv (7 .. Argv'Last), Objects));
668
669 begin
670 if Src_Path_Name /= null
671 and then Lib_Path_Name /= null
672 then
673 Add_Search_Dirs (Src_Path_Name, Include);
674 Add_Search_Dirs (Lib_Path_Name, Objects);
675
676 elsif Src_Path_Name = null
677 and then Lib_Path_Name = null
678 then
679 Osint.Fail ("RTS path not valid: missing " &
680 "adainclude and adalib directories");
681
682 elsif Src_Path_Name = null then
683 Osint.Fail ("RTS path not valid: missing " &
684 "adainclude directory");
685
686 elsif Lib_Path_Name = null then
687 Osint.Fail ("RTS path not valid: missing " &
688 "adalib directory");
689 end if;
690 end;
691 end if;
692 end if;
693
694 -- If not a switch, it must be a file name
695
696 else
697 Add_File (Argv);
698 end if;
699 end Scan_Ls_Arg;
700
701 -----------
702 -- Usage --
703 -----------
704
705 procedure Usage is
706
707 -- Start of processing for Usage
708
709 begin
710 -- Usage line
711
712 Write_Str ("Usage: ");
713 Osint.Write_Program_Name;
714 Write_Str (" switches [list of object files]");
715 Write_Eol;
716 Write_Eol;
717
718 -- GNATLS switches
719
720 Write_Str ("switches:");
721 Write_Eol;
722
723 -- Line for -a
724
725 Write_Str (" -a also output relevant predefined units");
726 Write_Eol;
727
728 -- Line for -u
729
730 Write_Str (" -u output only relevant unit names");
731 Write_Eol;
732
733 -- Line for -h
734
735 Write_Str (" -h output this help message");
736 Write_Eol;
737
738 -- Line for -s
739
740 Write_Str (" -s output only relevant source names");
741 Write_Eol;
742
743 -- Line for -o
744
745 Write_Str (" -o output only relevant object names");
746 Write_Eol;
747
748 -- Line for -d
749
750 Write_Str (" -d output sources on which specified units depend");
751 Write_Eol;
752
753 -- Line for -v
754
755 Write_Str (" -v verbose output, full path and unit information");
756 Write_Eol;
757 Write_Eol;
758
759 -- Line for -aI switch
760
761 Write_Str (" -aIdir specify source files search path");
762 Write_Eol;
763
764 -- Line for -aO switch
765
766 Write_Str (" -aOdir specify object files search path");
767 Write_Eol;
768
769 -- Line for -I switch
770
771 Write_Str (" -Idir like -aIdir -aOdir");
772 Write_Eol;
773
774 -- Line for -I- switch
775
776 Write_Str (" -I- do not look for sources & object files");
777 Write_Str (" in the default directory");
778 Write_Eol;
779
780 -- Line for -nostdinc
781
782 Write_Str (" -nostdinc do not look for source files");
783 Write_Str (" in the system default directory");
784 Write_Eol;
785
786 -- Line for --RTS
787
788 Write_Str (" --RTS=dir specify the default source and object search"
789 & " path");
790 Write_Eol;
791
792 -- File Status explanation
793
794 Write_Eol;
795 Write_Str (" file status can be:");
796 Write_Eol;
797
798 for ST in File_Status loop
799 Write_Str (" ");
800 Output_Status (ST, Verbose => False);
801 Write_Str (" ==> ");
802 Output_Status (ST, Verbose => True);
803 Write_Eol;
804 end loop;
805
806 end Usage;
807
808 -- Start of processing for Gnatls
809
810 begin
811
812 -- Use low level argument routines to avoid dragging in the secondary stack
813
814 Next_Arg := 1;
815
816 Scan_Args : while Next_Arg < Arg_Count loop
817 declare
818 Next_Argv : String (1 .. Len_Arg (Next_Arg));
819
820 begin
821 Fill_Arg (Next_Argv'Address, Next_Arg);
822 Scan_Ls_Arg (Next_Argv, And_Save => True);
823 end;
824
825 Next_Arg := Next_Arg + 1;
826 end loop Scan_Args;
827
828 -- Add the source and object directories specified on the
829 -- command line, if any, to the searched directories.
830
831 while First_Source_Dir /= null loop
832 Add_Src_Search_Dir (First_Source_Dir.Value.all);
833 First_Source_Dir := First_Source_Dir.Next;
834 end loop;
835
836 while First_Lib_Dir /= null loop
837 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
838 First_Lib_Dir := First_Lib_Dir.Next;
839 end loop;
840
841 -- Finally, add the default directories and obtain target parameters
842
843 Osint.Add_Default_Search_Dirs;
844
845 if Verbose_Mode then
846 Namet.Initialize;
847 Targparm.Get_Target_Parameters;
848
849 -- WARNING: the output of gnatls -v is used during the compilation
850 -- and installation of GLADE to recreate sdefault.adb and locate
851 -- the libgnat.a to use. Any change in the output of gnatls -v must
852 -- be synchronized with the GLADE Dist/config.sdefault shell script.
853
854 Write_Eol;
855 Write_Str ("GNATLS ");
856
857 if Targparm.High_Integrity_Mode_On_Target then
858 Write_Str ("Pro High Integrity ");
859 end if;
860
861 Write_Str (Gnat_Version_String);
862 Write_Str (" Copyright 1997-2002 Free Software Foundation, Inc.");
863 Write_Eol;
864 Write_Eol;
865 Write_Str ("Source Search Path:");
866 Write_Eol;
867
868 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
869 Write_Str (" ");
870
871 if Dir_In_Src_Search_Path (J)'Length = 0 then
872 Write_Str ("<Current_Directory>");
873 else
874 Write_Str (To_Host_Dir_Spec
875 (Dir_In_Src_Search_Path (J).all, True).all);
876 end if;
877
878 Write_Eol;
879 end loop;
880
881 Write_Eol;
882 Write_Eol;
883 Write_Str ("Object Search Path:");
884 Write_Eol;
885
886 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
887 Write_Str (" ");
888
889 if Dir_In_Obj_Search_Path (J)'Length = 0 then
890 Write_Str ("<Current_Directory>");
891 else
892 Write_Str (To_Host_Dir_Spec
893 (Dir_In_Obj_Search_Path (J).all, True).all);
894 end if;
895
896 Write_Eol;
897 end loop;
898
899 Write_Eol;
900 end if;
901
902 -- Output usage information when requested
903
904 if Print_Usage then
905 Usage;
906 end if;
907
908 if not More_Lib_Files then
909 if not Print_Usage and then not Verbose_Mode then
910 Usage;
911 end if;
912
913 Exit_Program (E_Fatal);
914 end if;
915
916 Namet.Initialize;
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_Decoded_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 Id :=
940 Scan_ALI
941 (Ali_File, Text, Ignore_ED => False, Err => False);
942 Free (Text);
943 end if;
944 end if;
945 end loop;
946
947 Find_General_Layout;
948 for Id in ALIs.First .. ALIs.Last loop
949 declare
950 Last_U : Unit_Id;
951
952 begin
953 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
954
955 if Also_Predef or else not Is_Internal_Unit then
956 Output_Object (ALIs.Table (Id).Ofile_Full_Name);
957
958 -- In verbose mode print all main units in the ALI file, otherwise
959 -- just print the first one to ease columnwise printout
960
961 if Verbose_Mode then
962 Last_U := ALIs.Table (Id).Last_Unit;
963 else
964 Last_U := ALIs.Table (Id).First_Unit;
965 end if;
966
967 for U in ALIs.Table (Id).First_Unit .. Last_U loop
968 if U /= ALIs.Table (Id).First_Unit
969 and then Selective_Output
970 and then Print_Unit
971 then
972 Write_Eol;
973 end if;
974
975 Output_Unit (U);
976
977 -- Output source now, unless if it will be done as part of
978 -- outputing dependencies.
979
980 if not (Dependable and then Print_Source) then
981 Output_Source (Corresponding_Sdep_Entry (Id, U));
982 end if;
983 end loop;
984
985 -- Print out list of dependable units
986
987 if Dependable and then Print_Source then
988 if Verbose_Mode then
989 Write_Str ("depends upon");
990 Write_Eol;
991 Write_Str (" ");
992
993 else
994 Write_Eol;
995 end if;
996
997 for D in
998 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
999 loop
1000 if Also_Predef
1001 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1002 then
1003 if Verbose_Mode then
1004 Write_Str (" ");
1005 Output_Source (D);
1006
1007 elsif Too_Long then
1008 Write_Str (" ");
1009 Output_Source (D);
1010 Write_Eol;
1011
1012 else
1013 Write_Str (Spaces (1 .. Source_Start - 2));
1014 Output_Source (D);
1015 Write_Eol;
1016 end if;
1017 end if;
1018 end loop;
1019 end if;
1020
1021 Write_Eol;
1022 end if;
1023 end;
1024 end loop;
1025
1026 -- All done. Set proper exit status.
1027
1028 Namet.Finalize;
1029 Exit_Program (E_Success);
1030
1031 end Gnatls;