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