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