utils/ccomp.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* Compiling C files and building C libraries *)
  16
  17 let command cmdline =
  18   if !Clflags.verbose then begin
  19     prerr_string "+ ";
  20     prerr_string cmdline;
  21     prerr_newline()
  22   end;
  23   Sys.command cmdline
  24
  25 let run_command cmdline = ignore(command cmdline)
  26
  27 (* Build @responsefile to work around Windows limitations on
  28    command-line length *)
  29 let build_diversion lst =
  30   let (responsefile, oc) = Filename.open_temp_file "camlresp" "" in
  31   List.iter
  32     (fun f ->
  33       if f <> "" then begin
  34         output_string oc (Filename.quote f); output_char oc '\n'
  35       end)
  36     lst;
  37   close_out oc;
  38   at_exit (fun () -> Misc.remove_file responsefile);
  39   "@" ^ responsefile
  40
  41 let quote_files lst =
  42   let s =
  43     String.concat " "
  44       (List.map (fun f -> if f = "" then f else Filename.quote f) lst) in
  45   if Sys.os_type = "Win32" && String.length s >= 256
  46   then build_diversion lst
  47   else s
  48
  49 let quote_optfile = function
  50   | None -> ""
  51   | Some f -> Filename.quote f
  52
  53 let compile_file name =
  54      command
  55        (Printf.sprintf
  56          "%s -c %s %s %s %s"
  57          !Clflags.c_compiler
  58          (String.concat " " (List.rev !Clflags.ccopts))
  59          (quote_files
  60              (List.rev_map (fun dir -> "-I" ^ dir) !Clflags.include_dirs))
  61          (Clflags.std_include_flag "-I")
  62          (Filename.quote name))
  63
  64 let create_archive archive file_list =
  65   Misc.remove_file archive;
  66   let quoted_archive = Filename.quote archive in
  67   match Config.ccomp_type with
  68     "msvc" ->
  69       command(Printf.sprintf "link /lib /nologo /out:%s %s"
  70                              quoted_archive (quote_files file_list))
  71   | _ ->
  72       let r1 =
  73         command(Printf.sprintf "ar rc %s %s"
  74                 quoted_archive (quote_files file_list)) in
  75       if r1 <> 0 || String.length Config.ranlib = 0
  76       then r1
  77       else command(Config.ranlib ^ " " ^ quoted_archive)
  78
  79 let expand_libname name =
  80   if String.length name < 2 || String.sub name 0 2 <> "-l"
  81   then name
  82   else begin
  83     let libname =
  84       "lib" ^ String.sub name 2 (String.length name - 2) ^ Config.ext_lib in
  85     try
  86       Misc.find_in_path !Config.load_path libname
  87     with Not_found ->
  88       libname
  89   end
  90
  91 (* Handling of msvc's /link options *)
  92
  93 let make_link_options optlist =
  94   let rec split linkopts otheropts = function
  95   | [] -> String.concat " " otheropts
  96           ^ " /link /subsystem:console "
  97           ^ String.concat " " linkopts
  98   | opt :: rem ->
  99       if String.length opt >= 5 && String.sub opt 0 5 = "/link"
 100       then split (String.sub opt 5 (String.length opt - 5) :: linkopts)
 101                  otheropts rem
 102       else split linkopts (opt :: otheropts) rem
 103   in split [] [] optlist
 104
 105 (* Handling of Visual C++ 2005 manifest files *)
 106
 107 let merge_manifest exefile =
 108   let manfile = exefile ^ ".manifest" in
 109   if not (Sys.file_exists manfile) then 0 else begin
 110     let retcode =
 111       command (Printf.sprintf "mt -nologo -outputresource:%s -manifest %s"
 112                               (Filename.quote exefile)
 113                               (Filename.quote manfile)) in
 114     Misc.remove_file manfile;
 115     retcode
 116   end