1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- M D L L . T O O L S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2008, 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-- Interface to externals tools used to build DLL and import libraries 27 28with Ada.Text_IO; 29with Ada.Exceptions; 30 31with GNAT.Directory_Operations; 32with Osint; 33 34package body MDLL.Utl is 35 36 use Ada; 37 use GNAT; 38 39 Dlltool_Name : constant String := "dlltool"; 40 Dlltool_Exec : OS_Lib.String_Access; 41 42 Gcc_Name : constant String := "gcc"; 43 Gcc_Exec : OS_Lib.String_Access; 44 45 Gnatbind_Name : constant String := "gnatbind"; 46 Gnatbind_Exec : OS_Lib.String_Access; 47 48 Gnatlink_Name : constant String := "gnatlink"; 49 Gnatlink_Exec : OS_Lib.String_Access; 50 51 procedure Print_Command 52 (Tool_Name : String; 53 Arguments : OS_Lib.Argument_List); 54 -- display the command run when in Verbose mode 55 56 ------------------- 57 -- Print_Command -- 58 ------------------- 59 60 procedure Print_Command 61 (Tool_Name : String; 62 Arguments : OS_Lib.Argument_List) 63 is 64 begin 65 if Verbose then 66 Text_IO.Put (Tool_Name); 67 for K in Arguments'Range loop 68 Text_IO.Put (" " & Arguments (K).all); 69 end loop; 70 Text_IO.New_Line; 71 end if; 72 end Print_Command; 73 74 ------------- 75 -- Dlltool -- 76 ------------- 77 78 procedure Dlltool 79 (Def_Filename : String; 80 DLL_Name : String; 81 Library : String; 82 Exp_Table : String := ""; 83 Base_File : String := ""; 84 Build_Import : Boolean) 85 is 86 Arguments : OS_Lib.Argument_List (1 .. 11); 87 A : Positive; 88 89 Success : Boolean; 90 91 Def_Opt : aliased String := "--def"; 92 Def_V : aliased String := Def_Filename; 93 Dll_Opt : aliased String := "--dllname"; 94 Dll_V : aliased String := DLL_Name; 95 Lib_Opt : aliased String := "--output-lib"; 96 Lib_V : aliased String := Library; 97 Exp_Opt : aliased String := "--output-exp"; 98 Exp_V : aliased String := Exp_Table; 99 Bas_Opt : aliased String := "--base-file"; 100 Bas_V : aliased String := Base_File; 101 No_Suf_Opt : aliased String := "-k"; 102 103 begin 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); 108 A := 4; 109 110 if Kill_Suffix then 111 A := A + 1; 112 Arguments (A) := No_Suf_Opt'Unchecked_Access; 113 end if; 114 115 if Library /= "" and then Build_Import then 116 A := A + 1; 117 Arguments (A) := Lib_Opt'Unchecked_Access; 118 A := A + 1; 119 Arguments (A) := Lib_V'Unchecked_Access; 120 end if; 121 122 if Exp_Table /= "" then 123 A := A + 1; 124 Arguments (A) := Exp_Opt'Unchecked_Access; 125 A := A + 1; 126 Arguments (A) := Exp_V'Unchecked_Access; 127 end if; 128 129 if Base_File /= "" then 130 A := A + 1; 131 Arguments (A) := Bas_Opt'Unchecked_Access; 132 A := A + 1; 133 Arguments (A) := Bas_V'Unchecked_Access; 134 end if; 135 136 Print_Command ("dlltool", Arguments (1 .. A)); 137 138 OS_Lib.Spawn (Dlltool_Exec.all, Arguments (1 .. A), Success); 139 140 if not Success then 141 Exceptions.Raise_Exception 142 (Tools_Error'Identity, Dlltool_Name & " execution error."); 143 end if; 144 end Dlltool; 145 146 --------- 147 -- Gcc -- 148 --------- 149 150 procedure Gcc 151 (Output_File : String; 152 Files : Argument_List; 153 Options : Argument_List; 154 Base_File : String := ""; 155 Build_Lib : Boolean := False) 156 is 157 use Osint; 158 159 Arguments : OS_Lib.Argument_List 160 (1 .. 5 + Files'Length + Options'Length); 161 A : Natural := 0; 162 163 Success : Boolean; 164 C_Opt : aliased String := "-c"; 165 Out_Opt : aliased String := "-o"; 166 Out_V : aliased String := Output_File; 167 Bas_Opt : aliased String := "-Wl,--base-file," & Base_File; 168 Lib_Opt : aliased String := "-mdll"; 169 Lib_Dir : aliased String := "-L" & Object_Dir_Default_Prefix; 170 171 begin 172 A := A + 1; 173 if Build_Lib then 174 Arguments (A) := Lib_Opt'Unchecked_Access; 175 else 176 Arguments (A) := C_Opt'Unchecked_Access; 177 end if; 178 179 A := A + 1; 180 Arguments (A .. A + 2) := (Out_Opt'Unchecked_Access, 181 Out_V'Unchecked_Access, 182 Lib_Dir'Unchecked_Access); 183 A := A + 2; 184 185 if Base_File /= "" then 186 A := A + 1; 187 Arguments (A) := Bas_Opt'Unchecked_Access; 188 end if; 189 190 A := A + 1; 191 Arguments (A .. A + Files'Length - 1) := Files; 192 A := A + Files'Length - 1; 193 194 if Build_Lib then 195 A := A + 1; 196 Arguments (A .. A + Options'Length - 1) := Options; 197 A := A + Options'Length - 1; 198 else 199 declare 200 Largs : Argument_List (Options'Range); 201 L : Natural := Largs'First - 1; 202 begin 203 for K in Options'Range loop 204 if Options (K) (1 .. 2) /= "-l" then 205 L := L + 1; 206 Largs (L) := Options (K); 207 end if; 208 end loop; 209 A := A + 1; 210 Arguments (A .. A + L - 1) := Largs (1 .. L); 211 A := A + L - 1; 212 end; 213 end if; 214 215 Print_Command ("gcc", Arguments (1 .. A)); 216 217 OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success); 218 219 if not Success then 220 Exceptions.Raise_Exception 221 (Tools_Error'Identity, Gcc_Name & " execution error."); 222 end if; 223 end Gcc; 224 225 -------------- 226 -- Gnatbind -- 227 -------------- 228 229 procedure Gnatbind 230 (Alis : Argument_List; 231 Args : Argument_List := Null_Argument_List) 232 is 233 Arguments : OS_Lib.Argument_List (1 .. 1 + Alis'Length + Args'Length); 234 Success : Boolean; 235 236 No_Main_Opt : aliased String := "-n"; 237 238 begin 239 Arguments (1) := No_Main_Opt'Unchecked_Access; 240 Arguments (2 .. 1 + Alis'Length) := Alis; 241 Arguments (2 + Alis'Length .. Arguments'Last) := Args; 242 243 Print_Command ("gnatbind", Arguments); 244 245 OS_Lib.Spawn (Gnatbind_Exec.all, Arguments, Success); 246 247 -- Delete binder files on failure 248 249 if not Success then 250 declare 251 Base_Name : constant String := 252 Directory_Operations.Base_Name (Alis (Alis'First).all, ".ali"); 253 begin 254 OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success); 255 OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success); 256 end; 257 258 Exceptions.Raise_Exception 259 (Tools_Error'Identity, Gnatbind_Name & " execution error."); 260 end if; 261 end Gnatbind; 262 263 -------------- 264 -- Gnatlink -- 265 -------------- 266 267 procedure Gnatlink 268 (Ali : String; 269 Args : Argument_List := Null_Argument_List) 270 is 271 Arguments : OS_Lib.Argument_List (1 .. 1 + Args'Length); 272 Success : Boolean; 273 274 Ali_Name : aliased String := Ali; 275 276 begin 277 Arguments (1) := Ali_Name'Unchecked_Access; 278 Arguments (2 .. Arguments'Last) := Args; 279 280 Print_Command ("gnatlink", Arguments); 281 282 OS_Lib.Spawn (Gnatlink_Exec.all, Arguments, Success); 283 284 if not Success then 285 -- Delete binder files 286 declare 287 Base_Name : constant String := 288 Directory_Operations.Base_Name (Ali, ".ali"); 289 begin 290 OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success); 291 OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success); 292 OS_Lib.Delete_File ("b~" & Base_Name & ".ali", Success); 293 OS_Lib.Delete_File ("b~" & Base_Name & ".o", Success); 294 end; 295 296 Exceptions.Raise_Exception 297 (Tools_Error'Identity, Gnatlink_Name & " execution error."); 298 end if; 299 end Gnatlink; 300 301 ------------ 302 -- Locate -- 303 ------------ 304 305 procedure Locate is 306 use type OS_Lib.String_Access; 307 begin 308 -- dlltool 309 310 if Dlltool_Exec = null then 311 Dlltool_Exec := OS_Lib.Locate_Exec_On_Path (Dlltool_Name); 312 313 if Dlltool_Exec = null then 314 Exceptions.Raise_Exception 315 (Tools_Error'Identity, Dlltool_Name & " not found in path"); 316 317 elsif Verbose then 318 Text_IO.Put_Line ("using " & Dlltool_Exec.all); 319 end if; 320 end if; 321 322 -- gcc 323 324 if Gcc_Exec = null then 325 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name); 326 327 if Gcc_Exec = null then 328 Exceptions.Raise_Exception 329 (Tools_Error'Identity, Gcc_Name & " not found in path"); 330 331 elsif Verbose then 332 Text_IO.Put_Line ("using " & Gcc_Exec.all); 333 end if; 334 end if; 335 336 -- gnatbind 337 338 if Gnatbind_Exec = null then 339 Gnatbind_Exec := OS_Lib.Locate_Exec_On_Path (Gnatbind_Name); 340 341 if Gnatbind_Exec = null then 342 Exceptions.Raise_Exception 343 (Tools_Error'Identity, Gnatbind_Name & " not found in path"); 344 345 elsif Verbose then 346 Text_IO.Put_Line ("using " & Gnatbind_Exec.all); 347 end if; 348 end if; 349 350 -- gnatlink 351 352 if Gnatlink_Exec = null then 353 Gnatlink_Exec := OS_Lib.Locate_Exec_On_Path (Gnatlink_Name); 354 355 if Gnatlink_Exec = null then 356 Exceptions.Raise_Exception 357 (Tools_Error'Identity, Gnatlink_Name & " not found in path"); 358 359 elsif Verbose then 360 Text_IO.Put_Line ("using " & Gnatlink_Exec.all); 361 Text_IO.New_Line; 362 end if; 363 end if; 364 end Locate; 365 366end MDLL.Utl; 367