1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1997-2019, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- GNATDLL is a Windows specific tool for building a DLL.
27 -- Both relocatable and non-relocatable DLL's are supported
30 with MDLL
.Fil
; use MDLL
.Fil
;
32 with Switch
; use Switch
;
34 with Ada
.Text_IO
; use Ada
.Text_IO
;
35 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
36 with Ada
.Exceptions
; use Ada
.Exceptions
;
37 with Ada
.Command_Line
; use Ada
.Command_Line
;
39 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
40 with GNAT
.Command_Line
; use GNAT
.Command_Line
;
47 procedure Check
(Filename
: String);
48 -- Check that the file whose name is Filename exists
50 procedure Parse_Command_Line
;
51 -- Parse the command line arguments passed to gnatdll
53 procedure Check_Context
;
54 -- Check the context before running any commands to build the library
56 Syntax_Error
: exception;
57 -- Raised when a syntax error is detected, in this case a usage info will
60 Context_Error
: exception;
61 -- Raised when some files (specified on the command line) are missing to
64 Help
: Boolean := False;
65 -- Help will be set to True the usage information is to be displayed
67 Version
: constant String := Gnatvsn
.Gnat_Version_String
;
68 -- Why should it be necessary to make a copy of this
70 Default_DLL_Address
: constant String := "0x11000000";
71 -- Default address for non relocatable DLL (Win32)
73 Lib_Filename
: Unbounded_String
:= Null_Unbounded_String
;
74 -- The DLL filename that will be created (.dll)
76 Def_Filename
: Unbounded_String
:= Null_Unbounded_String
;
77 -- The definition filename (.def)
79 List_Filename
: Unbounded_String
:= Null_Unbounded_String
;
80 -- The name of the file containing the objects file to put into the DLL
82 DLL_Address
: Unbounded_String
:= To_Unbounded_String
(Default_DLL_Address
);
83 -- The DLL's base address
85 Gen_Map_File
: Boolean := False;
86 -- Set to True if a map file is to be generated
88 Objects_Files
: Argument_List_Access
:= MDLL
.Null_Argument_List_Access
;
89 -- List of objects to put inside the library
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.
95 Options
: Argument_List_Access
:= MDLL
.Null_Argument_List_Access
;
96 -- A list of options set in the command line
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
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
108 Build_Mode
: Build_Mode_State
:= Nil
;
109 -- Will be set when parsing the command line
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.
120 procedure P
(Str
: String) renames Put_Line
;
122 P
("Usage : gnatdll [options] [list-of-files]");
124 P
("[list-of-files] a list of Ada libraries (.ali) and/or " &
125 "foreign object files");
127 P
("[options] can be");
128 P
(" -h Help - display this message");
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 "
136 P
(" -e file Definition file containing exports");
137 P
(" -d file Put objects in the relocatable dynamic "
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");
154 procedure Check
(Filename
: String) is
156 if not Is_Regular_File
(Filename
) then
158 (Context_Error
'Identity, "Error: " & Filename
& " not found.");
162 ------------------------
163 -- Parse_Command_Line --
164 ------------------------
166 procedure Parse_Command_Line
is
168 procedure Add_File
(Filename
: String);
169 -- Add one file to the list of file to handle
171 procedure Add_Files_From_List
(List_Filename
: String);
172 -- Add the files listed in List_Filename (one by line) to the list
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 ???
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
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
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
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)
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)
202 Build_Import
: Boolean := True;
203 -- Set to False if option -n if specified (no-import)
209 procedure Add_File
(Filename
: String) is
211 if Is_Ali
(Filename
) then
214 -- Record it to generate the binder program when
215 -- building dynamic library
217 Afiles
(A
) := new String'(Filename);
220 elsif Is_Obj (Filename) then
223 -- Just record this object file
225 Ofiles (O) := new String'(Filename
);
232 (Syntax_Error
'Identity,
233 "don't know what to do with " & Filename
& " !");
237 -------------------------
238 -- Add_Files_From_List --
239 -------------------------
241 procedure Add_Files_From_List
(List_Filename
: String) is
243 Buffer
: String (1 .. 500);
247 Open
(File
, In_File
, List_Filename
);
249 while not End_Of_File
(File
) loop
250 Get_Line
(File
, Buffer
, Last
);
251 Add_File
(Buffer
(1 .. Last
));
259 (Syntax_Error
'Identity,
260 "list-of-files file " & List_Filename
& " not found.");
261 end Add_Files_From_List
;
263 -- Start of processing for Parse_Command_Line
266 Initialize_Option_Scan
('-', False, "bargs largs");
268 -- scan gnatdll switches
271 case Getopt
("g h v q k a? b: d: e: l: n m I:") is
279 Gopts
(G
) := new String'("-g");
284 -- Turn verbose mode on
286 MDLL.Verbose := True;
289 (Syntax_Error'Identity,
290 "impossible to use -q and -v together.");
295 -- Turn quiet mode on
300 (Syntax_Error'Identity,
301 "impossible to use -v and -q together.");
305 MDLL.Kill_Suffix := True;
308 if Parameter = "" then
310 -- Default address for a relocatable dynamic library.
311 -- address for a non relocatable dynamic library.
313 DLL_Address := To_Unbounded_String (Default_DLL_Address);
316 DLL_Address := To_Unbounded_String (Parameter);
319 Must_Build_Relocatable := False;
322 DLL_Address := To_Unbounded_String (Parameter);
323 Must_Build_Relocatable := True;
326 Def_Filename := To_Unbounded_String (Parameter);
330 -- Build a non relocatable DLL
332 Lib_Filename := To_Unbounded_String (Parameter);
334 if Def_Filename = Null_Unbounded_String then
335 Def_Filename := To_Unbounded_String
336 (Ext_To (Parameter, "def"));
339 Build_Mode := Dynamic_Lib;
342 Gen_Map_File := True;
345 Build_Import := False;
348 List_Filename := To_Unbounded_String (Parameter);
351 Gopts (G) := new String'("-I" & Parameter
);
355 raise Invalid_Switch
;
363 File
: constant String := Get_Argument
(Do_Expansion
=> True);
365 exit when File
'Length = 0;
370 -- Get largs parameters
372 Goto_Section
("largs");
380 Lopts
(L
) := new String'(Full_Switch);
385 -- Get bargs parameters
387 Goto_Section ("bargs");
395 Bopts (B) := new String'(Full_Switch
);
400 -- if list filename has been specified, parse it
402 if List_Filename
/= Null_Unbounded_String
then
403 Add_Files_From_List
(To_String
(List_Filename
));
406 -- Check if the set of parameters are compatible
408 if Build_Mode
= Nil
and then not Help
and then not MDLL
.Verbose
then
409 Raise_Exception
(Syntax_Error
'Identity, "nothing to do.");
412 -- -n option but no file specified
415 and then A
= Afiles
'First
416 and then O
= Ofiles
'First
419 (Syntax_Error
'Identity,
420 "-n specified but there are no objects to build the library.");
423 -- Check if we want to build an import library (option -e and
424 -- no file specified)
426 if Build_Mode
= Dynamic_Lib
427 and then A
= Afiles
'First
428 and then O
= Ofiles
'First
430 Build_Mode
:= Import_Lib
;
433 -- If map file is to be generated, add linker option here
435 if Gen_Map_File
and then Build_Mode
= Import_Lib
then
437 (Syntax_Error
'Identity,
438 "Can't generate a map file for an import library.");
441 -- Check if only a dynamic library must be built
443 if Build_Mode
= Dynamic_Lib
and then not Build_Import
then
444 Build_Mode
:= Dynamic_Lib_Only
;
447 if O
/= Ofiles
'First then
448 Objects_Files
:= new Argument_List
'(Ofiles (1 .. O - 1));
451 if A /= Afiles'First then
452 Ali_Files := new Argument_List'(Afiles
(1 .. A
- 1));
455 if G
/= Gopts
'First then
456 Options
:= new Argument_List
'(Gopts (1 .. G - 1));
459 if L /= Lopts'First then
460 Largs_Options := new Argument_List'(Lopts
(1 .. L
- 1));
463 if B
/= Bopts
'First then
464 Bargs_Options
:= new Argument_List
'(Bopts (1 .. B - 1));
468 when Invalid_Switch =>
470 (Syntax_Error'Identity,
471 Message => "Invalid Switch " & Full_Switch);
473 when Invalid_Parameter =>
475 (Syntax_Error'Identity,
476 Message => "No parameter for " & Full_Switch);
477 end Parse_Command_Line;
483 procedure Check_Context is
485 Check (To_String (Def_Filename));
487 -- Check that each object file specified exists and raise exception
488 -- Context_Error if it does not.
490 for F in Objects_Files'Range loop
491 Check (Objects_Files (F).all);
495 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Syntax);
497 -- Start of processing for Gnatdll
500 Check_Version_And_Help ("GNATDLL", "1997");
502 if Ada.Command_Line.Argument_Count = 0 then
508 if MDLL.Verbose or else Help then
510 Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder");
517 or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1)
525 MDLL.Build_Import_Library
526 (To_String (Lib_Filename),
527 To_String (Def_Filename));
530 MDLL.Build_Dynamic_Library
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);
543 when Dynamic_Lib_Only =>
544 MDLL.Build_Dynamic_Library
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);
562 Set_Exit_Status (Success);
565 when SE : Syntax_Error =>
566 Put_Line ("Syntax error : " & Exception_Message (SE));
569 Set_Exit_Status (Failure);
571 when E : MDLL.Tools_Error | Context_Error =>
572 Put_Line (Exception_Message (E));
573 Set_Exit_Status (Failure);
576 Put_Line ("gnatdll: INTERNAL ERROR. Please report");
577 Set_Exit_Status (Failure);