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-2019, 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; 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 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 when ASCII.NUL => 273 exit; 274 275 when 'h' => 276 Help := True; 277 278 when 'g' => 279 Gopts (G) := new String'("-g"); 280 G := G + 1; 281 282 when 'v' => 283 284 -- Turn verbose mode on 285 286 MDLL.Verbose := True; 287 if MDLL.Quiet then 288 Raise_Exception 289 (Syntax_Error'Identity, 290 "impossible to use -q and -v together."); 291 end if; 292 293 when 'q' => 294 295 -- Turn quiet mode on 296 297 MDLL.Quiet := True; 298 if MDLL.Verbose then 299 Raise_Exception 300 (Syntax_Error'Identity, 301 "impossible to use -v and -q together."); 302 end if; 303 304 when 'k' => 305 MDLL.Kill_Suffix := True; 306 307 when 'a' => 308 if Parameter = "" then 309 310 -- Default address for a relocatable dynamic library. 311 -- address for a non relocatable dynamic library. 312 313 DLL_Address := To_Unbounded_String (Default_DLL_Address); 314 315 else 316 DLL_Address := To_Unbounded_String (Parameter); 317 end if; 318 319 Must_Build_Relocatable := False; 320 321 when 'b' => 322 DLL_Address := To_Unbounded_String (Parameter); 323 Must_Build_Relocatable := True; 324 325 when 'e' => 326 Def_Filename := To_Unbounded_String (Parameter); 327 328 when 'd' => 329 330 -- Build a non relocatable DLL 331 332 Lib_Filename := To_Unbounded_String (Parameter); 333 334 if Def_Filename = Null_Unbounded_String then 335 Def_Filename := To_Unbounded_String 336 (Ext_To (Parameter, "def")); 337 end if; 338 339 Build_Mode := Dynamic_Lib; 340 341 when 'm' => 342 Gen_Map_File := True; 343 344 when 'n' => 345 Build_Import := False; 346 347 when 'l' => 348 List_Filename := To_Unbounded_String (Parameter); 349 350 when 'I' => 351 Gopts (G) := new String'("-I" & Parameter); 352 G := G + 1; 353 354 when others => 355 raise Invalid_Switch; 356 end case; 357 end loop; 358 359 -- Get parameters 360 361 loop 362 declare 363 File : constant String := Get_Argument (Do_Expansion => True); 364 begin 365 exit when File'Length = 0; 366 Add_File (File); 367 end; 368 end loop; 369 370 -- Get largs parameters 371 372 Goto_Section ("largs"); 373 374 loop 375 case Getopt ("*") is 376 when ASCII.NUL => 377 exit; 378 379 when others => 380 Lopts (L) := new String'(Full_Switch); 381 L := L + 1; 382 end case; 383 end loop; 384 385 -- Get bargs parameters 386 387 Goto_Section ("bargs"); 388 389 loop 390 case Getopt ("*") is 391 when ASCII.NUL => 392 exit; 393 394 when others => 395 Bopts (B) := new String'(Full_Switch); 396 B := B + 1; 397 end case; 398 end loop; 399 400 -- if list filename has been specified, parse it 401 402 if List_Filename /= Null_Unbounded_String then 403 Add_Files_From_List (To_String (List_Filename)); 404 end if; 405 406 -- Check if the set of parameters are compatible 407 408 if Build_Mode = Nil and then not Help and then not MDLL.Verbose then 409 Raise_Exception (Syntax_Error'Identity, "nothing to do."); 410 end if; 411 412 -- -n option but no file specified 413 414 if not Build_Import 415 and then A = Afiles'First 416 and then O = Ofiles'First 417 then 418 Raise_Exception 419 (Syntax_Error'Identity, 420 "-n specified but there are no objects to build the library."); 421 end if; 422 423 -- Check if we want to build an import library (option -e and 424 -- no file specified) 425 426 if Build_Mode = Dynamic_Lib 427 and then A = Afiles'First 428 and then O = Ofiles'First 429 then 430 Build_Mode := Import_Lib; 431 end if; 432 433 -- If map file is to be generated, add linker option here 434 435 if Gen_Map_File and then Build_Mode = Import_Lib then 436 Raise_Exception 437 (Syntax_Error'Identity, 438 "Can't generate a map file for an import library."); 439 end if; 440 441 -- Check if only a dynamic library must be built 442 443 if Build_Mode = Dynamic_Lib and then not Build_Import then 444 Build_Mode := Dynamic_Lib_Only; 445 end if; 446 447 if O /= Ofiles'First then 448 Objects_Files := new Argument_List'(Ofiles (1 .. O - 1)); 449 end if; 450 451 if A /= Afiles'First then 452 Ali_Files := new Argument_List'(Afiles (1 .. A - 1)); 453 end if; 454 455 if G /= Gopts'First then 456 Options := new Argument_List'(Gopts (1 .. G - 1)); 457 end if; 458 459 if L /= Lopts'First then 460 Largs_Options := new Argument_List'(Lopts (1 .. L - 1)); 461 end if; 462 463 if B /= Bopts'First then 464 Bargs_Options := new Argument_List'(Bopts (1 .. B - 1)); 465 end if; 466 467 exception 468 when Invalid_Switch => 469 Raise_Exception 470 (Syntax_Error'Identity, 471 Message => "Invalid Switch " & Full_Switch); 472 473 when Invalid_Parameter => 474 Raise_Exception 475 (Syntax_Error'Identity, 476 Message => "No parameter for " & Full_Switch); 477 end Parse_Command_Line; 478 479 ------------------- 480 -- Check_Context -- 481 ------------------- 482 483 procedure Check_Context is 484 begin 485 Check (To_String (Def_Filename)); 486 487 -- Check that each object file specified exists and raise exception 488 -- Context_Error if it does not. 489 490 for F in Objects_Files'Range loop 491 Check (Objects_Files (F).all); 492 end loop; 493 end Check_Context; 494 495 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Syntax); 496 497-- Start of processing for Gnatdll 498 499begin 500 Check_Version_And_Help ("GNATDLL", "1997"); 501 502 if Ada.Command_Line.Argument_Count = 0 then 503 Help := True; 504 else 505 Parse_Command_Line; 506 end if; 507 508 if MDLL.Verbose or else Help then 509 New_Line; 510 Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder"); 511 New_Line; 512 end if; 513 514 MDLL.Utl.Locate; 515 516 if Help 517 or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1) 518 then 519 Syntax; 520 else 521 Check_Context; 522 523 case Build_Mode is 524 when Import_Lib => 525 MDLL.Build_Import_Library 526 (To_String (Lib_Filename), 527 To_String (Def_Filename)); 528 529 when Dynamic_Lib => 530 MDLL.Build_Dynamic_Library 531 (Objects_Files.all, 532 Ali_Files.all, 533 Options.all, 534 Bargs_Options.all, 535 Largs_Options.all, 536 To_String (Lib_Filename), 537 To_String (Def_Filename), 538 To_String (DLL_Address), 539 Build_Import => True, 540 Relocatable => Must_Build_Relocatable, 541 Map_File => Gen_Map_File); 542 543 when Dynamic_Lib_Only => 544 MDLL.Build_Dynamic_Library 545 (Objects_Files.all, 546 Ali_Files.all, 547 Options.all, 548 Bargs_Options.all, 549 Largs_Options.all, 550 To_String (Lib_Filename), 551 To_String (Def_Filename), 552 To_String (DLL_Address), 553 Build_Import => False, 554 Relocatable => Must_Build_Relocatable, 555 Map_File => Gen_Map_File); 556 557 when Nil => 558 null; 559 end case; 560 end if; 561 562 Set_Exit_Status (Success); 563 564exception 565 when SE : Syntax_Error => 566 Put_Line ("Syntax error : " & Exception_Message (SE)); 567 New_Line; 568 Syntax; 569 Set_Exit_Status (Failure); 570 571 when E : MDLL.Tools_Error | Context_Error => 572 Put_Line (Exception_Message (E)); 573 Set_Exit_Status (Failure); 574 575 when others => 576 Put_Line ("gnatdll: INTERNAL ERROR. Please report"); 577 Set_Exit_Status (Failure); 578end Gnatdll; 579