OSDN Git Service

PR fortran/23516
[pf3gnuchains/gcc-fork.git] / gcc / ada / mlib-tgt-darwin.adb
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 ------------------------------------------------------------------------------
27
28 --  This package provides a set of target dependent routines to build
29 --  static, dynamic and shared libraries.
30
31 --  This is the Darwin version of the body.
32
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;
40
41 package body MLib.Tgt is
42
43    use GNAT;
44    use MLib;
45
46    ---------------------
47    -- Archive_Builder --
48    ---------------------
49
50    function Archive_Builder return String is
51    begin
52       return "ar";
53    end Archive_Builder;
54
55    -----------------------------
56    -- Archive_Builder_Options --
57    -----------------------------
58
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;
63
64    -----------------
65    -- Archive_Ext --
66    -----------------
67
68    function Archive_Ext return  String is
69    begin
70       return "a";
71    end Archive_Ext;
72
73    ---------------------
74    -- Archive_Indexer --
75    ---------------------
76
77    function Archive_Indexer return String is
78    begin
79       return "ranlib";
80    end Archive_Indexer;
81
82    -----------------------------
83    -- Archive_Indexer_Options --
84    -----------------------------
85
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;
90
91    ---------------------------
92    -- Build_Dynamic_Library --
93    ---------------------------
94
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)
108    is
109       pragma Unreferenced (Foreign);
110       pragma Unreferenced (Afiles);
111       pragma Unreferenced (Interfaces);
112       pragma Unreferenced (Symbol_Data);
113       pragma Unreferenced (Auto_Init);
114
115       Lib_File : constant String :=
116                    Lib_Dir & Directory_Separator & "lib" &
117                    Fil.Ext_To (Lib_Filename, DLL_Ext);
118
119       Version_Arg          : String_Access;
120       Symbolic_Link_Needed : Boolean := False;
121
122    begin
123       if Opt.Verbose_Mode then
124          Write_Str ("building relocatable shared library ");
125          Write_Line (Lib_File);
126       end if;
127
128       --  If specified, add automatic elaboration/finalization
129
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);
137
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.
142
143          Version_Arg := new String'("-Wl,-flat_namespace");
144
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;
153
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;
164
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);
170
171                Result : Integer;
172                pragma Unreferenced (Result);
173
174                function Symlink
175                  (Oldpath : System.Address;
176                   Newpath : System.Address) return Integer;
177                pragma Import (C, Symlink, "__gnat_symlink");
178
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;
184
185                Delete_File (Lib_File, Success);
186
187                Result := Symlink (Oldpath'Address, Newpath'Address);
188             end;
189          end if;
190       end if;
191    end Build_Dynamic_Library;
192
193    -------------
194    -- DLL_Ext --
195    -------------
196
197    function DLL_Ext return String is
198    begin
199       return "dylib";
200    end DLL_Ext;
201
202    --------------------
203    -- Dynamic_Option --
204    --------------------
205
206    function Dynamic_Option return String is
207    begin
208       return "-dynamiclib";
209    end Dynamic_Option;
210
211    -------------------
212    -- Is_Object_Ext --
213    -------------------
214
215    function Is_Object_Ext (Ext : String) return Boolean is
216    begin
217       return Ext = ".o";
218    end Is_Object_Ext;
219
220    --------------
221    -- Is_C_Ext --
222    --------------
223
224    function Is_C_Ext (Ext : String) return Boolean is
225    begin
226       return Ext = ".c";
227    end Is_C_Ext;
228
229    --------------------
230    -- Is_Archive_Ext --
231    --------------------
232
233    function Is_Archive_Ext (Ext : String) return Boolean is
234    begin
235       return Ext = ".dylib" or else Ext = ".a";
236    end Is_Archive_Ext;
237
238    -------------
239    -- Libgnat --
240    -------------
241
242    function Libgnat return String is
243    begin
244       return "libgnat.a";
245    end Libgnat;
246
247    ------------------------
248    -- Library_Exists_For --
249    ------------------------
250
251    function Library_Exists_For
252      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
253    is
254    begin
255       if not In_Tree.Projects.Table (Project).Library then
256          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
257                        "for non library project");
258          return False;
259
260       else
261          declare
262             Lib_Dir : constant String :=
263               Get_Name_String
264                 (In_Tree.Projects.Table (Project).Library_Dir);
265             Lib_Name : constant String :=
266               Get_Name_String
267                 (In_Tree.Projects.Table (Project).Library_Name);
268
269          begin
270             if In_Tree.Projects.Table (Project).Library_Kind =
271               Static
272             then
273                return Is_Regular_File
274                  (Lib_Dir & Directory_Separator & "lib" &
275                   Fil.Ext_To (Lib_Name, Archive_Ext));
276
277             else
278                return Is_Regular_File
279                  (Lib_Dir & Directory_Separator & "lib" &
280                   Fil.Ext_To (Lib_Name, DLL_Ext));
281             end if;
282          end;
283       end if;
284    end Library_Exists_For;
285
286    ---------------------------
287    -- Library_File_Name_For --
288    ---------------------------
289
290    function Library_File_Name_For
291      (Project : Project_Id;
292       In_Tree : Project_Tree_Ref) return Name_Id
293    is
294    begin
295       if not In_Tree.Projects.Table (Project).Library then
296          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
297                        "for non library project");
298          return No_Name;
299
300       else
301          declare
302             Lib_Name : constant String :=
303               Get_Name_String
304                 (In_Tree.Projects.Table (Project).Library_Name);
305
306          begin
307             Name_Len := 3;
308             Name_Buffer (1 .. Name_Len) := "lib";
309
310             if In_Tree.Projects.Table (Project).Library_Kind =
311               Static then
312                Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
313
314             else
315                Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
316             end if;
317
318             return Name_Find;
319          end;
320       end if;
321    end Library_File_Name_For;
322
323    ----------------
324    -- Object_Ext --
325    ----------------
326
327    function Object_Ext return String is
328    begin
329       return "o";
330    end Object_Ext;
331
332    ----------------
333    -- PIC_Option --
334    ----------------
335
336    function PIC_Option return String is
337    begin
338       return "-fPIC";
339    end PIC_Option;
340
341    -----------------------------------------------
342    -- Standalone_Library_Auto_Init_Is_Supported --
343    -----------------------------------------------
344
345    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
346    begin
347       return True;
348    end Standalone_Library_Auto_Init_Is_Supported;
349
350    ---------------------------
351    -- Support_For_Libraries --
352    ---------------------------
353
354    function Support_For_Libraries return Library_Support is
355    begin
356       return Full;
357    end Support_For_Libraries;
358
359 end MLib.Tgt;