1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T D L L -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1997-2013, 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-- GNATDLL is a Windows specific tool for building a DLL. 27-- Both relocatable and non-relocatable DLL's are supported 28 29with Gnatvsn; 30with MDLL.Fil; use MDLL.Fil; 31with MDLL.Utl; use MDLL.Utl; 32with Switch; use Switch; 33 34with Ada.Text_IO; use Ada.Text_IO; 35with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 36with Ada.Exceptions; use Ada.Exceptions; 37with Ada.Command_Line; use Ada.Command_Line; 38 39with GNAT.OS_Lib; use GNAT.OS_Lib; 40with GNAT.Command_Line; use GNAT.Command_Line; 41 42procedure Gnatdll is 43 44 use type GNAT.OS_Lib.Argument_List; 45 46 procedure Syntax; 47 -- Print out usage 48 49 procedure Check (Filename : String); 50 -- Check that the file whose name is Filename exists 51 52 procedure Parse_Command_Line; 53 -- Parse the command line arguments passed to gnatdll 54 55 procedure Check_Context; 56 -- Check the context before running any commands to build the library 57 58 Syntax_Error : exception; 59 -- Raised when a syntax error is detected, in this case a usage info will 60 -- be displayed. 61 62 Context_Error : exception; 63 -- Raised when some files (specified on the command line) are missing to 64 -- build the DLL. 65 66 Help : Boolean := False; 67 -- Help will be set to True the usage information is to be displayed 68 69 Version : constant String := Gnatvsn.Gnat_Version_String; 70 -- Why should it be necessary to make a copy of this 71 72 Default_DLL_Address : constant String := "0x11000000"; 73 -- Default address for non relocatable DLL (Win32) 74 75 Lib_Filename : Unbounded_String := Null_Unbounded_String; 76 -- The DLL filename that will be created (.dll) 77 78 Def_Filename : Unbounded_String := Null_Unbounded_String; 79 -- The definition filename (.def) 80 81 List_Filename : Unbounded_String := Null_Unbounded_String; 82 -- The name of the file containing the objects file to put into the DLL 83 84 DLL_Address : Unbounded_String := To_Unbounded_String (Default_DLL_Address); 85 -- The DLL's base address 86 87 Gen_Map_File : Boolean := False; 88 -- Set to True if a map file is to be generated 89 90 Objects_Files : Argument_List_Access := MDLL.Null_Argument_List_Access; 91 -- List of objects to put inside the library 92 93 Ali_Files : Argument_List_Access := MDLL.Null_Argument_List_Access; 94 -- For each Ada file specified, we keep a record of the corresponding 95 -- ALI file. This list of SLI files is used to build the binder program. 96 97 Options : Argument_List_Access := MDLL.Null_Argument_List_Access; 98 -- A list of options set in the command line 99 100 Largs_Options : Argument_List_Access := MDLL.Null_Argument_List_Access; 101 Bargs_Options : Argument_List_Access := MDLL.Null_Argument_List_Access; 102 -- GNAT linker and binder args options 103 104 type Build_Mode_State is (Import_Lib, Dynamic_Lib, Dynamic_Lib_Only, Nil); 105 -- Import_Lib means only the .a file will be created, Dynamic_Lib means 106 -- that both the DLL and the import library will be created. 107 -- Dynamic_Lib_Only means that only the DLL will be created (no import 108 -- library). 109 110 Build_Mode : Build_Mode_State := Nil; 111 -- Will be set when parsing the command line 112 113 Must_Build_Relocatable : Boolean := True; 114 -- True means build a relocatable DLL, will be set to False if a 115 -- non-relocatable DLL must be built. 116 117 ------------ 118 -- Syntax -- 119 ------------ 120 121 procedure Syntax is 122 procedure P (Str : String) renames Put_Line; 123 begin 124 P ("Usage : gnatdll [options] [list-of-files]"); 125 New_Line; 126 P ("[list-of-files] a list of Ada libraries (.ali) and/or " & 127 "foreign object files"); 128 New_Line; 129 P ("[options] can be"); 130 P (" -h Help - display this message"); 131 P (" -v Verbose"); 132 P (" -q Quiet"); 133 P (" -k Remove @nn suffix from exported names"); 134 P (" -g Generate debugging information"); 135 P (" -Idir Specify source and object files search path"); 136 P (" -l file File contains a list-of-files to be added to " 137 & "the library"); 138 P (" -e file Definition file containing exports"); 139 P (" -d file Put objects in the relocatable dynamic " 140 & "library <file>"); 141 P (" -b addr Set base address for the relocatable DLL"); 142 P (" default address is " & Default_DLL_Address); 143 P (" -a[addr] Build non-relocatable DLL at address <addr>"); 144 P (" if <addr> is not specified use " 145 & Default_DLL_Address); 146 P (" -m Generate map file"); 147 P (" -n No-import - do not create the import library"); 148 P (" -bargs opts opts are passed to the binder"); 149 P (" -largs opts opts are passed to the linker"); 150 end Syntax; 151 152 ----------- 153 -- Check -- 154 ----------- 155 156 procedure Check (Filename : String) is 157 begin 158 if not Is_Regular_File (Filename) then 159 Raise_Exception 160 (Context_Error'Identity, "Error: " & Filename & " not found."); 161 end if; 162 end Check; 163 164 ------------------------ 165 -- Parse_Command_Line -- 166 ------------------------ 167 168 procedure Parse_Command_Line is 169 170 procedure Add_File (Filename : String); 171 -- Add one file to the list of file to handle 172 173 procedure Add_Files_From_List (List_Filename : String); 174 -- Add the files listed in List_Filename (one by line) to the list 175 -- of file to handle 176 177 Max_Files : constant := 5_000; 178 Max_Options : constant := 100; 179 -- These are arbitrary limits, a better way will be to use linked list. 180 -- No, a better choice would be to use tables ??? 181 -- Limits on what??? 182 183 Ofiles : Argument_List (1 .. Max_Files); 184 O : Positive := Ofiles'First; 185 -- List of object files to put in the library. O is the next entry 186 -- to be used. 187 188 Afiles : Argument_List (1 .. Max_Files); 189 A : Positive := Afiles'First; 190 -- List of ALI files. A is the next entry to be used 191 192 Gopts : Argument_List (1 .. Max_Options); 193 G : Positive := Gopts'First; 194 -- List of gcc options. G is the next entry to be used 195 196 Lopts : Argument_List (1 .. Max_Options); 197 L : Positive := Lopts'First; 198 -- A list of -largs options (L is next entry to be used) 199 200 Bopts : Argument_List (1 .. Max_Options); 201 B : Positive := Bopts'First; 202 -- A list of -bargs options (B is next entry to be used) 203 204 Build_Import : Boolean := True; 205 -- Set to False if option -n if specified (no-import) 206 207 -------------- 208 -- Add_File -- 209 -------------- 210 211 procedure Add_File (Filename : String) is 212 begin 213 if Is_Ali (Filename) then 214 Check (Filename); 215 216 -- Record it to generate the binder program when 217 -- building dynamic library 218 219 Afiles (A) := new String'(Filename); 220 A := A + 1; 221 222 elsif Is_Obj (Filename) then 223 Check (Filename); 224 225 -- Just record this object file 226 227 Ofiles (O) := new String'(Filename); 228 O := O + 1; 229 230 else 231 -- Unknown file type 232 233 Raise_Exception 234 (Syntax_Error'Identity, 235 "don't know what to do with " & Filename & " !"); 236 end if; 237 end Add_File; 238 239 ------------------------- 240 -- Add_Files_From_List -- 241 ------------------------- 242 243 procedure Add_Files_From_List (List_Filename : String) is 244 File : File_Type; 245 Buffer : String (1 .. 500); 246 Last : Natural; 247 248 begin 249 Open (File, In_File, List_Filename); 250 251 while not End_Of_File (File) loop 252 Get_Line (File, Buffer, Last); 253 Add_File (Buffer (1 .. Last)); 254 end loop; 255 256 Close (File); 257 258 exception 259 when Name_Error => 260 Raise_Exception 261 (Syntax_Error'Identity, 262 "list-of-files file " & List_Filename & " not found."); 263 end Add_Files_From_List; 264 265 -- Start of processing for Parse_Command_Line 266 267 begin 268 Initialize_Option_Scan ('-', False, "bargs largs"); 269 270 -- scan gnatdll switches 271 272 loop 273 case Getopt ("g h v q k a? b: d: e: l: n m I:") is 274 275 when ASCII.NUL => 276 exit; 277 278 when 'h' => 279 Help := True; 280 281 when 'g' => 282 Gopts (G) := new String'("-g"); 283 G := G + 1; 284 285 when 'v' => 286 287 -- Turn verbose mode on 288 289 MDLL.Verbose := True; 290 if MDLL.Quiet then 291 Raise_Exception 292 (Syntax_Error'Identity, 293 "impossible to use -q and -v together."); 294 end if; 295 296 when 'q' => 297 298 -- Turn quiet mode on 299 300 MDLL.Quiet := True; 301 if MDLL.Verbose then 302 Raise_Exception 303 (Syntax_Error'Identity, 304 "impossible to use -v and -q together."); 305 end if; 306 307 when 'k' => 308 309 MDLL.Kill_Suffix := True; 310 311 when 'a' => 312 313 if Parameter = "" then 314 315 -- Default address for a relocatable dynamic library. 316 -- address for a non relocatable dynamic library. 317 318 DLL_Address := To_Unbounded_String (Default_DLL_Address); 319 320 else 321 DLL_Address := To_Unbounded_String (Parameter); 322 end if; 323 324 Must_Build_Relocatable := False; 325 326 when 'b' => 327 328 DLL_Address := To_Unbounded_String (Parameter); 329 330 Must_Build_Relocatable := True; 331 332 when 'e' => 333 334 Def_Filename := To_Unbounded_String (Parameter); 335 336 when 'd' => 337 338 -- Build a non relocatable DLL 339 340 Lib_Filename := To_Unbounded_String (Parameter); 341 342 if Def_Filename = Null_Unbounded_String then 343 Def_Filename := To_Unbounded_String 344 (Ext_To (Parameter, "def")); 345 end if; 346 347 Build_Mode := Dynamic_Lib; 348 349 when 'm' => 350 351 Gen_Map_File := True; 352 353 when 'n' => 354 355 Build_Import := False; 356 357 when 'l' => 358 List_Filename := To_Unbounded_String (Parameter); 359 360 when 'I' => 361 Gopts (G) := new String'("-I" & Parameter); 362 G := G + 1; 363 364 when others => 365 raise Invalid_Switch; 366 end case; 367 end loop; 368 369 -- Get parameters 370 371 loop 372 declare 373 File : constant String := Get_Argument (Do_Expansion => True); 374 begin 375 exit when File'Length = 0; 376 Add_File (File); 377 end; 378 end loop; 379 380 -- Get largs parameters 381 382 Goto_Section ("largs"); 383 384 loop 385 case Getopt ("*") is 386 when ASCII.NUL => 387 exit; 388 389 when others => 390 Lopts (L) := new String'(Full_Switch); 391 L := L + 1; 392 end case; 393 end loop; 394 395 -- Get bargs parameters 396 397 Goto_Section ("bargs"); 398 399 loop 400 case Getopt ("*") is 401 402 when ASCII.NUL => 403 exit; 404 405 when others => 406 Bopts (B) := new String'(Full_Switch); 407 B := B + 1; 408 409 end case; 410 end loop; 411 412 -- if list filename has been specified, parse it 413 414 if List_Filename /= Null_Unbounded_String then 415 Add_Files_From_List (To_String (List_Filename)); 416 end if; 417 418 -- Check if the set of parameters are compatible 419 420 if Build_Mode = Nil and then not Help and then not MDLL.Verbose then 421 Raise_Exception (Syntax_Error'Identity, "nothing to do."); 422 end if; 423 424 -- -n option but no file specified 425 426 if not Build_Import 427 and then A = Afiles'First 428 and then O = Ofiles'First 429 then 430 Raise_Exception 431 (Syntax_Error'Identity, 432 "-n specified but there are no objects to build the library."); 433 end if; 434 435 -- Check if we want to build an import library (option -e and 436 -- no file specified) 437 438 if Build_Mode = Dynamic_Lib 439 and then A = Afiles'First 440 and then O = Ofiles'First 441 then 442 Build_Mode := Import_Lib; 443 end if; 444 445 -- If map file is to be generated, add linker option here 446 447 if Gen_Map_File and then Build_Mode = Import_Lib then 448 Raise_Exception 449 (Syntax_Error'Identity, 450 "Can't generate a map file for an import library."); 451 end if; 452 453 -- Check if only a dynamic library must be built 454 455 if Build_Mode = Dynamic_Lib and then not Build_Import then 456 Build_Mode := Dynamic_Lib_Only; 457 end if; 458 459 if O /= Ofiles'First then 460 Objects_Files := new Argument_List'(Ofiles (1 .. O - 1)); 461 end if; 462 463 if A /= Afiles'First then 464 Ali_Files := new Argument_List'(Afiles (1 .. A - 1)); 465 end if; 466 467 if G /= Gopts'First then 468 Options := new Argument_List'(Gopts (1 .. G - 1)); 469 end if; 470 471 if L /= Lopts'First then 472 Largs_Options := new Argument_List'(Lopts (1 .. L - 1)); 473 end if; 474 475 if B /= Bopts'First then 476 Bargs_Options := new Argument_List'(Bopts (1 .. B - 1)); 477 end if; 478 479 exception 480 when Invalid_Switch => 481 Raise_Exception 482 (Syntax_Error'Identity, 483 Message => "Invalid Switch " & Full_Switch); 484 485 when Invalid_Parameter => 486 Raise_Exception 487 (Syntax_Error'Identity, 488 Message => "No parameter for " & Full_Switch); 489 end Parse_Command_Line; 490 491 ------------------- 492 -- Check_Context -- 493 ------------------- 494 495 procedure Check_Context is 496 begin 497 Check (To_String (Def_Filename)); 498 499 -- Check that each object file specified exists and raise exception 500 -- Context_Error if it does not. 501 502 for F in Objects_Files'Range loop 503 Check (Objects_Files (F).all); 504 end loop; 505 end Check_Context; 506 507 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Syntax); 508 509-- Start of processing for Gnatdll 510 511begin 512 Check_Version_And_Help ("GNATDLL", "1997"); 513 514 if Ada.Command_Line.Argument_Count = 0 then 515 Help := True; 516 else 517 Parse_Command_Line; 518 end if; 519 520 if MDLL.Verbose or else Help then 521 New_Line; 522 Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder"); 523 New_Line; 524 end if; 525 526 MDLL.Utl.Locate; 527 528 if Help 529 or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1) 530 then 531 Syntax; 532 else 533 Check_Context; 534 535 case Build_Mode is 536 when Import_Lib => 537 MDLL.Build_Import_Library 538 (To_String (Lib_Filename), 539 To_String (Def_Filename)); 540 541 when Dynamic_Lib => 542 MDLL.Build_Dynamic_Library 543 (Objects_Files.all, 544 Ali_Files.all, 545 Options.all, 546 Bargs_Options.all, 547 Largs_Options.all, 548 To_String (Lib_Filename), 549 To_String (Def_Filename), 550 To_String (DLL_Address), 551 Build_Import => True, 552 Relocatable => Must_Build_Relocatable, 553 Map_File => Gen_Map_File); 554 555 when Dynamic_Lib_Only => 556 MDLL.Build_Dynamic_Library 557 (Objects_Files.all, 558 Ali_Files.all, 559 Options.all, 560 Bargs_Options.all, 561 Largs_Options.all, 562 To_String (Lib_Filename), 563 To_String (Def_Filename), 564 To_String (DLL_Address), 565 Build_Import => False, 566 Relocatable => Must_Build_Relocatable, 567 Map_File => Gen_Map_File); 568 569 when Nil => 570 null; 571 end case; 572 end if; 573 574 Set_Exit_Status (Success); 575 576exception 577 when SE : Syntax_Error => 578 Put_Line ("Syntax error : " & Exception_Message (SE)); 579 New_Line; 580 Syntax; 581 Set_Exit_Status (Failure); 582 583 when E : MDLL.Tools_Error | Context_Error => 584 Put_Line (Exception_Message (E)); 585 Set_Exit_Status (Failure); 586 587 when others => 588 Put_Line ("gnatdll: INTERNAL ERROR. Please report"); 589 Set_Exit_Status (Failure); 590end Gnatdll; 591