2005-12-29 Paul Brook <paul@codesourcery.com>
[official-gcc.git] / gcc / ada / mlib-tgt-darwin.adb
blob651f9838d39761cb7d9d3a5eef2e7005dadc44ae
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- M L I B . T G T --
6 -- (Darwin Version) --
7 -- --
8 -- B o d y --
9 -- --
10 -- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
11 -- --
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, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
22 -- --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 -- --
26 ------------------------------------------------------------------------------
28 -- This package provides a set of target dependent routines to build
29 -- static, dynamic and shared libraries.
31 -- This is the Darwin version of the body
33 with MLib.Fil;
34 with MLib.Utl;
35 with Namet; use Namet;
36 with Opt;
37 with Output; use Output;
38 with Prj.Com;
39 with System;
41 package body MLib.Tgt is
43 use GNAT;
44 use MLib;
46 ---------------------
47 -- Archive_Builder --
48 ---------------------
50 function Archive_Builder return String is
51 begin
52 return "ar";
53 end Archive_Builder;
55 -----------------------------
56 -- Archive_Builder_Options --
57 -----------------------------
59 function Archive_Builder_Options return String_List_Access is
60 begin
61 return new String_List'(1 => new String'("cr"));
62 end Archive_Builder_Options;
64 -----------------
65 -- Archive_Ext --
66 -----------------
68 function Archive_Ext return String is
69 begin
70 return "a";
71 end Archive_Ext;
73 ---------------------
74 -- Archive_Indexer --
75 ---------------------
77 function Archive_Indexer return String is
78 begin
79 return "ranlib";
80 end Archive_Indexer;
82 -----------------------------
83 -- Archive_Indexer_Options --
84 -----------------------------
86 function Archive_Indexer_Options return String_List_Access is
87 begin
88 return new String_List'(1 => new String'("-c"));
89 end Archive_Indexer_Options;
91 ---------------------------
92 -- Build_Dynamic_Library --
93 ---------------------------
95 procedure Build_Dynamic_Library
96 (Ofiles : Argument_List;
97 Foreign : Argument_List;
98 Afiles : Argument_List;
99 Options : Argument_List;
100 Options_2 : Argument_List;
101 Interfaces : Argument_List;
102 Lib_Filename : String;
103 Lib_Dir : String;
104 Symbol_Data : Symbol_Record;
105 Driver_Name : Name_Id := No_Name;
106 Lib_Version : String := "";
107 Auto_Init : Boolean := False)
109 pragma Unreferenced (Foreign);
110 pragma Unreferenced (Afiles);
111 pragma Unreferenced (Interfaces);
112 pragma Unreferenced (Symbol_Data);
113 pragma Unreferenced (Auto_Init);
115 Lib_File : constant String :=
116 Lib_Dir & Directory_Separator & "lib" &
117 Fil.Ext_To (Lib_Filename, DLL_Ext);
119 Version_Arg : String_Access;
120 Symbolic_Link_Needed : Boolean := False;
122 begin
123 if Opt.Verbose_Mode then
124 Write_Str ("building relocatable shared library ");
125 Write_Line (Lib_File);
126 end if;
128 -- If specified, add automatic elaboration/finalization
130 if Lib_Version = "" then
131 Utl.Gcc
132 (Output_File => Lib_File,
133 Objects => Ofiles,
134 Options => Options,
135 Driver_Name => Driver_Name,
136 Options_2 => Options_2);
138 else
139 -- Instruct the linker to build the shared library as a flat
140 -- namespace image, which is not the default. The default is a two
141 -- level namespace image.
143 Version_Arg := new String'("-Wl,-flat_namespace");
145 if Is_Absolute_Path (Lib_Version) then
146 Utl.Gcc
147 (Output_File => Lib_Version,
148 Objects => Ofiles,
149 Options => Options & Version_Arg,
150 Driver_Name => Driver_Name,
151 Options_2 => Options_2);
152 Symbolic_Link_Needed := Lib_Version /= Lib_File;
154 else
155 Utl.Gcc
156 (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
157 Objects => Ofiles,
158 Options => Options & Version_Arg,
159 Driver_Name => Driver_Name,
160 Options_2 => Options_2);
161 Symbolic_Link_Needed :=
162 Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
163 end if;
165 if Symbolic_Link_Needed then
166 declare
167 Success : Boolean;
168 Oldpath : String (1 .. Lib_Version'Length + 1);
169 Newpath : String (1 .. Lib_File'Length + 1);
171 Result : Integer;
172 pragma Unreferenced (Result);
174 function Symlink
175 (Oldpath : System.Address;
176 Newpath : System.Address) return Integer;
177 pragma Import (C, Symlink, "__gnat_symlink");
179 begin
180 Oldpath (1 .. Lib_Version'Length) := Lib_Version;
181 Oldpath (Oldpath'Last) := ASCII.NUL;
182 Newpath (1 .. Lib_File'Length) := Lib_File;
183 Newpath (Newpath'Last) := ASCII.NUL;
185 Delete_File (Lib_File, Success);
187 Result := Symlink (Oldpath'Address, Newpath'Address);
188 end;
189 end if;
190 end if;
191 end Build_Dynamic_Library;
193 -------------
194 -- DLL_Ext --
195 -------------
197 function DLL_Ext return String is
198 begin
199 return "dylib";
200 end DLL_Ext;
202 ----------------
203 -- DLL_Prefix --
204 ----------------
206 function DLL_Prefix return String is
207 begin
208 return "lib";
209 end DLL_Prefix;
211 --------------------
212 -- Dynamic_Option --
213 --------------------
215 function Dynamic_Option return String is
216 begin
217 return "-dynamiclib";
218 end Dynamic_Option;
220 -------------------
221 -- Is_Object_Ext --
222 -------------------
224 function Is_Object_Ext (Ext : String) return Boolean is
225 begin
226 return Ext = ".o";
227 end Is_Object_Ext;
229 --------------
230 -- Is_C_Ext --
231 --------------
233 function Is_C_Ext (Ext : String) return Boolean is
234 begin
235 return Ext = ".c";
236 end Is_C_Ext;
238 --------------------
239 -- Is_Archive_Ext --
240 --------------------
242 function Is_Archive_Ext (Ext : String) return Boolean is
243 begin
244 return Ext = ".dylib" or else Ext = ".a";
245 end Is_Archive_Ext;
247 -------------
248 -- Libgnat --
249 -------------
251 function Libgnat return String is
252 begin
253 return "libgnat.a";
254 end Libgnat;
256 ------------------------
257 -- Library_Exists_For --
258 ------------------------
260 function Library_Exists_For
261 (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
263 begin
264 if not In_Tree.Projects.Table (Project).Library then
265 Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
266 "for non library project");
267 return False;
269 else
270 declare
271 Lib_Dir : constant String :=
272 Get_Name_String
273 (In_Tree.Projects.Table (Project).Library_Dir);
274 Lib_Name : constant String :=
275 Get_Name_String
276 (In_Tree.Projects.Table (Project).Library_Name);
278 begin
279 if In_Tree.Projects.Table (Project).Library_Kind =
280 Static
281 then
282 return Is_Regular_File
283 (Lib_Dir & Directory_Separator & "lib" &
284 Fil.Ext_To (Lib_Name, Archive_Ext));
286 else
287 return Is_Regular_File
288 (Lib_Dir & Directory_Separator & "lib" &
289 Fil.Ext_To (Lib_Name, DLL_Ext));
290 end if;
291 end;
292 end if;
293 end Library_Exists_For;
295 ---------------------------
296 -- Library_File_Name_For --
297 ---------------------------
299 function Library_File_Name_For
300 (Project : Project_Id;
301 In_Tree : Project_Tree_Ref) return Name_Id
303 begin
304 if not In_Tree.Projects.Table (Project).Library then
305 Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
306 "for non library project");
307 return No_Name;
309 else
310 declare
311 Lib_Name : constant String :=
312 Get_Name_String
313 (In_Tree.Projects.Table (Project).Library_Name);
315 begin
316 Name_Len := 3;
317 Name_Buffer (1 .. Name_Len) := "lib";
319 if In_Tree.Projects.Table (Project).Library_Kind =
320 Static then
321 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
323 else
324 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
325 end if;
327 return Name_Find;
328 end;
329 end if;
330 end Library_File_Name_For;
332 ----------------
333 -- Object_Ext --
334 ----------------
336 function Object_Ext return String is
337 begin
338 return "o";
339 end Object_Ext;
341 ----------------
342 -- PIC_Option --
343 ----------------
345 function PIC_Option return String is
346 begin
347 return "-fPIC";
348 end PIC_Option;
350 -----------------------------------------------
351 -- Standalone_Library_Auto_Init_Is_Supported --
352 -----------------------------------------------
354 function Standalone_Library_Auto_Init_Is_Supported return Boolean is
355 begin
356 return True;
357 end Standalone_Library_Auto_Init_Is_Supported;
359 ---------------------------
360 -- Support_For_Libraries --
361 ---------------------------
363 function Support_For_Libraries return Library_Support is
364 begin
365 return Full;
366 end Support_For_Libraries;
368 end MLib.Tgt;