1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- M D L L . T O O L S --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 -- Interface to externals tools used to build DLL and import libraries
35 package body MDLL
.Utl
is
40 Dlltool_Name
: constant String := "dlltool";
41 Dlltool_Exec
: OS_Lib
.String_Access
;
43 Gcc_Name
: constant String := "gcc";
44 Gcc_Exec
: OS_Lib
.String_Access
;
46 Gnatbind_Name
: constant String := "gnatbind";
47 Gnatbind_Exec
: OS_Lib
.String_Access
;
49 Gnatlink_Name
: constant String := "gnatlink";
50 Gnatlink_Exec
: OS_Lib
.String_Access
;
52 procedure Print_Command
54 Arguments
: OS_Lib
.Argument_List
);
55 -- display the command runned when in Verbose mode
61 procedure Print_Command
63 Arguments
: OS_Lib
.Argument_List
)
67 Text_IO
.Put
(Tool_Name
);
68 for K
in Arguments
'Range loop
69 Text_IO
.Put
(" " & Arguments
(K
).all);
80 (Def_Filename
: String;
83 Exp_Table
: String := "";
84 Base_File
: String := "";
85 Build_Import
: Boolean)
87 Arguments
: OS_Lib
.Argument_List
(1 .. 11);
92 Def_Opt
: aliased String := "--def";
93 Def_V
: aliased String := Def_Filename
;
94 Dll_Opt
: aliased String := "--dllname";
95 Dll_V
: aliased String := DLL_Name
;
96 Lib_Opt
: aliased String := "--output-lib";
97 Lib_V
: aliased String := Library
;
98 Exp_Opt
: aliased String := "--output-exp";
99 Exp_V
: aliased String := Exp_Table
;
100 Bas_Opt
: aliased String := "--base-file";
101 Bas_V
: aliased String := Base_File
;
102 No_Suf_Opt
: aliased String := "-k";
104 Arguments
(1 .. 4) := (1 => Def_Opt
'Unchecked_Access,
105 2 => Def_V
'Unchecked_Access,
106 3 => Dll_Opt
'Unchecked_Access,
107 4 => Dll_V
'Unchecked_Access);
112 Arguments
(A
) := No_Suf_Opt
'Unchecked_Access;
115 if Library
/= "" and then Build_Import
then
117 Arguments
(A
) := Lib_Opt
'Unchecked_Access;
119 Arguments
(A
) := Lib_V
'Unchecked_Access;
122 if Exp_Table
/= "" then
124 Arguments
(A
) := Exp_Opt
'Unchecked_Access;
126 Arguments
(A
) := Exp_V
'Unchecked_Access;
129 if Base_File
/= "" then
131 Arguments
(A
) := Bas_Opt
'Unchecked_Access;
133 Arguments
(A
) := Bas_V
'Unchecked_Access;
136 Print_Command
("dlltool", Arguments
(1 .. A
));
138 OS_Lib
.Spawn
(Dlltool_Exec
.all, Arguments
(1 .. A
), Success
);
141 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
142 Dlltool_Name
& " execution error.");
152 (Output_File
: String;
153 Files
: Argument_List
;
154 Options
: Argument_List
;
155 Base_File
: String := "";
156 Build_Lib
: Boolean := False)
160 Arguments
: OS_Lib
.Argument_List
161 (1 .. 5 + Files
'Length + Options
'Length);
165 C_Opt
: aliased String := "-c";
166 Out_Opt
: aliased String := "-o";
167 Out_V
: aliased String := Output_File
;
168 Bas_Opt
: aliased String := "-Wl,--base-file," & Base_File
;
169 Lib_Opt
: aliased String := "-mdll";
170 Lib_Dir
: aliased String := "-L" & Object_Dir_Default_Name
.all;
175 Arguments
(A
) := Lib_Opt
'Unchecked_Access;
177 Arguments
(A
) := C_Opt
'Unchecked_Access;
181 Arguments
(A
.. A
+ 2) := (Out_Opt
'Unchecked_Access,
182 Out_V
'Unchecked_Access,
183 Lib_Dir
'Unchecked_Access);
186 if Base_File
/= "" then
188 Arguments
(A
) := Bas_Opt
'Unchecked_Access;
192 Arguments
(A
.. A
+ Files
'Length - 1) := Files
;
193 A
:= A
+ Files
'Length - 1;
197 Arguments
(A
.. A
+ Options
'Length - 1) := Options
;
198 A
:= A
+ Options
'Length - 1;
201 Largs
: Argument_List
(Options
'Range);
202 L
: Natural := Largs
'First - 1;
204 for K
in Options
'Range loop
205 if Options
(K
) (1 .. 2) /= "-l" then
207 Largs
(L
) := Options
(K
);
211 Arguments
(A
.. A
+ L
- 1) := Largs
(1 .. L
);
216 Print_Command
("gcc", Arguments
(1 .. A
));
218 OS_Lib
.Spawn
(Gcc_Exec
.all, Arguments
(1 .. A
), Success
);
221 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
222 Gcc_Name
& " execution error.");
231 (Alis
: Argument_List
;
232 Args
: Argument_List
:= Null_Argument_List
)
234 Arguments
: OS_Lib
.Argument_List
(1 .. 1 + Alis
'Length + Args
'Length);
237 No_Main_Opt
: aliased String := "-n";
240 Arguments
(1) := No_Main_Opt
'Unchecked_Access;
241 Arguments
(2 .. 1 + Alis
'Length) := Alis
;
242 Arguments
(2 + Alis
'Length .. Arguments
'Last) := Args
;
244 Print_Command
("gnatbind", Arguments
);
246 OS_Lib
.Spawn
(Gnatbind_Exec
.all, Arguments
, Success
);
249 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
250 Gnatbind_Name
& " execution error.");
260 Args
: Argument_List
:= Null_Argument_List
)
262 Arguments
: OS_Lib
.Argument_List
(1 .. 1 + Args
'Length);
265 Ali_Name
: aliased String := Ali
;
268 Arguments
(1) := Ali_Name
'Unchecked_Access;
269 Arguments
(2 .. Arguments
'Last) := Args
;
271 Print_Command
("gnatlink", Arguments
);
273 OS_Lib
.Spawn
(Gnatlink_Exec
.all, Arguments
, Success
);
276 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
277 Gnatlink_Name
& " execution error.");
286 use type OS_Lib
.String_Access
;
290 Dlltool_Exec
:= OS_Lib
.Locate_Exec_On_Path
(Dlltool_Name
);
292 if Dlltool_Exec
= null then
293 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
294 Dlltool_Name
& " not found in path");
296 Text_IO
.Put_Line
("using " & Dlltool_Exec
.all);
301 Gcc_Exec
:= OS_Lib
.Locate_Exec_On_Path
(Gcc_Name
);
303 if Gcc_Exec
= null then
304 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
305 Gcc_Name
& " not found in path");
307 Text_IO
.Put_Line
("using " & Gcc_Exec
.all);
312 Gnatbind_Exec
:= OS_Lib
.Locate_Exec_On_Path
(Gnatbind_Name
);
314 if Gnatbind_Exec
= null then
315 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
316 Gnatbind_Name
& " not found in path");
318 Text_IO
.Put_Line
("using " & Gnatbind_Exec
.all);
323 Gnatlink_Exec
:= OS_Lib
.Locate_Exec_On_Path
(Gnatlink_Name
);
325 if Gnatlink_Exec
= null then
326 Exceptions
.Raise_Exception
(Tools_Error
'Identity,
327 Gnatlink_Name
& " not found in path");
329 Text_IO
.Put_Line
("using " & Gnatlink_Exec
.all);