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