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