OSDN Git Service

* basic-block.h, bb-reorder.c, c-gimplify.c, config/darwin.c,
[pf3gnuchains/gcc-fork.git] / gcc / ada / mlib-tgt-aix.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                             M L I B . T G T                              --
6 --                              (AIX Version)                               --
7 --                                                                          --
8 --                                 B o d y                                  --
9 --                                                                          --
10 --           Copyright (C) 2003-2005, Ada Core Technologies, 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,  59 Temple Place - Suite 330,  Boston, --
21 -- MA 02111-1307, 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 or relocatable libraries.
30
31 --  This is the AIX version of the body.
32
33 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
34 with GNAT.OS_Lib;       use GNAT.OS_Lib;
35
36 with MLib.Fil;
37 with MLib.Utl;
38 with Namet;    use Namet;
39 with Osint;    use Osint;
40 with Opt;
41 with Output;   use Output;
42 with Prj.Com;
43 with Prj.Util; use Prj.Util;
44
45 package body MLib.Tgt is
46
47    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
48    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
49
50    Wl_Initfini_String  : constant String := "-Wl,-binitfini:";
51
52    Init_Fini_List      :  constant Argument_List_Access :=
53                             new Argument_List'(1 => null);
54    --  Used to put switch for automatic elaboration/finalization
55
56    Bexpall : aliased String := "-Wl,-bexpall";
57    Bexpall_Option : constant String_Access := Bexpall'Access;
58    --  The switch to export all symbols
59
60    Lpthreads : aliased String := "-lpthreads";
61    Native_Thread_Options : aliased Argument_List := (1 => Lpthreads'Access);
62    --  The switch to use when linking a library against libgnarl when using
63    --  Native threads.
64
65    Lgthreads : aliased String := "-lgthreads";
66    Lmalloc   : aliased String := "-lmalloc";
67    FSU_Thread_Options : aliased Argument_List :=
68                           (1 => Lgthreads'Access, 2 => Lmalloc'Access);
69    --  The switches to use when linking a library against libgnarl when using
70    --  FSU threads.
71
72    Thread_Options : Argument_List_Access := Empty_Argument_List;
73    --  Designate the thread switches to used when linking a library against
74    --  libgnarl. Depends on the thread library (Native or FSU). Resolved for
75    --  the first library linked against libgnarl.
76
77    ---------------------
78    -- Archive_Builder --
79    ---------------------
80
81    function Archive_Builder return String is
82    begin
83       return "ar";
84    end Archive_Builder;
85
86    -----------------------------
87    -- Archive_Builder_Options --
88    -----------------------------
89
90    function Archive_Builder_Options return String_List_Access is
91    begin
92       return new String_List'(1 => new String'("cr"));
93    end Archive_Builder_Options;
94
95    -----------------
96    -- Archive_Ext --
97    -----------------
98
99    function Archive_Ext return String is
100    begin
101       return "a";
102    end Archive_Ext;
103
104    ---------------------
105    -- Archive_Indexer --
106    ---------------------
107
108    function Archive_Indexer return String is
109    begin
110       return "ranlib";
111    end Archive_Indexer;
112
113    -----------------------------
114    -- Archive_Indexer_Options --
115    -----------------------------
116
117    function Archive_Indexer_Options return String_List_Access is
118    begin
119       return new String_List (1 .. 0);
120    end Archive_Indexer_Options;
121
122    ---------------------------
123    -- Build_Dynamic_Library --
124    ---------------------------
125
126    procedure Build_Dynamic_Library
127      (Ofiles       : Argument_List;
128       Foreign      : Argument_List;
129       Afiles       : Argument_List;
130       Options      : Argument_List;
131       Options_2    : Argument_List;
132       Interfaces   : Argument_List;
133       Lib_Filename : String;
134       Lib_Dir      : String;
135       Symbol_Data  : Symbol_Record;
136       Driver_Name  : Name_Id := No_Name;
137       Lib_Version  : String  := "";
138       Auto_Init    : Boolean := False)
139    is
140       pragma Unreferenced (Foreign);
141       pragma Unreferenced (Afiles);
142       pragma Unreferenced (Interfaces);
143       pragma Unreferenced (Symbol_Data);
144       pragma Unreferenced (Lib_Version);
145
146       Lib_File : constant String :=
147                    Lib_Dir & Directory_Separator & "lib" &
148                    MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
149       --  The file name of the library
150
151       Init_Fini : Argument_List_Access := Empty_Argument_List;
152       --  The switch for automatic initialization of Stand-Alone Libraries.
153       --  Changed to a real switch when Auto_Init is True.
154
155       Thread_Opts : Argument_List_Access := Empty_Argument_List;
156       --  Set to Thread_Options if -lgnarl is found in the Options
157
158    begin
159       if Opt.Verbose_Mode then
160          Write_Str ("building relocatable shared library ");
161          Write_Line (Lib_File);
162       end if;
163
164       --  If specified, add automatic elaboration/finalization
165
166       if Auto_Init then
167          Init_Fini := Init_Fini_List;
168          Init_Fini (1) :=
169            new String'(Wl_Initfini_String & Lib_Filename & "init:" &
170                        Lib_Filename & "final");
171       end if;
172
173       --  Look for -lgnarl in Options. If found, set the thread options.
174
175       for J in Options'Range loop
176          if Options (J).all = "-lgnarl" then
177
178             --  If Thread_Options is null, read s-osinte.ads to discover the
179             --  thread library and set Thread_Options accordingly.
180
181             if Thread_Options = null then
182                declare
183                   File : Text_File;
184                   Line : String (1 .. 100);
185                   Last : Natural;
186
187                begin
188                   Open
189                     (File, Include_Dir_Default_Prefix & "/s-osinte.ads");
190
191                   while not End_Of_File (File) loop
192                      Get_Line (File, Line, Last);
193
194                      if Index (Line (1 .. Last), "-lpthreads") /= 0 then
195                         Thread_Options := Native_Thread_Options'Access;
196                         exit;
197
198                      elsif Index (Line (1 .. Last), "-lgthreads") /= 0 then
199                         Thread_Options := FSU_Thread_Options'Access;
200                         exit;
201                      end if;
202                   end loop;
203
204                   Close (File);
205
206                   if Thread_Options = null then
207                      Prj.Com.Fail ("cannot find the thread library in use");
208                   end if;
209
210                exception
211                   when others =>
212                      Prj.Com.Fail ("cannot open s-osinte.ads");
213                end;
214             end if;
215
216             Thread_Opts := Thread_Options;
217             exit;
218          end if;
219       end loop;
220
221       --  Finally, call GCC (or the driver specified) to build the library
222
223       MLib.Utl.Gcc
224         (Output_File => Lib_File,
225          Objects     => Ofiles,
226          Options     => Options & Bexpall_Option & Init_Fini.all,
227          Driver_Name => Driver_Name,
228          Options_2   => Options_2 & Thread_Opts.all);
229    end Build_Dynamic_Library;
230
231    -------------
232    -- DLL_Ext --
233    -------------
234
235    function DLL_Ext return String is
236    begin
237       return "a";
238    end DLL_Ext;
239
240    --------------------
241    -- Dynamic_Option --
242    --------------------
243
244    function Dynamic_Option return String is
245    begin
246       return "-shared";
247    end Dynamic_Option;
248
249    -------------------
250    -- Is_Object_Ext --
251    -------------------
252
253    function Is_Object_Ext (Ext : String) return Boolean is
254    begin
255       return Ext = ".o";
256    end Is_Object_Ext;
257
258    --------------
259    -- Is_C_Ext --
260    --------------
261
262    function Is_C_Ext (Ext : String) return Boolean is
263    begin
264       return Ext = ".c";
265    end Is_C_Ext;
266
267    --------------------
268    -- Is_Archive_Ext --
269    --------------------
270
271    function Is_Archive_Ext (Ext : String) return Boolean is
272    begin
273       return Ext = ".a";
274    end Is_Archive_Ext;
275
276    -------------
277    -- Libgnat --
278    -------------
279
280    function Libgnat return String is
281    begin
282       return "libgnat.a";
283    end Libgnat;
284
285    ------------------------
286    -- Library_Exists_For --
287    ------------------------
288
289    function Library_Exists_For
290      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
291    is
292    begin
293       if not In_Tree.Projects.Table (Project).Library then
294          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
295                        "for non library project");
296          return False;
297
298       else
299          declare
300             Lib_Dir  : constant String :=
301               Get_Name_String
302                 (In_Tree.Projects.Table (Project).Library_Dir);
303
304             Lib_Name : constant String :=
305               Get_Name_String
306                 (In_Tree.Projects.Table (Project).Library_Name);
307
308          begin
309             if In_Tree.Projects.Table (Project).Library_Kind =
310               Static
311             then
312                return Is_Regular_File
313                  (Lib_Dir & Directory_Separator & "lib" &
314                   Fil.Ext_To (Lib_Name, Archive_Ext));
315
316             else
317                return Is_Regular_File
318                  (Lib_Dir & Directory_Separator & "lib" &
319                   Fil.Ext_To (Lib_Name, DLL_Ext));
320             end if;
321          end;
322       end if;
323    end Library_Exists_For;
324
325    ---------------------------
326    -- Library_File_Name_For --
327    ---------------------------
328
329    function Library_File_Name_For
330      (Project : Project_Id;
331       In_Tree : Project_Tree_Ref) return Name_Id
332    is
333    begin
334       if not In_Tree.Projects.Table (Project).Library then
335          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
336                        "for non library project");
337          return No_Name;
338
339       else
340          declare
341             Lib_Name : constant String :=
342               Get_Name_String
343                 (In_Tree.Projects.Table (Project).Library_Name);
344
345          begin
346             Name_Len := 3;
347             Name_Buffer (1 .. Name_Len) := "lib";
348
349             if In_Tree.Projects.Table (Project).Library_Kind =
350               Static
351             then
352                Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
353
354             else
355                Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
356             end if;
357
358             return Name_Find;
359          end;
360       end if;
361    end Library_File_Name_For;
362
363    ----------------
364    -- Object_Ext --
365    ----------------
366
367    function Object_Ext return String is
368    begin
369       return "o";
370    end Object_Ext;
371
372    ----------------
373    -- PIC_Option --
374    ----------------
375
376    function PIC_Option return String is
377    begin
378       return "-fPIC";
379    end PIC_Option;
380
381    -----------------------------------------------
382    -- Standalone_Library_Auto_Init_Is_Supported --
383    -----------------------------------------------
384
385    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
386    begin
387       return True;
388    end Standalone_Library_Auto_Init_Is_Supported;
389
390    ---------------------------
391    -- Support_For_Libraries --
392    ---------------------------
393
394    function Support_For_Libraries return Library_Support is
395    begin
396       return Static_Only;
397    end Support_For_Libraries;
398
399 end MLib.Tgt;