OSDN Git Service

* sysdep.c: Problem discovered during IA64 VMS port.
[pf3gnuchains/gcc-fork.git] / gcc / ada / 5zml-tgt.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                             M L I B . T G T                              --
6 --                            (VxWorks Version)                             --
7 --                                                                          --
8 --                                 B o d y                                  --
9 --                                                                          --
10 --              Copyright (C) 2003 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,  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 libraries.
30
31 --  This is the VxWorks version of the body
32
33 with MLib.Fil;
34 with Namet;  use Namet;
35 with Prj.Com;
36 with Sdefault;
37
38 package body MLib.Tgt is
39
40    -----------------------
41    -- Local Subprograms --
42    -----------------------
43
44    function Get_Target_Suffix return String;
45    --  Returns the required suffix for some utilities
46    --  (such as ar and ranlib) that depend on the real target.
47
48    ---------------------
49    -- Archive_Builder --
50    ---------------------
51
52    function Archive_Builder return String is
53    begin
54       return "ar" & Get_Target_Suffix;
55    end Archive_Builder;
56
57    -----------------------------
58    -- Archive_Builder_Options --
59    -----------------------------
60
61    function Archive_Builder_Options return String_List_Access is
62    begin
63       return new String_List'(1 => new String'("cr"));
64    end Archive_Builder_Options;
65
66    -----------------
67    -- Archive_Ext --
68    -----------------
69
70    function Archive_Ext return  String is
71    begin
72       return "a";
73    end Archive_Ext;
74
75    ---------------------
76    -- Archive_Indexer --
77    ---------------------
78
79    function Archive_Indexer return String is
80    begin
81       return "ranlib" & Get_Target_Suffix;
82    end Archive_Indexer;
83
84    ---------------------------
85    -- Build_Dynamic_Library --
86    ---------------------------
87
88    procedure Build_Dynamic_Library
89      (Ofiles       : Argument_List;
90       Foreign      : Argument_List;
91       Afiles       : Argument_List;
92       Options      : Argument_List;
93       Interfaces   : Argument_List;
94       Lib_Filename : String;
95       Lib_Dir      : String;
96       Driver_Name  : Name_Id := No_Name;
97       Lib_Address  : String  := "";
98       Lib_Version  : String  := "";
99       Relocatable  : Boolean := False;
100       Auto_Init    : Boolean := False)
101    is
102       pragma Unreferenced (Ofiles);
103       pragma Unreferenced (Foreign);
104       pragma Unreferenced (Afiles);
105       pragma Unreferenced (Options);
106       pragma Unreferenced (Interfaces);
107       pragma Unreferenced (Lib_Filename);
108       pragma Unreferenced (Lib_Dir);
109       pragma Unreferenced (Driver_Name);
110       pragma Unreferenced (Lib_Address);
111       pragma Unreferenced (Lib_Version);
112       pragma Unreferenced (Relocatable);
113       pragma Unreferenced (Auto_Init);
114
115    begin
116       null;
117    end Build_Dynamic_Library;
118
119    -------------------------
120    -- Default_DLL_Address --
121    -------------------------
122
123    function Default_DLL_Address return String is
124    begin
125       return "";
126    end Default_DLL_Address;
127
128    -------------
129    -- DLL_Ext --
130    -------------
131
132    function DLL_Ext return String is
133    begin
134       return "";
135    end DLL_Ext;
136
137    --------------------
138    -- Dynamic_Option --
139    --------------------
140
141    function Dynamic_Option return String is
142    begin
143       return "";
144    end Dynamic_Option;
145
146    -----------------------------
147    -- Get_Target_Suffix --
148    -----------------------------
149
150    function Get_Target_Suffix return String is
151       Target_Name : String_Ptr := Sdefault.Target_Name;
152       Index       : Positive   := Target_Name'First;
153    begin
154       while ((Index < Target_Name'Last) and then
155                (Target_Name (Index + 1) /= '-')) loop
156          Index := Index + 1;
157       end loop;
158
159       if Target_Name (Target_Name'First .. Index) = "m68k" then
160          return "68k";
161       elsif Target_Name (Target_Name'First .. Index) = "mips" then
162          return "mips";
163       elsif Target_Name (Target_Name'First .. Index) = "powerpc" then
164          return "ppc";
165       elsif Target_Name (Target_Name'First .. Index) = "sparc" then
166          return "sparc";
167       elsif Target_Name (Target_Name'First .. Index) = "sparc64" then
168          return "sparc64";
169       elsif Target_Name (Target_Name'First .. Index) = "xscale" then
170          return "arm";
171       else
172          return "";
173       end if;
174    end Get_Target_Suffix;
175
176    -------------------
177    -- Is_Object_Ext --
178    -------------------
179
180    function Is_Object_Ext (Ext : String) return Boolean is
181    begin
182       return Ext = ".o";
183    end Is_Object_Ext;
184
185    --------------
186    -- Is_C_Ext --
187    --------------
188
189    function Is_C_Ext (Ext : String) return Boolean is
190    begin
191       return Ext = ".c";
192    end Is_C_Ext;
193
194    --------------------
195    -- Is_Archive_Ext --
196    --------------------
197
198    function Is_Archive_Ext (Ext : String) return Boolean is
199    begin
200       return Ext = ".a";
201    end Is_Archive_Ext;
202
203    -------------
204    -- Libgnat --
205    -------------
206
207    function Libgnat return String is
208    begin
209       return "libgnat.a";
210    end Libgnat;
211
212    ------------------------
213    -- Library_Exists_For --
214    ------------------------
215
216    function Library_Exists_For (Project : Project_Id) return Boolean is
217    begin
218       if not Projects.Table (Project).Library then
219          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
220                        "for non library project");
221          return False; --  To avoid warning;
222
223       else
224          declare
225             Lib_Dir : constant String :=
226               Get_Name_String (Projects.Table (Project).Library_Dir);
227             Lib_Name : constant String :=
228               Get_Name_String (Projects.Table (Project).Library_Name);
229
230          begin
231             if Projects.Table (Project).Library_Kind = Static then
232                return Is_Regular_File
233                  (Lib_Dir & Directory_Separator & "lib" &
234                   Fil.Ext_To (Lib_Name, Archive_Ext));
235
236             else
237                return Is_Regular_File
238                  (Lib_Dir & Directory_Separator & "lib" &
239                   Fil.Ext_To (Lib_Name, DLL_Ext));
240             end if;
241          end;
242       end if;
243    end Library_Exists_For;
244
245    ---------------------------
246    -- Library_File_Name_For --
247    ---------------------------
248
249    function Library_File_Name_For (Project : Project_Id) return Name_Id is
250    begin
251       if not Projects.Table (Project).Library then
252          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
253                        "for non library project");
254          return No_Name;
255
256       else
257          declare
258             Lib_Name : constant String :=
259               Get_Name_String (Projects.Table (Project).Library_Name);
260
261          begin
262             Name_Len := 3;
263             Name_Buffer (1 .. Name_Len) := "lib";
264
265             if Projects.Table (Project).Library_Kind = Static then
266                Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
267
268             else
269                Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
270             end if;
271
272             return Name_Find;
273          end;
274       end if;
275    end Library_File_Name_For;
276
277    --------------------------------
278    -- Linker_Library_Path_Option --
279    --------------------------------
280
281    function Linker_Library_Path_Option return String_Access is
282    begin
283       return new String'("-Wl,-R,");
284    end Linker_Library_Path_Option;
285
286    ----------------
287    -- Object_Ext --
288    ----------------
289
290    function Object_Ext return String is
291    begin
292       return "o";
293    end Object_Ext;
294
295    ----------------
296    -- PIC_Option --
297    ----------------
298
299    function PIC_Option return String is
300    begin
301       return "";
302    end PIC_Option;
303
304    -----------------------------------------------
305    -- Standalone_Library_Auto_Init_Is_Supported --
306    -----------------------------------------------
307
308    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
309    begin
310       return False;
311    end Standalone_Library_Auto_Init_Is_Supported;
312
313    ---------------------------
314    -- Support_For_Libraries --
315    ---------------------------
316
317    function Support_For_Libraries return Library_Support is
318    begin
319       return Static_Only;
320    end Support_For_Libraries;
321
322 end MLib.Tgt;