1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             M L I B . T G T                              --
6--                            (Windows Version)                             --
7--                                                                          --
8--                                 B o d y                                  --
9--                                                                          --
10--           Copyright (C) 2002-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 and shared libraries.
30
31--  This is the Windows version of the body.
32
33with Namet;  use Namet;
34with Opt;
35with Output; use Output;
36with Prj.Com;
37
38with GNAT.OS_Lib; use GNAT.OS_Lib;
39
40with MDLL;
41with MDLL.Utl;
42with MLib.Fil;
43
44package body MLib.Tgt is
45
46   ---------------------
47   -- Archive_Builder --
48   ---------------------
49
50   function Archive_Builder return String is
51   begin
52      return "ar";
53   end Archive_Builder;
54
55   -----------------------------
56   -- Archive_Builder_Options --
57   -----------------------------
58
59   function Archive_Builder_Options return String_List_Access is
60   begin
61      return new String_List'(1 => new String'("cr"));
62   end Archive_Builder_Options;
63
64   -----------------
65   -- Archive_Ext --
66   -----------------
67
68   function Archive_Ext return  String is
69   begin
70      return "a";
71   end Archive_Ext;
72
73   ---------------------
74   -- Archive_Indexer --
75   ---------------------
76
77   function Archive_Indexer return String is
78   begin
79      return "ranlib";
80   end Archive_Indexer;
81
82   ---------------------------
83   -- Build_Dynamic_Library --
84   ---------------------------
85
86   procedure Build_Dynamic_Library
87     (Ofiles       : Argument_List;
88      Foreign      : Argument_List;
89      Afiles       : Argument_List;
90      Options      : Argument_List;
91      Interfaces   : Argument_List;
92      Lib_Filename : String;
93      Lib_Dir      : String;
94      Symbol_Data  : Symbol_Record;
95      Driver_Name  : Name_Id := No_Name;
96      Lib_Address  : String  := "";
97      Lib_Version  : String  := "";
98      Relocatable  : Boolean := False;
99      Auto_Init    : Boolean := False)
100   is
101      pragma Unreferenced (Ofiles);
102      pragma Unreferenced (Interfaces);
103      pragma Unreferenced (Symbol_Data);
104      pragma Unreferenced (Driver_Name);
105      pragma Unreferenced (Lib_Version);
106      pragma Unreferenced (Auto_Init);
107
108      Imp_File : constant String :=
109                   "lib" & MLib.Fil.Ext_To (Lib_Filename, Archive_Ext);
110      --  Name of the import library
111
112      DLL_File : constant String := MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
113      --  Name of the DLL file
114
115      Lib_File : constant String := Lib_Dir & Directory_Separator & DLL_File;
116      --  Full path of the DLL file
117
118      Success : Boolean;
119
120   begin
121      if Opt.Verbose_Mode then
122         if Relocatable then
123            Write_Str ("building relocatable shared library ");
124         else
125            Write_Str ("building non-relocatable shared library ");
126         end if;
127
128         Write_Line (Lib_File);
129      end if;
130
131      MDLL.Verbose := Opt.Verbose_Mode;
132      MDLL.Quiet   := not MDLL.Verbose;
133
134      MDLL.Utl.Locate;
135
136      MDLL.Build_Dynamic_Library
137        (Foreign, Afiles,
138         MDLL.Null_Argument_List, MDLL.Null_Argument_List, Options,
139         Lib_Filename, Lib_Filename & ".def",
140         Lib_Address, True, Relocatable);
141
142      --  Move the DLL and import library in the lib directory
143
144      Copy_File (DLL_File, Lib_Dir, Success, Mode => Overwrite);
145
146      if not Success then
147         Fail ("could not copy DLL to library dir");
148      end if;
149
150      Copy_File (Imp_File, Lib_Dir, Success, Mode => Overwrite);
151
152      if not Success then
153         Fail ("could not copy import library to library dir");
154      end if;
155
156      --  Delete files
157
158      Delete_File (DLL_File, Success);
159
160      if not Success then
161         Fail ("could not delete DLL from build dir");
162      end if;
163
164      Delete_File (Imp_File, Success);
165
166      if not Success then
167         Fail ("could not delete import library from build dir");
168      end if;
169   end Build_Dynamic_Library;
170
171   -------------------------
172   -- Default_DLL_Address --
173   -------------------------
174
175   function Default_DLL_Address return String is
176   begin
177      return "0x11000000";
178   end Default_DLL_Address;
179
180   -------------
181   -- DLL_Ext --
182   -------------
183
184   function DLL_Ext return String is
185   begin
186      return "dll";
187   end DLL_Ext;
188
189   --------------------
190   -- Dynamic_Option --
191   --------------------
192
193   function Dynamic_Option return String is
194   begin
195      return "";
196   end Dynamic_Option;
197
198   -------------------
199   -- Is_Object_Ext --
200   -------------------
201
202   function Is_Object_Ext (Ext : String) return Boolean is
203   begin
204      return Ext = ".o";
205   end Is_Object_Ext;
206
207   --------------
208   -- Is_C_Ext --
209   --------------
210
211   function Is_C_Ext (Ext : String) return Boolean is
212   begin
213      return Ext = ".c";
214   end Is_C_Ext;
215
216   --------------------
217   -- Is_Archive_Ext --
218   --------------------
219
220   function Is_Archive_Ext (Ext : String) return Boolean is
221   begin
222      return Ext = ".a";
223   end Is_Archive_Ext;
224
225   -------------
226   -- Libgnat --
227   -------------
228
229   function Libgnat return String is
230   begin
231      return "libgnat.a";
232   end Libgnat;
233
234   ------------------------
235   -- Library_Exists_For --
236   ------------------------
237
238   function Library_Exists_For (Project : Project_Id) return Boolean is
239   begin
240      if not Projects.Table (Project).Library then
241         Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
242                       "for non library project");
243         return False;
244
245      else
246         declare
247            Lib_Dir : constant String :=
248              Get_Name_String (Projects.Table (Project).Library_Dir);
249            Lib_Name : constant String :=
250              Get_Name_String (Projects.Table (Project).Library_Name);
251
252         begin
253            if Projects.Table (Project).Library_Kind = Static then
254
255               --  Static libraries are named : lib<name>.a
256
257               return Is_Regular_File
258                 (Lib_Dir & Directory_Separator & "lib" &
259                  MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
260
261            else
262               --  Shared libraries are named : <name>.dll
263
264               return Is_Regular_File
265                 (Lib_Dir & Directory_Separator &
266                  MLib.Fil.Ext_To (Lib_Name, DLL_Ext));
267            end if;
268         end;
269      end if;
270   end Library_Exists_For;
271
272   ---------------------------
273   -- Library_File_Name_For --
274   ---------------------------
275
276   function Library_File_Name_For (Project : Project_Id) return Name_Id is
277   begin
278      if not Projects.Table (Project).Library then
279         Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
280                       "for non library project");
281         return No_Name;
282
283      else
284         declare
285            Lib_Name : constant String :=
286                         Get_Name_String
287                           (Projects.Table (Project).Library_Name);
288
289         begin
290            if Projects.Table (Project).Library_Kind = Static then
291
292               --  Static libraries are named : lib<name>.a
293
294               Name_Len := 3;
295               Name_Buffer (1 .. Name_Len) := "lib";
296
297               Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
298
299            else
300               --  Shared libraries are named : <name>.dll
301
302               Name_Len := 0;
303               Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
304            end if;
305
306            return Name_Find;
307         end;
308      end if;
309   end Library_File_Name_For;
310
311   --------------------------------
312   -- Linker_Library_Path_Option --
313   --------------------------------
314
315   function Linker_Library_Path_Option return String_Access is
316   begin
317      return null;
318   end Linker_Library_Path_Option;
319
320   ----------------
321   -- Object_Ext --
322   ----------------
323
324   function Object_Ext return String is
325   begin
326      return "o";
327   end Object_Ext;
328
329   ----------------
330   -- PIC_Option --
331   ----------------
332
333   function PIC_Option return String is
334   begin
335      return "";
336   end PIC_Option;
337
338   -----------------------------------------------
339   -- Standalone_Library_Auto_Init_Is_Supported --
340   -----------------------------------------------
341
342   function Standalone_Library_Auto_Init_Is_Supported return Boolean is
343   begin
344      return False;
345   end Standalone_Library_Auto_Init_Is_Supported;
346
347   ---------------------------
348   -- Support_For_Libraries --
349   ---------------------------
350
351   function Support_For_Libraries return Library_Support is
352   begin
353      return Full;
354   end Support_For_Libraries;
355
356end MLib.Tgt;
357