1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- M D L L -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- 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 package provides the core high level routines used by GNATDLL 27-- to build Windows DLL. 28 29with Ada.Text_IO; 30 31with GNAT.Directory_Operations; 32with MDLL.Utl; 33with MDLL.Fil; 34 35package body MDLL is 36 37 use Ada; 38 use GNAT; 39 40 -- Convention used for the library names on Windows: 41 -- DLL: <name>.dll 42 -- Import library: lib<name>.dll 43 44 function Get_Dll_Name (Lib_Filename : String) return String; 45 -- Returns <Lib_Filename> if it contains a file extension otherwise it 46 -- returns <Lib_Filename>.dll. 47 48 --------------------------- 49 -- Build_Dynamic_Library -- 50 --------------------------- 51 52 procedure Build_Dynamic_Library 53 (Ofiles : Argument_List; 54 Afiles : Argument_List; 55 Options : Argument_List; 56 Bargs_Options : Argument_List; 57 Largs_Options : Argument_List; 58 Lib_Filename : String; 59 Def_Filename : String; 60 Lib_Address : String := ""; 61 Build_Import : Boolean := False; 62 Relocatable : Boolean := False; 63 Map_File : Boolean := False) 64 is 65 66 use type OS_Lib.Argument_List; 67 68 Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename); 69 70 Def_File : aliased constant String := Def_Filename; 71 Jnk_File : aliased String := Base_Filename & ".jnk"; 72 Bas_File : aliased constant String := Base_Filename & ".base"; 73 Dll_File : aliased String := Get_Dll_Name (Lib_Filename); 74 Exp_File : aliased String := Base_Filename & ".exp"; 75 Lib_File : aliased constant String := "lib" & Base_Filename & ".dll.a"; 76 77 Bas_Opt : aliased String := "-Wl,--base-file," & Bas_File; 78 Lib_Opt : aliased String := "-mdll"; 79 Out_Opt : aliased String := "-o"; 80 Adr_Opt : aliased String := "-Wl,--image-base=" & Lib_Address; 81 Map_Opt : aliased String := "-Wl,-Map," & Lib_Filename & ".map"; 82 83 L_Afiles : Argument_List := Afiles; 84 -- Local afiles list. This list can be reordered to ensure that the 85 -- binder ALI file is not the first entry in this list. 86 87 All_Options : constant Argument_List := Options & Largs_Options; 88 89 procedure Build_Reloc_DLL; 90 -- Build a relocatable DLL with only objects file specified. This uses 91 -- the well known five step build (see GNAT User's Guide). 92 93 procedure Ada_Build_Reloc_DLL; 94 -- Build a relocatable DLL with Ada code. This uses the well known five 95 -- step build (see GNAT User's Guide). 96 97 procedure Build_Non_Reloc_DLL; 98 -- Build a non relocatable DLL containing no Ada code 99 100 procedure Ada_Build_Non_Reloc_DLL; 101 -- Build a non relocatable DLL with Ada code 102 103 --------------------- 104 -- Build_Reloc_DLL -- 105 --------------------- 106 107 procedure Build_Reloc_DLL is 108 109 Objects_Exp_File : constant OS_Lib.Argument_List := 110 Exp_File'Unchecked_Access & Ofiles; 111 -- Objects plus the export table (.exp) file 112 113 Success : Boolean; 114 pragma Warnings (Off, Success); 115 116 begin 117 if not Quiet then 118 Text_IO.Put_Line ("building relocatable DLL..."); 119 Text_IO.Put ("make " & Dll_File); 120 121 if Build_Import then 122 Text_IO.Put_Line (" and " & Lib_File); 123 else 124 Text_IO.New_Line; 125 end if; 126 end if; 127 128 -- 1) Build base file with objects files 129 130 Utl.Gcc (Output_File => Jnk_File, 131 Files => Ofiles, 132 Options => All_Options, 133 Base_File => Bas_File, 134 Build_Lib => True); 135 136 -- 2) Build exp from base file 137 138 Utl.Dlltool (Def_File, Dll_File, Lib_File, 139 Base_File => Bas_File, 140 Exp_Table => Exp_File, 141 Build_Import => False); 142 143 -- 3) Build base file with exp file and objects files 144 145 Utl.Gcc (Output_File => Jnk_File, 146 Files => Objects_Exp_File, 147 Options => All_Options, 148 Base_File => Bas_File, 149 Build_Lib => True); 150 151 -- 4) Build new exp from base file and the lib file (.a) 152 153 Utl.Dlltool (Def_File, Dll_File, Lib_File, 154 Base_File => Bas_File, 155 Exp_Table => Exp_File, 156 Build_Import => Build_Import); 157 158 -- 5) Build the dynamic library 159 160 declare 161 Params : constant OS_Lib.Argument_List := 162 Map_Opt'Unchecked_Access & 163 Adr_Opt'Unchecked_Access & All_Options; 164 First_Param : Positive := Params'First + 1; 165 166 begin 167 if Map_File then 168 First_Param := Params'First; 169 end if; 170 171 Utl.Gcc 172 (Output_File => Dll_File, 173 Files => Objects_Exp_File, 174 Options => Params (First_Param .. Params'Last), 175 Build_Lib => True); 176 end; 177 178 OS_Lib.Delete_File (Exp_File, Success); 179 OS_Lib.Delete_File (Bas_File, Success); 180 OS_Lib.Delete_File (Jnk_File, Success); 181 182 exception 183 when others => 184 OS_Lib.Delete_File (Exp_File, Success); 185 OS_Lib.Delete_File (Bas_File, Success); 186 OS_Lib.Delete_File (Jnk_File, Success); 187 raise; 188 end Build_Reloc_DLL; 189 190 ------------------------- 191 -- Ada_Build_Reloc_DLL -- 192 ------------------------- 193 194 procedure Ada_Build_Reloc_DLL is 195 Success : Boolean; 196 pragma Warnings (Off, Success); 197 198 begin 199 if not Quiet then 200 Text_IO.Put_Line ("Building relocatable DLL..."); 201 Text_IO.Put ("make " & Dll_File); 202 203 if Build_Import then 204 Text_IO.Put_Line (" and " & Lib_File); 205 else 206 Text_IO.New_Line; 207 end if; 208 end if; 209 210 -- 1) Build base file with objects files 211 212 Utl.Gnatbind (L_Afiles, Options & Bargs_Options); 213 214 declare 215 Params : constant OS_Lib.Argument_List := 216 Out_Opt'Unchecked_Access & 217 Jnk_File'Unchecked_Access & 218 Lib_Opt'Unchecked_Access & 219 Bas_Opt'Unchecked_Access & 220 Ofiles & 221 All_Options; 222 begin 223 Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params); 224 end; 225 226 -- 2) Build exp from base file 227 228 Utl.Dlltool (Def_File, Dll_File, Lib_File, 229 Base_File => Bas_File, 230 Exp_Table => Exp_File, 231 Build_Import => False); 232 233 -- 3) Build base file with exp file and objects files 234 235 Utl.Gnatbind (L_Afiles, Options & Bargs_Options); 236 237 declare 238 Params : constant OS_Lib.Argument_List := 239 Out_Opt'Unchecked_Access & 240 Jnk_File'Unchecked_Access & 241 Lib_Opt'Unchecked_Access & 242 Bas_Opt'Unchecked_Access & 243 Exp_File'Unchecked_Access & 244 Ofiles & 245 All_Options; 246 begin 247 Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params); 248 end; 249 250 -- 4) Build new exp from base file and the lib file (.a) 251 252 Utl.Dlltool (Def_File, Dll_File, Lib_File, 253 Base_File => Bas_File, 254 Exp_Table => Exp_File, 255 Build_Import => Build_Import); 256 257 -- 5) Build the dynamic library 258 259 Utl.Gnatbind (L_Afiles, Options & Bargs_Options); 260 261 declare 262 Params : constant OS_Lib.Argument_List := 263 Map_Opt'Unchecked_Access & 264 Out_Opt'Unchecked_Access & 265 Dll_File'Unchecked_Access & 266 Lib_Opt'Unchecked_Access & 267 Exp_File'Unchecked_Access & 268 Adr_Opt'Unchecked_Access & 269 Ofiles & 270 All_Options; 271 First_Param : Positive := Params'First + 1; 272 273 begin 274 if Map_File then 275 First_Param := Params'First; 276 end if; 277 278 Utl.Gnatlink 279 (L_Afiles (L_Afiles'Last).all, 280 Params (First_Param .. Params'Last)); 281 end; 282 283 OS_Lib.Delete_File (Exp_File, Success); 284 OS_Lib.Delete_File (Bas_File, Success); 285 OS_Lib.Delete_File (Jnk_File, Success); 286 287 exception 288 when others => 289 OS_Lib.Delete_File (Exp_File, Success); 290 OS_Lib.Delete_File (Bas_File, Success); 291 OS_Lib.Delete_File (Jnk_File, Success); 292 raise; 293 end Ada_Build_Reloc_DLL; 294 295 ------------------------- 296 -- Build_Non_Reloc_DLL -- 297 ------------------------- 298 299 procedure Build_Non_Reloc_DLL is 300 Success : Boolean; 301 pragma Warnings (Off, Success); 302 303 begin 304 if not Quiet then 305 Text_IO.Put_Line ("building non relocatable DLL..."); 306 Text_IO.Put ("make " & Dll_File & 307 " using address " & Lib_Address); 308 309 if Build_Import then 310 Text_IO.Put_Line (" and " & Lib_File); 311 else 312 Text_IO.New_Line; 313 end if; 314 end if; 315 316 -- Build exp table and the lib .a file 317 318 Utl.Dlltool (Def_File, Dll_File, Lib_File, 319 Exp_Table => Exp_File, 320 Build_Import => Build_Import); 321 322 -- Build the DLL 323 324 declare 325 Params : OS_Lib.Argument_List := 326 Adr_Opt'Unchecked_Access & All_Options; 327 begin 328 if Map_File then 329 Params := Map_Opt'Unchecked_Access & Params; 330 end if; 331 332 Utl.Gcc (Output_File => Dll_File, 333 Files => Exp_File'Unchecked_Access & Ofiles, 334 Options => Params, 335 Build_Lib => True); 336 end; 337 338 OS_Lib.Delete_File (Exp_File, Success); 339 340 exception 341 when others => 342 OS_Lib.Delete_File (Exp_File, Success); 343 raise; 344 end Build_Non_Reloc_DLL; 345 346 ----------------------------- 347 -- Ada_Build_Non_Reloc_DLL -- 348 ----------------------------- 349 350 -- Build a non relocatable DLL with Ada code 351 352 procedure Ada_Build_Non_Reloc_DLL is 353 Success : Boolean; 354 pragma Warnings (Off, Success); 355 356 begin 357 if not Quiet then 358 Text_IO.Put_Line ("building non relocatable DLL..."); 359 Text_IO.Put ("make " & Dll_File & 360 " using address " & Lib_Address); 361 362 if Build_Import then 363 Text_IO.Put_Line (" and " & Lib_File); 364 else 365 Text_IO.New_Line; 366 end if; 367 end if; 368 369 -- Build exp table and the lib .a file 370 371 Utl.Dlltool (Def_File, Dll_File, Lib_File, 372 Exp_Table => Exp_File, 373 Build_Import => Build_Import); 374 375 -- Build the DLL 376 377 Utl.Gnatbind (L_Afiles, Options & Bargs_Options); 378 379 declare 380 Params : OS_Lib.Argument_List := 381 Out_Opt'Unchecked_Access & 382 Dll_File'Unchecked_Access & 383 Lib_Opt'Unchecked_Access & 384 Exp_File'Unchecked_Access & 385 Adr_Opt'Unchecked_Access & 386 Ofiles & 387 All_Options; 388 begin 389 if Map_File then 390 Params := Map_Opt'Unchecked_Access & Params; 391 end if; 392 393 Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params); 394 end; 395 396 OS_Lib.Delete_File (Exp_File, Success); 397 398 exception 399 when others => 400 OS_Lib.Delete_File (Exp_File, Success); 401 raise; 402 end Ada_Build_Non_Reloc_DLL; 403 404 -- Start of processing for Build_Dynamic_Library 405 406 begin 407 -- On Windows the binder file must not be in the first position in the 408 -- list. This is due to the way DLL's are built on Windows. We swap the 409 -- first ali with the last one if it is the case. 410 411 if L_Afiles'Length > 1 then 412 declare 413 Filename : constant String := 414 Directory_Operations.Base_Name 415 (L_Afiles (L_Afiles'First).all); 416 First : constant Positive := Filename'First; 417 418 begin 419 if Filename (First .. First + 1) = "b~" then 420 L_Afiles (L_Afiles'Last) := Afiles (Afiles'First); 421 L_Afiles (L_Afiles'First) := Afiles (Afiles'Last); 422 end if; 423 end; 424 end if; 425 426 case Relocatable is 427 when True => 428 if L_Afiles'Length = 0 then 429 Build_Reloc_DLL; 430 else 431 Ada_Build_Reloc_DLL; 432 end if; 433 434 when False => 435 if L_Afiles'Length = 0 then 436 Build_Non_Reloc_DLL; 437 else 438 Ada_Build_Non_Reloc_DLL; 439 end if; 440 end case; 441 end Build_Dynamic_Library; 442 443 -------------------------- 444 -- Build_Import_Library -- 445 -------------------------- 446 447 procedure Build_Import_Library 448 (Lib_Filename : String; 449 Def_Filename : String) 450 is 451 procedure Build_Import_Library (Lib_Filename : String); 452 -- Build an import library. This is to build only a .a library to link 453 -- against a DLL. 454 455 -------------------------- 456 -- Build_Import_Library -- 457 -------------------------- 458 459 procedure Build_Import_Library (Lib_Filename : String) is 460 461 function No_Lib_Prefix (Filename : String) return String; 462 -- Return Filename without the lib prefix if present 463 464 ------------------- 465 -- No_Lib_Prefix -- 466 ------------------- 467 468 function No_Lib_Prefix (Filename : String) return String is 469 begin 470 if Filename (Filename'First .. Filename'First + 2) = "lib" then 471 return Filename (Filename'First + 3 .. Filename'Last); 472 else 473 return Filename; 474 end if; 475 end No_Lib_Prefix; 476 477 -- Local variables 478 479 Def_File : String renames Def_Filename; 480 Dll_File : constant String := Get_Dll_Name (Lib_Filename); 481 Base_Filename : constant String := 482 MDLL.Fil.Ext_To (No_Lib_Prefix (Lib_Filename)); 483 Lib_File : constant String := "lib" & Base_Filename & ".dll.a"; 484 485 -- Start of processing for Build_Import_Library 486 487 begin 488 if not Quiet then 489 Text_IO.Put_Line ("Building import library..."); 490 Text_IO.Put_Line 491 ("make " & Lib_File & " to use dynamic library " & Dll_File); 492 end if; 493 494 Utl.Dlltool 495 (Def_File, Dll_File, Lib_File, Build_Import => True); 496 end Build_Import_Library; 497 498 -- Start of processing for Build_Import_Library 499 500 begin 501 Build_Import_Library (Lib_Filename); 502 end Build_Import_Library; 503 504 ------------------ 505 -- Get_Dll_Name -- 506 ------------------ 507 508 function Get_Dll_Name (Lib_Filename : String) return String is 509 begin 510 if MDLL.Fil.Get_Ext (Lib_Filename) = "" then 511 return Lib_Filename & ".dll"; 512 else 513 return Lib_Filename; 514 end if; 515 end Get_Dll_Name; 516 517end MDLL; 518