diff options
-rw-r--r-- | driver/Assembler.ml | 9 | ||||
-rw-r--r-- | driver/Driveraux.ml | 23 | ||||
-rw-r--r-- | driver/Driveraux.mli | 8 | ||||
-rw-r--r-- | driver/Frontend.ml | 9 | ||||
-rw-r--r-- | driver/Linker.ml | 13 | ||||
-rw-r--r-- | lib/Responsefile.ml | 16 | ||||
-rw-r--r-- | lib/Responsefile.mli | 4 |
7 files changed, 51 insertions, 31 deletions
diff --git a/driver/Assembler.ml b/driver/Assembler.ml index 52fb17d8..d6cb65ea 100644 --- a/driver/Assembler.ml +++ b/driver/Assembler.ml @@ -18,12 +18,17 @@ open Driveraux (* From asm to object file *) let assemble ifile ofile = - let cmd = List.concat [ - Configuration.asm; + let cmd,opts = match Configuration.asm with + | name::opts -> name,opts + | [] -> assert false (* Should be catched in Configuration *) in + let opts = List.concat [ + opts; ["-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 3fe22fac..8ebf261d 100644 --- a/driver/Driveraux.ml +++ b/driver/Driveraux.ml @@ -14,12 +14,33 @@ open Printf open Clflags +(* Is this a gnu based tool chain *) +let gnu_system = Configuration.system <> "diab" + (* 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 = if !option_v then begin eprintf "+ %s" (String.concat " " args); @@ -94,8 +115,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 diff --git a/driver/Driveraux.mli b/driver/Driveraux.mli index 60efcc80..54df4336 100644 --- a/driver/Driveraux.mli +++ b/driver/Driveraux.mli @@ -12,7 +12,13 @@ (* *********************************************************************) -val command: ?stdout:string -> string list -> int +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 043d4e5a..41b09b58 100644 --- a/driver/Frontend.ml +++ b/driver/Frontend.ml @@ -24,8 +24,11 @@ open Printf let preprocess ifile ofile = let output = if ofile = "-" then None else Some ofile in - let cmd = List.concat [ - Configuration.prepro; + let cmd,opts = match Configuration.prepro with + | name::opts -> name,opts + | [] -> assert false (* Should be catched in Configuration *) in + let opts = List.concat [ + opts; ["-D__COMPCERT__"]; (if !Clflags.use_standard_headers then ["-I" ^ Filename.concat !Clflags.stdlib_path "include" ] @@ -33,6 +36,8 @@ 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 2f767023..14c9bcb3 100644 --- a/driver/Linker.ml +++ b/driver/Linker.ml @@ -19,14 +19,19 @@ open Driveraux (* Linking *) let linker exe_name files = - let cmd = List.concat [ - Configuration.linker; + let cmd,opts = match Configuration.linker with + | name::opts -> name,opts + | [] -> assert false (* Should be catched in Configuration *) in + let opts = List.concat [ + opts; ["-o"; exe_name]; files; (if Configuration.has_runtime_lib - then ["-L" ^ !stdlib_path; "-lcompcert"] - else []) + 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; diff --git a/lib/Responsefile.ml b/lib/Responsefile.ml index 6dd1bc93..c10fe302 100644 --- a/lib/Responsefile.ml +++ b/lib/Responsefile.ml @@ -131,19 +131,3 @@ let expand_responsefiles args = acc := file::!acc done; Array.of_list !acc - -let write_responsefile oc args start = - 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 - let first = ref true in - let sep oc = if !first then - first := false - else - output_string oc " " in - for i = start to (Array.length args -1) do - Printf.fprintf oc "%t%s" sep (quote args.(i)) - done diff --git a/lib/Responsefile.mli b/lib/Responsefile.mli index 95c74bda..b55dac16 100644 --- a/lib/Responsefile.mli +++ b/lib/Responsefile.mli @@ -18,7 +18,3 @@ val expand_responsefiles: string array -> string array (** Expand responsefile arguments contained in the array and return the full set of arguments. *) - -val write_responsefile: out_channel -> string array -> int -> unit - (** Write the arguments starting at the given index as repsonsefile on the given - out_channel. All arguments that contain whitespaces are quoted. *) |