diff options
author | Bernhard Schommer <bernhardschommer@gmail.com> | 2016-08-29 14:54:06 +0200 |
---|---|---|
committer | Bernhard Schommer <bernhardschommer@gmail.com> | 2016-08-29 14:54:06 +0200 |
commit | 5cf814404cec9a8702e4bfa88e0f9176fa04ecfb (patch) | |
tree | fabd44046e3e5b9aaac7f33b9e4dddaa8d3f06e8 /driver/Driveraux.ml | |
parent | 3208e22ea89c459a5a7944ad8e82511d4a5328fa (diff) | |
parent | 477f73ef96d957de5a896a05175ceaab7e0dce03 (diff) | |
download | compcert-5cf814404cec9a8702e4bfa88e0f9176fa04ecfb.tar.gz compcert-5cf814404cec9a8702e4bfa88e0f9176fa04ecfb.zip |
Merge branch 'master' into advanced-diagnostics
Diffstat (limited to 'driver/Driveraux.ml')
-rw-r--r-- | driver/Driveraux.ml | 50 |
1 files changed, 36 insertions, 14 deletions
diff --git a/driver/Driveraux.ml b/driver/Driveraux.ml index 3fe22fac..d25301d2 100644 --- a/driver/Driveraux.ml +++ b/driver/Driveraux.ml @@ -14,21 +14,20 @@ open Printf open Clflags +(* Is this a gnu based tool chain *) +let gnu_system = Configuration.system <> "diab" + +(* Safe removal 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 command ?stdout args = - if !option_v then begin - eprintf "+ %s" (String.concat " " args); - begin match stdout with - | None -> () - | Some f -> eprintf " > %s" f - end; - prerr_endline "" - end; +let command stdout args = let argv = Array.of_list args in assert (Array.length argv > 0); try @@ -51,12 +50,37 @@ let command ?stdout args = argv.(0) fn (Unix.error_message err) param; -1 +let command ?stdout args = + if !option_v then begin + eprintf "+ %s" (String.concat " " args); + begin match stdout with + | None -> () + | Some f -> eprintf " > %s" f + end; + prerr_endline "" + end; + let resp = Sys.win32 && Configuration.response_file_style <> Configuration.Unsupported in + if resp && List.fold_left (fun len arg -> len + String.length arg + 1) 0 args > 7000 then + let quote,prefix = match Configuration.response_file_style with + | Configuration.Unsupported -> assert false + | Configuration.Gnu -> Responsefile.gnu_quote,"@" + | Configuration.Diab -> Responsefile.diab_quote,"-@" in + 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 = prefix^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). @@ -94,8 +118,6 @@ let print_error oc msg = List.iter print_one_error msg; output_char oc '\n' -let gnu_system = Configuration.system <> "diab" - (* Command-line parsing *) let explode_comma_option s = match Str.split (Str.regexp ",") s with |