1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2005, Ada Core Technologies, Inc. --
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
;
30 with MLib
.Fil
; use MLib
.Fil
;
31 with MLib
.Tgt
; use MLib
.Tgt
;
32 with MLib
.Utl
; use MLib
.Utl
;
33 with Namet
; use Namet
;
35 with Output
; use Output
;
36 with Prj
.Com
; use Prj
.Com
;
37 with Prj
.Env
; use Prj
.Env
;
38 with Prj
.Util
; use Prj
.Util
;
40 with Snames
; use Snames
;
41 with Switch
; use Switch
;
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 aq stand-alone
60 -- False for Windows, True for other platforms.
62 ALI_Suffix
: constant String := ".ali";
63 B_Start
: String := "b~";
65 S_Osinte_Ads
: Name_Id
:= No_Name
;
66 -- Name_Id for "s-osinte.ads"
68 S_Dec_Ads
: Name_Id
:= No_Name
;
69 -- Name_Id for "dec.ads"
71 G_Trasym_Ads
: Name_Id
:= No_Name
;
72 -- Name_Id for "g-trasym.ads"
74 No_Argument_List
: aliased String_List
:= (1 .. 0 => null);
75 No_Argument
: constant String_List_Access
:= No_Argument_List
'Access;
77 Arguments
: String_List_Access
:= No_Argument
;
78 -- Used to accumulate arguments for the invocation of gnatbind and of
79 -- the compiler. Also used to collect the interface ALI when copying
80 -- the ALI files to the library directory.
82 Argument_Number
: Natural := 0;
83 -- Index of the last argument in Arguments
85 Initial_Argument_Max
: constant := 10;
87 No_Main_String
: aliased String := "-n";
88 No_Main
: constant String_Access
:= No_Main_String
'Access;
90 Output_Switch_String
: aliased String := "-o";
91 Output_Switch
: constant String_Access
:= Output_Switch_String
'Access;
93 Compile_Switch_String
: aliased String := "-c";
94 Compile_Switch
: constant String_Access
:= Compile_Switch_String
'Access;
96 Auto_Initialize
: constant String := "-a";
98 -- List of objects to put inside the library
100 Object_Files
: Argument_List_Access
;
102 package Objects
is new Table
.Table
103 (Table_Name
=> "Mlib.Prj.Objects",
104 Table_Component_Type
=> String_Access
,
105 Table_Index_Type
=> Natural,
106 Table_Low_Bound
=> 1,
108 Table_Increment
=> 100);
110 package Objects_Htable
is new GNAT
.HTable
.Simple_HTable
111 (Header_Num
=> Header_Num
,
118 -- List of non-Ada object files
120 Foreign_Objects
: Argument_List_Access
;
122 package Foreigns
is new Table
.Table
123 (Table_Name
=> "Mlib.Prj.Foreigns",
124 Table_Component_Type
=> String_Access
,
125 Table_Index_Type
=> Natural,
126 Table_Low_Bound
=> 1,
128 Table_Increment
=> 100);
132 Ali_Files
: Argument_List_Access
;
134 package ALIs
is new Table
.Table
135 (Table_Name
=> "Mlib.Prj.Alis",
136 Table_Component_Type
=> String_Access
,
137 Table_Index_Type
=> Natural,
138 Table_Low_Bound
=> 1,
140 Table_Increment
=> 100);
142 -- List of options set in the command line.
144 Options
: Argument_List_Access
;
146 package Opts
is new Table
.Table
147 (Table_Name
=> "Mlib.Prj.Opts",
148 Table_Component_Type
=> String_Access
,
149 Table_Index_Type
=> Natural,
150 Table_Low_Bound
=> 1,
152 Table_Increment
=> 100);
154 -- All the ALI file in the library
156 package Library_ALIs
is new GNAT
.HTable
.Simple_HTable
157 (Header_Num
=> Header_Num
,
164 -- The ALI files in the interface sets
166 package Interface_ALIs
is new GNAT
.HTable
.Simple_HTable
167 (Header_Num
=> Header_Num
,
174 -- The ALI files that have been processed to check if the corresponding
175 -- library unit is in the interface set.
177 package Processed_ALIs
is new GNAT
.HTable
.Simple_HTable
178 (Header_Num
=> Header_Num
,
185 -- The projects imported directly or indirectly.
187 package Processed_Projects
is new GNAT
.HTable
.Simple_HTable
188 (Header_Num
=> Header_Num
,
195 -- The library projects imported directly or indirectly.
197 package Library_Projs
is new Table
.Table
(
198 Table_Component_Type
=> Project_Id
,
199 Table_Index_Type
=> Integer,
200 Table_Low_Bound
=> 1,
202 Table_Increment
=> 10,
203 Table_Name
=> "Make.Library_Projs");
205 type Build_Mode_State
is (None
, Static
, Dynamic
, Relocatable
);
207 procedure Add_Argument
(S
: String);
208 -- Add one argument to the array Arguments.
209 -- If Arguments 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 Clean
(Directory
: Name_Id
);
222 -- Attempt to delete all files in Directory, but not subdirectories
224 procedure Copy_Interface_Sources
225 (For_Project
: Project_Id
;
226 In_Tree
: Project_Tree_Ref
;
227 Interfaces
: Argument_List
;
229 -- Copy the interface sources of a SAL to directory To_Dir
231 procedure Display
(Executable
: String);
232 -- Display invocation of gnatbind and of the compiler with the arguments
233 -- in Arguments, except when Quiet_Output is True.
235 procedure Process_Binder_File
(Name
: String);
236 -- For Stand-Alone libraries, get the Linker Options in the binder
239 procedure Reset_Tables
;
240 -- Make sure that all the above tables are empty
241 -- (Objects, Foreign_Objects, Ali_Files, Options).
243 function SALs_Use_Constructors
return Boolean;
244 -- Indicate if Stand-Alone Libraries are automatically initialized using
245 -- the constructor mechanism.
251 procedure Add_Argument
(S
: String) is
253 if Argument_Number
= Arguments
'Last then
255 New_Args
: constant String_List_Access
:=
256 new String_List
(1 .. 2 * Arguments
'Last);
259 -- Copy the String_Accesses and set them to null in Arguments
260 -- so that they will not be deallocated by the call to
263 New_Args
(Arguments
'Range) := Arguments
.all;
264 Arguments
.all := (others => null);
266 Arguments
:= New_Args
;
270 Argument_Number
:= Argument_Number
+ 1;
271 Arguments
(Argument_Number
) := new String'(S);
278 function ALI_File_Name (Source : String) return String is
280 -- If the source name has an extension, then replace it with
283 for Index in reverse Source'First + 1 .. Source'Last loop
284 if Source (Index) = '.' then
285 return Source (Source'First .. Index - 1) & ALI_Suffix;
289 -- If there is no dot, or if it is the first character, just add the
292 return Source & ALI_Suffix;
299 procedure Build_Library
300 (For_Project : Project_Id;
301 In_Tree : Project_Tree_Ref;
303 Gnatbind_Path : String_Access;
305 Gcc_Path : String_Access;
306 Bind : Boolean := True;
307 Link : Boolean := True)
309 Warning_For_Library : Boolean := False;
310 -- Set to True for the first warning about a unit missing from the
313 Libgnarl_Needed : Boolean := False;
314 -- Set to True if library needs to be linked with libgnarl
316 Libdecgnat_Needed : Boolean := False;
317 -- On OpenVMS, set to True if library needs to be linked with libdecgnat
319 Gtrasymobj_Needed : Boolean := False;
320 -- On OpenVMS, set to True if library needs to be linked with
323 Data : Project_Data := In_Tree.Projects.Table (For_Project);
325 Object_Directory_Path : constant String :=
326 Get_Name_String (Data.Object_Directory);
328 Standalone : constant Boolean := Data.Standalone_Library;
330 Project_Name : constant String := Get_Name_String (Data.Name);
332 Current_Dir : constant String := Get_Current_Dir;
334 Lib_Filename : String_Access;
335 Lib_Dirpath : String_Access;
336 Lib_Version : String_Access := new String'("");
338 The_Build_Mode
: Build_Mode_State
:= None
;
340 Success
: Boolean := False;
342 Library_Options
: Variable_Value
:= Nil_Variable_Value
;
344 Library_GCC
: Variable_Value
:= Nil_Variable_Value
;
346 Driver_Name
: Name_Id
:= No_Name
;
348 In_Main_Object_Directory
: Boolean := True;
350 Rpath
: String_Access
:= null;
351 -- Allocated only if Path Option is supported
353 Rpath_Last
: Natural := 0;
354 -- Index of last valid character of Rpath
356 Initial_Rpath_Length
: constant := 200;
357 -- Initial size of Rpath, when first allocated
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.
364 -- Directory where to copy ALI files and possibly interface sources
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 (Hostparm
.OpenVMS
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 Hostparm
.OpenVMS
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 Hostparm
.OpenVMS
then
810 B_Start
(B_Start
'Last) := '$';
814 (B_Start
& 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 Hostparm
.OpenVMS
then
1023 B_Start
(B_Start
'Last) := '$';
1027 (B_Start
& 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
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 & "/lib
" &
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;
1480 -- Clean the library directory, if it is also the directory where
1481 -- the ALI files are copied, either because there is no interface
1482 -- copy directory or because the interface copy directory is the
1483 -- same as the library directory.
1486 In_Tree.Projects.Table (For_Project).Library_Dir;
1489 -- Call procedure to build the library, depending on the build mode
1491 case The_Build_Mode is
1492 when Dynamic | Relocatable =>
1493 Build_Dynamic_Library
1494 (Ofiles => Object_Files.all,
1495 Foreign => Foreign_Objects.all,
1496 Afiles => Ali_Files.all,
1497 Options => Options.all,
1498 Options_2 => No_Argument_List,
1499 Interfaces => Arguments (1 .. Argument_Number),
1500 Lib_Filename => Lib_Filename.all,
1501 Lib_Dir => Lib_Dirpath.all,
1502 Symbol_Data => Data.Symbol_Data,
1503 Driver_Name => Driver_Name,
1504 Lib_Version => Lib_Version.all,
1505 Auto_Init => Data.Lib_Auto_Init);
1518 -- We need to copy the ALI files from the object directory to
1519 -- the library directory, so that the linker find them there,
1520 -- and does not need to look in the object directory where it
1521 -- would also find the object files; and we don't want that:
1522 -- we want the linker to use the library.
1524 -- Copy the ALI files and make the copies read-only. For interfaces,
1525 -- mark the copies as interfaces.
1528 (Files => Ali_Files.all,
1530 Interfaces => Arguments (1 .. Argument_Number));
1532 -- Copy interface sources if Library_Src_Dir specified
1535 and then In_Tree.Projects.Table
1536 (For_Project).Library_Src_Dir /= No_Name
1538 -- Clean the interface copy directory, if it is not also the
1539 -- library directory. If it is also the library directory, it
1540 -- has already been cleaned before generation of the library.
1542 if In_Tree.Projects.Table
1543 (For_Project).Library_Src_Dir /= Copy_Dir
1545 Copy_Dir := In_Tree.Projects.Table
1546 (For_Project).Library_Src_Dir;
1550 Copy_Interface_Sources
1551 (For_Project => For_Project,
1553 Interfaces => Arguments (1 .. Argument_Number),
1554 To_Dir => Copy_Dir);
1558 -- Reset the current working directory to its previous value
1560 Change_Dir (Current_Dir);
1567 procedure Check (Filename : String) is
1569 if not Is_Regular_File (Filename) then
1570 Com.Fail (Filename, " not found
.");
1578 procedure Check_Context is
1580 -- Check that each object file exists
1582 for F in Object_Files'Range loop
1583 Check (Object_Files (F).all);
1591 procedure Check_Library
1592 (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
1594 Data : constant Project_Data :=
1595 In_Tree.Projects.Table (For_Project);
1598 -- No need to build the library if there is no object directory,
1599 -- hence no object files to build the library.
1602 and then not Data.Need_To_Build_Lib
1603 and then Data.Object_Directory /= No_Name
1606 Current : constant Dir_Name_Str := Get_Current_Dir;
1607 Lib_Name : constant Name_Id :=
1608 Library_File_Name_For (For_Project, In_Tree);
1609 Lib_TS : Time_Stamp_Type;
1610 Obj_TS : Time_Stamp_Type;
1612 Object_Dir : Dir_Type;
1615 if Hostparm.OpenVMS then
1616 B_Start (B_Start'Last) := '$';
1619 Change_Dir (Get_Name_String (Data.Library_Dir));
1621 Lib_TS := File_Stamp (Lib_Name);
1623 -- If the library file does not exist, then the time stamp will
1624 -- be Empty_Time_Stamp, earlier than any other time stamp.
1626 Change_Dir (Get_Name_String (Data.Object_Directory));
1627 Open (Dir => Object_Dir, Dir_Name => ".");
1629 -- For all entries in the object directory
1632 Read (Object_Dir, Name_Buffer, Name_Len);
1633 exit when Name_Len = 0;
1635 -- Check if it is an object file, but ignore any binder
1638 if Is_Obj (Name_Buffer (1 .. Name_Len))
1639 and then Name_Buffer (1 .. B_Start'Length) /= B_Start
1641 -- Get the object file time stamp
1643 Obj_TS := File_Stamp (Name_Find);
1645 -- If library file time stamp is earlier, set
1646 -- Need_To_Build_Lib and return. String comparaison is used,
1647 -- otherwise time stamps may be too close and the
1648 -- comparaison would return True, which would trigger
1649 -- an unnecessary rebuild of the library.
1651 if String (Lib_TS) < String (Obj_TS) then
1653 -- Library must be rebuilt
1655 In_Tree.Projects.Table
1656 (For_Project).Need_To_Build_Lib := True;
1662 Change_Dir (Current);
1671 procedure Clean (Directory : Name_Id) is
1672 Current : constant Dir_Name_Str := Get_Current_Dir;
1676 Name : String (1 .. 200);
1679 Disregard : Boolean;
1682 Get_Name_String (Directory);
1684 -- Change the working directory to the directory to clean
1687 Change_Dir (Name_Buffer (1 .. Name_Len));
1692 ("unable to
access directory
""",
1693 Name_Buffer (1 .. Name_Len),
1699 -- For each regular file in the directory, make it writable and
1703 Read (Dir, Name, Last);
1706 if Is_Regular_File (Name (1 .. Last)) then
1707 Set_Writable (Name (1 .. Last));
1708 Delete_File (Name (1 .. Last), Disregard);
1714 -- Restore the initial working directory
1716 Change_Dir (Current);
1719 ----------------------------
1720 -- Copy_Interface_Sources --
1721 ----------------------------
1723 procedure Copy_Interface_Sources
1724 (For_Project : Project_Id;
1725 In_Tree : Project_Tree_Ref;
1726 Interfaces : Argument_List;
1729 Current : constant Dir_Name_Str := Get_Current_Dir;
1730 -- The current directory, where to return to at the end
1732 Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
1733 -- The directory where to copy sources
1735 Text : Text_Buffer_Ptr;
1736 The_ALI : ALI.ALI_Id;
1739 First_Unit : ALI.Unit_Id;
1740 Second_Unit : ALI.Unit_Id;
1744 Copy_Subunits : Boolean := False;
1745 -- When True, indicates that subunits, if any, need to be copied too
1747 procedure Copy (File_Name : Name_Id);
1748 -- Copy one source of the project to the target directory
1750 function Is_Same_Or_Extension
1751 (Extending : Project_Id;
1752 Extended : Project_Id)
1754 -- Return True if project Extending is equal to or extends project
1761 procedure Copy (File_Name : Name_Id) is
1762 Success : Boolean := False;
1766 for Index in Unit_Table.First ..
1767 Unit_Table.Last (In_Tree.Units)
1769 Data := In_Tree.Units.Table (Index);
1771 -- Find and copy the immediate or inherited source
1773 for J in Data.File_Names'Range loop
1774 if Is_Same_Or_Extension
1775 (For_Project, Data.File_Names (J).Project)
1776 and then Data.File_Names (J).Name = File_Name
1779 (Get_Name_String (Data.File_Names (J).Path),
1783 Preserve => Preserve);
1790 --------------------------
1791 -- Is_Same_Or_Extension --
1792 --------------------------
1794 function Is_Same_Or_Extension
1795 (Extending : Project_Id;
1796 Extended : Project_Id)
1799 Ext : Project_Id := Extending;
1802 while Ext /= No_Project loop
1803 if Ext = Extended then
1807 Ext := In_Tree.Projects.Table (Ext).Extends;
1811 end Is_Same_Or_Extension;
1813 -- Start of processing for Copy_Interface_Sources
1816 -- Change the working directory to the object directory
1820 (In_Tree.Projects.Table
1821 (For_Project).Object_Directory));
1823 for Index in Interfaces'Range loop
1825 -- First, load the ALI file
1828 Add_Str_To_Name_Buffer (Interfaces (Index).all);
1829 Lib_File := Name_Find;
1830 Text := Read_Library_Info (Lib_File);
1831 The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1834 Second_Unit := No_Unit_Id;
1835 First_Unit := ALI.ALIs.Table (The_ALI).First_Unit;
1836 Copy_Subunits := True;
1838 -- If there is both a spec and a body, check if they are both needed
1840 if ALI.Units.Table (First_Unit).Utype = Is_Body then
1841 Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit;
1843 -- If the body is not needed, then reset First_Unit
1845 if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then
1846 First_Unit := No_Unit_Id;
1847 Copy_Subunits := False;
1850 elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then
1851 Copy_Subunits := False;
1854 -- Copy the file(s) that need to be copied
1856 if First_Unit /= No_Unit_Id then
1857 Copy (File_Name => ALI.Units.Table (First_Unit).Sfile);
1860 if Second_Unit /= No_Unit_Id then
1861 Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile);
1864 -- Copy all the separates, if any
1866 if Copy_Subunits then
1867 for Dep in ALI.ALIs.Table (The_ALI).First_Sdep ..
1868 ALI.ALIs.Table (The_ALI).Last_Sdep
1870 if Sdep.Table (Dep).Subunit_Name /= No_Name then
1871 Copy (File_Name => Sdep.Table (Dep).Sfile);
1877 -- Restore the initial working directory
1879 Change_Dir (Current);
1880 end Copy_Interface_Sources;
1886 procedure Display (Executable : String) is
1888 if not Opt.Quiet_Output then
1889 Write_Str (Executable);
1891 for Index in 1 .. Argument_Number loop
1893 Write_Str (Arguments (Index).all);
1900 -------------------------
1901 -- Process_Binder_File --
1902 -------------------------
1904 procedure Process_Binder_File (Name : String) is
1906 -- Binder file's descriptor
1908 Read_Mode : constant String := "r
" & ASCII.Nul;
1911 Status : Interfaces.C_Streams.int;
1912 pragma Unreferenced (Status);
1915 Begin_Info : constant String := "-- BEGIN Object file/option list";
1916 End_Info
: constant String := "-- END Object file/option list ";
1918 Next_Line
: String (1 .. 1000);
1919 -- Current line value
1920 -- Where does this odd constant 1000 come from, looks suspicious ???
1923 -- End of line slice (the slice does not contain the line terminator)
1925 procedure Get_Next_Line
;
1926 -- Read the next line from the binder file without the line terminator
1932 procedure Get_Next_Line
is
1936 Fchars
:= fgets
(Next_Line
'Address, Next_Line
'Length, Fd
);
1938 if Fchars
= System
.Null_Address
then
1939 Fail
("Error reading binder output");
1943 while Nlast
<= Next_Line
'Last
1944 and then Next_Line
(Nlast
) /= ASCII
.LF
1945 and then Next_Line
(Nlast
) /= ASCII
.CR
1953 -- Start of processing for Process_Binder_File
1956 Fd
:= fopen
(Name
'Address, Read_Mode
'Address);
1958 if Fd
= NULL_Stream
then
1959 Fail
("Failed to open binder output");
1962 -- Skip up to the Begin Info line
1966 exit when Next_Line
(1 .. Nlast
) = Begin_Info
;
1969 -- Find the first switch
1974 exit when Next_Line
(1 .. Nlast
) = End_Info
;
1976 -- As the binder generated file is in Ada, remove the first eight
1977 -- characters " -- ".
1979 Next_Line
(1 .. Nlast
- 8) := Next_Line
(9 .. Nlast
);
1982 -- Stop when the first switch is found
1984 exit when Next_Line
(1) = '-';
1987 if Next_Line
(1 .. Nlast
) /= End_Info
then
1989 -- Ignore -static and -shared, since -shared will be used
1992 -- Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
1993 -- later, because they are also needed for non Stand-Alone shared
1996 -- Also ignore the shared libraries which are :
1998 -- UNIX / Windows VMS
1999 -- -lgnat-<version> -lgnat_<version> (7 + version'length chars)
2000 -- -lgnarl-<version> -lgnarl_<version> (8 + version'length chars)
2002 if Next_Line
(1 .. Nlast
) /= "-static" and then
2003 Next_Line
(1 .. Nlast
) /= "-shared" and then
2004 Next_Line
(1 .. Nlast
) /= "-ldecgnat" and then
2005 Next_Line
(1 .. Nlast
) /= "-lgnarl" and then
2006 Next_Line
(1 .. Nlast
) /= "-lgnat" and then
2008 (1 .. Natural'Min (Nlast
, 8 + Library_Version
'Length)) /=
2009 Shared_Lib
("gnarl") and then
2011 (1 .. Natural'Min (Nlast
, 7 + Library_Version
'Length)) /=
2014 if Next_Line
(1) /= '-' then
2016 -- This is not an option, should we add it?
2018 if Add_Object_Files
then
2019 Opts
.Increment_Last
;
2020 Opts
.Table
(Opts
.Last
) :=
2021 new String'(Next_Line (1 .. Nlast));
2025 -- Add all other options
2027 Opts.Increment_Last;
2028 Opts.Table (Opts.Last) :=
2029 new String'(Next_Line
(1 .. Nlast
));
2033 -- Next option, if any
2036 exit when Next_Line
(1 .. Nlast
) = End_Info
;
2038 -- Remove first eight characters " -- "
2040 Next_Line
(1 .. Nlast
- 8) := Next_Line
(9 .. Nlast
);
2045 Status
:= fclose
(Fd
);
2047 -- Is it really right to ignore any close error ???
2049 end Process_Binder_File
;
2055 procedure Reset_Tables
is
2058 Objects_Htable
.Reset
;
2062 Processed_Projects
.Reset
;
2066 ---------------------------
2067 -- SALs_Use_Constructors --
2068 ---------------------------
2070 function SALs_Use_Constructors
return Boolean is
2071 function C_SALs_Init_Using_Constructors
return Integer;
2072 pragma Import
(C
, C_SALs_Init_Using_Constructors
,
2073 "__gnat_sals_init_using_constructors");
2075 return C_SALs_Init_Using_Constructors
/= 0;
2076 end SALs_Use_Constructors
;