Merged responfile function into command.

Command now decides whether to use a responsefile or call the
external command directly.
Bug 18004

5 files changed, 33 insertions, 49 deletions

diff --git a/driver/Assembler.ml b/driver/Assembler.ml
index d6cb65ea..52fb17d8 100644
--- a/driver/Assembler.ml
+++ b/driver/Assembler.ml
@@ -18,17 +18,12 @@ open Driveraux
 (* From asm to object file *)
 
 let assemble ifile ofile =
-  let cmd,opts = match Configuration.asm with
-  | name::opts -> name,opts
-  | [] -> assert false (* Should be catched in Configuration *) in
-  let opts = List.concat [
-    opts;
+  let cmd = List.concat [
+    Configuration.asm;
     ["-o"; ofile];
     List.rev !assembler_options;
     [ifile]
   ] in
-  let opts = responsefile opts (fun a -> if gnu_system then ["@"^a] else ["@"^a]) in
-  let cmd = cmd::opts in
   let exc = command cmd in
   if exc <> 0 then begin
     safe_remove ofile;
diff --git a/driver/Driveraux.ml b/driver/Driveraux.ml
index 8ebf261d..2c03c65c 100644
--- a/driver/Driveraux.ml
+++ b/driver/Driveraux.ml
@@ -17,31 +17,17 @@ open Clflags
 (* Is this a gnu based tool chain *)
 let gnu_system = Configuration.system <> "diab"
 
+(* Sage removale of files *)
+let safe_remove file =
+  try Sys.remove file with Sys_error _ -> ()
+
 (* Invocation of external tools *)
 
 let rec waitpid_no_intr pid =
   try Unix.waitpid [] pid
   with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_no_intr pid
 
-let responsefile args resp_arg =
-  try
-    if Sys.win32 && (String.length (String.concat "" args) > 7000) then
-      let file,oc = Filename.open_temp_file "compcert" "" in
-      let whitespace = Str.regexp "[ \t\r\n]" in
-      let quote arg =
-        if Str.string_match whitespace arg 0 then
-          Filename.quote arg (* We need to quote arguments containing whitespaces *)
-        else
-          arg in
-      List.iter (fun a -> Printf.fprintf oc "%s " (quote a)) args;
-      close_out oc;
-      resp_arg file
-    else
-      args
-  with Sys_error _ ->
-    args
-
-let command ?stdout args =
+let command stdout args =
   if !option_v then begin
     eprintf "+ %s" (String.concat " " args);
     begin match stdout with
@@ -72,12 +58,31 @@ let command ?stdout args =
             argv.(0) fn (Unix.error_message err) param;
     -1
 
+let quote arg =
+  let whitespace = Str.regexp "[ \t\r\n]" in
+  if Str.string_match whitespace arg 0 then
+    Filename.quote arg (* We need to quote arguments containing whitespaces *)
+  else
+    arg
+
+let command ?stdout args =
+  if Sys.win32 && List.fold_left (fun len arg -> len + String.length arg + 1) 0 args > 7000 then
+    let file,oc = Filename.open_temp_file "compcert" "" in
+    let cmd,args = match args with
+    | cmd::args -> cmd,args
+    | [] -> assert false (* Should never happen *) in
+    List.iter (fun a -> Printf.fprintf oc "%s " (quote a)) args;
+    close_out oc;
+    let arg = if gnu_system then "@"^file else "-@"^file in
+    let ret = command stdout [cmd;arg] in
+    safe_remove file;
+    ret
+  else
+    command stdout args
+
 let command_error n exc =
   eprintf "Error: %s command failed with exit code %d (use -v to see invocation)\n" n exc
 
-let safe_remove file =
-  try Sys.remove file with Sys_error _ -> ()
-
 
 (* Determine names for output files.  We use -o option if specified
    and if this is the final destination file (not a dump file).
diff --git a/driver/Driveraux.mli b/driver/Driveraux.mli
index 54df4336..e6bac6e3 100644
--- a/driver/Driveraux.mli
+++ b/driver/Driveraux.mli
@@ -12,12 +12,6 @@
 (* *********************************************************************)
 
 
-val responsefile: string list -> (string -> string list) -> string list
-    (** [responsefiles args resp_arg] Test whether [args] should be passed
-        via responsefile and writes them into a file. [resp_arg] generates
-        the new argument constructed from the responsefile. If no
-        responsefile is written the arguments are returned unchanged. *)
-
 val command: ?stdout:string -> string list -> int
     (** Execute the command with the given arguments and an optional file for
         the stdout. Returns the exit code. *)
diff --git a/driver/Frontend.ml b/driver/Frontend.ml
index 41b09b58..043d4e5a 100644
--- a/driver/Frontend.ml
+++ b/driver/Frontend.ml
@@ -24,11 +24,8 @@ open Printf
 let preprocess ifile ofile =
   let output =
     if ofile = "-" then None else Some ofile in
-  let cmd,opts = match Configuration.prepro with
-  | name::opts -> name,opts
-  | [] -> assert false (* Should be catched in Configuration *) in
-  let opts = List.concat [
-    opts;
+  let cmd = List.concat [
+    Configuration.prepro;
     ["-D__COMPCERT__"];
     (if !Clflags.use_standard_headers
      then ["-I" ^ Filename.concat !Clflags.stdlib_path "include" ]
@@ -36,8 +33,6 @@ let preprocess ifile ofile =
     List.rev !prepro_options;
     [ifile]
   ] in
-  let opts = responsefile opts (fun a -> if gnu_system then ["@"^a] else ["@"^a]) in
-  let cmd = cmd::opts in
   let exc = command ?stdout:output cmd in
   if exc <> 0 then begin
     if ofile <> "-" then safe_remove ofile;
diff --git a/driver/Linker.ml b/driver/Linker.ml
index 14c9bcb3..305c5603 100644
--- a/driver/Linker.ml
+++ b/driver/Linker.ml
@@ -19,19 +19,14 @@ open Driveraux
 (* Linking *)
 
 let linker exe_name files =
-  let cmd,opts = match Configuration.linker with
-  | name::opts -> name,opts
-  | [] -> assert false (* Should be catched in Configuration *) in
-  let opts = List.concat [
-    opts;
+  let cmd = List.concat [
+    Configuration.linker;
     ["-o"; exe_name];
     files;
     (if Configuration.has_runtime_lib
     then ["-L" ^ !stdlib_path; "-lcompcert"]
     else [])
   ] in
-  let opts = responsefile opts (fun a -> if gnu_system then ["@"^a] else ["-@"^a]) in
-  let cmd = cmd::opts in
   let exc = command cmd in
   if exc <> 0 then begin
     command_error "linker" exc;