1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
6 -- (Windows Version) --
10 -- Copyright (C) 2002-2004, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 -- This package provides a set of target dependent routines to build
29 -- static, dynamic and shared libraries.
31 -- This is the Windows version of the body. Works only with GCC versions
32 -- supporting the "-shared" option.
34 with Namet; use Namet;
36 with Output; use Output;
39 with GNAT.OS_Lib; use GNAT.OS_Lib;
44 package body MLib.Tgt is
46 package Files renames MLib.Fil;
47 package Tools renames MLib.Utl;
53 function Archive_Builder return String is
58 -----------------------------
59 -- Archive_Builder_Options --
60 -----------------------------
62 function Archive_Builder_Options return String_List_Access is
64 return new String_List'(1 => new String'("cr"));
65 end Archive_Builder_Options;
71 function Archive_Ext return String is
80 function Archive_Indexer return String is
85 ---------------------------
86 -- Build_Dynamic_Library --
87 ---------------------------
89 procedure Build_Dynamic_Library
90 (Ofiles : Argument_List;
91 Foreign : Argument_List;
92 Afiles : Argument_List;
93 Options : Argument_List;
94 Interfaces : Argument_List;
95 Lib_Filename : String;
97 Symbol_Data : Symbol_Record;
98 Driver_Name : Name_Id := No_Name;
99 Lib_Address : String := "";
100 Lib_Version : String := "";
101 Relocatable : Boolean := False;
102 Auto_Init : Boolean := False)
104 pragma Unreferenced (Foreign);
105 pragma Unreferenced (Afiles);
106 pragma Unreferenced (Auto_Init);
107 pragma Unreferenced (Symbol_Data);
108 pragma Unreferenced (Interfaces);
109 pragma Unreferenced (Lib_Version);
111 Strip_Name : constant String := "strip";
112 Strip_Exec : String_Access;
114 procedure Strip_Reloc (Lib_File : String);
115 -- Strip .reloc section to build a non relocatable DLL
121 procedure Strip_Reloc (Lib_File : String) is
122 Arguments : Argument_List (1 .. 3);
124 Line_Length : Natural;
127 -- Look for strip executable
129 Strip_Exec := Locate_Exec_On_Path (Strip_Name);
131 if Strip_Exec = null then
132 Fail (Strip_Name, " not found in path");
134 elsif Opt.Verbose_Mode then
135 Write_Str ("found ");
136 Write_Line (Strip_Exec.all);
139 -- Call it: strip -R .reloc <dll>
141 Arguments (1) := new String'("-R");
142 Arguments (2) := new String'(".reloc");
143 Arguments (3) := new String'(Lib_File);
145 if not Opt.Quiet_Output then
146 Write_Str (Strip_Exec.all);
147 Line_Length := Strip_Exec'Length;
149 for K in Arguments'Range loop
151 -- Make sure the Output buffer does not overflow
153 if Line_Length + 1 + Arguments (K)'Length >
154 Integer (Opt.Max_Line_Length)
161 Write_Str (Arguments (K).all);
162 Line_Length := Line_Length + 1 + Arguments (K)'Length;
168 Spawn (Strip_Exec.all, Arguments, Success);
171 Fail (Strip_Name, " execution error.");
174 for K in Arguments'Range loop
175 Free (Arguments (K));
179 Lib_File : constant String :=
180 Lib_Dir & Directory_Separator & "lib" &
181 Files.Ext_To (Lib_Filename, DLL_Ext);
183 I_Base : aliased String := "-Wl,--image-base," & Lib_Address;
185 Options_2 : Argument_List (1 .. 1);
186 O_Index : Natural := 0;
188 -- Start of processing for Build_Dynamic_Library
191 if Opt.Verbose_Mode then
192 Write_Str ("building ");
194 if not Relocatable then
198 Write_Str ("relocatable shared library ");
199 Write_Line (Lib_File);
202 if not Relocatable then
203 O_Index := O_Index + 1;
204 Options_2 (O_Index) := I_Base'Unchecked_Access;
208 (Output_File => Lib_File,
211 Driver_Name => Driver_Name,
212 Options_2 => Options_2 (1 .. O_Index));
214 if not Relocatable then
216 -- Strip reloc symbols from the DLL
218 Strip_Reloc (Lib_File);
220 end Build_Dynamic_Library;
222 -------------------------
223 -- Default_DLL_Address --
224 -------------------------
226 function Default_DLL_Address return String is
229 end Default_DLL_Address;
235 function DLL_Ext return String is
244 function Dynamic_Option return String is
253 function Is_Object_Ext (Ext : String) return Boolean is
262 function Is_C_Ext (Ext : String) return Boolean is
271 function Is_Archive_Ext (Ext : String) return Boolean is
273 return Ext = ".a" or else Ext = ".dll";
280 function Libgnat return String is
285 ------------------------
286 -- Library_Exists_For --
287 ------------------------
289 function Library_Exists_For (Project : Project_Id) return Boolean is
291 if not Projects.Table (Project).Library then
292 Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
293 "for non library project");
298 Lib_Dir : constant String :=
300 (Projects.Table (Project).Library_Dir);
301 Lib_Name : constant String :=
303 (Projects.Table (Project).Library_Name);
306 if Projects.Table (Project).Library_Kind = Static then
307 return Is_Regular_File
308 (Lib_Dir & Directory_Separator & "lib" &
309 MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
312 return Is_Regular_File
313 (Lib_Dir & Directory_Separator & "lib" &
314 MLib.Fil.Ext_To (Lib_Name, DLL_Ext));
318 end Library_Exists_For;
320 ---------------------------
321 -- Library_File_Name_For --
322 ---------------------------
324 function Library_File_Name_For (Project : Project_Id) return Name_Id is
326 if not Projects.Table (Project).Library then
327 Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
328 "for non library project");
333 Lib_Name : constant String :=
334 Get_Name_String (Projects.Table (Project).Library_Name);
338 Name_Buffer (1 .. Name_Len) := "lib";
340 if Projects.Table (Project).Library_Kind = Static then
341 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
344 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
350 end Library_File_Name_For;
356 function Object_Ext return String is
365 function PIC_Option return String is
370 -----------------------------------------------
371 -- Standalone_Library_Auto_Init_Is_Supported --
372 -----------------------------------------------
374 function Standalone_Library_Auto_Init_Is_Supported return Boolean is
377 end Standalone_Library_Auto_Init_Is_Supported;
379 ---------------------------
380 -- Support_For_Libraries --
381 ---------------------------
383 function Support_For_Libraries return Library_Support is
386 end Support_For_Libraries;