1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 1996 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Compiling C files and building C libraries *)
17
18 let command cmdline =
19 if !Clflags.verbose then begin
20 prerr_string "+ ";
21 prerr_string cmdline;
22 prerr_newline()
23 end;
24 let res = Sys.command cmdline in
25 if res = 127 then raise (Sys_error cmdline);
26 res
27
28 let run_command cmdline = ignore(command cmdline)
29
30 (* Build @responsefile to work around Windows limitations on
31 command-line length *)
32 let build_diversion lst =
33 let (responsefile, oc) = Filename.open_temp_file "camlresp" "" in
34 List.iter (fun f -> Printf.fprintf oc "%s\n" f) lst;
35 close_out oc;
36 at_exit (fun () -> Misc.remove_file responsefile);
37 "@" ^ responsefile
38
39 let quote_files lst =
40 let lst = List.filter (fun f -> f <> "") lst in
41 let quoted = List.map Filename.quote lst in
42 let s = String.concat " " quoted in
43 if String.length s >= 4096 && Sys.os_type = "Win32"
44 then build_diversion quoted
45 else s
46
47 let quote_prefixed pr lst =
48 let lst = List.filter (fun f -> f <> "") lst in
49 let lst = List.map (fun f -> pr ^ f) lst in
50 quote_files lst
51
52 let quote_optfile = function
53 | None -> ""
54 | Some f -> Filename.quote f
55
56 let display_msvc_output file name =
57 let c = open_in file in
58 try
59 let first = input_line c in
60 if first <> Filename.basename name then
61 print_endline first;
62 while true do
63 print_endline (input_line c)
64 done
65 with _ ->
66 close_in c;
67 Sys.remove file
68
69 let compile_file ?output ?(opt="") ?stable_name name =
70 let (pipe, file) =
71 if Config.ccomp_type = "msvc" && not !Clflags.verbose then
72 try
73 let (t, c) = Filename.open_temp_file "msvc" "stdout" in
74 close_out c;
75 (Printf.sprintf " > %s" (Filename.quote t), t)
76 with _ ->
77 ("", "")
78 else
79 ("", "") in
80 let debug_prefix_map =
81 match stable_name with
82 | Some stable when Config.c_has_debug_prefix_map ->
83 Printf.sprintf " -fdebug-prefix-map=%s=%s" name stable
84 | Some _ | None -> "" in
85 let exit =
86 command
87 (Printf.sprintf
88 "%s%s %s %s -c %s %s %s %s %s%s"
89 (match !Clflags.c_compiler with
90 | Some cc -> cc
91 | None ->
92 let (cflags, cppflags) =
93 if !Clflags.native_code
94 then (Config.ocamlopt_cflags, Config.ocamlopt_cppflags)
95 else (Config.ocamlc_cflags, Config.ocamlc_cppflags) in
96 (String.concat " " [Config.c_compiler; cflags; cppflags]))
97 debug_prefix_map
98 (match output with
99 | None -> ""
100 | Some o -> Printf.sprintf "%s%s" Config.c_output_obj o)
101 opt
102 (if !Clflags.debug && Config.ccomp_type <> "msvc" then "-g" else "")
103 (String.concat " " (List.rev !Clflags.all_ccopts))
104 (quote_prefixed "-I"
105 (List.map (Misc.expand_directory Config.standard_library)
106 (List.rev !Clflags.include_dirs)))
107 (Clflags.std_include_flag "-I")
108 (Filename.quote name)
109 (* cl tediously includes the name of the C file as the first thing it
110 outputs (in fairness, the tedious thing is that there's no switch to
111 disable this behaviour). In the absence of the Unix module, use
112 a temporary file to filter the output (cannot pipe the output to a
113 filter because this removes the exit status of cl, which is wanted.
114 *)
115 pipe) in
116 if pipe <> ""
117 then display_msvc_output file name;
118 exit
119
120 let macos_create_empty_archive ~quoted_archive =
121 let result =
122 command (Printf.sprintf "%s rc %s /dev/null" Config.ar quoted_archive)
123 in
124 if result <> 0 then result
125 else
126 let result =
127 command (Printf.sprintf "%s %s 2> /dev/null" Config.ranlib quoted_archive)
128 in
129 if result <> 0 then result
130 else
131 command (Printf.sprintf "%s d %s /dev/null" Config.ar quoted_archive)
132
133 let create_archive archive file_list =
134 Misc.remove_file archive;
135 let quoted_archive = Filename.quote archive in
136 match Config.ccomp_type with
137 "msvc" ->
138 command(Printf.sprintf "link /lib /nologo /out:%s %s"
139 quoted_archive (quote_files file_list))
140 | _ ->
141 assert(String.length Config.ar > 0);
142 let is_macosx =
143 match Config.system with
144 | "macosx" -> true
145 | _ -> false
146 in
147 if is_macosx && file_list = [] then (* PR#6550 *)
148 macos_create_empty_archive ~quoted_archive
149 else
150 let r1 =
151 command(Printf.sprintf "%s rc %s %s"
152 Config.ar quoted_archive (quote_files file_list)) in
153 if r1 <> 0 || String.length Config.ranlib = 0
154 then r1
155 else command(Config.ranlib ^ " " ^ quoted_archive)
156
157 let expand_libname name =
158 if String.length name < 2 || String.sub name 0 2 <> "-l"
159 then name
160 else begin
161 let libname =
162 "lib" ^ String.sub name 2 (String.length name - 2) ^ Config.ext_lib in
163 try
164 Load_path.find libname
165 with Not_found ->
166 libname
167 end
168
169 type link_mode =
170 | Exe
171 | Dll
172 | MainDll
173 | Partial
174
175 let remove_Wl cclibs =
176 cclibs |> List.map (fun cclib ->
177 (* -Wl,-foo,bar -> -foo bar *)
178 if String.length cclib >= 4 && "-Wl," = String.sub cclib 0 4 then
179 String.map (function ',' -> ' ' | c -> c)
180 (String.sub cclib 4 (String.length cclib - 4))
181 else cclib)
182
183 let call_linker mode output_name files extra =
184 Profile.record_call "c-linker" (fun () ->
185 let cmd =
186 if mode = Partial then
187 let l_prefix =
188 match Config.ccomp_type with
189 | "msvc" -> "/libpath:"
190 | _ -> "-L"
191 in
192 Printf.sprintf "%s%s %s %s %s"
193 Config.native_pack_linker
194 (Filename.quote output_name)
195 (quote_prefixed l_prefix (Load_path.get_paths ()))
196 (quote_files (remove_Wl files))
197 extra
198 else
199 Printf.sprintf "%s -o %s %s %s %s %s %s"
200 (match !Clflags.c_compiler, mode with
201 | Some cc, _ -> cc
202 | None, Exe -> Config.mkexe
203 | None, Dll -> Config.mkdll
204 | None, MainDll -> Config.mkmaindll
205 | None, Partial -> assert false
206 )
207 (Filename.quote output_name)
208 "" (*(Clflags.std_include_flag "-I")*)
209 (quote_prefixed "-L" (Load_path.get_paths ()))
210 (String.concat " " (List.rev !Clflags.all_ccopts))
211 (quote_files files)
212 extra
213 in
214 command cmd = 0
215 )
216