1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2005, AdaCore --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
28 with Gnatvsn
; use Gnatvsn
;
29 with MLib
.Fil
; use MLib
.Fil
;
30 with MLib
.Tgt
; use MLib
.Tgt
;
31 with MLib
.Utl
; use MLib
.Utl
;
32 with Namet
; use Namet
;
34 with Output
; use Output
;
35 with Prj
.Com
; use Prj
.Com
;
36 with Prj
.Env
; use Prj
.Env
;
37 with Prj
.Util
; use Prj
.Util
;
39 with Snames
; use Snames
;
40 with Switch
; use Switch
;
42 with Targparm
; use Targparm
;
44 with Ada
.Characters
.Handling
;
46 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
48 with Interfaces
.C_Streams
; use Interfaces
.C_Streams
;
49 with System
; use System
;
50 with System
.Case_Util
; use System
.Case_Util
;
52 package body MLib
.Prj
is
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.
61 ALI_Suffix
: constant String := ".ali";
63 B_Start
: String_Ptr
:= new String'("b~");
64 -- Prefix of bind file, changed to b__ for VMS
66 S_Osinte_Ads : Name_Id := No_Name;
67 -- Name_Id for "s-osinte.ads"
69 S_Dec_Ads : Name_Id := No_Name;
70 -- Name_Id for "dec.ads"
72 G_Trasym_Ads : Name_Id := No_Name;
73 -- Name_Id for "g-trasym.ads"
75 No_Argument_List : aliased String_List := (1 .. 0 => null);
76 No_Argument : constant String_List_Access := No_Argument_List'Access;
78 Arguments : String_List_Access := No_Argument;
79 -- Used to accumulate arguments for the invocation of gnatbind and of
80 -- the compiler. Also used to collect the interface ALI when copying
81 -- the ALI files to the library directory.
83 Argument_Number : Natural := 0;
84 -- Index of the last argument in Arguments
86 Initial_Argument_Max : constant := 10;
88 No_Main_String : aliased String := "-n";
89 No_Main : constant String_Access := No_Main_String'Access;
91 Output_Switch_String : aliased String := "-o";
92 Output_Switch : constant String_Access := Output_Switch_String'Access;
94 Compile_Switch_String : aliased String := "-c";
95 Compile_Switch : constant String_Access := Compile_Switch_String'Access;
97 Auto_Initialize : constant String := "-a";
99 -- List of objects to put inside the library
101 Object_Files : Argument_List_Access;
103 package Objects is new Table.Table
104 (Table_Name => "Mlib.Prj.Objects",
105 Table_Component_Type => String_Access,
106 Table_Index_Type => Natural,
107 Table_Low_Bound => 1,
109 Table_Increment => 100);
111 package Objects_Htable is new GNAT.HTable.Simple_HTable
112 (Header_Num => Header_Num,
119 -- List of non-Ada object files
121 Foreign_Objects : Argument_List_Access;
123 package Foreigns is new Table.Table
124 (Table_Name => "Mlib.Prj.Foreigns",
125 Table_Component_Type => String_Access,
126 Table_Index_Type => Natural,
127 Table_Low_Bound => 1,
129 Table_Increment => 100);
133 Ali_Files : Argument_List_Access;
135 package ALIs is new Table.Table
136 (Table_Name => "Mlib.Prj.Alis",
137 Table_Component_Type => String_Access,
138 Table_Index_Type => Natural,
139 Table_Low_Bound => 1,
141 Table_Increment => 100);
143 -- List of options set in the command line
145 Options : Argument_List_Access;
147 package Opts is new Table.Table
148 (Table_Name => "Mlib.Prj.Opts",
149 Table_Component_Type => String_Access,
150 Table_Index_Type => Natural,
151 Table_Low_Bound => 1,
153 Table_Increment => 100);
155 -- All the ALI file in the library
157 package Library_ALIs is new GNAT.HTable.Simple_HTable
158 (Header_Num => Header_Num,
165 -- The ALI files in the interface sets
167 package Interface_ALIs is new GNAT.HTable.Simple_HTable
168 (Header_Num => Header_Num,
175 -- The ALI files that have been processed to check if the corresponding
176 -- library unit is in the interface set.
178 package Processed_ALIs is new GNAT.HTable.Simple_HTable
179 (Header_Num => Header_Num,
186 -- The projects imported directly or indirectly
188 package Processed_Projects is new GNAT.HTable.Simple_HTable
189 (Header_Num => Header_Num,
196 -- The library projects imported directly or indirectly
198 package Library_Projs is new Table.Table (
199 Table_Component_Type => Project_Id,
200 Table_Index_Type => Integer,
201 Table_Low_Bound => 1,
203 Table_Increment => 10,
204 Table_Name => "Make.Library_Projs");
206 type Build_Mode_State is (None, Static, Dynamic, Relocatable);
208 procedure Add_Argument (S : String);
209 -- Add one argument to Arguments array, if array is full, double its size
211 function ALI_File_Name (Source : String) return String;
212 -- Return the ALI file name corresponding to a source
214 procedure Check (Filename : String);
215 -- Check if filename is a regular file. Fail if it is not
217 procedure Check_Context;
218 -- Check each object files in table Object_Files
219 -- Fail if any of them is not a regular file
221 procedure Copy_Interface_Sources
222 (For_Project : Project_Id;
223 In_Tree : Project_Tree_Ref;
224 Interfaces : Argument_List;
226 -- Copy the interface sources of a SAL to directory To_Dir
228 procedure Display (Executable : String);
229 -- Display invocation of gnatbind and of the compiler with the arguments
230 -- in Arguments, except when Quiet_Output is True.
232 procedure Process_Binder_File (Name : String);
233 -- For Stand-Alone libraries, get the Linker Options in the binder
236 procedure Reset_Tables;
237 -- Make sure that all the above tables are empty
238 -- (Objects, Foreign_Objects, Ali_Files, Options).
240 function SALs_Use_Constructors return Boolean;
241 -- Indicate if Stand-Alone Libraries are automatically initialized using
242 -- the constructor mechanism.
244 function Ultimate_Extension_Of
245 (Project : Project_Id;
246 In_Tree : Project_Tree_Ref) return Project_Id;
247 -- Returns the Project_Id of project Project. Returns No_Project
248 -- if Project is No_Project.
254 procedure Add_Argument (S : String) is
256 if Argument_Number = Arguments'Last then
258 New_Args : constant String_List_Access :=
259 new String_List (1 .. 2 * Arguments'Last);
262 -- Copy the String_Accesses and set them to null in Arguments
263 -- so that they will not be deallocated by the call to
266 New_Args (Arguments'Range) := Arguments.all;
267 Arguments.all := (others => null);
269 Arguments := New_Args;
273 Argument_Number := Argument_Number + 1;
274 Arguments (Argument_Number) := new String'(S
);
281 function ALI_File_Name
(Source
: String) return String is
283 -- If the source name has an extension, then replace it with
286 for Index
in reverse Source
'First + 1 .. Source
'Last loop
287 if Source
(Index
) = '.' then
288 return Source
(Source
'First .. Index
- 1) & ALI_Suffix
;
292 -- If there is no dot, or if it is the first character, just add the
295 return Source
& ALI_Suffix
;
302 procedure Build_Library
303 (For_Project
: Project_Id
;
304 In_Tree
: Project_Tree_Ref
;
306 Gnatbind_Path
: String_Access
;
308 Gcc_Path
: String_Access
;
309 Bind
: Boolean := True;
310 Link
: Boolean := True)
312 Warning_For_Library
: Boolean := False;
313 -- Set to True for the first warning about a unit missing from the
316 Libgnarl_Needed
: Boolean := False;
317 -- Set to True if library needs to be linked with libgnarl
319 Libdecgnat_Needed
: Boolean := False;
320 -- On OpenVMS, set to True if library needs to be linked with libdecgnat
322 Gtrasymobj_Needed
: Boolean := False;
323 -- On OpenVMS, set to True if library needs to be linked with
326 Data
: Project_Data
:= In_Tree
.Projects
.Table
(For_Project
);
328 Object_Directory_Path
: constant String :=
329 Get_Name_String
(Data
.Object_Directory
);
331 Standalone
: constant Boolean := Data
.Standalone_Library
;
333 Project_Name
: constant String := Get_Name_String
(Data
.Name
);
335 Current_Dir
: constant String := Get_Current_Dir
;
337 Lib_Filename
: String_Access
;
338 Lib_Dirpath
: String_Access
;
339 Lib_Version
: String_Access
:= new String'("");
341 The_Build_Mode : Build_Mode_State := None;
343 Success : Boolean := False;
345 Library_Options : Variable_Value := Nil_Variable_Value;
347 Library_GCC : Variable_Value := Nil_Variable_Value;
349 Driver_Name : Name_Id := No_Name;
351 In_Main_Object_Directory : Boolean := True;
353 Rpath : String_Access := null;
354 -- Allocated only if Path Option is supported
356 Rpath_Last : Natural := 0;
357 -- Index of last valid character of Rpath
359 Initial_Rpath_Length : constant := 200;
360 -- Initial size of Rpath, when first allocated
362 Path_Option : String_Access := Linker_Library_Path_Option;
363 -- If null, Path Option is not supported.
364 -- Not a constant so that it can be deallocated.
366 First_ALI : Name_Id := No_Name;
367 -- Store the ALI file name of a source of the library (the first found)
369 procedure Add_ALI_For (Source : Name_Id);
370 -- Add the name of the ALI file corresponding to Source to the
373 procedure Add_Rpath (Path : String);
374 -- Add a path name to Rpath
376 function Check_Project (P : Project_Id) return Boolean;
377 -- Returns True if P is For_Project or a project extended by For_Project
379 procedure Check_Libs (ALI_File : String);
380 -- Set Libgnarl_Needed if the ALI_File indicates that there is a need
381 -- to link with -lgnarl (this is the case when there is a dependency
382 -- on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file
383 -- indicates that there is a need to link with -ldecgnat (this is the
384 -- case when there is a dependency on dec.ads), and set
385 -- Gtrasymobj_Needed if there is a dependency on g-trasym.ads.
387 procedure Process (The_ALI : File_Name_Type);
388 -- Check if the closure of a library unit which is or should be in the
389 -- interface set is also in the interface set. Issue a warning for each
390 -- missing library unit.
392 procedure Process_Imported_Libraries;
393 -- Add the -L and -l switches for the imported Library Project Files,
394 -- and, if Path Option is supported, the library directory path names
401 procedure Add_ALI_For (Source : Name_Id) is
402 ALI : constant String := ALI_File_Name (Get_Name_String (Source));
411 Add_Str_To_Name_Buffer (S => ALI);
414 -- Add the ALI file name to the library ALIs
417 Library_ALIs.Set (ALI_Id, True);
420 -- Set First_ALI, if not already done
422 if First_ALI = No_Name then
431 procedure Add_Rpath (Path : String) is
441 New_Rpath : constant String_Access :=
442 new String (1 .. 2 * Rpath'Length);
444 New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);
449 -- Start of processing for Add_Rpath
452 -- If firt path, allocate initial Rpath
455 Rpath := new String (1 .. Initial_Rpath_Length);
459 -- Otherwise, add a path separator between two path names
461 if Rpath_Last = Rpath'Last then
465 Rpath_Last := Rpath_Last + 1;
466 Rpath (Rpath_Last) := Path_Separator;
469 -- Increase Rpath size until it is large enough
471 while Rpath_Last + Path'Length > Rpath'Last loop
477 Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;
478 Rpath_Last := Rpath_Last + Path'Length;
485 function Check_Project (P : Project_Id) return Boolean is
487 if P = For_Project then
490 elsif P /= No_Project then
492 Data : Project_Data :=
493 In_Tree.Projects.Table (For_Project);
495 while Data.Extends /= No_Project loop
496 if P = Data.Extends then
500 Data := In_Tree.Projects.Table (Data.Extends);
512 procedure Check_Libs (ALI_File : String) is
514 Text : Text_Buffer_Ptr;
518 if not Libgnarl_Needed or
519 (OpenVMS_On_Target and then
520 ((not Libdecgnat_Needed) or
521 (not Gtrasymobj_Needed)))
525 Name_Len := ALI_File'Length;
526 Name_Buffer (1 .. Name_Len) := ALI_File;
527 Lib_File := Name_Find;
528 Text := Read_Library_Info (Lib_File, True);
538 -- Look for s-osinte.ads in the dependencies
540 for Index in ALI.ALIs.Table (Id).First_Sdep ..
541 ALI.ALIs.Table (Id).Last_Sdep
543 if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then
544 Libgnarl_Needed := True;
546 elsif OpenVMS_On_Target then
547 if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then
548 Libdecgnat_Needed := True;
550 elsif ALI.Sdep.Table (Index).Sfile = G_Trasym_Ads then
551 Gtrasymobj_Needed := True;
562 procedure Process (The_ALI : File_Name_Type) is
563 Text : Text_Buffer_Ptr;
565 First_Unit : ALI.Unit_Id;
566 Last_Unit : ALI.Unit_Id;
567 Unit_Data : Unit_Record;
568 Afile : File_Name_Type;
571 -- Nothing to do if the ALI file has already been processed.
572 -- This happens if an interface imports another interface.
574 if not Processed_ALIs.Get (The_ALI) then
575 Processed_ALIs.Set (The_ALI, True);
576 Text := Read_Library_Info (The_ALI);
587 if Idread /= No_ALI_Id then
588 First_Unit := ALI.ALIs.Table (Idread).First_Unit;
589 Last_Unit := ALI.ALIs.Table (Idread).Last_Unit;
591 -- Process both unit (spec and body) if the body is needed
592 -- by the spec (inline or generic). Otherwise, just process
595 if First_Unit /= Last_Unit and then
596 not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL
598 First_Unit := Last_Unit;
601 for Unit in First_Unit .. Last_Unit loop
602 Unit_Data := ALI.Units.Table (Unit);
604 -- Check if each withed unit which is in the library is
605 -- also in the interface set, if it has not yet been
608 for W in Unit_Data.First_With .. Unit_Data.Last_With loop
609 Afile := Withs.Table (W).Afile;
611 if Afile /= No_Name and then Library_ALIs.Get (Afile)
612 and then not Processed_ALIs.Get (Afile)
614 if not Interface_ALIs.Get (Afile) then
615 if not Warning_For_Library then
616 Write_Str ("Warning: In library project """);
617 Get_Name_String (Data.Name);
618 To_Mixed (Name_Buffer (1 .. Name_Len));
619 Write_Str (Name_Buffer (1 .. Name_Len));
621 Warning_For_Library := True;
624 Write_Str (" Unit """);
625 Get_Name_String (Withs.Table (W).Uname);
626 To_Mixed (Name_Buffer (1 .. Name_Len - 2));
627 Write_Str (Name_Buffer (1 .. Name_Len - 2));
628 Write_Line (""" is not in the interface set");
629 Write_Str (" but it is needed by ");
631 case Unit_Data.Utype is
633 Write_Str ("the spec of ");
636 Write_Str ("the body of ");
643 Get_Name_String (Unit_Data.Uname);
644 To_Mixed (Name_Buffer (1 .. Name_Len - 2));
645 Write_Str (Name_Buffer (1 .. Name_Len - 2));
649 -- Now, process this unit
660 --------------------------------
661 -- Process_Imported_Libraries --
662 --------------------------------
664 procedure Process_Imported_Libraries is
665 Current : Project_Id;
667 procedure Process_Project (Project : Project_Id);
668 -- Process Project and its imported projects recursively.
669 -- Add any library projects to table Library_Projs.
671 ---------------------
672 -- Process_Project --
673 ---------------------
675 procedure Process_Project (Project : Project_Id) is
676 Data : constant Project_Data :=
677 In_Tree.Projects.Table (Project);
678 Imported : Project_List := Data.Imported_Projects;
679 Element : Project_Element;
682 -- Nothing to do if process has already been processed
684 if not Processed_Projects.Get (Data.Name) then
685 Processed_Projects.Set (Data.Name, True);
687 -- Call Process_Project recursively for any imported project.
688 -- We first process the imported projects to guarantee that
689 -- we have a proper reverse order for the libraries.
691 while Imported /= Empty_Project_List loop
693 In_Tree.Project_Lists.Table (Imported);
695 if Element.Project /= No_Project then
696 Process_Project (Element.Project);
699 Imported := Element.Next;
702 -- If it is a library project, add it to Library_Projs
704 if Project /= For_Project and then Data.Library then
705 Library_Projs.Increment_Last;
706 Library_Projs.Table (Library_Projs.Last) := Project;
712 -- Start of processing for Process_Imported_Libraries
715 -- Build list of library projects imported directly or indirectly,
716 -- in the reverse order.
718 Process_Project (For_Project);
720 -- Add the -L and -l switches and, if the Rpath option is supported,
721 -- add the directory to the Rpath.
722 -- As the library projects are in the wrong order, process from the
723 -- last to the first.
725 for Index in reverse 1 .. Library_Projs.Last loop
726 Current := Library_Projs.Table (Index);
729 (In_Tree.Projects.Table (Current).Library_Dir);
731 Opts.Table (Opts.Last) :=
732 new String'("-L" & Name_Buffer
(1 .. Name_Len
));
734 if Path_Option
/= null then
735 Add_Rpath
(Name_Buffer
(1 .. Name_Len
));
739 Opts
.Table
(Opts
.Last
) :=
743 (In_Tree.Projects.Table
744 (Current).Library_Name));
746 end Process_Imported_Libraries;
748 -- Start of processing for Build_Library
753 -- Fail if project is not a library project
755 if not Data.Library then
756 Com.Fail ("project """, Project_Name, """ has no library");
759 -- If this is the first time Build_Library is called, get the Name_Id
760 -- of "s-osinte.ads".
762 if S_Osinte_Ads = No_Name then
764 Add_Str_To_Name_Buffer ("s-osinte.ads");
765 S_Osinte_Ads := Name_Find;
768 if S_Dec_Ads = No_Name then
770 Add_Str_To_Name_Buffer ("dec.ads");
771 S_Dec_Ads := Name_Find;
774 if G_Trasym_Ads = No_Name then
776 Add_Str_To_Name_Buffer ("g-trasym.ads");
777 G_Trasym_Ads := Name_Find;
780 -- We work in the object directory
782 Change_Dir (Object_Directory_Path);
785 -- Call gnatbind only if Bind is True
788 if Gnatbind_Path = null then
789 Com.Fail ("unable to locate ", Gnatbind);
792 if Gcc_Path = null then
793 Com.Fail ("unable to locate ", Gcc);
796 -- Allocate Arguments, if it is the first time we see a standalone
799 if Arguments = No_Argument then
800 Arguments := new String_List (1 .. Initial_Argument_Max);
803 -- Add "-n -o b~<lib>.adb (b__<lib>.adb on VMS) -L<lib>"
805 Argument_Number := 2;
806 Arguments (1) := No_Main;
807 Arguments (2) := Output_Switch;
809 if OpenVMS_On_Target then
810 B_Start := new String'("b__");
814 (B_Start
.all & Get_Name_String
(Data
.Library_Name
) & ".adb");
815 Add_Argument
("-L" & Get_Name_String
(Data
.Library_Name
));
817 if Data
.Lib_Auto_Init
and then SALs_Use_Constructors
then
818 Add_Argument
(Auto_Initialize
);
821 -- Check if Binder'Default_Switches ("Ada") is defined. If it is,
822 -- add these switches to call gnatbind.
825 Binder_Package
: constant Package_Id
:=
827 (Name
=> Name_Binder
,
828 In_Packages
=> Data
.Decl
.Packages
,
832 if Binder_Package
/= No_Package
then
834 Defaults
: constant Array_Element_Id
:=
836 (Name
=> Name_Default_Switches
,
838 In_Tree
.Packages
.Table
839 (Binder_Package
).Decl
.Arrays
,
841 Switches
: Variable_Value
:= Nil_Variable_Value
;
843 Switch
: String_List_Id
:= Nil_String
;
846 if Defaults
/= No_Array_Element
then
851 In_Array
=> Defaults
,
854 if not Switches
.Default
then
855 Switch
:= Switches
.Values
;
857 while Switch
/= Nil_String
loop
860 (In_Tree
.String_Elements
.Table
862 Switch
:= In_Tree
.String_Elements
.
872 -- Get all the ALI files of the project file. We do that even if
873 -- Bind is False, so that First_ALI is set.
880 Interface_ALIs
.Reset
;
881 Processed_ALIs
.Reset
;
883 for Source
in Unit_Table
.First
..
884 Unit_Table
.Last
(In_Tree
.Units
)
886 Unit
:= In_Tree
.Units
.Table
(Source
);
888 if Unit
.File_Names
(Body_Part
).Name
/= No_Name
889 and then Unit
.File_Names
(Body_Part
).Path
/= Slash
892 Check_Project
(Unit
.File_Names
(Body_Part
).Project
)
894 if Unit
.File_Names
(Specification
).Name
= No_Name
then
896 Src_Ind
: Source_File_Index
;
899 Src_Ind
:= Sinput
.P
.Load_Project_File
904 -- Add the ALI file only if it is not a subunit
907 not Sinput
.P
.Source_File_Is_Subunit
(Src_Ind
)
910 (Unit
.File_Names
(Body_Part
).Name
);
916 Add_ALI_For
(Unit
.File_Names
(Body_Part
).Name
);
921 elsif Unit
.File_Names
(Specification
).Name
/= No_Name
922 and then Unit
.File_Names
(Specification
).Path
/= Slash
923 and then Check_Project
924 (Unit
.File_Names
(Specification
).Project
)
926 Add_ALI_For
(Unit
.File_Names
(Specification
).Name
);
932 -- Continue setup and call gnatbind if Bind is True
936 -- Get an eventual --RTS from the ALI file
938 if First_ALI
/= No_Name
then
946 T
:= Read_Library_Info
(First_ALI
, True);
951 (First_ALI
, T
, Ignore_ED
=> False, Err
=> False);
953 if A
/= No_ALI_Id
then
956 (ALI
.ALIs
.Table
(A
).First_Unit
).First_Arg
..
958 (ALI
.ALIs
.Table
(A
).First_Unit
).Last_Arg
960 -- Look for --RTS. If found, add the switch to call
964 Arg
: String_Ptr
renames Args
.Table
(Index
);
966 if Arg
'Length >= 6 and then
967 Arg
(Arg
'First + 2 .. Arg
'First + 5) = "RTS="
969 Add_Argument
(Arg
.all);
981 (Project
=> For_Project
,
983 Including_Libraries
=> True);
985 -- Display the gnatbind command, if not in quiet output
992 (Gnatbind_Path
.all, Arguments
(1 .. Argument_Number
), Success
);
995 Com
.Fail
("could not bind standalone library ",
996 Get_Name_String
(Data
.Library_Name
));
1000 -- Compile the binder generated file only if Link is true
1006 (Project
=> For_Project
,
1008 Including_Libraries
=> True);
1010 -- Invoke <gcc> -c b__<lib>.adb
1012 -- Allocate Arguments, if it is the first time we see a standalone
1015 if Arguments
= No_Argument
then
1016 Arguments
:= new String_List
(1 .. Initial_Argument_Max
);
1019 Argument_Number
:= 1;
1020 Arguments
(1) := Compile_Switch
;
1022 if OpenVMS_On_Target
then
1023 B_Start
:= new String'("b__");
1027 (B_Start.all & Get_Name_String (Data.Library_Name) & ".adb");
1029 -- If necessary, add the PIC option
1031 if PIC_Option /= "" then
1032 Add_Argument (PIC_Option);
1035 -- Get the back-end switches and --RTS from the ALI file
1037 if First_ALI /= No_Name then
1039 T : Text_Buffer_Ptr;
1043 -- Load the ALI file
1045 T := Read_Library_Info (First_ALI, True);
1050 (First_ALI, T, Ignore_ED => False, Err => False);
1052 if A /= No_ALI_Id then
1055 (ALI.ALIs.Table (A).First_Unit).First_Arg ..
1057 (ALI.ALIs.Table (A).First_Unit).Last_Arg
1059 -- Do not compile with the front end switches except
1063 Arg : String_Ptr renames Args.Table (Index);
1065 if not Is_Front_End_Switch (Arg.all)
1067 Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
1069 Add_Argument (Arg.all);
1077 -- Now that all the arguments are set, compile the binder
1082 (Gcc_Path.all, Arguments (1 .. Argument_Number), Success);
1086 ("could not compile binder generated file for library ",
1087 Get_Name_String (Data.Library_Name));
1090 -- Process binder generated file for pragmas Linker_Options
1092 Process_Binder_File (Arguments (2).all & ASCII.NUL);
1096 -- Build the library only if Link is True
1099 -- If attribute Library_GCC was specified, get the driver name
1102 Value_Of (Name_Library_GCC, Data.Decl.Attributes, In_Tree);
1104 if not Library_GCC.Default then
1105 Driver_Name := Library_GCC.Value;
1108 -- If attribute Library_Options was specified, add these additional
1112 Value_Of (Name_Library_Options, Data.Decl.Attributes, In_Tree);
1114 if not Library_Options.Default then
1116 Current : String_List_Id := Library_Options.Values;
1117 Element : String_Element;
1120 while Current /= Nil_String loop
1122 In_Tree.String_Elements.Table (Current);
1123 Get_Name_String (Element.Value);
1125 if Name_Len /= 0 then
1126 Opts.Increment_Last;
1127 Opts.Table (Opts.Last) :=
1128 new String'(Name_Buffer
(1 .. Name_Len
));
1131 Current
:= Element
.Next
;
1136 Lib_Dirpath
:= new String'(Get_Name_String (Data.Library_Dir));
1137 Lib_Filename := new String'(Get_Name_String
(Data
.Library_Name
));
1139 case Data
.Library_Kind
is
1141 The_Build_Mode
:= Static
;
1144 The_Build_Mode
:= Dynamic
;
1147 The_Build_Mode
:= Relocatable
;
1149 if PIC_Option
/= "" then
1150 Opts
.Increment_Last
;
1151 Opts
.Table
(Opts
.Last
) := new String'(PIC_Option);
1155 -- Get the library version, if any
1157 if Data.Lib_Internal_Name /= No_Name then
1159 new String'(Get_Name_String
(Data
.Lib_Internal_Name
));
1162 -- Add the objects found in the object directory and the object
1163 -- directories of the extended files, if any, except for generated
1164 -- object files (b~.. or B__..) from extended projects.
1165 -- When there are one or more extended files, only add an object file
1166 -- if no object file with the same name have already been added.
1168 In_Main_Object_Directory
:= True;
1172 Object_Dir_Path
: constant String :=
1173 Get_Name_String
(Data
.Object_Directory
);
1174 Object_Dir
: Dir_Type
;
1175 Filename
: String (1 .. 255);
1180 Open
(Dir
=> Object_Dir
, Dir_Name
=> Object_Dir_Path
);
1182 -- For all entries in the object directory
1185 Read
(Object_Dir
, Filename
, Last
);
1189 -- Check if it is an object file
1191 if Is_Obj
(Filename
(1 .. Last
)) then
1193 Object_Path
: String :=
1195 (Object_Dir_Path
& Directory_Separator
&
1196 Filename
(1 .. Last
));
1199 Canonical_Case_File_Name
(Object_Path
);
1200 Canonical_Case_File_Name
(Filename
(1 .. Last
));
1202 -- If in the object directory of an extended project,
1203 -- do not consider generated object files.
1205 if In_Main_Object_Directory
1207 or else Filename
(1 .. B_Start
'Length) /= B_Start
.all
1210 Name_Buffer
(1 .. Name_Len
) := Filename
(1 .. Last
);
1213 if not Objects_Htable
.Get
(Id
) then
1215 -- Record this object file
1217 Objects_Htable
.Set
(Id
, True);
1218 Objects
.Increment_Last
;
1219 Objects
.Table
(Objects
.Last
) :=
1220 new String'(Object_Path);
1223 ALI_File : constant String :=
1224 Ext_To (Object_Path, "ali");
1227 if Is_Regular_File (ALI_File) then
1229 -- Record the ALI file
1231 ALIs.Increment_Last;
1232 ALIs.Table (ALIs.Last) :=
1233 new String'(ALI_File
);
1235 -- Find out if for this ALI file,
1236 -- libgnarl or libdecgnat or g-trasym.obj
1237 -- (on OpenVMS) is necessary.
1239 Check_Libs
(ALI_File
);
1242 -- Object file is a foreign object file
1244 Foreigns
.Increment_Last
;
1245 Foreigns
.Table
(Foreigns
.Last
) :=
1246 new String'(Object_Path);
1255 Close (Dir => Object_Dir);
1258 when Directory_Error =>
1259 Com.Fail ("cannot find object directory """,
1260 Get_Name_String (Data.Object_Directory),
1264 exit when Data.Extends = No_Project;
1266 In_Main_Object_Directory := False;
1267 Data := In_Tree.Projects.Table (Data.Extends);
1270 -- Add the -L and -l switches for the imported Library Project Files,
1271 -- and, if Path Option is supported, the library directory path names
1274 Process_Imported_Libraries;
1276 -- Link with libgnat and possibly libgnarl
1278 Opts.Increment_Last;
1279 Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory
);
1281 -- If Path Option is supported, add libgnat directory path name to
1284 if Path_Option
/= null then
1285 Add_Rpath
(Lib_Directory
);
1288 if Libgnarl_Needed
then
1289 Opts
.Increment_Last
;
1291 if The_Build_Mode
= Static
then
1292 Opts
.Table
(Opts
.Last
) := new String'("-lgnarl");
1294 Opts.Table (Opts.Last) := new String'(Shared_Lib
("gnarl"));
1298 if Gtrasymobj_Needed
then
1299 Opts
.Increment_Last
;
1300 Opts
.Table
(Opts
.Last
) :=
1301 new String'(Lib_Directory & "/g-trasym.obj");
1304 if Libdecgnat_Needed then
1305 Opts.Increment_Last;
1306 Opts.Table (Opts.Last) :=
1307 new String'("-L" & Lib_Directory
& "/../declib");
1308 Opts
.Increment_Last
;
1309 Opts
.Table
(Opts
.Last
) := new String'("-ldecgnat");
1312 Opts.Increment_Last;
1314 if The_Build_Mode = Static then
1315 Opts.Table (Opts.Last) := new String'("-lgnat");
1317 Opts
.Table
(Opts
.Last
) := new String'(Shared_Lib ("gnat"));
1320 -- If Path Option is supported, add the necessary switch with the
1321 -- content of Rpath. As Rpath contains at least libgnat directory
1322 -- path name, it is guaranteed that it is not null.
1324 if Path_Option /= null then
1325 Opts.Increment_Last;
1326 Opts.Table (Opts.Last) :=
1327 new String'(Path_Option
.all & Rpath
(1 .. Rpath_Last
));
1334 (Argument_List (Objects.Table (1 .. Objects.Last)));
1337 new Argument_List'(Argument_List
1338 (Foreigns
.Table
(1 .. Foreigns
.Last
)));
1341 new Argument_List
'(Argument_List (ALIs.Table (1 .. ALIs.Last)));
1344 new Argument_List'(Argument_List
(Opts
.Table
(1 .. Opts
.Last
)));
1346 -- We fail if there are no object to put in the library
1347 -- (Ada or foreign objects).
1349 if Object_Files
'Length = 0 then
1350 Com
.Fail
("no object files for library """ &
1351 Lib_Filename
.all & '"');
1354 if not Opt
.Quiet_Output
then
1356 Write_Str
("building ");
1357 Write_Str
(Ada
.Characters
.Handling
.To_Lower
1358 (Build_Mode_State
'Image (The_Build_Mode
)));
1359 Write_Str
(" library for project ");
1360 Write_Line
(Project_Name
);
1364 Write_Line
("object files:");
1366 for Index
in Object_Files
'Range loop
1368 Write_Line
(Object_Files
(Index
).all);
1373 if Ali_Files
'Length = 0 then
1374 Write_Line
("NO ALI files");
1377 Write_Line
("ALI files:");
1379 for Index
in Ali_Files
'Range loop
1381 Write_Line
(Ali_Files
(Index
).all);
1388 -- We check that all object files are regular files
1392 -- Delete the existing library file, if it exists.
1393 -- Fail if the library file is not writable, or if it is not possible
1394 -- to delete the file.
1397 DLL_Name
: aliased String :=
1398 Lib_Dirpath
.all & '/' & DLL_Prefix
&
1399 Lib_Filename
.all & "." & DLL_Ext
;
1401 Archive_Name
: aliased String :=
1402 Lib_Dirpath
.all & "/lib" &
1403 Lib_Filename
.all & "." & Archive_Ext
;
1405 type Str_Ptr
is access all String;
1406 -- This type is necessary to meet the accessibility rules of Ada.
1407 -- It is not possible to use String_Access here.
1409 Full_Lib_Name
: Str_Ptr
;
1410 -- Designates the full library path name. Either DLL_Name or
1411 -- Archive_Name, depending on the library kind.
1413 Success
: Boolean := False;
1414 -- Used to call Delete_File
1417 if The_Build_Mode
= Static
then
1418 Full_Lib_Name
:= Archive_Name
'Access;
1420 Full_Lib_Name
:= DLL_Name
'Access;
1423 if Is_Regular_File
(Full_Lib_Name
.all) then
1424 if Is_Writable_File
(Full_Lib_Name
.all) then
1425 Delete_File
(Full_Lib_Name
.all, Success
);
1428 if Is_Regular_File
(Full_Lib_Name
.all) then
1429 Com
.Fail
("could not delete """ & Full_Lib_Name
.all & """");
1434 Argument_Number
:= 0;
1436 -- If we have a standalone library, gather all the interface ALI.
1437 -- They are passed to Build_Dynamic_Library, where they are used by
1438 -- some platforms (VMS, for example) to decide what symbols should be
1439 -- exported. They are also flagged as Interface when we copy them to
1440 -- the library directory (by Copy_ALI_Files, below).
1443 Data
:= In_Tree
.Projects
.Table
(For_Project
);
1446 Iface
: String_List_Id
:= Data
.Lib_Interface_ALIs
;
1447 ALI
: File_Name_Type
;
1450 while Iface
/= Nil_String
loop
1452 In_Tree
.String_Elements
.Table
(Iface
).Value
;
1453 Interface_ALIs
.Set
(ALI
, True);
1455 (In_Tree
.String_Elements
.Table
(Iface
).Value
);
1456 Add_Argument
(Name_Buffer
(1 .. Name_Len
));
1458 In_Tree
.String_Elements
.Table
(Iface
).Next
;
1461 Iface
:= Data
.Lib_Interface_ALIs
;
1463 if not Opt
.Quiet_Output
then
1465 -- Check that the interface set is complete: any unit in the
1466 -- library that is needed by an interface should also be an
1467 -- interface. If it is not the case, output a warning.
1469 while Iface
/= Nil_String
loop
1470 ALI
:= In_Tree
.String_Elements
.Table
1474 In_Tree
.String_Elements
.Table
(Iface
).Next
;
1481 Current_Dir
: constant String := Get_Current_Dir
;
1484 Name
: String (1 .. 200);
1487 Disregard
: Boolean;
1489 DLL_Name
: aliased constant String :=
1490 Lib_Filename
.all & "." & DLL_Ext
;
1492 Archive_Name
: aliased constant String :=
1493 Lib_Filename
.all & "." & Archive_Ext
;
1495 Delete
: Boolean := False;
1498 -- Clean the library directory: remove any file with the name of
1499 -- the library file and any ALI file of a source of the project.
1503 (In_Tree
.Projects
.Table
(For_Project
).Library_Dir
);
1504 Change_Dir
(Name_Buffer
(1 .. Name_Len
));
1509 ("unable to access library directory """,
1510 Name_Buffer
(1 .. Name_Len
),
1517 Read
(Dir
, Name
, Last
);
1520 if Is_Regular_File
(Name
(1 .. Last
)) then
1521 Canonical_Case_File_Name
(Name
(1 .. Last
));
1524 if (The_Build_Mode
= Static
and then
1525 Name
(1 .. Last
) = Archive_Name
)
1527 ((The_Build_Mode
= Dynamic
or else
1528 The_Build_Mode
= Relocatable
)
1530 Name
(1 .. Last
) = DLL_Name
)
1534 elsif Last
> 4 and then Name
(Last
- 3 .. Last
) = ".ali" then
1538 -- Compare with ALI file names of the project
1540 for Index
in 1 .. Unit_Table
.Last
(In_Tree
.Units
) loop
1541 Unit
:= In_Tree
.Units
.Table
(Index
);
1543 if Unit
.File_Names
(Body_Part
).Project
/=
1546 if Ultimate_Extension_Of
1547 (Unit
.File_Names
(Body_Part
).Project
, In_Tree
)
1551 (Unit
.File_Names
(Body_Part
).Name
);
1552 Name_Len
:= Name_Len
-
1554 (Name
(1 .. Name_Len
))'Length;
1555 if Name_Buffer
(1 .. Name_Len
) =
1556 Name
(1 .. Last
- 4)
1563 elsif Ultimate_Extension_Of
1564 (Unit
.File_Names
(Specification
).Project
, In_Tree
)
1568 (Unit
.File_Names
(Specification
).Name
);
1569 Name_Len
:= Name_Len
-
1570 File_Extension
(Name
(1 .. Name_Len
))'Length;
1572 if Name_Buffer
(1 .. Name_Len
) =
1573 Name
(1 .. Last
- 4)
1584 Set_Writable
(Name
(1 .. Last
));
1585 Delete_File
(Name
(1 .. Last
), Disregard
);
1592 Change_Dir
(Current_Dir
);
1595 -- Call procedure to build the library, depending on the build mode
1597 case The_Build_Mode
is
1598 when Dynamic | Relocatable
=>
1599 Build_Dynamic_Library
1600 (Ofiles
=> Object_Files
.all,
1601 Foreign
=> Foreign_Objects
.all,
1602 Afiles
=> Ali_Files
.all,
1603 Options
=> Options
.all,
1604 Options_2
=> No_Argument_List
,
1605 Interfaces
=> Arguments
(1 .. Argument_Number
),
1606 Lib_Filename
=> Lib_Filename
.all,
1607 Lib_Dir
=> Lib_Dirpath
.all,
1608 Symbol_Data
=> Data
.Symbol_Data
,
1609 Driver_Name
=> Driver_Name
,
1610 Lib_Version
=> Lib_Version
.all,
1611 Auto_Init
=> Data
.Lib_Auto_Init
);
1624 -- We need to copy the ALI files from the object directory to
1625 -- the library ALI directory, so that the linker find them there,
1626 -- and does not need to look in the object directory where it
1627 -- would also find the object files; and we don't want that:
1628 -- we want the linker to use the library.
1630 -- Copy the ALI files and make the copies read-only. For interfaces,
1631 -- mark the copies as interfaces.
1634 (Files
=> Ali_Files
.all,
1635 To
=> In_Tree
.Projects
.Table
(For_Project
).Library_ALI_Dir
,
1636 Interfaces
=> Arguments
(1 .. Argument_Number
));
1638 -- Copy interface sources if Library_Src_Dir specified
1641 and then In_Tree
.Projects
.Table
1642 (For_Project
).Library_Src_Dir
/= No_Name
1644 -- Clean the interface copy directory: remove any source that
1645 -- could be a source of the project.
1649 (In_Tree
.Projects
.Table
(For_Project
).Library_Src_Dir
);
1650 Change_Dir
(Name_Buffer
(1 .. Name_Len
));
1655 ("unable to access library source copy directory """,
1656 Name_Buffer
(1 .. Name_Len
),
1662 Delete
: Boolean := False;
1665 Name
: String (1 .. 200);
1668 Disregard
: Boolean;
1674 Read
(Dir
, Name
, Last
);
1677 if Is_Regular_File
(Name
(1 .. Last
)) then
1678 Canonical_Case_File_Name
(Name
(1 .. Last
));
1681 -- Compare with source file names of the project
1683 for Index
in 1 .. Unit_Table
.Last
(In_Tree
.Units
) loop
1684 Unit
:= In_Tree
.Units
.Table
(Index
);
1686 if Ultimate_Extension_Of
1687 (Unit
.File_Names
(Body_Part
).Project
, In_Tree
) =
1691 (Unit
.File_Names
(Body_Part
).Name
) =
1698 if Ultimate_Extension_Of
1699 (Unit
.File_Names
(Specification
).Project
, In_Tree
) =
1703 (Unit
.File_Names
(Specification
).Name
) =
1713 Set_Writable
(Name
(1 .. Last
));
1714 Delete_File
(Name
(1 .. Last
), Disregard
);
1721 Copy_Interface_Sources
1722 (For_Project
=> For_Project
,
1724 Interfaces
=> Arguments
(1 .. Argument_Number
),
1725 To_Dir
=> In_Tree
.Projects
.Table
1726 (For_Project
).Library_Src_Dir
);
1730 -- Reset the current working directory to its previous value
1732 Change_Dir
(Current_Dir
);
1739 procedure Check
(Filename
: String) is
1741 if not Is_Regular_File
(Filename
) then
1742 Com
.Fail
(Filename
, " not found.");
1750 procedure Check_Context
is
1752 -- Check that each object file exists
1754 for F
in Object_Files
'Range loop
1755 Check
(Object_Files
(F
).all);
1763 procedure Check_Library
1764 (For_Project
: Project_Id
; In_Tree
: Project_Tree_Ref
)
1766 Data
: constant Project_Data
:=
1767 In_Tree
.Projects
.Table
(For_Project
);
1768 Lib_TS
: Time_Stamp_Type
;
1769 Current
: constant Dir_Name_Str
:= Get_Current_Dir
;
1772 -- No need to build the library if there is no object directory,
1773 -- hence no object files to build the library.
1775 if Data
.Library
then
1777 Lib_Name
: constant Name_Id
:=
1778 Library_File_Name_For
(For_Project
, In_Tree
);
1780 Change_Dir
(Get_Name_String
(Data
.Library_Dir
));
1781 Lib_TS
:= File_Stamp
(Lib_Name
);
1782 In_Tree
.Projects
.Table
(For_Project
).Library_TS
:= Lib_TS
;
1785 if not Data
.Externally_Built
1786 and then not Data
.Need_To_Build_Lib
1787 and then Data
.Object_Directory
/= No_Name
1790 Obj_TS
: Time_Stamp_Type
;
1791 Object_Dir
: Dir_Type
;
1794 if OpenVMS_On_Target
then
1795 B_Start
:= new String'("b__");
1798 -- If the library file does not exist, then the time stamp will
1799 -- be Empty_Time_Stamp, earlier than any other time stamp.
1801 Change_Dir (Get_Name_String (Data.Object_Directory));
1802 Open (Dir => Object_Dir, Dir_Name => ".");
1804 -- For all entries in the object directory
1807 Read (Object_Dir, Name_Buffer, Name_Len);
1808 exit when Name_Len = 0;
1810 -- Check if it is an object file, but ignore any binder
1813 if Is_Obj (Name_Buffer (1 .. Name_Len))
1814 and then Name_Buffer (1 .. B_Start'Length) /= B_Start.all
1816 -- Get the object file time stamp
1818 Obj_TS := File_Stamp (Name_Find);
1820 -- If library file time stamp is earlier, set
1821 -- Need_To_Build_Lib and return. String comparaison is
1822 -- used, otherwise time stamps may be too close and the
1823 -- comparaison would return True, which would trigger
1824 -- an unnecessary rebuild of the library.
1826 if String (Lib_TS) < String (Obj_TS) then
1828 -- Library must be rebuilt
1830 In_Tree.Projects.Table
1831 (For_Project).Need_To_Build_Lib := True;
1841 Change_Dir (Current);
1845 ----------------------------
1846 -- Copy_Interface_Sources --
1847 ----------------------------
1849 procedure Copy_Interface_Sources
1850 (For_Project : Project_Id;
1851 In_Tree : Project_Tree_Ref;
1852 Interfaces : Argument_List;
1855 Current : constant Dir_Name_Str := Get_Current_Dir;
1856 -- The current directory, where to return to at the end
1858 Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
1859 -- The directory where to copy sources
1861 Text : Text_Buffer_Ptr;
1862 The_ALI : ALI.ALI_Id;
1865 First_Unit : ALI.Unit_Id;
1866 Second_Unit : ALI.Unit_Id;
1870 Copy_Subunits : Boolean := False;
1871 -- When True, indicates that subunits, if any, need to be copied too
1873 procedure Copy (File_Name : Name_Id);
1874 -- Copy one source of the project to the target directory
1876 function Is_Same_Or_Extension
1877 (Extending : Project_Id;
1878 Extended : Project_Id) return Boolean;
1879 -- Return True if project Extending is equal to or extends project
1886 procedure Copy (File_Name : Name_Id) is
1887 Success : Boolean := False;
1891 for Index in Unit_Table.First ..
1892 Unit_Table.Last (In_Tree.Units)
1894 Data := In_Tree.Units.Table (Index);
1896 -- Find and copy the immediate or inherited source
1898 for J in Data.File_Names'Range loop
1899 if Is_Same_Or_Extension
1900 (For_Project, Data.File_Names (J).Project)
1901 and then Data.File_Names (J).Name = File_Name
1904 (Get_Name_String (Data.File_Names (J).Path),
1908 Preserve => Preserve);
1915 --------------------------
1916 -- Is_Same_Or_Extension --
1917 --------------------------
1919 function Is_Same_Or_Extension
1920 (Extending : Project_Id;
1921 Extended : Project_Id) return Boolean
1923 Ext : Project_Id := Extending;
1926 while Ext /= No_Project loop
1927 if Ext = Extended then
1931 Ext := In_Tree.Projects.Table (Ext).Extends;
1935 end Is_Same_Or_Extension;
1937 -- Start of processing for Copy_Interface_Sources
1940 -- Change the working directory to the object directory
1944 (In_Tree.Projects.Table
1945 (For_Project).Object_Directory));
1947 for Index in Interfaces'Range loop
1949 -- First, load the ALI file
1952 Add_Str_To_Name_Buffer (Interfaces (Index).all);
1953 Lib_File := Name_Find;
1954 Text := Read_Library_Info (Lib_File);
1955 The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1958 Second_Unit := No_Unit_Id;
1959 First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
1960 Copy_Subunits := True;
1962 -- If there is both a spec and a body, check if they are both needed
1964 if ALI.Units.Table (First_Unit).Utype = Is_Body then
1965 Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
1967 -- If the body is not needed, then reset First_Unit
1969 if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
1970 First_Unit := No_Unit_Id;
1971 Copy_Subunits := False;
1974 elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
1975 Copy_Subunits := False;
1978 -- Copy the file(s) that need to be copied
1980 if First_Unit /= No_Unit_Id then
1981 Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
1984 if Second_Unit /= No_Unit_Id then
1985 Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
1988 -- Copy all the separates, if any
1990 if Copy_Subunits then
1991 for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
1992 ALI.ALIs.Table (The_ALI).Last_Sdep
1994 if Sdep.Table (Dep).Subunit_Name /= No_Name then
1995 Copy (File_Name => Sdep.Table (Dep).Sfile);
2001 -- Restore the initial working directory
2003 Change_Dir (Current);
2004 end Copy_Interface_Sources;
2010 procedure Display (Executable : String) is
2012 if not Opt.Quiet_Output then
2013 Write_Str (Executable);
2015 for Index in 1 .. Argument_Number loop
2017 Write_Str (Arguments (Index).all);
2024 -------------------------
2025 -- Process_Binder_File --
2026 -------------------------
2028 procedure Process_Binder_File (Name : String) is
2030 -- Binder file's descriptor
2032 Read_Mode : constant String := "r" & ASCII.Nul;
2035 Status : Interfaces.C_Streams.int;
2036 pragma Unreferenced (Status);
2039 Begin_Info : constant String := "-- BEGIN Object file/option list";
2040 End_Info : constant String := "-- END Object file/option list ";
2042 Next_Line : String (1 .. 1000);
2043 -- Current line value
2044 -- Where does this odd constant 1000 come from, looks suspicious ???
2047 -- End of line slice (the slice does not contain the line terminator)
2049 procedure Get_Next_Line;
2050 -- Read the next line from the binder file without the line terminator
2056 procedure Get_Next_Line is
2060 Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
2062 if Fchars = System.Null_Address then
2063 Fail ("Error reading binder output");
2067 while Nlast <= Next_Line'Last
2068 and then Next_Line (Nlast) /= ASCII.LF
2069 and then Next_Line (Nlast) /= ASCII.CR
2077 -- Start of processing for Process_Binder_File
2080 Fd := fopen (Name'Address, Read_Mode'Address);
2082 if Fd = NULL_Stream then
2083 Fail ("Failed to open binder output");
2086 -- Skip up to the Begin Info line
2090 exit when Next_Line (1 .. Nlast) = Begin_Info;
2093 -- Find the first switch
2098 exit when Next_Line (1 .. Nlast) = End_Info;
2100 -- As the binder generated file is in Ada, remove the first eight
2101 -- characters " -- ".
2103 Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2106 -- Stop when the first switch is found
2108 exit when Next_Line (1) = '-';
2111 if Next_Line (1 .. Nlast) /= End_Info then
2113 -- Ignore -static and -shared, since -shared will be used
2116 -- Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
2117 -- later, because they are also needed for non Stand-Alone shared
2120 -- Also ignore the shared libraries which are :
2122 -- UNIX / Windows VMS
2123 -- -lgnat-<version> -lgnat_<version> (7 + version'length chars)
2124 -- -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
2126 if Next_Line (1 .. Nlast) /= "-static" and then
2127 Next_Line (1 .. Nlast) /= "-shared" and then
2128 Next_Line (1 .. Nlast) /= "-ldecgnat" and then
2129 Next_Line (1 .. Nlast) /= "-lgnarl" and then
2130 Next_Line (1 .. Nlast) /= "-lgnat" and then
2132 (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
2133 Shared_Lib ("gnarl") and then
2135 (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
2138 if Next_Line (1) /= '-' then
2140 -- This is not an option, should we add it?
2142 if Add_Object_Files then
2143 Opts.Increment_Last;
2144 Opts.Table (Opts.Last) :=
2145 new String'(Next_Line
(1 .. Nlast
));
2149 -- Add all other options
2151 Opts
.Increment_Last
;
2152 Opts
.Table
(Opts
.Last
) :=
2153 new String'(Next_Line (1 .. Nlast));
2157 -- Next option, if any
2160 exit when Next_Line (1 .. Nlast) = End_Info;
2162 -- Remove first eight characters " -- "
2164 Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast);
2169 Status := fclose (Fd);
2171 -- Is it really right to ignore any close error ???
2173 end Process_Binder_File;
2179 procedure Reset_Tables is
2182 Objects_Htable.Reset;
2186 Processed_Projects.Reset;
2190 ---------------------------
2191 -- SALs_Use_Constructors --
2192 ---------------------------
2194 function SALs_Use_Constructors return Boolean is
2195 function C_SALs_Init_Using_Constructors return Integer;
2196 pragma Import (C, C_SALs_Init_Using_Constructors,
2197 "__gnat_sals_init_using_constructors");
2199 return C_SALs_Init_Using_Constructors /= 0;
2200 end SALs_Use_Constructors;
2202 ---------------------------
2203 -- Ultimate_Extension_Of --
2204 ---------------------------
2206 function Ultimate_Extension_Of
2207 (Project : Project_Id;
2208 In_Tree : Project_Tree_Ref) return Project_Id
2210 Result : Project_Id := Project;
2211 Data : Project_Data;
2214 if Project /= No_Project then
2216 Data := In_Tree.Projects.Table (Result);
2217 exit when Data.Extended_By = No_Project;
2218 Result := Data.Extended_By;
2223 end Ultimate_Extension_Of;