OSDN Git Service

2007-09-26 Robert Dewar <dewar@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-2007, 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 --  This is the default version which does not support libraries.
27 --  All subprograms are dummies, because they are never called,
28 --  except Support_For_Libraries which returns None.
29
30 with MLib.Fil;
31 with Prj.Com;
32
33 with MLib.Tgt.Specific;
34 pragma Warnings (Off, MLib.Tgt.Specific);
35 --  MLib.Tgt.Specific is with'ed only for elaboration purposes
36
37 package body MLib.Tgt is
38
39    ---------------------
40    -- Archive_Builder --
41    ---------------------
42
43    function Archive_Builder return String is
44    begin
45       return Archive_Builder_Ptr.all;
46    end Archive_Builder;
47
48    -----------------------------
49    -- Archive_Builder_Default --
50    -----------------------------
51
52    function Archive_Builder_Default return String is
53    begin
54       return "ar";
55    end Archive_Builder_Default;
56
57    -----------------------------
58    -- Archive_Builder_Options --
59    -----------------------------
60
61    function Archive_Builder_Options return String_List_Access is
62    begin
63       return Archive_Builder_Options_Ptr.all;
64    end Archive_Builder_Options;
65
66    -------------------------------------
67    -- Archive_Builder_Options_Default --
68    -------------------------------------
69
70    function Archive_Builder_Options_Default return String_List_Access is
71    begin
72       return new String_List'(1 => new String'("cr"));
73    end Archive_Builder_Options_Default;
74
75    ------------------------------------
76    -- Archive_Builder_Append_Options --
77    ------------------------------------
78
79    function Archive_Builder_Append_Options return String_List_Access is
80    begin
81       return Archive_Builder_Append_Options_Ptr.all;
82    end Archive_Builder_Append_Options;
83
84    --------------------------------------------
85    -- Archive_Builder_Append_Options_Default --
86    --------------------------------------------
87
88    function Archive_Builder_Append_Options_Default return String_List_Access is
89    begin
90       return new String_List'(1 => new String'("q"));
91    end Archive_Builder_Append_Options_Default;
92
93    -----------------
94    -- Archive_Ext --
95    -----------------
96
97    function Archive_Ext return String is
98    begin
99       return Archive_Ext_Ptr.all;
100    end Archive_Ext;
101
102    -------------------------
103    -- Archive_Ext_Default --
104    -------------------------
105
106    function Archive_Ext_Default return String is
107    begin
108       return "a";
109    end Archive_Ext_Default;
110
111    ---------------------
112    -- Archive_Indexer --
113    ---------------------
114
115    function Archive_Indexer return String is
116    begin
117       return Archive_Indexer_Ptr.all;
118    end Archive_Indexer;
119
120    -----------------------------
121    -- Archive_Indexer_Default --
122    -----------------------------
123
124    function Archive_Indexer_Default return String is
125    begin
126       return "ranlib";
127    end Archive_Indexer_Default;
128
129    -----------------------------
130    -- Archive_Indexer_Options --
131    -----------------------------
132
133    function Archive_Indexer_Options return String_List_Access is
134    begin
135       return Archive_Indexer_Options_Ptr.all;
136    end Archive_Indexer_Options;
137
138    -------------------------------------
139    -- Archive_Indexer_Options_Default --
140    -------------------------------------
141
142    function Archive_Indexer_Options_Default return String_List_Access is
143    begin
144       return new String_List (1 .. 0);
145    end Archive_Indexer_Options_Default;
146
147    ---------------------------
148    -- Build_Dynamic_Library --
149    ---------------------------
150
151    procedure Build_Dynamic_Library
152      (Ofiles       : Argument_List;
153       Options      : Argument_List;
154       Interfaces   : Argument_List;
155       Lib_Filename : String;
156       Lib_Dir      : String;
157       Symbol_Data  : Symbol_Record;
158       Driver_Name  : Name_Id := No_Name;
159       Lib_Version  : String  := "";
160       Auto_Init    : Boolean := False)
161    is
162    begin
163       Build_Dynamic_Library_Ptr
164         (Ofiles,
165          Options,
166          Interfaces,
167          Lib_Filename,
168          Lib_Dir,
169          Symbol_Data,
170          Driver_Name,
171          Lib_Version,
172          Auto_Init);
173    end Build_Dynamic_Library;
174
175    ------------------------------
176    -- Default_Symbol_File_Name --
177    ------------------------------
178
179    function Default_Symbol_File_Name return String is
180    begin
181       return Default_Symbol_File_Name_Ptr.all;
182    end Default_Symbol_File_Name;
183
184    --------------------------------------
185    -- Default_Symbol_File_Name_Default --
186    --------------------------------------
187
188    function Default_Symbol_File_Name_Default return String is
189    begin
190       return "";
191    end Default_Symbol_File_Name_Default;
192
193    -------------
194    -- DLL_Ext --
195    -------------
196
197    function DLL_Ext return String is
198    begin
199       return DLL_Ext_Ptr.all;
200    end DLL_Ext;
201
202    ---------------------
203    -- DLL_Ext_Default --
204    ---------------------
205
206    function DLL_Ext_Default return String is
207    begin
208       return "so";
209    end DLL_Ext_Default;
210
211    ----------------
212    -- DLL_Prefix --
213    ----------------
214
215    function DLL_Prefix return String is
216    begin
217       return DLL_Prefix_Ptr.all;
218    end DLL_Prefix;
219
220    ------------------------
221    -- DLL_Prefix_Default --
222    ------------------------
223
224    function DLL_Prefix_Default return String is
225    begin
226       return "lib";
227    end DLL_Prefix_Default;
228
229    --------------------
230    -- Dynamic_Option --
231    --------------------
232
233    function Dynamic_Option return String is
234    begin
235       return Dynamic_Option_Ptr.all;
236    end Dynamic_Option;
237
238    ----------------------------
239    -- Dynamic_Option_Default --
240    ----------------------------
241
242    function Dynamic_Option_Default return String is
243    begin
244       return "-shared";
245    end Dynamic_Option_Default;
246
247    -------------------
248    -- Is_Object_Ext --
249    -------------------
250
251    function Is_Object_Ext (Ext : String) return Boolean is
252    begin
253       return Is_Object_Ext_Ptr (Ext);
254    end Is_Object_Ext;
255
256    ---------------------------
257    -- Is_Object_Ext_Default --
258    ---------------------------
259
260    function Is_Object_Ext_Default (Ext : String) return Boolean is
261    begin
262       return Ext = ".o";
263    end Is_Object_Ext_Default;
264
265    --------------
266    -- Is_C_Ext --
267    --------------
268
269    function Is_C_Ext (Ext : String) return Boolean is
270    begin
271       return Is_C_Ext_Ptr (Ext);
272    end Is_C_Ext;
273
274    ----------------------
275    -- Is_C_Ext_Default --
276    ----------------------
277
278    function Is_C_Ext_Default (Ext : String) return Boolean is
279    begin
280       return Ext = ".c";
281    end Is_C_Ext_Default;
282
283    --------------------
284    -- Is_Archive_Ext --
285    --------------------
286
287    function Is_Archive_Ext (Ext : String) return Boolean is
288    begin
289       return Is_Archive_Ext_Ptr (Ext);
290    end Is_Archive_Ext;
291
292    ----------------------------
293    -- Is_Archive_Ext_Default --
294    ----------------------------
295
296    function Is_Archive_Ext_Default (Ext : String) return Boolean is
297    begin
298       return Ext = ".a";
299    end Is_Archive_Ext_Default;
300
301    -------------
302    -- Libgnat --
303    -------------
304
305    function Libgnat return String is
306    begin
307       return Libgnat_Ptr.all;
308    end Libgnat;
309
310    ---------------------
311    -- Libgnat_Default --
312    ---------------------
313
314    function Libgnat_Default return String is
315    begin
316       return "libgnat.a";
317    end Libgnat_Default;
318
319    ------------------------
320    -- Library_Exists_For --
321    ------------------------
322
323    function Library_Exists_For
324      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
325    is
326    begin
327       return Library_Exists_For_Ptr (Project, In_Tree);
328    end Library_Exists_For;
329
330    --------------------------------
331    -- Library_Exists_For_Default --
332    --------------------------------
333
334    function Library_Exists_For_Default
335      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
336    is
337    begin
338       if not In_Tree.Projects.Table (Project).Library then
339          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
340                        "for non library project");
341          return False;
342
343       else
344          declare
345             Lib_Dir  : constant String :=
346                          Get_Name_String
347                            (In_Tree.Projects.Table (Project).Library_Dir);
348             Lib_Name : constant String :=
349                          Get_Name_String
350                            (In_Tree.Projects.Table (Project).Library_Name);
351
352          begin
353             if In_Tree.Projects.Table (Project).Library_Kind = Static then
354                return Is_Regular_File
355                  (Lib_Dir & Directory_Separator & "lib" &
356                   Fil.Append_To (Lib_Name, Archive_Ext));
357
358             else
359                return Is_Regular_File
360                  (Lib_Dir & Directory_Separator & DLL_Prefix &
361                   Fil.Append_To (Lib_Name, DLL_Ext));
362             end if;
363          end;
364       end if;
365    end Library_Exists_For_Default;
366
367    ---------------------------
368    -- Library_File_Name_For --
369    ---------------------------
370
371    function Library_File_Name_For
372      (Project : Project_Id;
373       In_Tree : Project_Tree_Ref) return File_Name_Type
374    is
375    begin
376       return Library_File_Name_For_Ptr (Project, In_Tree);
377    end Library_File_Name_For;
378
379    -----------------------------------
380    -- Library_File_Name_For_Default --
381    -----------------------------------
382
383    function Library_File_Name_For_Default
384      (Project : Project_Id;
385       In_Tree : Project_Tree_Ref) return File_Name_Type
386    is
387    begin
388       if not In_Tree.Projects.Table (Project).Library then
389          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
390                        "for non library project");
391          return No_File;
392
393       else
394          declare
395             Lib_Name : constant String :=
396                          Get_Name_String
397                            (In_Tree.Projects.Table (Project).Library_Name);
398
399          begin
400             if In_Tree.Projects.Table (Project).Library_Kind =
401                  Static
402             then
403                Name_Len := 3;
404                Name_Buffer (1 .. Name_Len) := "lib";
405                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
406             else
407                Name_Len := 0;
408                Add_Str_To_Name_Buffer (DLL_Prefix);
409                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
410             end if;
411
412             return Name_Find;
413          end;
414       end if;
415    end Library_File_Name_For_Default;
416
417    --------------------------------------
418    -- Library_Major_Minor_Id_Supported --
419    --------------------------------------
420
421    function Library_Major_Minor_Id_Supported return Boolean is
422    begin
423       return Library_Major_Minor_Id_Supported_Ptr.all;
424    end Library_Major_Minor_Id_Supported;
425
426    ----------------------------------------------
427    -- Library_Major_Minor_Id_Supported_Default --
428    ----------------------------------------------
429
430    function Library_Major_Minor_Id_Supported_Default return Boolean is
431    begin
432       return True;
433    end Library_Major_Minor_Id_Supported_Default;
434
435    ----------------
436    -- Object_Ext --
437    ----------------
438
439    function Object_Ext return String is
440    begin
441       return Object_Ext_Ptr.all;
442    end Object_Ext;
443
444    ------------------------
445    -- Object_Ext_Default --
446    ------------------------
447
448    function Object_Ext_Default return String is
449    begin
450       return "o";
451    end Object_Ext_Default;
452
453    ----------------
454    -- PIC_Option --
455    ----------------
456
457    function PIC_Option return String is
458    begin
459       return PIC_Option_Ptr.all;
460    end PIC_Option;
461
462    ------------------------
463    -- PIC_Option_Default --
464    ------------------------
465
466    function PIC_Option_Default return String is
467    begin
468       return "-fPIC";
469    end PIC_Option_Default;
470
471    -----------------------------------------------
472    -- Standalone_Library_Auto_Init_Is_Supported --
473    -----------------------------------------------
474
475    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
476    begin
477       return Standalone_Library_Auto_Init_Is_Supported_Ptr.all;
478    end Standalone_Library_Auto_Init_Is_Supported;
479
480    -------------------------------------------------------
481    -- Standalone_Library_Auto_Init_Is_Supported_Default --
482    -------------------------------------------------------
483
484    function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean is
485    begin
486       return True;
487    end Standalone_Library_Auto_Init_Is_Supported_Default;
488
489    ---------------------------
490    -- Support_For_Libraries --
491    ---------------------------
492
493    function Support_For_Libraries return Library_Support is
494    begin
495       return Support_For_Libraries_Ptr.all;
496    end Support_For_Libraries;
497
498    -----------------------------------
499    -- Support_For_Libraries_Default --
500    -----------------------------------
501
502    function Support_For_Libraries_Default return Library_Support is
503    begin
504       return Full;
505    end Support_For_Libraries_Default;
506 end MLib.Tgt;