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