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