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