1996-11-07 03:04:12 -08:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Objective Caml *)
|
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1996-11-07 03:04:12 -08:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
(* Compiling C files and building C libraries *)
|
|
|
|
|
1997-05-15 06:30:31 -07:00
|
|
|
let command cmdline =
|
|
|
|
if !Clflags.verbose then begin
|
|
|
|
prerr_string "+ ";
|
|
|
|
prerr_string cmdline;
|
|
|
|
prerr_newline()
|
|
|
|
end;
|
|
|
|
Sys.command cmdline
|
|
|
|
|
1999-02-24 07:21:50 -08:00
|
|
|
let run_command cmdline = ignore(command cmdline)
|
1998-11-12 06:54:12 -08:00
|
|
|
|
2003-03-24 07:27:27 -08:00
|
|
|
(* Build @responsefile to work around Windows limitations on
|
2004-06-16 09:58:46 -07:00
|
|
|
command-line length *)
|
2003-03-24 07:27:27 -08:00
|
|
|
let build_diversion lst =
|
|
|
|
let (responsefile, oc) = Filename.open_temp_file "camlresp" "" in
|
|
|
|
List.iter
|
|
|
|
(fun f ->
|
|
|
|
if f <> "" then begin
|
|
|
|
output_string oc (Filename.quote f); output_char oc '\n'
|
|
|
|
end)
|
|
|
|
lst;
|
|
|
|
close_out oc;
|
|
|
|
at_exit (fun () -> Misc.remove_file responsefile);
|
|
|
|
"@" ^ responsefile
|
|
|
|
|
2002-03-12 08:17:53 -08:00
|
|
|
let quote_files lst =
|
2003-03-24 07:27:27 -08:00
|
|
|
let s =
|
|
|
|
String.concat " "
|
|
|
|
(List.map (fun f -> if f = "" then f else Filename.quote f) lst) in
|
|
|
|
if Sys.os_type = "Win32" && String.length s >= 256
|
|
|
|
then build_diversion lst
|
|
|
|
else s
|
2002-03-12 08:17:53 -08:00
|
|
|
|
1998-11-06 07:39:43 -08:00
|
|
|
let compile_file name =
|
1999-11-29 11:04:49 -08:00
|
|
|
command
|
|
|
|
(Printf.sprintf
|
2002-02-14 07:17:11 -08:00
|
|
|
"%s -c %s %s %s %s"
|
1999-11-29 11:04:49 -08:00
|
|
|
!Clflags.c_compiler
|
|
|
|
(String.concat " " (List.rev !Clflags.ccopts))
|
2002-03-12 08:17:53 -08:00
|
|
|
(quote_files
|
|
|
|
(List.rev_map (fun dir -> "-I" ^ dir) !Clflags.include_dirs))
|
2002-02-14 07:17:11 -08:00
|
|
|
(Clflags.std_include_flag "-I")
|
2002-03-12 08:17:53 -08:00
|
|
|
(Filename.quote name))
|
1997-06-23 07:36:30 -07:00
|
|
|
|
1996-11-07 03:04:12 -08:00
|
|
|
let create_archive archive file_list =
|
|
|
|
Misc.remove_file archive;
|
2002-03-12 08:17:53 -08:00
|
|
|
let quoted_archive = Filename.quote archive in
|
2002-06-07 02:49:45 -07:00
|
|
|
match Config.ccomp_type with
|
|
|
|
"msvc" ->
|
2006-05-09 09:00:36 -07:00
|
|
|
command(Printf.sprintf "link /lib /nologo /out:%s %s"
|
2002-03-12 08:17:53 -08:00
|
|
|
quoted_archive (quote_files file_list))
|
1996-11-07 03:04:12 -08:00
|
|
|
| _ ->
|
|
|
|
let r1 =
|
1997-05-15 06:30:31 -07:00
|
|
|
command(Printf.sprintf "ar rc %s %s"
|
2002-03-12 08:17:53 -08:00
|
|
|
quoted_archive (quote_files file_list)) in
|
2000-12-28 05:07:42 -08:00
|
|
|
if r1 <> 0 || String.length Config.ranlib = 0
|
1996-11-07 03:04:12 -08:00
|
|
|
then r1
|
2002-03-12 08:17:53 -08:00
|
|
|
else command(Config.ranlib ^ " " ^ quoted_archive)
|
1998-12-02 06:39:27 -08:00
|
|
|
|
|
|
|
let expand_libname name =
|
|
|
|
if String.length name < 2 || String.sub name 0 2 <> "-l"
|
|
|
|
then name
|
|
|
|
else begin
|
|
|
|
let libname =
|
|
|
|
"lib" ^ String.sub name 2 (String.length name - 2) ^ Config.ext_lib in
|
|
|
|
try
|
|
|
|
Misc.find_in_path !Config.load_path libname
|
|
|
|
with Not_found ->
|
|
|
|
libname
|
|
|
|
end
|
2006-05-09 09:00:36 -07:00
|
|
|
|
|
|
|
(* Handling of msvc's /link options *)
|
|
|
|
|
|
|
|
let make_link_options optlist =
|
|
|
|
let rec split linkopts otheropts = function
|
|
|
|
| [] -> String.concat " " otheropts
|
|
|
|
^ " /link /subsystem:console "
|
|
|
|
^ String.concat " " linkopts
|
|
|
|
| opt :: rem ->
|
|
|
|
if String.length opt >= 5 && String.sub opt 0 5 = "/link"
|
|
|
|
then split (String.sub opt 5 (String.length opt - 5) :: linkopts)
|
|
|
|
otheropts rem
|
|
|
|
else split linkopts (opt :: otheropts) rem
|
|
|
|
in split [] [] optlist
|
2006-09-23 01:51:31 -07:00
|
|
|
|
|
|
|
(* Handling of Visual C++ 2005 manifest files *)
|
|
|
|
|
|
|
|
let merge_manifest exefile =
|
|
|
|
let manfile = exefile ^ ".manifest" in
|
|
|
|
if not (Sys.file_exists manfile) then 0 else begin
|
|
|
|
let retcode =
|
|
|
|
command (Printf.sprintf "mt -nologo -outputresource:%s -manifest:%s"
|
|
|
|
(Filename.quote exefile)
|
|
|
|
(Filename.quote manfile)) in
|
|
|
|
Misc.remove_file manfile;
|
|
|
|
retcode
|
|
|
|
end
|