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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [mlib-prj.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
--                            M L I B . P R J                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--                     Copyright (C) 2001-2011, AdaCore                     --
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 Gnatvsn;  use Gnatvsn;
28
with Makeutl;  use Makeutl;
29
with MLib.Fil; use MLib.Fil;
30
with MLib.Tgt; use MLib.Tgt;
31
with MLib.Utl; use MLib.Utl;
32
with Opt;
33
with Output;   use Output;
34
with Prj.Com;  use Prj.Com;
35
with Prj.Env;  use Prj.Env;
36
with Prj.Util; use Prj.Util;
37
with Sinput.P;
38
with Snames;   use Snames;
39
with Switch;   use Switch;
40
with Table;
41
with Targparm; use Targparm;
42
with Tempdir;
43
with Types;    use Types;
44
 
45
with Ada.Characters.Handling;
46
 
47
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
48
with GNAT.HTable;
49
with Interfaces.C_Streams;      use Interfaces.C_Streams;
50
with System;                    use System;
51
with System.Case_Util;          use System.Case_Util;
52
 
53
package body MLib.Prj is
54
 
55
   Prj_Add_Obj_Files : Types.Int;
56
   pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");
57
   Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;
58
   --  Indicates if object files in pragmas Linker_Options (found in the
59
   --  binder generated file) should be taken when linking a stand-alone
60
   --  library. False for Windows, True for other platforms.
61
 
62
   ALI_Suffix : constant String := ".ali";
63
 
64
   B_Start : String_Ptr := new String'("b~");
65
   --  Prefix of bind file, changed to b__ for VMS
66
 
67
   S_Osinte_Ads : File_Name_Type := No_File;
68
   --  Name_Id for "s-osinte.ads"
69
 
70
   S_Dec_Ads : File_Name_Type := No_File;
71
   --  Name_Id for "dec.ads"
72
 
73
   Arguments : String_List_Access := No_Argument;
74
   --  Used to accumulate arguments for the invocation of gnatbind and of the
75
   --  compiler. Also used to collect the interface ALI when copying the ALI
76
   --  files to the library directory.
77
 
78
   Argument_Number : Natural := 0;
79
   --  Index of the last argument in Arguments
80
 
81
   Initial_Argument_Max : constant := 10;
82
   --  Where does the magic constant 10 come from???
83
 
84
   No_Main_String        : aliased String         := "-n";
85
   No_Main               : constant String_Access := No_Main_String'Access;
86
 
87
   Output_Switch_String  : aliased String         := "-o";
88
   Output_Switch         : constant String_Access :=
89
                             Output_Switch_String'Access;
90
 
91
   Compile_Switch_String : aliased String         := "-c";
92
   Compile_Switch        : constant String_Access :=
93
                             Compile_Switch_String'Access;
94
 
95
   No_Warning_String     : aliased String         := "-gnatws";
96
   No_Warning            : constant String_Access := No_Warning_String'Access;
97
 
98
   Auto_Initialize : constant String := "-a";
99
 
100
   --  List of objects to put inside the library
101
 
102
   Object_Files : Argument_List_Access;
103
 
104
   package Objects is new Table.Table
105
     (Table_Name           => "Mlib.Prj.Objects",
106
      Table_Component_Type => String_Access,
107
      Table_Index_Type     => Natural,
108
      Table_Low_Bound      => 1,
109
      Table_Initial        => 50,
110
      Table_Increment      => 100);
111
 
112
   package Objects_Htable is new GNAT.HTable.Simple_HTable
113
     (Header_Num => Header_Num,
114
      Element    => Boolean,
115
      No_Element => False,
116
      Key        => Name_Id,
117
      Hash       => Hash,
118
      Equal      => "=");
119
 
120
   --  List of ALI files
121
 
122
   Ali_Files : Argument_List_Access;
123
 
124
   package ALIs is new Table.Table
125
     (Table_Name           => "Mlib.Prj.Alis",
126
      Table_Component_Type => String_Access,
127
      Table_Index_Type     => Natural,
128
      Table_Low_Bound      => 1,
129
      Table_Initial        => 50,
130
      Table_Increment      => 100);
131
 
132
   --  List of options set in the command line
133
 
134
   Options : Argument_List_Access;
135
 
136
   package Opts is new Table.Table
137
     (Table_Name           => "Mlib.Prj.Opts",
138
      Table_Component_Type => String_Access,
139
      Table_Index_Type     => Natural,
140
      Table_Low_Bound      => 1,
141
      Table_Initial        => 5,
142
      Table_Increment      => 100);
143
 
144
   --  All the ALI file in the library
145
 
146
   package Library_ALIs is new GNAT.HTable.Simple_HTable
147
     (Header_Num => Header_Num,
148
      Element    => Boolean,
149
      No_Element => False,
150
      Key        => File_Name_Type,
151
      Hash       => Hash,
152
      Equal      => "=");
153
 
154
   --  The ALI files in the interface sets
155
 
156
   package Interface_ALIs is new GNAT.HTable.Simple_HTable
157
     (Header_Num => Header_Num,
158
      Element    => Boolean,
159
      No_Element => False,
160
      Key        => File_Name_Type,
161
      Hash       => Hash,
162
      Equal      => "=");
163
 
164
   --  The ALI files that have been processed to check if the corresponding
165
   --  library unit is in the interface set.
166
 
167
   package Processed_ALIs is new GNAT.HTable.Simple_HTable
168
     (Header_Num => Header_Num,
169
      Element    => Boolean,
170
      No_Element => False,
171
      Key        => File_Name_Type,
172
      Hash       => Hash,
173
      Equal      => "=");
174
 
175
   --  The projects imported directly or indirectly
176
 
177
   package Processed_Projects is new GNAT.HTable.Simple_HTable
178
     (Header_Num => Header_Num,
179
      Element    => Boolean,
180
      No_Element => False,
181
      Key        => Name_Id,
182
      Hash       => Hash,
183
      Equal      => "=");
184
 
185
   --  The library projects imported directly or indirectly
186
 
187
   package Library_Projs is new Table.Table (
188
     Table_Component_Type => Project_Id,
189
     Table_Index_Type     => Integer,
190
     Table_Low_Bound      => 1,
191
     Table_Initial        => 10,
192
     Table_Increment      => 10,
193
     Table_Name           => "Make.Library_Projs");
194
 
195
   type Build_Mode_State is (None, Static, Dynamic, Relocatable);
196
 
197
   procedure Add_Argument (S : String);
198
   --  Add one argument to Arguments array, if array is full, double its size
199
 
200
   function ALI_File_Name (Source : String) return String;
201
   --  Return the ALI file name corresponding to a source
202
 
203
   procedure Check (Filename : String);
204
   --  Check if filename is a regular file. Fail if it is not
205
 
206
   procedure Check_Context;
207
   --  Check each object files in table Object_Files
208
   --  Fail if any of them is not a regular file
209
 
210
   procedure Copy_Interface_Sources
211
     (For_Project : Project_Id;
212
      In_Tree     : Project_Tree_Ref;
213
      Interfaces  : Argument_List;
214
      To_Dir      : Path_Name_Type);
215
   --  Copy the interface sources of a SAL to directory To_Dir
216
 
217
   procedure Display (Executable : String);
218
   --  Display invocation of gnatbind and of the compiler with the arguments
219
   --  in Arguments, except when Quiet_Output is True.
220
 
221
   function Index (S, Pattern : String) return Natural;
222
   --  Return the last occurrence of Pattern in S, or 0 if none
223
 
224
   procedure Process_Binder_File (Name : String);
225
   --  For Stand-Alone libraries, get the Linker Options in the binder
226
   --  generated file.
227
 
228
   procedure Reset_Tables;
229
   --  Make sure that all the above tables are empty
230
   --  (Objects, Ali_Files, Options).
231
 
232
   function SALs_Use_Constructors return Boolean;
233
   --  Indicate if Stand-Alone Libraries are automatically initialized using
234
   --  the constructor mechanism.
235
 
236
   ------------------
237
   -- Add_Argument --
238
   ------------------
239
 
240
   procedure Add_Argument (S : String) is
241
   begin
242
      if Argument_Number = Arguments'Last then
243
         declare
244
            New_Args : constant String_List_Access :=
245
              new String_List (1 .. 2 * Arguments'Last);
246
 
247
         begin
248
            --  Copy the String_Accesses and set them to null in Arguments
249
            --  so that they will not be deallocated by the call to
250
            --  Free (Arguments).
251
 
252
            New_Args (Arguments'Range) := Arguments.all;
253
            Arguments.all := (others => null);
254
            Free (Arguments);
255
            Arguments := New_Args;
256
         end;
257
      end if;
258
 
259
      Argument_Number := Argument_Number + 1;
260
      Arguments (Argument_Number) := new String'(S);
261
   end Add_Argument;
262
 
263
   -------------------
264
   -- ALI_File_Name --
265
   -------------------
266
 
267
   function ALI_File_Name (Source : String) return String is
268
   begin
269
      --  If the source name has an extension, then replace it with
270
      --  the ALI suffix.
271
 
272
      for Index in reverse Source'First + 1 .. Source'Last loop
273
         if Source (Index) = '.' then
274
            return Source (Source'First .. Index - 1) & ALI_Suffix;
275
         end if;
276
      end loop;
277
 
278
      --  If there is no dot, or if it is the first character, just add the
279
      --  ALI suffix.
280
 
281
      return Source & ALI_Suffix;
282
   end ALI_File_Name;
283
 
284
   -------------------
285
   -- Build_Library --
286
   -------------------
287
 
288
   procedure Build_Library
289
     (For_Project   : Project_Id;
290
      In_Tree       : Project_Tree_Ref;
291
      Gnatbind      : String;
292
      Gnatbind_Path : String_Access;
293
      Gcc           : String;
294
      Gcc_Path      : String_Access;
295
      Bind          : Boolean := True;
296
      Link          : Boolean := True)
297
   is
298
      Maximum_Size : Integer;
299
      pragma Import (C, Maximum_Size, "__gnat_link_max");
300
      --  Maximum number of bytes to put in an invocation of gnatbind
301
 
302
      Size : Integer;
303
      --  The number of bytes for the invocation of gnatbind
304
 
305
      Warning_For_Library : Boolean := False;
306
      --  Set True for first warning for a unit missing from the interface set
307
 
308
      Current_Proj : Project_Id;
309
 
310
      Libgnarl_Needed   : Yes_No_Unknown := For_Project.Libgnarl_Needed;
311
      --  Set True if library needs to be linked with libgnarl
312
 
313
      Libdecgnat_Needed : Boolean := False;
314
      --  On OpenVMS, set True if library needs to be linked with libdecgnat
315
 
316
      Object_Directory_Path : constant String :=
317
                                Get_Name_String
318
                                  (For_Project.Object_Directory.Display_Name);
319
 
320
      Standalone   : constant Boolean := For_Project.Standalone_Library /= No;
321
 
322
      Project_Name : constant String := Get_Name_String (For_Project.Name);
323
 
324
      Current_Dir  : constant String := Get_Current_Dir;
325
 
326
      Lib_Filename : String_Access;
327
      Lib_Dirpath  : String_Access;
328
      Lib_Version  : String_Access := new String'("");
329
 
330
      The_Build_Mode : Build_Mode_State := None;
331
 
332
      Success : Boolean := False;
333
 
334
      Library_Options : Variable_Value := Nil_Variable_Value;
335
 
336
      Driver_Name : Name_Id := No_Name;
337
 
338
      In_Main_Object_Directory : Boolean := True;
339
 
340
      Foreign_Sources : Boolean;
341
 
342
      Rpath : String_Access := null;
343
      --  Allocated only if Path Option is supported
344
 
345
      Rpath_Last : Natural := 0;
346
      --  Index of last valid character of Rpath
347
 
348
      Initial_Rpath_Length : constant := 200;
349
      --  Initial size of Rpath, when first allocated
350
 
351
      Path_Option : String_Access := Linker_Library_Path_Option;
352
      --  If null, Path Option is not supported. Not a constant so that it can
353
      --  be deallocated.
354
 
355
      First_ALI : File_Name_Type := No_File;
356
      --  Store the ALI file name of a source of the library (the first found)
357
 
358
      procedure Add_ALI_For (Source : File_Name_Type);
359
      --  Add name of the ALI file corresponding to Source to the Arguments
360
 
361
      procedure Add_Rpath (Path : String);
362
      --  Add a path name to Rpath
363
 
364
      function Check_Project (P : Project_Id) return Boolean;
365
      --  Returns True if P is For_Project or a project extended by For_Project
366
 
367
      procedure Check_Libs (ALI_File : String; Main_Project : Boolean);
368
      --  Set Libgnarl_Needed if the ALI_File indicates that there is a need
369
      --  to link with -lgnarl (this is the case when there is a dependency
370
      --  on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
371
      --  indicates that there is a need to link with -ldecgnat (this is the
372
      --  case when there is a dependency on dec.ads).
373
 
374
      procedure Process (The_ALI : File_Name_Type);
375
      --  Check if the closure of a library unit which is or should be in the
376
      --  interface set is also in the interface set. Issue a warning for each
377
      --  missing library unit.
378
 
379
      procedure Process_Imported_Libraries;
380
      --  Add the -L and -l switches for the imported Library Project Files,
381
      --  and, if Path Option is supported, the library directory path names
382
      --  to Rpath.
383
 
384
      -----------------
385
      -- Add_ALI_For --
386
      -----------------
387
 
388
      procedure Add_ALI_For (Source : File_Name_Type) is
389
         ALI    : constant String := ALI_File_Name (Get_Name_String (Source));
390
         ALI_Id : File_Name_Type;
391
 
392
      begin
393
         if Bind then
394
            Add_Argument (ALI);
395
         end if;
396
 
397
         Name_Len := 0;
398
         Add_Str_To_Name_Buffer (S => ALI);
399
         ALI_Id := Name_Find;
400
 
401
         --  Add the ALI file name to the library ALIs
402
 
403
         if Bind then
404
            Library_ALIs.Set (ALI_Id, True);
405
         end if;
406
 
407
         --  Set First_ALI, if not already done
408
 
409
         if First_ALI = No_File then
410
            First_ALI := ALI_Id;
411
         end if;
412
      end Add_ALI_For;
413
 
414
      ---------------
415
      -- Add_Rpath --
416
      ---------------
417
 
418
      procedure Add_Rpath (Path : String) is
419
 
420
         procedure Double;
421
         --  Double Rpath size
422
 
423
         ------------
424
         -- Double --
425
         ------------
426
 
427
         procedure Double is
428
            New_Rpath : constant String_Access :=
429
                          new String (1 .. 2 * Rpath'Length);
430
         begin
431
            New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);
432
            Free (Rpath);
433
            Rpath := New_Rpath;
434
         end Double;
435
 
436
      --  Start of processing for Add_Rpath
437
 
438
      begin
439
         --  If first path, allocate initial Rpath
440
 
441
         if Rpath = null then
442
            Rpath := new String (1 .. Initial_Rpath_Length);
443
            Rpath_Last := 0;
444
 
445
         else
446
            --  Otherwise, add a path separator between two path names
447
 
448
            if Rpath_Last = Rpath'Last then
449
               Double;
450
            end if;
451
 
452
            Rpath_Last := Rpath_Last + 1;
453
            Rpath (Rpath_Last) := Path_Separator;
454
         end if;
455
 
456
         --  Increase Rpath size until it is large enough
457
 
458
         while Rpath_Last + Path'Length > Rpath'Last loop
459
            Double;
460
         end loop;
461
 
462
         --  Add the path name
463
 
464
         Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
465
         Rpath_Last := Rpath_Last + Path'Length;
466
      end Add_Rpath;
467
 
468
      -------------------
469
      -- Check_Project --
470
      -------------------
471
 
472
      function Check_Project (P : Project_Id) return Boolean is
473
      begin
474
         if P = For_Project then
475
            return True;
476
 
477
         elsif P /= No_Project then
478
            declare
479
               Proj : Project_Id;
480
 
481
            begin
482
               Proj := For_Project;
483
               while Proj.Extends /= No_Project loop
484
                  if P = Proj.Extends then
485
                     return True;
486
                  end if;
487
 
488
                  Proj := Proj.Extends;
489
               end loop;
490
            end;
491
         end if;
492
 
493
         return False;
494
      end Check_Project;
495
 
496
      ----------------
497
      -- Check_Libs --
498
      ----------------
499
 
500
      procedure Check_Libs (ALI_File : String; Main_Project : Boolean) is
501
         Lib_File : File_Name_Type;
502
         Text     : Text_Buffer_Ptr;
503
         Id       : ALI.ALI_Id;
504
 
505
      begin
506
         if Libgnarl_Needed /= Yes
507
           or else
508
            (Main_Project
509
              and then OpenVMS_On_Target)
510
         then
511
            --  Scan the ALI file
512
 
513
            Name_Len := ALI_File'Length;
514
            Name_Buffer (1 .. Name_Len) := ALI_File;
515
            Lib_File := Name_Find;
516
            Text := Read_Library_Info (Lib_File, True);
517
 
518
            Id := ALI.Scan_ALI
519
                    (F          => Lib_File,
520
                     T          => Text,
521
                     Ignore_ED  => False,
522
                     Err        => True,
523
                     Read_Lines => "D");
524
            Free (Text);
525
 
526
            --  Look for s-osinte.ads in the dependencies
527
 
528
            for Index in ALI.ALIs.Table (Id).First_Sdep ..
529
                         ALI.ALIs.Table (Id).Last_Sdep
530
            loop
531
               if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
532
                  Libgnarl_Needed := Yes;
533
 
534
                  if Main_Project then
535
                     For_Project.Libgnarl_Needed := Yes;
536
                  else
537
                     exit;
538
                  end if;
539
 
540
               elsif OpenVMS_On_Target then
541
                  if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
542
                     Libdecgnat_Needed := True;
543
                  end if;
544
               end if;
545
            end loop;
546
         end if;
547
      end Check_Libs;
548
 
549
      -------------
550
      -- Process --
551
      -------------
552
 
553
      procedure Process (The_ALI : File_Name_Type) is
554
         Text       : Text_Buffer_Ptr;
555
         Idread     : ALI_Id;
556
         First_Unit : ALI.Unit_Id;
557
         Last_Unit  : ALI.Unit_Id;
558
         Unit_Data  : Unit_Record;
559
         Afile      : File_Name_Type;
560
 
561
      begin
562
         --  Nothing to do if the ALI file has already been processed.
563
         --  This happens if an interface imports another interface.
564
 
565
         if not Processed_ALIs.Get (The_ALI) then
566
            Processed_ALIs.Set (The_ALI, True);
567
            Text := Read_Library_Info (The_ALI);
568
 
569
            if Text /= null then
570
               Idread :=
571
                 Scan_ALI
572
                   (F         => The_ALI,
573
                    T         => Text,
574
                    Ignore_ED => False,
575
                    Err       => True);
576
               Free (Text);
577
 
578
               if Idread /= No_ALI_Id then
579
                  First_Unit := ALI.ALIs.Table (Idread).First_Unit;
580
                  Last_Unit  := ALI.ALIs.Table (Idread).Last_Unit;
581
 
582
                  --  Process both unit (spec and body) if the body is needed
583
                  --  by the spec (inline or generic). Otherwise, just process
584
                  --  the spec.
585
 
586
                  if First_Unit /= Last_Unit and then
587
                    not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
588
                  then
589
                     First_Unit := Last_Unit;
590
                  end if;
591
 
592
                  for Unit in First_Unit .. Last_Unit loop
593
                     Unit_Data := ALI.Units.Table (Unit);
594
 
595
                     --  Check if each withed unit which is in the library is
596
                     --  also in the interface set, if it has not yet been
597
                     --  processed.
598
 
599
                     for W in Unit_Data.First_With .. Unit_Data.Last_With loop
600
                        Afile := Withs.Table (W).Afile;
601
 
602
                        if Afile /= No_File and then Library_ALIs.Get (Afile)
603
                          and then not Processed_ALIs.Get (Afile)
604
                        then
605
                           if not Interface_ALIs.Get (Afile) then
606
                              if not Warning_For_Library then
607
                                 Write_Str ("Warning: In library project """);
608
                                 Get_Name_String (Current_Proj.Name);
609
                                 To_Mixed (Name_Buffer (1 .. Name_Len));
610
                                 Write_Str (Name_Buffer (1 .. Name_Len));
611
                                 Write_Line ("""");
612
                                 Warning_For_Library := True;
613
                              end if;
614
 
615
                              Write_Str ("         Unit """);
616
                              Get_Name_String (Withs.Table (W).Uname);
617
                              To_Mixed (Name_Buffer (1 .. Name_Len - 2));
618
                              Write_Str (Name_Buffer (1 .. Name_Len - 2));
619
                              Write_Line (""" is not in the interface set");
620
                              Write_Str ("         but it is needed by ");
621
 
622
                              case Unit_Data.Utype is
623
                                 when Is_Spec =>
624
                                    Write_Str ("the spec of ");
625
 
626
                                 when Is_Body =>
627
                                    Write_Str ("the body of ");
628
 
629
                                 when others =>
630
                                    null;
631
                              end case;
632
 
633
                              Write_Str ("""");
634
                              Get_Name_String (Unit_Data.Uname);
635
                              To_Mixed (Name_Buffer (1 .. Name_Len - 2));
636
                              Write_Str (Name_Buffer (1 .. Name_Len - 2));
637
                              Write_Line ("""");
638
                           end if;
639
 
640
                           --  Now, process this unit
641
 
642
                           Process (Afile);
643
                        end if;
644
                     end loop;
645
                  end loop;
646
               end if;
647
            end if;
648
         end if;
649
      end Process;
650
 
651
      --------------------------------
652
      -- Process_Imported_Libraries --
653
      --------------------------------
654
 
655
      procedure Process_Imported_Libraries is
656
         Current : Project_Id;
657
 
658
         procedure Process_Project (Project : Project_Id);
659
         --  Process Project and its imported projects recursively.
660
         --  Add any library projects to table Library_Projs.
661
 
662
         ---------------------
663
         -- Process_Project --
664
         ---------------------
665
 
666
         procedure Process_Project (Project : Project_Id) is
667
            Imported : Project_List;
668
 
669
         begin
670
            --  Nothing to do if process has already been processed
671
 
672
            if not Processed_Projects.Get (Project.Name) then
673
               Processed_Projects.Set (Project.Name, True);
674
 
675
               --  Call Process_Project recursively for any imported project.
676
               --  We first process the imported projects to guarantee that
677
               --  we have a proper reverse order for the libraries.
678
 
679
               Imported := Project.Imported_Projects;
680
               while Imported /= null loop
681
                  if Imported.Project /= No_Project then
682
                     Process_Project (Imported.Project);
683
                  end if;
684
 
685
                  Imported := Imported.Next;
686
               end loop;
687
 
688
               --  If it is a library project, add it to Library_Projs
689
 
690
               if Project /= For_Project and then Project.Library then
691
                  Library_Projs.Increment_Last;
692
                  Library_Projs.Table (Library_Projs.Last) := Project;
693
 
694
                  --  Check if because of this library we need to use libgnarl
695
 
696
                  if Libgnarl_Needed = Unknown then
697
                     if Project.Libgnarl_Needed = Unknown
698
                       and then Project.Object_Directory /= No_Path_Information
699
                     then
700
                        --  Check if libgnarl is needed for this library
701
 
702
                        declare
703
                           Object_Dir_Path : constant String :=
704
                                               Get_Name_String
705
                                                 (Project.Object_Directory.
706
                                                    Display_Name);
707
                           Object_Dir      : Dir_Type;
708
                           Filename        : String (1 .. 255);
709
                           Last            : Natural;
710
 
711
                        begin
712
                           Open (Object_Dir, Object_Dir_Path);
713
 
714
                           --  For all entries in the object directory
715
 
716
                           loop
717
                              Read (Object_Dir, Filename, Last);
718
                              exit when Last = 0;
719
 
720
                              --  Check if it is an object file
721
 
722
                              if Is_Obj (Filename (1 .. Last)) then
723
                                 declare
724
                                    Object_Path : constant String :=
725
                                                    Normalize_Pathname
726
                                                      (Object_Dir_Path &
727
                                                       Directory_Separator &
728
                                                       Filename (1 .. Last));
729
                                    ALI_File    : constant String :=
730
                                                    Ext_To
731
                                                      (Object_Path, "ali");
732
 
733
                                 begin
734
                                    if Is_Regular_File (ALI_File) then
735
 
736
                                       --  Find out if for this ALI file,
737
                                       --  libgnarl is necessary.
738
 
739
                                       Check_Libs
740
                                         (ALI_File, Main_Project => False);
741
 
742
                                       if Libgnarl_Needed = Yes then
743
                                          Project.Libgnarl_Needed := Yes;
744
                                          For_Project.Libgnarl_Needed := Yes;
745
                                          exit;
746
                                       end if;
747
                                    end if;
748
                                 end;
749
                              end if;
750
                           end loop;
751
 
752
                           Close (Object_Dir);
753
                        end;
754
                     end if;
755
 
756
                     if Project.Libgnarl_Needed = Yes then
757
                        Libgnarl_Needed := Yes;
758
                        For_Project.Libgnarl_Needed := Yes;
759
                     end if;
760
                  end if;
761
               end if;
762
            end if;
763
         end Process_Project;
764
 
765
      --  Start of processing for Process_Imported_Libraries
766
 
767
      begin
768
         --  Build list of library projects imported directly or indirectly,
769
         --  in the reverse order.
770
 
771
         Process_Project (For_Project);
772
 
773
         --  Add the -L and -l switches and, if the Rpath option is supported,
774
         --  add the directory to the Rpath. As the library projects are in the
775
         --  wrong order, process from the last to the first.
776
 
777
         for Index in reverse 1 .. Library_Projs.Last loop
778
            Current := Library_Projs.Table (Index);
779
 
780
            Get_Name_String (Current.Library_Dir.Display_Name);
781
            Opts.Increment_Last;
782
            Opts.Table (Opts.Last) :=
783
              new String'("-L" & Name_Buffer (1 .. Name_Len));
784
 
785
            if Path_Option /= null then
786
               Add_Rpath (Name_Buffer (1 .. Name_Len));
787
            end if;
788
 
789
            Opts.Increment_Last;
790
            Opts.Table (Opts.Last) :=
791
              new String'("-l" & Get_Name_String (Current.Library_Name));
792
         end loop;
793
      end Process_Imported_Libraries;
794
 
795
      Path_FD : File_Descriptor := Invalid_FD;
796
      --  Used for setting the source and object paths
797
 
798
   --  Start of processing for Build_Library
799
 
800
   begin
801
      Reset_Tables;
802
 
803
      --  Fail if project is not a library project
804
 
805
      if not For_Project.Library then
806
         Com.Fail ("project """ & Project_Name & """ has no library");
807
      end if;
808
 
809
      --  Do not attempt to build the library if it is externally built
810
 
811
      if For_Project.Externally_Built then
812
         return;
813
      end if;
814
 
815
      --  If this is the first time Build_Library is called, get the Name_Id
816
      --  of "s-osinte.ads".
817
 
818
      if S_Osinte_Ads = No_File then
819
         Name_Len := 0;
820
         Add_Str_To_Name_Buffer ("s-osinte.ads");
821
         S_Osinte_Ads := Name_Find;
822
      end if;
823
 
824
      if S_Dec_Ads = No_File then
825
         Name_Len := 0;
826
         Add_Str_To_Name_Buffer ("dec.ads");
827
         S_Dec_Ads := Name_Find;
828
      end if;
829
 
830
      --  We work in the object directory
831
 
832
      Change_Dir (Object_Directory_Path);
833
 
834
      if Standalone then
835
 
836
         --  Call gnatbind only if Bind is True
837
 
838
         if Bind then
839
            if Gnatbind_Path = null then
840
               Com.Fail ("unable to locate " & Gnatbind);
841
            end if;
842
 
843
            if Gcc_Path = null then
844
               Com.Fail ("unable to locate " & Gcc);
845
            end if;
846
 
847
            --  Allocate Arguments, if it is the first time we see a standalone
848
            --  library.
849
 
850
            if Arguments = No_Argument then
851
               Arguments := new String_List (1 .. Initial_Argument_Max);
852
            end if;
853
 
854
            --  Add "-n -o b~<lib>.adb (b__<lib>.adb on VMS) -L<lib>_"
855
 
856
            Argument_Number := 2;
857
            Arguments (1) := No_Main;
858
            Arguments (2) := Output_Switch;
859
 
860
            if OpenVMS_On_Target then
861
               B_Start := new String'("b__");
862
            end if;
863
 
864
            Add_Argument
865
              (B_Start.all
866
               & Get_Name_String (For_Project.Library_Name) & ".adb");
867
 
868
            --  Make sure that the init procedure is never "adainit"
869
 
870
            Get_Name_String (For_Project.Library_Name);
871
 
872
            if Name_Buffer (1 .. Name_Len) = "ada" then
873
               Add_Argument ("-Lada_");
874
            else
875
               Add_Argument
876
                 ("-L" & Get_Name_String (For_Project.Library_Name));
877
            end if;
878
 
879
            if For_Project.Lib_Auto_Init and then SALs_Use_Constructors then
880
               Add_Argument (Auto_Initialize);
881
            end if;
882
 
883
            --  Check if Binder'Default_Switches ("Ada") is defined. If it is,
884
            --  add these switches to call gnatbind.
885
 
886
            declare
887
               Binder_Package : constant Package_Id :=
888
                                  Value_Of
889
                                    (Name        => Name_Binder,
890
                                     In_Packages => For_Project.Decl.Packages,
891
                                     Shared      => In_Tree.Shared);
892
 
893
            begin
894
               if Binder_Package /= No_Package then
895
                  declare
896
                     Defaults : constant Array_Element_Id :=
897
                                  Value_Of
898
                                    (Name      => Name_Default_Switches,
899
                                     In_Arrays =>
900
                                       In_Tree.Shared.Packages.Table
901
                                         (Binder_Package).Decl.Arrays,
902
                                     Shared    => In_Tree.Shared);
903
 
904
                     Switches : Variable_Value := Nil_Variable_Value;
905
                     Switch   : String_List_Id := Nil_String;
906
 
907
                  begin
908
                     if Defaults /= No_Array_Element then
909
                        Switches :=
910
                          Value_Of
911
                            (Index     => Name_Ada,
912
                             Src_Index => 0,
913
                             In_Array  => Defaults,
914
                             Shared    => In_Tree.Shared);
915
 
916
                        if not Switches.Default then
917
                           Switch := Switches.Values;
918
 
919
                           while Switch /= Nil_String loop
920
                              Add_Argument
921
                                (Get_Name_String
922
                                   (In_Tree.Shared.String_Elements.Table
923
                                      (Switch).Value));
924
                              Switch := In_Tree.Shared.String_Elements.
925
                                          Table (Switch).Next;
926
                           end loop;
927
                        end if;
928
                     end if;
929
                  end;
930
               end if;
931
            end;
932
         end if;
933
 
934
         --  Get all the ALI files of the project file. We do that even if
935
         --  Bind is False, so that First_ALI is set.
936
 
937
         declare
938
            Unit : Unit_Index;
939
 
940
         begin
941
            Library_ALIs.Reset;
942
            Interface_ALIs.Reset;
943
            Processed_ALIs.Reset;
944
 
945
            Unit := Units_Htable.Get_First (In_Tree.Units_HT);
946
            while Unit /= No_Unit_Index loop
947
               if Unit.File_Names (Impl) /= null
948
                 and then not Unit.File_Names (Impl).Locally_Removed
949
               then
950
                  if Check_Project (Unit.File_Names (Impl).Project) then
951
                     if Unit.File_Names (Spec) = null then
952
 
953
                        --  Add the ALI file only if it is not a subunit
954
 
955
                        declare
956
                           Src_Ind : constant Source_File_Index :=
957
                                       Sinput.P.Load_Project_File
958
                                         (Get_Name_String
959
                                           (Unit.File_Names (Impl).Path.Name));
960
                        begin
961
                           if not
962
                             Sinput.P.Source_File_Is_Subunit (Src_Ind)
963
                           then
964
                              Add_ALI_For (Unit.File_Names (Impl).File);
965
                              exit when not Bind;
966
                           end if;
967
                        end;
968
 
969
                     else
970
                        Add_ALI_For (Unit.File_Names (Impl).File);
971
                        exit when not Bind;
972
                     end if;
973
                  end if;
974
 
975
               elsif Unit.File_Names (Spec) /= null
976
                 and then not Unit.File_Names (Spec).Locally_Removed
977
                 and then Check_Project (Unit.File_Names (Spec).Project)
978
               then
979
                  Add_ALI_For (Unit.File_Names (Spec).File);
980
                  exit when not Bind;
981
               end if;
982
 
983
               Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
984
            end loop;
985
         end;
986
 
987
         --  Continue setup and call gnatbind if Bind is True
988
 
989
         if Bind then
990
 
991
            --  Get an eventual --RTS from the ALI file
992
 
993
            if First_ALI /= No_File then
994
               declare
995
                  T : Text_Buffer_Ptr;
996
                  A : ALI_Id;
997
 
998
               begin
999
                  --  Load the ALI file
1000
 
1001
                  T := Read_Library_Info (First_ALI, True);
1002
 
1003
                  --  Read it
1004
 
1005
                  A := Scan_ALI
1006
                         (First_ALI, T, Ignore_ED => False, Err => False);
1007
 
1008
                  if A /= No_ALI_Id then
1009
                     for Index in
1010
                       ALI.Units.Table
1011
                         (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1012
                       ALI.Units.Table
1013
                         (ALI.ALIs.Table (A).First_Unit).Last_Arg
1014
                     loop
1015
                        --  If --RTS found, add switch to call gnatbind
1016
 
1017
                        declare
1018
                           Arg : String_Ptr renames Args.Table (Index);
1019
                        begin
1020
                           if Arg'Length >= 6 and then
1021
                              Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1022
                           then
1023
                              Add_Argument (Arg.all);
1024
                              exit;
1025
                           end if;
1026
                        end;
1027
                     end loop;
1028
                  end if;
1029
               end;
1030
            end if;
1031
 
1032
            --  Set the paths
1033
 
1034
            --  First the source path
1035
 
1036
            if For_Project.Include_Path_File = No_Path then
1037
               Get_Directories
1038
                 (Project_Tree => In_Tree,
1039
                  For_Project  => For_Project,
1040
                  Activity     => Compilation,
1041
                  Languages    => Ada_Only);
1042
 
1043
               Create_New_Path_File
1044
                 (In_Tree.Shared, Path_FD, For_Project.Include_Path_File);
1045
 
1046
               Write_Path_File (Path_FD);
1047
               Path_FD := Invalid_FD;
1048
            end if;
1049
 
1050
            if Current_Source_Path_File_Of (In_Tree.Shared) /=
1051
                                                For_Project.Include_Path_File
1052
            then
1053
               Set_Current_Source_Path_File_Of
1054
                 (In_Tree.Shared, For_Project.Include_Path_File);
1055
               Set_Path_File_Var
1056
                 (Project_Include_Path_File,
1057
                  Get_Name_String (For_Project.Include_Path_File));
1058
            end if;
1059
 
1060
            --  Then, the object path
1061
 
1062
            Get_Directories
1063
              (Project_Tree => In_Tree,
1064
               For_Project  => For_Project,
1065
               Activity     => SAL_Binding,
1066
               Languages    => Ada_Only);
1067
 
1068
            declare
1069
               Path_File_Name : Path_Name_Type;
1070
 
1071
            begin
1072
               Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name);
1073
 
1074
               Write_Path_File (Path_FD);
1075
               Path_FD := Invalid_FD;
1076
 
1077
               Set_Path_File_Var
1078
                 (Project_Objects_Path_File, Get_Name_String (Path_File_Name));
1079
               Set_Current_Source_Path_File_Of
1080
                 (In_Tree.Shared, Path_File_Name);
1081
            end;
1082
 
1083
            --  Display the gnatbind command, if not in quiet output
1084
 
1085
            Display (Gnatbind);
1086
 
1087
            Size := 0;
1088
            for J in 1 .. Argument_Number loop
1089
               Size := Size + Arguments (J)'Length + 1;
1090
            end loop;
1091
 
1092
            --  Invoke gnatbind with the arguments if the size is not too large
1093
 
1094
            if Size <= Maximum_Size then
1095
               Spawn
1096
                 (Gnatbind_Path.all,
1097
                  Arguments (1 .. Argument_Number),
1098
                  Success);
1099
 
1100
            --  Otherwise create a temporary response file
1101
 
1102
            else
1103
               declare
1104
                  FD            : File_Descriptor;
1105
                  Path          : Path_Name_Type;
1106
                  Args          : Argument_List (1 .. 1);
1107
                  EOL           : constant String (1 .. 1) := (1 => ASCII.LF);
1108
                  Status        : Integer;
1109
                  Succ          : Boolean;
1110
                  Quotes_Needed : Boolean;
1111
                  Last_Char     : Natural;
1112
                  Ch            : Character;
1113
 
1114
               begin
1115
                  Tempdir.Create_Temp_File (FD, Path);
1116
                  Args (1) := new String'("@" & Get_Name_String (Path));
1117
 
1118
                  for J in 1 .. Argument_Number loop
1119
 
1120
                     --  Check if the argument should be quoted
1121
 
1122
                     Quotes_Needed := False;
1123
                     Last_Char     := Arguments (J)'Length;
1124
 
1125
                     for K in Arguments (J)'Range loop
1126
                        Ch := Arguments (J) (K);
1127
 
1128
                        if Ch = ' ' or else Ch = ASCII.HT or else Ch = '"' then
1129
                           Quotes_Needed := True;
1130
                           exit;
1131
                        end if;
1132
                     end loop;
1133
 
1134
                     if Quotes_Needed then
1135
 
1136
                        --  Quote the argument, doubling '"'
1137
 
1138
                        declare
1139
                           Arg : String (1 .. Arguments (J)'Length * 2 + 2);
1140
 
1141
                        begin
1142
                           Arg (1) := '"';
1143
                           Last_Char := 1;
1144
 
1145
                           for K in Arguments (J)'Range loop
1146
                              Ch := Arguments (J) (K);
1147
                              Last_Char := Last_Char + 1;
1148
                              Arg (Last_Char) := Ch;
1149
 
1150
                              if Ch = '"' then
1151
                                 Last_Char := Last_Char + 1;
1152
                                 Arg (Last_Char) := '"';
1153
                              end if;
1154
                           end loop;
1155
 
1156
                           Last_Char := Last_Char + 1;
1157
                           Arg (Last_Char) := '"';
1158
 
1159
                           Status := Write (FD, Arg'Address, Last_Char);
1160
                        end;
1161
 
1162
                     else
1163
                        Status := Write
1164
                          (FD,
1165
                           Arguments (J) (Arguments (J)'First)'Address,
1166
                           Last_Char);
1167
                     end if;
1168
 
1169
                     if Status /= Last_Char then
1170
                        Fail ("disk full");
1171
                     end if;
1172
 
1173
                     Status := Write (FD, EOL (1)'Address, 1);
1174
 
1175
                     if Status /= 1 then
1176
                        Fail ("disk full");
1177
                     end if;
1178
                  end loop;
1179
 
1180
                  Close (FD);
1181
 
1182
                  --  And invoke gnatbind with this response file
1183
 
1184
                  Spawn (Gnatbind_Path.all, Args, Success);
1185
 
1186
                  Delete_File (Get_Name_String (Path), Succ);
1187
 
1188
                  if not Succ then
1189
                     null;
1190
                  end if;
1191
               end;
1192
            end if;
1193
 
1194
            if not Success then
1195
               Com.Fail ("could not bind standalone library "
1196
                         & Get_Name_String (For_Project.Library_Name));
1197
            end if;
1198
         end if;
1199
 
1200
         --  Compile the binder generated file only if Link is true
1201
 
1202
         if Link then
1203
 
1204
            --  Set the paths
1205
 
1206
            Set_Ada_Paths
1207
              (Project             => For_Project,
1208
               In_Tree             => In_Tree,
1209
               Including_Libraries => True);
1210
 
1211
            --  Invoke <gcc> -c b__<lib>.adb
1212
 
1213
            --  Allocate Arguments, if first time we see a standalone library
1214
 
1215
            if Arguments = No_Argument then
1216
               Arguments := new String_List (1 .. Initial_Argument_Max);
1217
            end if;
1218
 
1219
            Argument_Number := 2;
1220
            Arguments (1) := Compile_Switch;
1221
            Arguments (2) := No_Warning;
1222
 
1223
            if OpenVMS_On_Target then
1224
               B_Start := new String'("b__");
1225
            end if;
1226
 
1227
            Add_Argument
1228
              (B_Start.all
1229
               & Get_Name_String (For_Project.Library_Name) & ".adb");
1230
 
1231
            --  If necessary, add the PIC option
1232
 
1233
            if PIC_Option /= "" then
1234
               Add_Argument (PIC_Option);
1235
            end if;
1236
 
1237
            --  Get the back-end switches and --RTS from the ALI file
1238
 
1239
            if First_ALI /= No_File then
1240
               declare
1241
                  T : Text_Buffer_Ptr;
1242
                  A : ALI_Id;
1243
 
1244
               begin
1245
                  --  Load the ALI file
1246
 
1247
                  T := Read_Library_Info (First_ALI, True);
1248
 
1249
                  --  Read it
1250
 
1251
                  A :=
1252
                    Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False);
1253
 
1254
                  if A /= No_ALI_Id then
1255
                     for Index in
1256
                       ALI.Units.Table
1257
                         (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1258
                       ALI.Units.Table
1259
                         (ALI.ALIs.Table (A).First_Unit).Last_Arg
1260
                     loop
1261
                        --  Do not compile with the front end switches except
1262
                        --  for --RTS.
1263
 
1264
                        declare
1265
                           Arg : String_Ptr renames Args.Table (Index);
1266
                        begin
1267
                           if not Is_Front_End_Switch (Arg.all)
1268
                             or else
1269
                               Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1270
                           then
1271
                              Add_Argument (Arg.all);
1272
                           end if;
1273
                        end;
1274
                     end loop;
1275
                  end if;
1276
               end;
1277
            end if;
1278
 
1279
            --  Now all the arguments are set, compile binder generated file
1280
 
1281
            Display (Gcc);
1282
            Spawn
1283
              (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
1284
 
1285
            if not Success then
1286
               Com.Fail
1287
                ("could not compile binder generated file for library "
1288
                  & Get_Name_String (For_Project.Library_Name));
1289
            end if;
1290
 
1291
            --  Process binder generated file for pragmas Linker_Options
1292
 
1293
            Process_Binder_File (Arguments (3).all & ASCII.NUL);
1294
         end if;
1295
      end if;
1296
 
1297
      --  Build the library only if Link is True
1298
 
1299
      if Link then
1300
 
1301
         --  If attributes Library_GCC or Linker'Driver were specified, get the
1302
         --  driver name.
1303
 
1304
         if For_Project.Config.Shared_Lib_Driver /= No_File then
1305
            Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver);
1306
         end if;
1307
 
1308
         --  If attribute Library_Options was specified, add these options
1309
 
1310
         Library_Options := Value_Of
1311
           (Name_Library_Options, For_Project.Decl.Attributes,
1312
            In_Tree.Shared);
1313
 
1314
         if not Library_Options.Default then
1315
            declare
1316
               Current : String_List_Id;
1317
               Element : String_Element;
1318
 
1319
            begin
1320
               Current := Library_Options.Values;
1321
               while Current /= Nil_String loop
1322
                  Element := In_Tree.Shared.String_Elements.Table (Current);
1323
                  Get_Name_String (Element.Value);
1324
 
1325
                  if Name_Len /= 0 then
1326
                     Opts.Increment_Last;
1327
                     Opts.Table (Opts.Last) :=
1328
                       new String'(Name_Buffer (1 .. Name_Len));
1329
                  end if;
1330
 
1331
                  Current := Element.Next;
1332
               end loop;
1333
            end;
1334
         end if;
1335
 
1336
         Lib_Dirpath  :=
1337
           new String'(Get_Name_String (For_Project.Library_Dir.Display_Name));
1338
         Lib_Filename :=
1339
           new String'(Get_Name_String (For_Project.Library_Name));
1340
 
1341
         case For_Project.Library_Kind is
1342
            when Static =>
1343
               The_Build_Mode := Static;
1344
 
1345
            when Dynamic =>
1346
               The_Build_Mode := Dynamic;
1347
 
1348
            when Relocatable =>
1349
               The_Build_Mode := Relocatable;
1350
 
1351
               if PIC_Option /= "" then
1352
                  Opts.Increment_Last;
1353
                  Opts.Table (Opts.Last) := new String'(PIC_Option);
1354
               end if;
1355
         end case;
1356
 
1357
         --  Get the library version, if any
1358
 
1359
         if For_Project.Lib_Internal_Name /= No_Name then
1360
            Lib_Version :=
1361
              new String'(Get_Name_String (For_Project.Lib_Internal_Name));
1362
         end if;
1363
 
1364
         --  Add the objects found in the object directory and the object
1365
         --  directories of the extended files, if any, except for generated
1366
         --  object files (b~.. or B__..) from extended projects.
1367
         --  When there are one or more extended files, only add an object file
1368
         --  if no object file with the same name have already been added.
1369
 
1370
         In_Main_Object_Directory := True;
1371
 
1372
         --  For gnatmake, when the project specifies more than just Ada as a
1373
         --  language (even if course we could not find any source file for
1374
         --  the other languages), we will take all object files found in the
1375
         --  object directories. Since we know the project supports at least
1376
         --  Ada, we just have to test whether it has at least two languages,
1377
         --  and not care about the sources.
1378
 
1379
         Foreign_Sources := For_Project.Languages.Next /= null;
1380
         Current_Proj := For_Project;
1381
         loop
1382
            if Current_Proj.Object_Directory /= No_Path_Information then
1383
 
1384
               --  The following code gets far too indented ... suggest some
1385
               --  procedural abstraction here. How about making this declare
1386
               --  block a named procedure???
1387
 
1388
               declare
1389
                  Object_Dir_Path : constant String :=
1390
                                      Get_Name_String
1391
                                        (Current_Proj.Object_Directory
1392
                                         .Display_Name);
1393
 
1394
                  Object_Dir : Dir_Type;
1395
                  Filename   : String (1 .. 255);
1396
                  Last       : Natural;
1397
                  Id         : Name_Id;
1398
 
1399
               begin
1400
                  Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
1401
 
1402
                  --  For all entries in the object directory
1403
 
1404
                  loop
1405
                     Read (Object_Dir, Filename, Last);
1406
 
1407
                     exit when Last = 0;
1408
 
1409
                     --  Check if it is an object file
1410
 
1411
                     if Is_Obj (Filename (1 .. Last)) then
1412
                        declare
1413
                           Object_Path  : constant String :=
1414
                                            Normalize_Pathname
1415
                                              (Object_Dir_Path
1416
                                               & Directory_Separator
1417
                                               & Filename (1 .. Last));
1418
                           Object_File  : constant String :=
1419
                                            Filename (1 .. Last);
1420
 
1421
                           C_Filename    : String := Object_File;
1422
 
1423
                        begin
1424
                           Canonical_Case_File_Name (C_Filename);
1425
 
1426
                           --  If in the object directory of an extended
1427
                           --  project, do not consider generated object files.
1428
 
1429
                           if In_Main_Object_Directory
1430
                             or else Last < 5
1431
                             or else
1432
                               C_Filename (1 .. B_Start'Length) /= B_Start.all
1433
                           then
1434
                              Name_Len := 0;
1435
                              Add_Str_To_Name_Buffer (C_Filename);
1436
                              Id := Name_Find;
1437
 
1438
                              if not Objects_Htable.Get (Id) then
1439
                                 declare
1440
                                    ALI_File : constant String :=
1441
                                                 Ext_To (C_Filename, "ali");
1442
 
1443
                                    ALI_Path : constant String :=
1444
                                                 Ext_To (Object_Path, "ali");
1445
 
1446
                                    Add_It : Boolean;
1447
                                    Fname  : File_Name_Type;
1448
                                    Proj   : Project_Id;
1449
                                    Index  : Unit_Index;
1450
 
1451
                                 begin
1452
                                    --  The following assignment could use
1453
                                    --  a comment ???
1454
 
1455
                                    Add_It :=
1456
                                      Foreign_Sources
1457
                                        or else
1458
                                          (Last >= 5
1459
                                             and then
1460
                                               C_Filename (1 .. B_Start'Length)
1461
                                                 = B_Start.all);
1462
 
1463
                                    if Is_Regular_File (ALI_Path) then
1464
 
1465
                                       --  If there is an ALI file, check if
1466
                                       --  the object file should be added to
1467
                                       --  the library. If there are foreign
1468
                                       --  sources we put all object files in
1469
                                       --  the library.
1470
 
1471
                                       if not Add_It then
1472
                                          Index :=
1473
                                            Units_Htable.Get_First
1474
                                             (In_Tree.Units_HT);
1475
                                          while Index /= null loop
1476
                                             if Index.File_Names (Impl) /=
1477
                                               null
1478
                                             then
1479
                                                Proj :=
1480
                                                  Index.File_Names (Impl)
1481
                                                  .Project;
1482
                                                Fname :=
1483
                                                  Index.File_Names (Impl).File;
1484
 
1485
                                             elsif Index.File_Names (Spec) /=
1486
                                               null
1487
                                             then
1488
                                                Proj :=
1489
                                                  Index.File_Names (Spec)
1490
                                                  .Project;
1491
                                                Fname :=
1492
                                                  Index.File_Names (Spec).File;
1493
 
1494
                                             else
1495
                                                Proj := No_Project;
1496
                                             end if;
1497
 
1498
                                             Add_It := Proj /= No_Project;
1499
 
1500
                                             --  If the source is in the
1501
                                             --  project or a project it
1502
                                             --  extends, we may put it in
1503
                                             --  the library.
1504
 
1505
                                             if Add_It then
1506
                                                Add_It := Check_Project (Proj);
1507
                                             end if;
1508
 
1509
                                             --  But we don't, if the ALI file
1510
                                             --  does not correspond to the
1511
                                             --  unit.
1512
 
1513
                                             if Add_It then
1514
                                                declare
1515
                                                   F : constant String :=
1516
                                                         Ext_To
1517
                                                           (Get_Name_String
1518
                                                              (Fname), "ali");
1519
                                                begin
1520
                                                   Add_It := F = ALI_File;
1521
                                                end;
1522
                                             end if;
1523
 
1524
                                             exit when Add_It;
1525
 
1526
                                             Index :=
1527
                                               Units_Htable.Get_Next
1528
                                                 (In_Tree.Units_HT);
1529
                                          end loop;
1530
                                       end if;
1531
 
1532
                                       if Add_It then
1533
                                          Objects_Htable.Set (Id, True);
1534
                                          Objects.Append
1535
                                            (new String'(Object_Path));
1536
 
1537
                                          --  Record the ALI file
1538
 
1539
                                          ALIs.Append (new String'(ALI_Path));
1540
 
1541
                                          --  Find out if for this ALI file,
1542
                                          --  libgnarl or libdecgnat is
1543
                                          --  necessary.
1544
 
1545
                                          Check_Libs (ALI_Path, True);
1546
                                       end if;
1547
 
1548
                                    elsif Foreign_Sources then
1549
                                       Objects.Append
1550
                                         (new String'(Object_Path));
1551
                                    end if;
1552
                                 end;
1553
                              end if;
1554
                           end if;
1555
                        end;
1556
                     end if;
1557
                  end loop;
1558
 
1559
                  Close (Dir => Object_Dir);
1560
 
1561
               exception
1562
                  when Directory_Error =>
1563
                     Com.Fail ("cannot find object directory """
1564
                               & Get_Name_String
1565
                                  (Current_Proj.Object_Directory.Display_Name)
1566
                               & """");
1567
               end;
1568
            end if;
1569
 
1570
            exit when Current_Proj.Extends = No_Project;
1571
 
1572
            In_Main_Object_Directory  := False;
1573
            Current_Proj := Current_Proj.Extends;
1574
         end loop;
1575
 
1576
         --  Add the -L and -l switches for the imported Library Project Files,
1577
         --  and, if Path Option is supported, the library directory path names
1578
         --  to Rpath.
1579
 
1580
         Process_Imported_Libraries;
1581
 
1582
         --  Link with libgnat and possibly libgnarl
1583
 
1584
         Opts.Increment_Last;
1585
         Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory);
1586
 
1587
         --  If Path Option supported, add libgnat directory path name to Rpath
1588
 
1589
         if Path_Option /= null then
1590
            declare
1591
               Libdir    : constant String := Lib_Directory;
1592
               GCC_Index : Natural := 0;
1593
 
1594
            begin
1595
               Add_Rpath (Libdir);
1596
 
1597
               --  For shared libraries, add to the Path Option the directory
1598
               --  of the shared version of libgcc.
1599
 
1600
               if The_Build_Mode /= Static then
1601
                  GCC_Index := Index (Libdir, "/lib/");
1602
 
1603
                  if GCC_Index = 0 then
1604
                     GCC_Index :=
1605
                       Index
1606
                         (Libdir,
1607
                          Directory_Separator & "lib" & Directory_Separator);
1608
                  end if;
1609
 
1610
                  if GCC_Index /= 0 then
1611
                     Add_Rpath (Libdir (Libdir'First .. GCC_Index + 3));
1612
                  end if;
1613
               end if;
1614
            end;
1615
         end if;
1616
 
1617
         if Libgnarl_Needed = Yes then
1618
            Opts.Increment_Last;
1619
 
1620
            if The_Build_Mode = Static then
1621
               Opts.Table (Opts.Last) := new String'("-lgnarl");
1622
            else
1623
               Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl"));
1624
            end if;
1625
         end if;
1626
 
1627
         if Libdecgnat_Needed then
1628
            Opts.Increment_Last;
1629
 
1630
            Opts.Table (Opts.Last) :=
1631
              new String'("-L" & Lib_Directory & "/../declib");
1632
 
1633
            Opts.Increment_Last;
1634
 
1635
            if The_Build_Mode = Static then
1636
               Opts.Table (Opts.Last) := new String'("-ldecgnat");
1637
            else
1638
               Opts.Table (Opts.Last) := new String'(Shared_Lib ("decgnat"));
1639
            end if;
1640
         end if;
1641
 
1642
         Opts.Increment_Last;
1643
 
1644
         if The_Build_Mode = Static then
1645
            Opts.Table (Opts.Last) := new String'("-lgnat");
1646
         else
1647
            Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnat"));
1648
         end if;
1649
 
1650
         --  If Path Option is supported, add the necessary switch with the
1651
         --  content of Rpath. As Rpath contains at least libgnat directory
1652
         --  path name, it is guaranteed that it is not null.
1653
 
1654
         if Path_Option /= null then
1655
            Opts.Increment_Last;
1656
            Opts.Table (Opts.Last) :=
1657
              new String'(Path_Option.all & Rpath (1 .. Rpath_Last));
1658
            Free (Path_Option);
1659
            Free (Rpath);
1660
         end if;
1661
 
1662
         Object_Files :=
1663
           new Argument_List'
1664
             (Argument_List (Objects.Table (1 .. Objects.Last)));
1665
 
1666
         Ali_Files :=
1667
           new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1668
 
1669
         Options :=
1670
           new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
1671
 
1672
         --  We fail if there are no object to put in the library
1673
         --  (Ada or foreign objects).
1674
 
1675
         if Object_Files'Length = 0 then
1676
            Com.Fail ("no object files for library """ &
1677
                      Lib_Filename.all & '"');
1678
         end if;
1679
 
1680
         if not Opt.Quiet_Output then
1681
            Write_Eol;
1682
            Write_Str  ("building ");
1683
            Write_Str (Ada.Characters.Handling.To_Lower
1684
                         (Build_Mode_State'Image (The_Build_Mode)));
1685
            Write_Str  (" library for project ");
1686
            Write_Line (Project_Name);
1687
 
1688
            --  Only output list of object files and ALI files in verbose mode
1689
 
1690
            if Opt.Verbose_Mode then
1691
               Write_Eol;
1692
 
1693
               Write_Line ("object files:");
1694
 
1695
               for Index in Object_Files'Range loop
1696
                  Write_Str  ("   ");
1697
                  Write_Line (Object_Files (Index).all);
1698
               end loop;
1699
 
1700
               Write_Eol;
1701
 
1702
               if Ali_Files'Length = 0 then
1703
                  Write_Line ("NO ALI files");
1704
 
1705
               else
1706
                  Write_Line ("ALI files:");
1707
 
1708
                  for Index in Ali_Files'Range loop
1709
                     Write_Str  ("   ");
1710
                     Write_Line (Ali_Files (Index).all);
1711
                  end loop;
1712
               end if;
1713
 
1714
               Write_Eol;
1715
            end if;
1716
         end if;
1717
 
1718
         --  We check that all object files are regular files
1719
 
1720
         Check_Context;
1721
 
1722
         --  Delete the existing library file, if it exists. Fail if the
1723
         --  library file is not writable, or if it is not possible to delete
1724
         --  the file.
1725
 
1726
         declare
1727
            DLL_Name : aliased String :=
1728
                         Lib_Dirpath.all & Directory_Separator & DLL_Prefix &
1729
                           Lib_Filename.all & "." & DLL_Ext;
1730
 
1731
            Archive_Name : aliased String :=
1732
                             Lib_Dirpath.all & Directory_Separator & "lib" &
1733
                               Lib_Filename.all & "." & Archive_Ext;
1734
 
1735
            type Str_Ptr is access all String;
1736
            --  This type is necessary to meet the accessibility rules of Ada.
1737
            --  It is not possible to use String_Access here.
1738
 
1739
            Full_Lib_Name : Str_Ptr;
1740
            --  Designates the full library path name. Either DLL_Name or
1741
            --  Archive_Name, depending on the library kind.
1742
 
1743
            Success : Boolean;
1744
            pragma Warnings (Off, Success);
1745
            --  Used to call Delete_File
1746
 
1747
         begin
1748
            if The_Build_Mode = Static then
1749
               Full_Lib_Name := Archive_Name'Access;
1750
            else
1751
               Full_Lib_Name := DLL_Name'Access;
1752
            end if;
1753
 
1754
            if Is_Regular_File (Full_Lib_Name.all) then
1755
               if Is_Writable_File (Full_Lib_Name.all) then
1756
                  Delete_File (Full_Lib_Name.all, Success);
1757
               end if;
1758
 
1759
               if Is_Regular_File (Full_Lib_Name.all) then
1760
                  Com.Fail ("could not delete """ & Full_Lib_Name.all & """");
1761
               end if;
1762
            end if;
1763
         end;
1764
 
1765
         Argument_Number := 0;
1766
 
1767
         --  If we have a standalone library, gather all the interface ALI.
1768
         --  They are passed to Build_Dynamic_Library, where they are used by
1769
         --  some platforms (VMS, for example) to decide what symbols should be
1770
         --  exported. They are also flagged as Interface when we copy them to
1771
         --  the library directory (by Copy_ALI_Files, below).
1772
 
1773
         if Standalone then
1774
            Current_Proj := For_Project;
1775
 
1776
            declare
1777
               Iface : String_List_Id := For_Project.Lib_Interface_ALIs;
1778
               ALI   : File_Name_Type;
1779
 
1780
            begin
1781
               while Iface /= Nil_String loop
1782
                  ALI :=
1783
                    File_Name_Type
1784
                      (In_Tree.Shared.String_Elements.Table (Iface).Value);
1785
                  Interface_ALIs.Set (ALI, True);
1786
                  Get_Name_String
1787
                    (In_Tree.Shared.String_Elements.Table (Iface).Value);
1788
                  Add_Argument (Name_Buffer (1 .. Name_Len));
1789
                  Iface := In_Tree.Shared.String_Elements.Table (Iface).Next;
1790
               end loop;
1791
 
1792
               Iface := For_Project.Lib_Interface_ALIs;
1793
 
1794
               if not Opt.Quiet_Output then
1795
 
1796
                  --  Check that the interface set is complete: any unit in the
1797
                  --  library that is needed by an interface should also be an
1798
                  --  interface. If it is not the case, output a warning.
1799
 
1800
                  while Iface /= Nil_String loop
1801
                     ALI :=
1802
                       File_Name_Type
1803
                         (In_Tree.Shared.String_Elements.Table (Iface).Value);
1804
                     Process (ALI);
1805
                     Iface :=
1806
                       In_Tree.Shared.String_Elements.Table (Iface).Next;
1807
                  end loop;
1808
               end if;
1809
            end;
1810
         end if;
1811
 
1812
         declare
1813
            Current_Dir  : constant String := Get_Current_Dir;
1814
            Dir          : Dir_Type;
1815
 
1816
            Name : String (1 .. 200);
1817
            Last : Natural;
1818
 
1819
            Disregard : Boolean;
1820
            pragma Warnings (Off, Disregard);
1821
 
1822
            DLL_Name : aliased constant String :=
1823
                         Lib_Filename.all & "." & DLL_Ext;
1824
 
1825
            Archive_Name : aliased constant String :=
1826
                             Lib_Filename.all & "." & Archive_Ext;
1827
 
1828
            Delete : Boolean := False;
1829
 
1830
         begin
1831
            --  Clean the library directory: remove any file with the name of
1832
            --  the library file and any ALI file of a source of the project.
1833
 
1834
            begin
1835
               Get_Name_String (For_Project.Library_Dir.Display_Name);
1836
               Change_Dir (Name_Buffer (1 .. Name_Len));
1837
 
1838
            exception
1839
               when others =>
1840
                  Com.Fail
1841
                    ("unable to access library directory """
1842
                     & Name_Buffer (1 .. Name_Len)
1843
                     & """");
1844
            end;
1845
 
1846
            Open (Dir, ".");
1847
 
1848
            loop
1849
               Read (Dir, Name, Last);
1850
               exit when Last = 0;
1851
 
1852
               declare
1853
                  Filename : constant String := Name (1 .. Last);
1854
 
1855
               begin
1856
                  if Is_Regular_File (Filename) then
1857
                     Canonical_Case_File_Name (Name (1 .. Last));
1858
                     Delete := False;
1859
 
1860
                     if (The_Build_Mode = Static
1861
                          and then Name (1 .. Last) =  Archive_Name)
1862
                       or else
1863
                         ((The_Build_Mode = Dynamic
1864
                            or else
1865
                           The_Build_Mode = Relocatable)
1866
                          and then Name (1 .. Last) = DLL_Name)
1867
                     then
1868
                        Delete := True;
1869
 
1870
                     elsif Last > 4
1871
                       and then Name (Last - 3 .. Last) = ".ali"
1872
                     then
1873
                        declare
1874
                           Unit : Unit_Index;
1875
 
1876
                        begin
1877
                           --  Compare with ALI file names of the project
1878
 
1879
                           Unit := Units_Htable.Get_First (In_Tree.Units_HT);
1880
                           while Unit /= No_Unit_Index loop
1881
                              if Unit.File_Names (Impl) /= null
1882
                                and then Unit.File_Names (Impl).Project /=
1883
                                                                 No_Project
1884
                              then
1885
                                 if Ultimate_Extending_Project_Of
1886
                                      (Unit.File_Names (Impl).Project) =
1887
                                                                 For_Project
1888
                                 then
1889
                                    Get_Name_String
1890
                                      (Unit.File_Names (Impl).File);
1891
                                    Name_Len :=
1892
                                      Name_Len -
1893
                                        File_Extension
1894
                                          (Name (1 .. Name_Len))'Length;
1895
 
1896
                                    if Name_Buffer (1 .. Name_Len) =
1897
                                      Name (1 .. Last - 4)
1898
                                    then
1899
                                       Delete := True;
1900
                                       exit;
1901
                                    end if;
1902
                                 end if;
1903
 
1904
                              elsif Unit.File_Names (Spec) /= null
1905
                                and then Ultimate_Extending_Project_Of
1906
                                           (Unit.File_Names (Spec).Project) =
1907
                                                                   For_Project
1908
                              then
1909
                                 Get_Name_String (Unit.File_Names (Spec).File);
1910
                                 Name_Len :=
1911
                                   Name_Len -
1912
                                     File_Extension (Name (1 .. Last))'Length;
1913
 
1914
                                 if Name_Buffer (1 .. Name_Len) =
1915
                                      Name (1 .. Last - 4)
1916
                                 then
1917
                                    Delete := True;
1918
                                    exit;
1919
                                 end if;
1920
                              end if;
1921
 
1922
                              Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
1923
                           end loop;
1924
                        end;
1925
                     end if;
1926
 
1927
                     if Delete then
1928
                        Set_Writable (Filename);
1929
                        Delete_File (Filename, Disregard);
1930
                     end if;
1931
                  end if;
1932
               end;
1933
            end loop;
1934
 
1935
            Close (Dir);
1936
 
1937
            Change_Dir (Current_Dir);
1938
         end;
1939
 
1940
         --  Call procedure to build the library, depending on the build mode
1941
 
1942
         case The_Build_Mode is
1943
            when Dynamic | Relocatable =>
1944
               Build_Dynamic_Library
1945
                 (Ofiles        => Object_Files.all,
1946
                  Options       => Options.all,
1947
                  Interfaces    => Arguments (1 .. Argument_Number),
1948
                  Lib_Filename  => Lib_Filename.all,
1949
                  Lib_Dir       => Lib_Dirpath.all,
1950
                  Symbol_Data   => Current_Proj.Symbol_Data,
1951
                  Driver_Name   => Driver_Name,
1952
                  Lib_Version   => Lib_Version.all,
1953
                  Auto_Init     => Current_Proj.Lib_Auto_Init);
1954
 
1955
            when Static =>
1956
               MLib.Build_Library
1957
                 (Object_Files.all,
1958
                  Lib_Filename.all,
1959
                  Lib_Dirpath.all);
1960
 
1961
            when None =>
1962
               null;
1963
         end case;
1964
 
1965
         --  We need to copy the ALI files from the object directory to the
1966
         --  library ALI directory, so that the linker find them there, and
1967
         --  does not need to look in the object directory where it would also
1968
         --  find the object files; and we don't want that: we want the linker
1969
         --  to use the library.
1970
 
1971
         --  Copy the ALI files and make the copies read-only. For interfaces,
1972
         --  mark the copies as interfaces.
1973
 
1974
         Copy_ALI_Files
1975
           (Files      => Ali_Files.all,
1976
            To         => For_Project.Library_ALI_Dir.Display_Name,
1977
            Interfaces => Arguments (1 .. Argument_Number));
1978
 
1979
         --  Copy interface sources if Library_Src_Dir specified
1980
 
1981
         if Standalone
1982
           and then For_Project.Library_Src_Dir /= No_Path_Information
1983
         then
1984
            --  Clean the interface copy directory: remove any source that
1985
            --  could be a source of the project.
1986
 
1987
            begin
1988
               Get_Name_String (For_Project.Library_Src_Dir.Display_Name);
1989
               Change_Dir (Name_Buffer (1 .. Name_Len));
1990
 
1991
            exception
1992
               when others =>
1993
                  Com.Fail
1994
                    ("unable to access library source copy directory """
1995
                     & Name_Buffer (1 .. Name_Len)
1996
                     & """");
1997
            end;
1998
 
1999
            declare
2000
               Dir    : Dir_Type;
2001
               Delete : Boolean := False;
2002
               Unit   : Unit_Index;
2003
 
2004
               Name : String (1 .. 200);
2005
               Last : Natural;
2006
 
2007
               Disregard : Boolean;
2008
               pragma Warnings (Off, Disregard);
2009
 
2010
            begin
2011
               Open (Dir, ".");
2012
 
2013
               loop
2014
                  Read (Dir, Name, Last);
2015
                  exit when Last = 0;
2016
 
2017
                  if Is_Regular_File (Name (1 .. Last)) then
2018
                     Canonical_Case_File_Name (Name (1 .. Last));
2019
                     Delete := False;
2020
 
2021
                     --  Compare with source file names of the project
2022
 
2023
                     Unit := Units_Htable.Get_First (In_Tree.Units_HT);
2024
                     while Unit /= No_Unit_Index loop
2025
                        if Unit.File_Names (Impl) /= null
2026
                          and then Ultimate_Extending_Project_Of
2027
                            (Unit.File_Names (Impl).Project) = For_Project
2028
                          and then
2029
                            Get_Name_String
2030
                              (Unit.File_Names (Impl).File) =
2031
                            Name (1 .. Last)
2032
                        then
2033
                           Delete := True;
2034
                           exit;
2035
                        end if;
2036
 
2037
                        if Unit.File_Names (Spec) /= null
2038
                          and then Ultimate_Extending_Project_Of
2039
                            (Unit.File_Names (Spec).Project) =
2040
                             For_Project
2041
                          and then
2042
                           Get_Name_String
2043
                             (Unit.File_Names (Spec).File) =
2044
                           Name (1 .. Last)
2045
                        then
2046
                           Delete := True;
2047
                           exit;
2048
                        end if;
2049
 
2050
                        Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
2051
                     end loop;
2052
                  end if;
2053
 
2054
                  if Delete then
2055
                     Set_Writable (Name (1 .. Last));
2056
                     Delete_File (Name (1 .. Last), Disregard);
2057
                  end if;
2058
               end loop;
2059
 
2060
               Close (Dir);
2061
            end;
2062
 
2063
            Copy_Interface_Sources
2064
              (For_Project => For_Project,
2065
               In_Tree     => In_Tree,
2066
               Interfaces  => Arguments (1 .. Argument_Number),
2067
               To_Dir      => For_Project.Library_Src_Dir.Display_Name);
2068
         end if;
2069
      end if;
2070
 
2071
      --  Reset the current working directory to its previous value
2072
 
2073
      Change_Dir (Current_Dir);
2074
   end Build_Library;
2075
 
2076
   -----------
2077
   -- Check --
2078
   -----------
2079
 
2080
   procedure Check (Filename : String) is
2081
   begin
2082
      if not Is_Regular_File (Filename) then
2083
         Com.Fail (Filename & " not found.");
2084
      end if;
2085
   end Check;
2086
 
2087
   -------------------
2088
   -- Check_Context --
2089
   -------------------
2090
 
2091
   procedure Check_Context is
2092
   begin
2093
      --  Check that each object file exists
2094
 
2095
      for F in Object_Files'Range loop
2096
         Check (Object_Files (F).all);
2097
      end loop;
2098
   end Check_Context;
2099
 
2100
   -------------------
2101
   -- Check_Library --
2102
   -------------------
2103
 
2104
   procedure Check_Library
2105
     (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
2106
   is
2107
      Lib_TS  : Time_Stamp_Type;
2108
      Current : constant Dir_Name_Str := Get_Current_Dir;
2109
 
2110
   begin
2111
      --  No need to build the library if there is no object directory,
2112
      --  hence no object files to build the library.
2113
 
2114
      if For_Project.Library then
2115
         declare
2116
            Lib_Name : constant File_Name_Type :=
2117
                         Library_File_Name_For (For_Project, In_Tree);
2118
         begin
2119
            Change_Dir
2120
              (Get_Name_String (For_Project.Library_Dir.Display_Name));
2121
            Lib_TS := File_Stamp (Lib_Name);
2122
            For_Project.Library_TS := Lib_TS;
2123
         end;
2124
 
2125
         if not For_Project.Externally_Built
2126
           and then not For_Project.Need_To_Build_Lib
2127
           and then For_Project.Object_Directory /= No_Path_Information
2128
         then
2129
            declare
2130
               Obj_TS     : Time_Stamp_Type;
2131
               Object_Dir : Dir_Type;
2132
 
2133
            begin
2134
               if OpenVMS_On_Target then
2135
                  B_Start := new String'("b__");
2136
               end if;
2137
 
2138
               --  If the library file does not exist, then the time stamp will
2139
               --  be Empty_Time_Stamp, earlier than any other time stamp.
2140
 
2141
               Change_Dir
2142
                 (Get_Name_String (For_Project.Object_Directory.Display_Name));
2143
               Open (Dir => Object_Dir, Dir_Name => ".");
2144
 
2145
               --  For all entries in the object directory
2146
 
2147
               loop
2148
                  Read (Object_Dir, Name_Buffer, Name_Len);
2149
                  exit when Name_Len = 0;
2150
 
2151
                  --  Check if it is an object file, but ignore any binder
2152
                  --  generated file.
2153
 
2154
                  if Is_Obj (Name_Buffer (1 .. Name_Len))
2155
                    and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all
2156
                  then
2157
                     --  Get the object file time stamp
2158
 
2159
                     Obj_TS := File_Stamp (File_Name_Type'(Name_Find));
2160
 
2161
                     --  If library file time stamp is earlier, set
2162
                     --  Need_To_Build_Lib and return. String comparison is
2163
                     --  used, otherwise time stamps may be too close and the
2164
                     --  comparison would return True, which would trigger
2165
                     --  an unnecessary rebuild of the library.
2166
 
2167
                     if String (Lib_TS) < String (Obj_TS) then
2168
 
2169
                        --  Library must be rebuilt
2170
 
2171
                        For_Project.Need_To_Build_Lib := True;
2172
                        exit;
2173
                     end if;
2174
                  end if;
2175
               end loop;
2176
 
2177
               Close (Object_Dir);
2178
            end;
2179
         end if;
2180
 
2181
         Change_Dir (Current);
2182
      end if;
2183
   end Check_Library;
2184
 
2185
   ----------------------------
2186
   -- Copy_Interface_Sources --
2187
   ----------------------------
2188
 
2189
   procedure Copy_Interface_Sources
2190
     (For_Project : Project_Id;
2191
      In_Tree     : Project_Tree_Ref;
2192
      Interfaces  : Argument_List;
2193
      To_Dir      : Path_Name_Type)
2194
   is
2195
      Current : constant Dir_Name_Str := Get_Current_Dir;
2196
      --  The current directory, where to return to at the end
2197
 
2198
      Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
2199
      --  The directory where to copy sources
2200
 
2201
      Text     : Text_Buffer_Ptr;
2202
      The_ALI  : ALI.ALI_Id;
2203
      Lib_File : File_Name_Type;
2204
 
2205
      First_Unit  : ALI.Unit_Id;
2206
      Second_Unit : ALI.Unit_Id;
2207
 
2208
      Copy_Subunits : Boolean := False;
2209
      --  When True, indicates that subunits, if any, need to be copied too
2210
 
2211
      procedure Copy (File_Name : File_Name_Type);
2212
      --  Copy one source of the project to the target directory
2213
 
2214
      ----------
2215
      -- Copy --
2216
      ----------
2217
 
2218
      procedure Copy (File_Name : File_Name_Type) is
2219
         Success : Boolean;
2220
         pragma Warnings (Off, Success);
2221
 
2222
         Source : Standard.Prj.Source_Id;
2223
      begin
2224
         Source := Find_Source
2225
           (In_Tree, For_Project,
2226
            In_Extended_Only => True,
2227
            Base_Name => File_Name);
2228
 
2229
         if Source /= No_Source
2230
           and then not Source.Locally_Removed
2231
           and then Source.Replaced_By = No_Source
2232
         then
2233
            Copy_File
2234
              (Get_Name_String (Source.Path.Name),
2235
               Target,
2236
               Success,
2237
               Mode     => Overwrite,
2238
               Preserve => Preserve);
2239
         end if;
2240
      end Copy;
2241
 
2242
   --  Start of processing for Copy_Interface_Sources
2243
 
2244
   begin
2245
      --  Change the working directory to the object directory
2246
 
2247
      Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name));
2248
 
2249
      for Index in Interfaces'Range loop
2250
 
2251
         --  First, load the ALI file
2252
 
2253
         Name_Len := 0;
2254
         Add_Str_To_Name_Buffer (Interfaces (Index).all);
2255
         Lib_File := Name_Find;
2256
         Text := Read_Library_Info (Lib_File);
2257
         The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
2258
         Free (Text);
2259
 
2260
         Second_Unit := No_Unit_Id;
2261
         First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
2262
         Copy_Subunits := True;
2263
 
2264
         --  If there is both a spec and a body, check if they are both needed
2265
 
2266
         if ALI.Units.Table (First_Unit).Utype = Is_Body then
2267
            Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
2268
 
2269
            --  If the body is not needed, then reset First_Unit
2270
 
2271
            if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
2272
               First_Unit := No_Unit_Id;
2273
               Copy_Subunits := False;
2274
            end if;
2275
 
2276
         elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
2277
            Copy_Subunits := False;
2278
         end if;
2279
 
2280
         --  Copy the file(s) that need to be copied
2281
 
2282
         if First_Unit /= No_Unit_Id then
2283
            Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
2284
         end if;
2285
 
2286
         if Second_Unit /= No_Unit_Id then
2287
            Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
2288
         end if;
2289
 
2290
         --  Copy all the separates, if any
2291
 
2292
         if Copy_Subunits then
2293
            for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
2294
              ALI.ALIs.Table (The_ALI).Last_Sdep
2295
            loop
2296
               if Sdep.Table (Dep).Subunit_Name /= No_Name then
2297
                  Copy (File_Name => Sdep.Table (Dep).Sfile);
2298
               end if;
2299
            end loop;
2300
         end if;
2301
      end loop;
2302
 
2303
      --  Restore the initial working directory
2304
 
2305
      Change_Dir (Current);
2306
   end Copy_Interface_Sources;
2307
 
2308
   -------------
2309
   -- Display --
2310
   -------------
2311
 
2312
   procedure Display (Executable : String) is
2313
   begin
2314
      if not Opt.Quiet_Output then
2315
         Write_Str (Executable);
2316
 
2317
         for Index in 1 .. Argument_Number loop
2318
            Write_Char (' ');
2319
            Write_Str (Arguments (Index).all);
2320
 
2321
            if not Opt.Verbose_Mode and then Index > 4 then
2322
               Write_Str (" ...");
2323
               exit;
2324
            end if;
2325
         end loop;
2326
 
2327
         Write_Eol;
2328
      end if;
2329
   end Display;
2330
 
2331
   -----------
2332
   -- Index --
2333
   -----------
2334
 
2335
   function Index (S, Pattern : String) return Natural is
2336
      Len : constant Natural := Pattern'Length;
2337
 
2338
   begin
2339
      for J in reverse S'First .. S'Last - Len + 1 loop
2340
         if Pattern = S (J .. J + Len - 1) then
2341
            return J;
2342
         end if;
2343
      end loop;
2344
 
2345
      return 0;
2346
   end Index;
2347
 
2348
   -------------------------
2349
   -- Process_Binder_File --
2350
   -------------------------
2351
 
2352
   procedure Process_Binder_File (Name : String) is
2353
      Fd : FILEs;
2354
      --  Binder file's descriptor
2355
 
2356
      Read_Mode : constant String := "r" & ASCII.NUL;
2357
      --  For fopen
2358
 
2359
      Status : Interfaces.C_Streams.int;
2360
      pragma Unreferenced (Status);
2361
      --  For fclose
2362
 
2363
      Begin_Info : constant String := "--  BEGIN Object file/option list";
2364
      End_Info   : constant String := "--  END Object file/option list   ";
2365
 
2366
      Next_Line : String (1 .. 1000);
2367
      --  Current line value
2368
      --  Where does this odd constant 1000 come from, looks suspicious ???
2369
 
2370
      Nlast : Integer;
2371
      --  End of line slice (the slice does not contain the line terminator)
2372
 
2373
      procedure Get_Next_Line;
2374
      --  Read the next line from the binder file without the line terminator
2375
 
2376
      -------------------
2377
      -- Get_Next_Line --
2378
      -------------------
2379
 
2380
      procedure Get_Next_Line is
2381
         Fchars : chars;
2382
 
2383
      begin
2384
         Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
2385
 
2386
         if Fchars = System.Null_Address then
2387
            Fail ("Error reading binder output");
2388
         end if;
2389
 
2390
         Nlast := 1;
2391
         while Nlast <= Next_Line'Last
2392
           and then Next_Line (Nlast) /= ASCII.LF
2393
           and then Next_Line (Nlast) /= ASCII.CR
2394
         loop
2395
            Nlast := Nlast + 1;
2396
         end loop;
2397
 
2398
         Nlast := Nlast - 1;
2399
      end Get_Next_Line;
2400
 
2401
   --  Start of processing for Process_Binder_File
2402
 
2403
   begin
2404
      Fd := fopen (Name'Address, Read_Mode'Address);
2405
 
2406
      if Fd = NULL_Stream then
2407
         Fail ("Failed to open binder output");
2408
      end if;
2409
 
2410
      --  Skip up to the Begin Info line
2411
 
2412
      loop
2413
         Get_Next_Line;
2414
         exit when Next_Line (1 .. Nlast) = Begin_Info;
2415
      end loop;
2416
 
2417
      --  Find the first switch
2418
 
2419
      loop
2420
         Get_Next_Line;
2421
 
2422
         exit when Next_Line (1 .. Nlast) = End_Info;
2423
 
2424
         --  As the binder generated file is in Ada, remove the first eight
2425
         --  characters "   --   ".
2426
 
2427
         Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2428
         Nlast := Nlast - 8;
2429
 
2430
         --  Stop when the first switch is found
2431
 
2432
         exit when Next_Line (1) = '-';
2433
      end loop;
2434
 
2435
      if Next_Line (1 .. Nlast) /= End_Info then
2436
         loop
2437
            --  Ignore -static and -shared, since -shared will be used
2438
            --  in any case.
2439
 
2440
            --  Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
2441
            --  later, because they are also needed for non Stand-Alone shared
2442
            --  libraries.
2443
 
2444
            --  Also ignore the shared libraries which are :
2445
 
2446
            --  UNIX / Windows    VMS
2447
            --  -lgnat-<version>  -lgnat_<version>  (7 + version'length chars)
2448
            --  -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
2449
 
2450
            if Next_Line (1 .. Nlast) /= "-static" and then
2451
               Next_Line (1 .. Nlast) /= "-shared" and then
2452
               Next_Line (1 .. Nlast) /= "-ldecgnat" and then
2453
               Next_Line (1 .. Nlast) /= "-lgnarl" and then
2454
               Next_Line (1 .. Nlast) /= "-lgnat" and then
2455
               Next_Line
2456
                 (1 .. Natural'Min (Nlast, 10 + Library_Version'Length)) /=
2457
                   Shared_Lib ("decgnat") and then
2458
               Next_Line
2459
                 (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
2460
                   Shared_Lib ("gnarl") and then
2461
               Next_Line
2462
                 (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
2463
                   Shared_Lib ("gnat")
2464
            then
2465
               if Next_Line (1) /= '-' then
2466
 
2467
                  --  This is not an option, should we add it?
2468
 
2469
                  if Add_Object_Files then
2470
                     Opts.Increment_Last;
2471
                     Opts.Table (Opts.Last) :=
2472
                       new String'(Next_Line (1 .. Nlast));
2473
                  end if;
2474
 
2475
               else
2476
                  --  Add all other options
2477
 
2478
                  Opts.Increment_Last;
2479
                  Opts.Table (Opts.Last) :=
2480
                    new String'(Next_Line (1 .. Nlast));
2481
               end if;
2482
            end if;
2483
 
2484
            --  Next option, if any
2485
 
2486
            Get_Next_Line;
2487
            exit when Next_Line (1 .. Nlast) = End_Info;
2488
 
2489
            --  Remove first eight characters "   --   "
2490
 
2491
            Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2492
            Nlast := Nlast - 8;
2493
         end loop;
2494
      end if;
2495
 
2496
      Status := fclose (Fd);
2497
 
2498
      --  Is it really right to ignore any close error ???
2499
 
2500
   end Process_Binder_File;
2501
 
2502
   ------------------
2503
   -- Reset_Tables --
2504
   ------------------
2505
 
2506
   procedure Reset_Tables is
2507
   begin
2508
      Objects.Init;
2509
      Objects_Htable.Reset;
2510
      ALIs.Init;
2511
      Opts.Init;
2512
      Processed_Projects.Reset;
2513
      Library_Projs.Init;
2514
   end Reset_Tables;
2515
 
2516
   ---------------------------
2517
   -- SALs_Use_Constructors --
2518
   ---------------------------
2519
 
2520
   function SALs_Use_Constructors return Boolean is
2521
      function C_SALs_Init_Using_Constructors return Integer;
2522
      pragma Import (C, C_SALs_Init_Using_Constructors,
2523
                     "__gnat_sals_init_using_constructors");
2524
   begin
2525
      return C_SALs_Init_Using_Constructors /= 0;
2526
   end SALs_Use_Constructors;
2527
 
2528
end MLib.Prj;

powered by: WebSVN 2.1.0

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