1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1997-2002, Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- GNATDLL is a Windows specific tool for building a DLL.
28 -- Both relocatable and non-relocatable DLL's are supported
31 with Ada.Strings.Unbounded;
33 with Ada.Command_Line;
35 with GNAT.Command_Line;
46 use Ada.Strings.Unbounded;
48 use type OS_Lib.Argument_List;
53 procedure Check (Filename : String);
54 -- Check that the file whose name is Filename exists
56 procedure Parse_Command_Line;
57 -- Parse the command line arguments passed to gnatdll
59 procedure Check_Context;
60 -- Check the context before runing any commands to build the library
62 Syntax_Error : exception;
63 -- Raised when a syntax error is detected, in this case a usage info will
66 Context_Error : exception;
67 -- Raised when some files (specifed on the command line) are missing to
70 Help : Boolean := False;
71 -- Help will be set to True the usage information is to be displayed.
73 Version : constant String := Gnatvsn.Gnat_Version_String;
74 -- Why should it be necessary to make a copy of this
76 Default_DLL_Address : constant String := "0x11000000";
77 -- Default address for non relocatable DLL (Win32)
79 Lib_Filename : Unbounded_String := Null_Unbounded_String;
80 -- The DLL filename that will be created (.dll)
82 Def_Filename : Unbounded_String := Null_Unbounded_String;
83 -- The definition filename (.def)
85 List_Filename : Unbounded_String := Null_Unbounded_String;
86 -- The name of the file containing the objects file to put into the DLL
88 DLL_Address : Unbounded_String :=
89 To_Unbounded_String (Default_DLL_Address);
90 -- The DLL's base address
92 Objects_Files : Argument_List_Access := Null_Argument_List_Access;
93 -- List of objects to put inside the library
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.
99 Options : Argument_List_Access := Null_Argument_List_Access;
100 -- A list of options set in the command line.
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
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
112 Build_Mode : Build_Mode_State := Nil;
113 -- Will be set when parsing the command line.
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.
126 procedure P (Str : in String) renames Text_IO.Put_Line;
129 P ("Usage : gnatdll [options] [list-of-files]");
131 P ("[list-of-files] a list of Ada libraries (.ali) and/or " &
132 "foreign object files");
134 P ("[options] can be");
135 P (" -h Help - display this message");
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 "
143 P (" -e file Definition file containing exports");
144 P (" -d file Put objects in the relocatable dynamic "
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");
160 procedure Check (Filename : in String) is
162 if not OS_Lib.Is_Regular_File (Filename) then
163 Exceptions.Raise_Exception (Context_Error'Identity,
164 "Error: " & Filename & " not found.");
168 ------------------------
169 -- Parse_Command_Line --
170 ------------------------
172 procedure Parse_Command_Line is
174 use GNAT.Command_Line;
176 procedure Add_File (Filename : in String);
177 -- Add one file to the list of file to handle
179 procedure Add_Files_From_List (List_Filename : in String);
180 -- Add the files listed in List_Filename (one by line) to the list
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 ???
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
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.
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.
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)
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)
210 Build_Import : Boolean := True;
211 -- Set to Fals if option -n if specified (no-import).
217 procedure Add_File (Filename : in String) is
219 if Fil.Is_Ali (Filename) then
223 -- Record it to generate the binder program when
224 -- building dynamic library
226 Afiles (A) := new String'(Filename);
229 elsif Fil.Is_Obj (Filename) then
233 -- Just record this object file
235 Ofiles (O) := new String'(Filename);
241 Exceptions.Raise_Exception
242 (Syntax_Error'Identity,
243 "don't know what to do with " & Filename & " !");
247 -------------------------
248 -- Add_Files_From_List --
249 -------------------------
251 procedure Add_Files_From_List (List_Filename : in String) is
252 File : Text_IO.File_Type;
253 Buffer : String (1 .. 500);
257 Text_IO.Open (File, Text_IO.In_File, List_Filename);
259 while not Text_IO.End_Of_File (File) loop
260 Text_IO.Get_Line (File, Buffer, Last);
261 Add_File (Buffer (1 .. Last));
264 Text_IO.Close (File);
265 end Add_Files_From_List;
267 -- Start of processing for Parse_Command_Line
270 Initialize_Option_Scan ('-', False, "bargs largs");
272 -- scan gnatdll switches
275 case Getopt ("g h v q k a? b: d: e: l: n I:") is
284 Gopts (G) := new String'("-g");
289 -- Turn verbose mode on
291 MDLL.Verbose := True;
293 Exceptions.Raise_Exception
294 (Syntax_Error'Identity,
295 "impossible to use -q and -v together.");
300 -- Turn quiet mode on
304 Exceptions.Raise_Exception
305 (Syntax_Error'Identity,
306 "impossible to use -v and -q together.");
311 MDLL.Kill_Suffix := True;
315 if Parameter = "" then
317 -- Default address for a relocatable dynamic library.
318 -- address for a non relocatable dynamic library.
320 DLL_Address := To_Unbounded_String (Default_DLL_Address);
323 DLL_Address := To_Unbounded_String (Parameter);
326 Must_Build_Relocatable := False;
330 DLL_Address := To_Unbounded_String (Parameter);
332 Must_Build_Relocatable := True;
336 Def_Filename := To_Unbounded_String (Parameter);
340 -- Build a non relocatable DLL
342 Lib_Filename := To_Unbounded_String (Parameter);
344 if Def_Filename = Null_Unbounded_String then
345 Def_Filename := To_Unbounded_String
346 (Fil.Ext_To (Parameter, "def"));
349 Build_Mode := Dynamic_Lib;
353 Build_Import := False;
356 List_Filename := To_Unbounded_String (Parameter);
359 Gopts (G) := new String'("-I" & Parameter);
363 raise Invalid_Switch;
372 File : constant String := Get_Argument (Do_Expansion => True);
374 exit when File'Length = 0;
379 -- Get largs parameters
381 Goto_Section ("largs");
390 Lopts (L) := new String'(Full_Switch);
396 -- Get bargs parameters
398 Goto_Section ("bargs");
407 Bopts (B) := new String'(Full_Switch);
413 -- if list filename has been specified, parse it
415 if List_Filename /= Null_Unbounded_String then
416 Add_Files_From_List (To_String (List_Filename));
419 -- Check if the set of parameters are compatible.
421 if Build_Mode = Nil and then not Help and then not Verbose then
422 Exceptions.Raise_Exception
423 (Syntax_Error'Identity,
427 -- -n option but no file specified
430 and then A = Afiles'First
431 and then O = Ofiles'First
433 Exceptions.Raise_Exception
434 (Syntax_Error'Identity,
435 "-n specified but there are no objects to build the library.");
438 -- Check if we want to build an import library (option -e and
439 -- no file specified)
441 if Build_Mode = Dynamic_Lib
442 and then A = Afiles'First
443 and then O = Ofiles'First
445 Build_Mode := Import_Lib;
448 -- Check if only a dynamic library must be built.
450 if Build_Mode = Dynamic_Lib and then not Build_Import then
451 Build_Mode := Dynamic_Lib_Only;
454 if O /= Ofiles'First then
455 Objects_Files := new OS_Lib.Argument_List'(Ofiles (1 .. O - 1));
458 if A /= Afiles'First then
459 Ali_Files := new OS_Lib.Argument_List'(Afiles (1 .. A - 1));
462 if G /= Gopts'First then
463 Options := new OS_Lib.Argument_List'(Gopts (1 .. G - 1));
466 if L /= Lopts'First then
467 Largs_Options := new OS_Lib.Argument_List'(Lopts (1 .. L - 1));
470 if B /= Bopts'First then
471 Bargs_Options := new OS_Lib.Argument_List'(Bopts (1 .. B - 1));
476 when Invalid_Switch =>
477 Exceptions.Raise_Exception
478 (Syntax_Error'Identity,
479 Message => "Invalid Switch " & Full_Switch);
481 when Invalid_Parameter =>
482 Exceptions.Raise_Exception
483 (Syntax_Error'Identity,
484 Message => "No parameter for " & Full_Switch);
486 end Parse_Command_Line;
492 procedure Check_Context is
495 Check (To_String (Def_Filename));
497 -- Check that each object file specified exists and raise exception
498 -- Context_Error if it does not.
500 for F in Objects_Files'Range loop
501 Check (Objects_Files (F).all);
505 -- Start of processing for Gnatdll
508 if Ada.Command_Line.Argument_Count = 0 then
514 if MDLL.Verbose or else Help then
516 Text_IO.Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder");
523 or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1)
532 MDLL.Build_Import_Library
533 (To_String (Lib_Filename),
534 To_String (Def_Filename));
537 MDLL.Build_Dynamic_Library
543 To_String (Lib_Filename),
544 To_String (Def_Filename),
545 To_String (DLL_Address),
546 Build_Import => True,
547 Relocatable => Must_Build_Relocatable);
549 when Dynamic_Lib_Only =>
550 MDLL.Build_Dynamic_Library
556 To_String (Lib_Filename),
557 To_String (Def_Filename),
558 To_String (DLL_Address),
559 Build_Import => False,
560 Relocatable => Must_Build_Relocatable);
569 Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
573 when SE : Syntax_Error =>
574 Text_IO.Put_Line ("Syntax error : " & Exceptions.Exception_Message (SE));
577 Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
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);
584 Text_IO.Put_Line ("gnatdll: INTERNAL ERROR. Please report");
585 Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);