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