OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [gnatls.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.