1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1999-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 ------------------------------------------------------------------------------
27 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
28 with Interfaces
.C
.Strings
;
32 with Output
; use Output
;
33 with Namet
; use Namet
;
35 with MLib
.Utl
; use MLib
.Utl
;
37 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
45 procedure Build_Library
46 (Ofiles
: Argument_List
;
47 Afiles
: Argument_List
;
51 pragma Warnings
(Off
, Afiles
);
54 if not Opt
.Quiet_Output
then
55 Write_Line
("building a library...");
57 Write_Line
(Output_File
);
60 Ar
(Output_Dir
& "/lib" & Output_File
& ".a", Objects
=> Ofiles
);
63 ------------------------
64 -- Check_Library_Name --
65 ------------------------
67 procedure Check_Library_Name
(Name
: String) is
69 if Name
'Length = 0 then
70 Fail
("library name cannot be empty");
73 if Name
'Length > Max_Characters_In_Library_Name
then
74 Fail
("illegal library name """, Name
, """: too long");
77 if not Is_Letter
(Name
(Name
'First)) then
78 Fail
("illegal library name """,
80 """: should start with a letter");
83 for Index
in Name
'Range loop
84 if not Is_Alphanumeric
(Name
(Index
)) then
85 Fail
("illegal library name """,
87 """: should include only letters and digits");
90 end Check_Library_Name
;
96 procedure Copy_ALI_Files
97 (Files
: Argument_List
;
99 Interfaces
: String_List
)
101 Success
: Boolean := False;
102 To_Dir
: constant String := Get_Name_String
(To
);
103 Is_Interface
: Boolean := False;
105 procedure Verbose_Copy
(Index
: Positive);
106 -- In verbose mode, output a message that the indexed file is copied
107 -- to the destination directory.
113 procedure Verbose_Copy
(Index
: Positive) is
115 if Opt
.Verbose_Mode
then
116 Write_Str
("Copying """);
117 Write_Str
(Files
(Index
).all);
118 Write_Str
(""" to """);
125 if Interfaces
'Length = 0 then
127 -- If there are no Interfaces, copy all the ALI files as is
129 for Index
in Files
'Range loop
130 Verbose_Copy
(Index
);
136 Preserve
=> Preserve
);
138 exit when not Success
;
142 -- Copy only the interface ALI file, and put the special indicator
143 -- "SL" on the P line.
145 for Index
in Files
'Range loop
148 File_Name
: String := Base_Name
(Files
(Index
).all);
150 Canonical_Case_File_Name
(File_Name
);
152 -- Check if this is one of the interface ALIs
154 Is_Interface
:= False;
156 for Index
in Interfaces
'Range loop
157 if File_Name
= Interfaces
(Index
).all then
158 Is_Interface
:= True;
163 -- If it is an interface ALI, copy line by line. Insert
164 -- the interface indication at the end of the P line.
165 -- Do not copy ALI files that are not Interfaces.
169 Verbose_Copy
(Index
);
172 FD
: File_Descriptor
;
174 Actual_Len
: Integer;
177 P_Line_Found
: Boolean;
183 Name_Len
:= Files
(Index
)'Length;
184 Name_Buffer
(1 .. Name_Len
) := Files
(Index
).all;
185 Name_Len
:= Name_Len
+ 1;
186 Name_Buffer
(Name_Len
) := ASCII
.NUL
;
188 FD
:= Open_Read
(Name_Buffer
'Address, Binary
);
190 if FD
/= Invalid_FD
then
191 Len
:= Integer (File_Length
(FD
));
193 S
:= new String (1 .. Len
+ 3);
195 -- Read the file. Note that the loop is not necessary
196 -- since the whole file is read at once except on VMS.
201 while Actual_Len
/= 0 loop
202 Actual_Len
:= Read
(FD
, S
(Curr
)'Address, Len
);
203 Curr
:= Curr
+ Actual_Len
;
206 -- We are done with the input file, so we close it
209 -- We simply ignore any bad status
211 P_Line_Found
:= False;
213 -- Look for the P line. When found, add marker SL
214 -- at the beginning of the P line.
216 for Index
in 1 .. Len
- 3 loop
217 if (S
(Index
) = ASCII
.LF
or else
218 S
(Index
) = ASCII
.CR
)
222 S
(Index
+ 5 .. Len
+ 3) := S
(Index
+ 2 .. Len
);
223 S
(Index
+ 2 .. Index
+ 4) := " SL";
224 P_Line_Found
:= True;
231 -- Create new modified ALI file
233 Name_Len
:= To_Dir
'Length;
234 Name_Buffer
(1 .. Name_Len
) := To_Dir
;
235 Name_Len
:= Name_Len
+ 1;
236 Name_Buffer
(Name_Len
) := Directory_Separator
;
238 (Name_Len
+ 1 .. Name_Len
+ File_Name
'Length) :=
240 Name_Len
:= Name_Len
+ File_Name
'Length + 1;
241 Name_Buffer
(Name_Len
) := ASCII
.NUL
;
243 FD
:= Create_File
(Name_Buffer
'Address, Binary
);
245 -- Write the modified text and close the newly
248 if FD
/= Invalid_FD
then
249 Actual_Len
:= Write
(FD
, S
(1)'Address, Len
+ 3);
253 -- Set Success to True only if the newly
254 -- created file has been correctly written.
256 Success
:= Status
and Actual_Len
= Len
+ 3;
260 Name_Buffer
(1 .. Name_Len
- 1));
268 -- This is not an interface ALI
276 Fail
("could not copy ALI files to library dir");
282 --------------------------------
283 -- Linker_Library_Path_Option --
284 --------------------------------
286 function Linker_Library_Path_Option
return String_Access
is
288 Run_Path_Option_Ptr
: Interfaces
.C
.Strings
.chars_ptr
;
289 pragma Import
(C
, Run_Path_Option_Ptr
, "__gnat_run_path_option");
290 -- Pointer to string representing the native linker option which
291 -- specifies the path where the dynamic loader should find shared
292 -- libraries. Equal to null string if this system doesn't support it.
294 S
: constant String := Interfaces
.C
.Strings
.Value
(Run_Path_Option_Ptr
);
300 return new String'(S);
302 end Linker_Library_Path_Option;
304 -- Package elaboration
307 -- Copy_Attributes always fails on VMS
309 if Hostparm.OpenVMS then