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