OSDN Git Service

2009-04-29 Bob Duff <duff@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / mlib-tgt.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                             M L I B . T G T                              --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --                     Copyright (C) 2001-2009, AdaCore                     --
10 --                                                                          --
11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
12 -- terms of the  GNU General Public License as published  by the Free Soft- --
13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
20 --                                                                          --
21 -- GNAT was originally developed  by the GNAT team at  New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
23 --                                                                          --
24 ------------------------------------------------------------------------------
25
26 with MLib.Fil;
27 with Prj.Com;
28
29 with MLib.Tgt.Specific;
30 pragma Warnings (Off, MLib.Tgt.Specific);
31 --  MLib.Tgt.Specific is with'ed only for elaboration purposes
32
33 package body MLib.Tgt is
34
35    ---------------------
36    -- Archive_Builder --
37    ---------------------
38
39    function Archive_Builder return String is
40    begin
41       return Archive_Builder_Ptr.all;
42    end Archive_Builder;
43
44    -----------------------------
45    -- Archive_Builder_Default --
46    -----------------------------
47
48    function Archive_Builder_Default return String is
49    begin
50       return "ar";
51    end Archive_Builder_Default;
52
53    -----------------------------
54    -- Archive_Builder_Options --
55    -----------------------------
56
57    function Archive_Builder_Options return String_List_Access is
58    begin
59       return Archive_Builder_Options_Ptr.all;
60    end Archive_Builder_Options;
61
62    -------------------------------------
63    -- Archive_Builder_Options_Default --
64    -------------------------------------
65
66    function Archive_Builder_Options_Default return String_List_Access is
67    begin
68       return new String_List'(1 => new String'("cr"));
69    end Archive_Builder_Options_Default;
70
71    ------------------------------------
72    -- Archive_Builder_Append_Options --
73    ------------------------------------
74
75    function Archive_Builder_Append_Options return String_List_Access is
76    begin
77       return Archive_Builder_Append_Options_Ptr.all;
78    end Archive_Builder_Append_Options;
79
80    --------------------------------------------
81    -- Archive_Builder_Append_Options_Default --
82    --------------------------------------------
83
84    function Archive_Builder_Append_Options_Default return String_List_Access is
85    begin
86       return new String_List'(1 => new String'("q"));
87    end Archive_Builder_Append_Options_Default;
88
89    -----------------
90    -- Archive_Ext --
91    -----------------
92
93    function Archive_Ext return String is
94    begin
95       return Archive_Ext_Ptr.all;
96    end Archive_Ext;
97
98    -------------------------
99    -- Archive_Ext_Default --
100    -------------------------
101
102    function Archive_Ext_Default return String is
103    begin
104       return "a";
105    end Archive_Ext_Default;
106
107    ---------------------
108    -- Archive_Indexer --
109    ---------------------
110
111    function Archive_Indexer return String is
112    begin
113       return Archive_Indexer_Ptr.all;
114    end Archive_Indexer;
115
116    -----------------------------
117    -- Archive_Indexer_Default --
118    -----------------------------
119
120    function Archive_Indexer_Default return String is
121    begin
122       return "ranlib";
123    end Archive_Indexer_Default;
124
125    -----------------------------
126    -- Archive_Indexer_Options --
127    -----------------------------
128
129    function Archive_Indexer_Options return String_List_Access is
130    begin
131       return Archive_Indexer_Options_Ptr.all;
132    end Archive_Indexer_Options;
133
134    -------------------------------------
135    -- Archive_Indexer_Options_Default --
136    -------------------------------------
137
138    function Archive_Indexer_Options_Default return String_List_Access is
139    begin
140       return new String_List (1 .. 0);
141    end Archive_Indexer_Options_Default;
142
143    ---------------------------
144    -- Build_Dynamic_Library --
145    ---------------------------
146
147    procedure Build_Dynamic_Library
148      (Ofiles       : Argument_List;
149       Options      : Argument_List;
150       Interfaces   : Argument_List;
151       Lib_Filename : String;
152       Lib_Dir      : String;
153       Symbol_Data  : Symbol_Record;
154       Driver_Name  : Name_Id := No_Name;
155       Lib_Version  : String  := "";
156       Auto_Init    : Boolean := False)
157    is
158    begin
159       Build_Dynamic_Library_Ptr
160         (Ofiles,
161          Options,
162          Interfaces,
163          Lib_Filename,
164          Lib_Dir,
165          Symbol_Data,
166          Driver_Name,
167          Lib_Version,
168          Auto_Init);
169    end Build_Dynamic_Library;
170
171    ------------------------------
172    -- Default_Symbol_File_Name --
173    ------------------------------
174
175    function Default_Symbol_File_Name return String is
176    begin
177       return Default_Symbol_File_Name_Ptr.all;
178    end Default_Symbol_File_Name;
179
180    --------------------------------------
181    -- Default_Symbol_File_Name_Default --
182    --------------------------------------
183
184    function Default_Symbol_File_Name_Default return String is
185    begin
186       return "";
187    end Default_Symbol_File_Name_Default;
188
189    -------------
190    -- DLL_Ext --
191    -------------
192
193    function DLL_Ext return String is
194    begin
195       return DLL_Ext_Ptr.all;
196    end DLL_Ext;
197
198    ---------------------
199    -- DLL_Ext_Default --
200    ---------------------
201
202    function DLL_Ext_Default return String is
203    begin
204       return "so";
205    end DLL_Ext_Default;
206
207    ----------------
208    -- DLL_Prefix --
209    ----------------
210
211    function DLL_Prefix return String is
212    begin
213       return DLL_Prefix_Ptr.all;
214    end DLL_Prefix;
215
216    ------------------------
217    -- DLL_Prefix_Default --
218    ------------------------
219
220    function DLL_Prefix_Default return String is
221    begin
222       return "lib";
223    end DLL_Prefix_Default;
224
225    --------------------
226    -- Dynamic_Option --
227    --------------------
228
229    function Dynamic_Option return String is
230    begin
231       return Dynamic_Option_Ptr.all;
232    end Dynamic_Option;
233
234    ----------------------------
235    -- Dynamic_Option_Default --
236    ----------------------------
237
238    function Dynamic_Option_Default return String is
239    begin
240       return "-shared";
241    end Dynamic_Option_Default;
242
243    -------------------
244    -- Is_Object_Ext --
245    -------------------
246
247    function Is_Object_Ext (Ext : String) return Boolean is
248    begin
249       return Is_Object_Ext_Ptr (Ext);
250    end Is_Object_Ext;
251
252    ---------------------------
253    -- Is_Object_Ext_Default --
254    ---------------------------
255
256    function Is_Object_Ext_Default (Ext : String) return Boolean is
257    begin
258       return Ext = ".o";
259    end Is_Object_Ext_Default;
260
261    --------------
262    -- Is_C_Ext --
263    --------------
264
265    function Is_C_Ext (Ext : String) return Boolean is
266    begin
267       return Is_C_Ext_Ptr (Ext);
268    end Is_C_Ext;
269
270    ----------------------
271    -- Is_C_Ext_Default --
272    ----------------------
273
274    function Is_C_Ext_Default (Ext : String) return Boolean is
275    begin
276       return Ext = ".c";
277    end Is_C_Ext_Default;
278
279    --------------------
280    -- Is_Archive_Ext --
281    --------------------
282
283    function Is_Archive_Ext (Ext : String) return Boolean is
284    begin
285       return Is_Archive_Ext_Ptr (Ext);
286    end Is_Archive_Ext;
287
288    ----------------------------
289    -- Is_Archive_Ext_Default --
290    ----------------------------
291
292    function Is_Archive_Ext_Default (Ext : String) return Boolean is
293    begin
294       return Ext = ".a";
295    end Is_Archive_Ext_Default;
296
297    -------------
298    -- Libgnat --
299    -------------
300
301    function Libgnat return String is
302    begin
303       return Libgnat_Ptr.all;
304    end Libgnat;
305
306    ---------------------
307    -- Libgnat_Default --
308    ---------------------
309
310    function Libgnat_Default return String is
311    begin
312       return "libgnat.a";
313    end Libgnat_Default;
314
315    ------------------------
316    -- Library_Exists_For --
317    ------------------------
318
319    function Library_Exists_For
320      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
321    is
322    begin
323       return Library_Exists_For_Ptr (Project, In_Tree);
324    end Library_Exists_For;
325
326    --------------------------------
327    -- Library_Exists_For_Default --
328    --------------------------------
329
330    function Library_Exists_For_Default
331      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
332    is
333       pragma Unreferenced (In_Tree);
334    begin
335       if not Project.Library then
336          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
337                        "for non library project");
338          return False;
339
340       else
341          declare
342             Lib_Dir  : constant String :=
343                          Get_Name_String (Project.Library_Dir.Name);
344             Lib_Name : constant String :=
345                          Get_Name_String (Project.Library_Name);
346
347          begin
348             if Project.Library_Kind = Static then
349                return Is_Regular_File
350                  (Lib_Dir & Directory_Separator & "lib" &
351                   Fil.Append_To (Lib_Name, Archive_Ext));
352
353             else
354                return Is_Regular_File
355                  (Lib_Dir & Directory_Separator & DLL_Prefix &
356                   Fil.Append_To (Lib_Name, DLL_Ext));
357             end if;
358          end;
359       end if;
360    end Library_Exists_For_Default;
361
362    ---------------------------
363    -- Library_File_Name_For --
364    ---------------------------
365
366    function Library_File_Name_For
367      (Project : Project_Id;
368       In_Tree : Project_Tree_Ref) return File_Name_Type
369    is
370    begin
371       return Library_File_Name_For_Ptr (Project, In_Tree);
372    end Library_File_Name_For;
373
374    -----------------------------------
375    -- Library_File_Name_For_Default --
376    -----------------------------------
377
378    function Library_File_Name_For_Default
379      (Project : Project_Id;
380       In_Tree : Project_Tree_Ref) return File_Name_Type
381    is
382       pragma Unreferenced (In_Tree);
383    begin
384       if not Project.Library then
385          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
386                        "for non library project");
387          return No_File;
388
389       else
390          declare
391             Lib_Name : constant String :=
392                          Get_Name_String (Project.Library_Name);
393
394          begin
395             if Project.Library_Kind =
396                  Static
397             then
398                Name_Len := 3;
399                Name_Buffer (1 .. Name_Len) := "lib";
400                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
401             else
402                Name_Len := 0;
403                Add_Str_To_Name_Buffer (DLL_Prefix);
404                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
405             end if;
406
407             return Name_Find;
408          end;
409       end if;
410    end Library_File_Name_For_Default;
411
412    --------------------------------------
413    -- Library_Major_Minor_Id_Supported --
414    --------------------------------------
415
416    function Library_Major_Minor_Id_Supported return Boolean is
417    begin
418       return Library_Major_Minor_Id_Supported_Ptr.all;
419    end Library_Major_Minor_Id_Supported;
420
421    ----------------------------------------------
422    -- Library_Major_Minor_Id_Supported_Default --
423    ----------------------------------------------
424
425    function Library_Major_Minor_Id_Supported_Default return Boolean is
426    begin
427       return True;
428    end Library_Major_Minor_Id_Supported_Default;
429
430    ----------------
431    -- Object_Ext --
432    ----------------
433
434    function Object_Ext return String is
435    begin
436       return Object_Ext_Ptr.all;
437    end Object_Ext;
438
439    ------------------------
440    -- Object_Ext_Default --
441    ------------------------
442
443    function Object_Ext_Default return String is
444    begin
445       return "o";
446    end Object_Ext_Default;
447
448    ----------------
449    -- PIC_Option --
450    ----------------
451
452    function PIC_Option return String is
453    begin
454       return PIC_Option_Ptr.all;
455    end PIC_Option;
456
457    ------------------------
458    -- PIC_Option_Default --
459    ------------------------
460
461    function PIC_Option_Default return String is
462    begin
463       return "-fPIC";
464    end PIC_Option_Default;
465
466    -----------------------------------------------
467    -- Standalone_Library_Auto_Init_Is_Supported --
468    -----------------------------------------------
469
470    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
471    begin
472       return Standalone_Library_Auto_Init_Is_Supported_Ptr.all;
473    end Standalone_Library_Auto_Init_Is_Supported;
474
475    -------------------------------------------------------
476    -- Standalone_Library_Auto_Init_Is_Supported_Default --
477    -------------------------------------------------------
478
479    function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean is
480    begin
481       return True;
482    end Standalone_Library_Auto_Init_Is_Supported_Default;
483
484    ---------------------------
485    -- Support_For_Libraries --
486    ---------------------------
487
488    function Support_For_Libraries return Library_Support is
489    begin
490       return Support_For_Libraries_Ptr.all;
491    end Support_For_Libraries;
492
493    -----------------------------------
494    -- Support_For_Libraries_Default --
495    -----------------------------------
496
497    function Support_For_Libraries_Default return Library_Support is
498    begin
499       return Full;
500    end Support_For_Libraries_Default;
501
502 end MLib.Tgt;