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