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