1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1999-2004, 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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;
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
48 procedure Build_Library
49 (Ofiles : Argument_List;
50 Afiles : Argument_List;
54 pragma Warnings (Off, Afiles);
59 if not Opt.Quiet_Output then
60 Write_Line ("building a library...");
62 Write_Line (Output_File);
65 Ar (Output_Dir & "/lib" & Output_File & ".a", Objects => Ofiles);
68 ------------------------
69 -- Check_Library_Name --
70 ------------------------
72 procedure Check_Library_Name (Name : String) is
74 if Name'Length = 0 then
75 Fail ("library name cannot be empty");
78 if Name'Length > Max_Characters_In_Library_Name then
79 Fail ("illegal library name """, Name, """: too long");
82 if not Is_Letter (Name (Name'First)) then
83 Fail ("illegal library name """,
85 """: should start with a letter");
88 for Index in Name'Range loop
89 if not Is_Alphanumeric (Name (Index)) then
90 Fail ("illegal library name """,
92 """: should include only letters and digits");
95 end Check_Library_Name;
101 procedure Copy_ALI_Files
102 (Files : Argument_List;
104 Interfaces : String_List)
106 Success : Boolean := False;
107 To_Dir : constant String := Get_Name_String (To);
108 Interface : Boolean := False;
110 procedure Set_Readonly (Name : System.Address);
111 pragma Import (C, Set_Readonly, "__gnat_set_readonly");
113 procedure Verbose_Copy (Index : Positive);
114 -- In verbose mode, output a message that the indexed file is copied
115 -- to the destination directory.
121 procedure Verbose_Copy (Index : Positive) is
123 if Opt.Verbose_Mode then
124 Write_Str ("Copying """);
125 Write_Str (Files (Index).all);
126 Write_Str (""" to """);
133 if Interfaces'Length = 0 then
135 -- If there are no Interfaces, copy all the ALI files as is
137 for Index in Files'Range loop
138 Verbose_Copy (Index);
144 Preserve => Preserve);
146 exit when not Success;
150 -- Copy only the interface ALI file, and put the special indicator
151 -- "SL" on the P line.
153 for Index in Files'Range loop
156 File_Name : String := Base_Name (Files (Index).all);
158 Canonical_Case_File_Name (File_Name);
160 -- Check if this is one of the interface ALIs
164 for Index in Interfaces'Range loop
165 if File_Name = Interfaces (Index).all then
171 -- If it is an interface ALI, copy line by line. Insert
172 -- the interface indication at the end of the P line.
173 -- Do not copy ALI files that are not Interfaces.
177 Verbose_Copy (Index);
180 FD : File_Descriptor;
182 Actual_Len : Integer;
185 P_Line_Found : Boolean;
191 Name_Len := Files (Index)'Length;
192 Name_Buffer (1 .. Name_Len) := Files (Index).all;
193 Name_Len := Name_Len + 1;
194 Name_Buffer (Name_Len) := ASCII.NUL;
196 FD := Open_Read (Name_Buffer'Address, Binary);
198 if FD /= Invalid_FD then
199 Len := Integer (File_Length (FD));
201 S := new String (1 .. Len + 3);
203 -- Read the file. Note that the loop is not necessary
204 -- since the whole file is read at once except on VMS.
209 while Actual_Len /= 0 loop
210 Actual_Len := Read (FD, S (Curr)'Address, Len);
211 Curr := Curr + Actual_Len;
214 -- We are done with the input file, so we close it
217 -- We simply ignore any bad status
219 P_Line_Found := False;
221 -- Look for the P line. When found, add marker SL
222 -- at the beginning of the P line.
224 for Index in 1 .. Len - 3 loop
225 if (S (Index) = ASCII.LF or else
226 S (Index) = ASCII.CR)
230 S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
231 S (Index + 2 .. Index + 4) := " SL";
232 P_Line_Found := True;
239 -- Create new modified ALI file
241 Name_Len := To_Dir'Length;
242 Name_Buffer (1 .. Name_Len) := To_Dir;
243 Name_Len := Name_Len + 1;
244 Name_Buffer (Name_Len) := Directory_Separator;
246 (Name_Len + 1 .. Name_Len + File_Name'Length) :=
248 Name_Len := Name_Len + File_Name'Length + 1;
249 Name_Buffer (Name_Len) := ASCII.NUL;
251 FD := Create_File (Name_Buffer'Address, Binary);
253 -- Write the modified text and close the newly
256 if FD /= Invalid_FD then
257 Actual_Len := Write (FD, S (1)'Address, Len + 3);
261 -- Set Success to True only if the newly
262 -- created file has been correctly written.
264 Success := Status and Actual_Len = Len + 3;
267 Set_Readonly (Name_Buffer'Address);
275 -- This is not an interface ALI
283 Fail ("could not copy ALI files to library dir");
289 --------------------------------
290 -- Linker_Library_Path_Option --
291 --------------------------------
293 function Linker_Library_Path_Option return String_Access is
295 Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
296 pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
297 -- Pointer to string representing the native linker option which
298 -- specifies the path where the dynamic loader should find shared
299 -- libraries. Equal to null string if this system doesn't support it.
301 S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
307 return new String'(S);
309 end Linker_Library_Path_Option;
311 -- Package elaboration
314 -- Copy_Attributes always fails on VMS
316 if Hostparm.OpenVMS then