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-2021, 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 := 50_000; 176 Max_Options : constant := 1_000; 177 178 Ofiles : Argument_List (1 .. Max_Files); 179 O : Positive := Ofiles'First; 180 -- List of object files to put in the library. O is the next entry 181 -- to be used. 182 183 Afiles : Argument_List (1 .. Max_Files); 184 A : Positive := Afiles'First; 185 -- List of ALI files. A is the next entry to be used 186 187 Gopts : Argument_List (1 .. Max_Options); 188 G : Positive := Gopts'First; 189 -- List of gcc options. G is the next entry to be used 190 191 Lopts : Argument_List (1 .. Max_Options); 192 L : Positive := Lopts'First; 193 -- A list of -largs options (L is next entry to be used) 194 195 Bopts : Argument_List (1 .. Max_Options); 196 B : Positive := Bopts'First; 197 -- A list of -bargs options (B is next entry to be used) 198 199 Build_Import : Boolean := True; 200 -- Set to False if option -n if specified (no-import) 201 202 -------------- 203 -- Add_File -- 204 -------------- 205 206 procedure Add_File (Filename : String) is 207 begin 208 if Is_Ali (Filename) then 209 Check (Filename); 210 211 -- Record it to generate the binder program when 212 -- building dynamic library 213 214 Afiles (A) := new String'(Filename); 215 A := A + 1; 216 217 elsif Is_Obj (Filename) then 218 Check (Filename); 219 220 -- Just record this object file 221 222 Ofiles (O) := new String'(Filename); 223 O := O + 1; 224 225 else 226 -- Unknown file type 227 228 Raise_Exception 229 (Syntax_Error'Identity, 230 "don't know what to do with " & Filename & " !"); 231 end if; 232 end Add_File; 233 234 ------------------------- 235 -- Add_Files_From_List -- 236 ------------------------- 237 238 procedure Add_Files_From_List (List_Filename : String) is 239 File : File_Type; 240 Buffer : String (1 .. 500); 241 Last : Natural; 242 243 begin 244 Open (File, In_File, List_Filename); 245 246 while not End_Of_File (File) loop 247 Get_Line (File, Buffer, Last); 248 Add_File (Buffer (1 .. Last)); 249 end loop; 250 251 Close (File); 252 253 exception 254 when Name_Error => 255 Raise_Exception 256 (Syntax_Error'Identity, 257 "list-of-files file " & List_Filename & " not found."); 258 end Add_Files_From_List; 259 260 -- Start of processing for Parse_Command_Line 261 262 begin 263 Initialize_Option_Scan ('-', False, "bargs largs"); 264 265 -- scan gnatdll switches 266 267 loop 268 case Getopt ("g h v q k a? b: d: e: l: n m I:") is 269 when ASCII.NUL => 270 exit; 271 272 when 'h' => 273 Help := True; 274 275 when 'g' => 276 Gopts (G) := new String'("-g"); 277 G := G + 1; 278 279 when 'v' => 280 281 -- Turn verbose mode on 282 283 MDLL.Verbose := True; 284 if MDLL.Quiet then 285 Raise_Exception 286 (Syntax_Error'Identity, 287 "impossible to use -q and -v together."); 288 end if; 289 290 when 'q' => 291 292 -- Turn quiet mode on 293 294 MDLL.Quiet := True; 295 if MDLL.Verbose then 296 Raise_Exception 297 (Syntax_Error'Identity, 298 "impossible to use -v and -q together."); 299 end if; 300 301 when 'k' => 302 MDLL.Kill_Suffix := True; 303 304 when 'a' => 305 if Parameter = "" then 306 307 -- Default address for a relocatable dynamic library. 308 -- address for a non relocatable dynamic library. 309 310 DLL_Address := To_Unbounded_String (Default_DLL_Address); 311 312 else 313 DLL_Address := To_Unbounded_String (Parameter); 314 end if; 315 316 Must_Build_Relocatable := False; 317 318 when 'b' => 319 DLL_Address := To_Unbounded_String (Parameter); 320 Must_Build_Relocatable := True; 321 322 when 'e' => 323 Def_Filename := To_Unbounded_String (Parameter); 324 325 when 'd' => 326 327 -- Build a non relocatable DLL 328 329 Lib_Filename := To_Unbounded_String (Parameter); 330 331 if Def_Filename = Null_Unbounded_String then 332 Def_Filename := To_Unbounded_String 333 (Ext_To (Parameter, "def")); 334 end if; 335 336 Build_Mode := Dynamic_Lib; 337 338 when 'm' => 339 Gen_Map_File := True; 340 341 when 'n' => 342 Build_Import := False; 343 344 when 'l' => 345 List_Filename := To_Unbounded_String (Parameter); 346 347 when 'I' => 348 Gopts (G) := new String'("-I" & Parameter); 349 G := G + 1; 350 351 when others => 352 raise Invalid_Switch; 353 end case; 354 end loop; 355 356 -- Get parameters 357 358 loop 359 declare 360 File : constant String := Get_Argument (Do_Expansion => True); 361 begin 362 exit when File'Length = 0; 363 Add_File (File); 364 end; 365 end loop; 366 367 -- Get largs parameters 368 369 Goto_Section ("largs"); 370 371 loop 372 case Getopt ("*") is 373 when ASCII.NUL => 374 exit; 375 376 when others => 377 Lopts (L) := new String'(Full_Switch); 378 L := L + 1; 379 end case; 380 end loop; 381 382 -- Get bargs parameters 383 384 Goto_Section ("bargs"); 385 386 loop 387 case Getopt ("*") is 388 when ASCII.NUL => 389 exit; 390 391 when others => 392 Bopts (B) := new String'(Full_Switch); 393 B := B + 1; 394 end case; 395 end loop; 396 397 -- if list filename has been specified, parse it 398 399 if List_Filename /= Null_Unbounded_String then 400 Add_Files_From_List (To_String (List_Filename)); 401 end if; 402 403 -- Check if the set of parameters are compatible 404 405 if Build_Mode = Nil and then not Help and then not MDLL.Verbose then 406 Raise_Exception (Syntax_Error'Identity, "nothing to do."); 407 end if; 408 409 -- -n option but no file specified 410 411 if not Build_Import 412 and then A = Afiles'First 413 and then O = Ofiles'First 414 then 415 Raise_Exception 416 (Syntax_Error'Identity, 417 "-n specified but there are no objects to build the library."); 418 end if; 419 420 -- Check if we want to build an import library (option -e and 421 -- no file specified) 422 423 if Build_Mode = Dynamic_Lib 424 and then A = Afiles'First 425 and then O = Ofiles'First 426 then 427 Build_Mode := Import_Lib; 428 end if; 429 430 -- If map file is to be generated, add linker option here 431 432 if Gen_Map_File and then Build_Mode = Import_Lib then 433 Raise_Exception 434 (Syntax_Error'Identity, 435 "Can't generate a map file for an import library."); 436 end if; 437 438 -- Check if only a dynamic library must be built 439 440 if Build_Mode = Dynamic_Lib and then not Build_Import then 441 Build_Mode := Dynamic_Lib_Only; 442 end if; 443 444 if O /= Ofiles'First then 445 Objects_Files := new Argument_List'(Ofiles (1 .. O - 1)); 446 end if; 447 448 if A /= Afiles'First then 449 Ali_Files := new Argument_List'(Afiles (1 .. A - 1)); 450 end if; 451 452 if G /= Gopts'First then 453 Options := new Argument_List'(Gopts (1 .. G - 1)); 454 end if; 455 456 if L /= Lopts'First then 457 Largs_Options := new Argument_List'(Lopts (1 .. L - 1)); 458 end if; 459 460 if B /= Bopts'First then 461 Bargs_Options := new Argument_List'(Bopts (1 .. B - 1)); 462 end if; 463 464 exception 465 when Invalid_Switch => 466 Raise_Exception 467 (Syntax_Error'Identity, 468 Message => "Invalid Switch " & Full_Switch); 469 470 when Invalid_Parameter => 471 Raise_Exception 472 (Syntax_Error'Identity, 473 Message => "No parameter for " & Full_Switch); 474 end Parse_Command_Line; 475 476 ------------------- 477 -- Check_Context -- 478 ------------------- 479 480 procedure Check_Context is 481 begin 482 Check (To_String (Def_Filename)); 483 484 -- Check that each object file specified exists and raise exception 485 -- Context_Error if it does not. 486 487 for F in Objects_Files'Range loop 488 Check (Objects_Files (F).all); 489 end loop; 490 end Check_Context; 491 492 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Syntax); 493 494-- Start of processing for Gnatdll 495 496begin 497 Check_Version_And_Help ("GNATDLL", "1997"); 498 499 if Ada.Command_Line.Argument_Count = 0 then 500 Help := True; 501 else 502 Parse_Command_Line; 503 end if; 504 505 if MDLL.Verbose or else Help then 506 New_Line; 507 Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder"); 508 New_Line; 509 end if; 510 511 MDLL.Utl.Locate; 512 513 if Help 514 or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1) 515 then 516 Syntax; 517 else 518 Check_Context; 519 520 case Build_Mode is 521 when Import_Lib => 522 MDLL.Build_Import_Library 523 (To_String (Lib_Filename), 524 To_String (Def_Filename)); 525 526 when Dynamic_Lib => 527 MDLL.Build_Dynamic_Library 528 (Objects_Files.all, 529 Ali_Files.all, 530 Options.all, 531 Bargs_Options.all, 532 Largs_Options.all, 533 To_String (Lib_Filename), 534 To_String (Def_Filename), 535 To_String (DLL_Address), 536 Build_Import => True, 537 Relocatable => Must_Build_Relocatable, 538 Map_File => Gen_Map_File); 539 540 when Dynamic_Lib_Only => 541 MDLL.Build_Dynamic_Library 542 (Objects_Files.all, 543 Ali_Files.all, 544 Options.all, 545 Bargs_Options.all, 546 Largs_Options.all, 547 To_String (Lib_Filename), 548 To_String (Def_Filename), 549 To_String (DLL_Address), 550 Build_Import => False, 551 Relocatable => Must_Build_Relocatable, 552 Map_File => Gen_Map_File); 553 554 when Nil => 555 null; 556 end case; 557 end if; 558 559 Set_Exit_Status (Success); 560 561exception 562 when SE : Syntax_Error => 563 Put_Line ("Syntax error : " & Exception_Message (SE)); 564 New_Line; 565 Syntax; 566 Set_Exit_Status (Failure); 567 568 when E : MDLL.Tools_Error | Context_Error => 569 Put_Line (Exception_Message (E)); 570 Set_Exit_Status (Failure); 571 572 when others => 573 Put_Line ("gnatdll: INTERNAL ERROR. Please report"); 574 Set_Exit_Status (Failure); 575end Gnatdll; 576