diff options
| -rwxr-xr-x | configure | 2 | ||||
| -rw-r--r-- | driver/Configuration.ml | 2 | ||||
| -rw-r--r-- | driver/Configuration.mli | 1 | ||||
| -rw-r--r-- | driver/Driveraux.ml | 18 |
4 files changed, 21 insertions, 2 deletions
@@ -119,7 +119,7 @@ case "$target" in asm_supports_cfi=false clinker="${toolprefix}dcc" libmath="-lm" - responsefile="unsupported" + responsefile="diab" ;; *) system="linux" diff --git a/driver/Configuration.ml b/driver/Configuration.ml index be581e14..0a2b3eec 100644 --- a/driver/Configuration.ml +++ b/driver/Configuration.ml @@ -174,10 +174,12 @@ let struct_return_style = type response_file_style = | Gnu (* responsefiles in gnu compatible syntax *) + | Diab (* responsefiles in diab compatible syntax *) | Unsupported (* responsefiles are not supported *) let response_file_style = match get_config_string "response_file_style" with | "unsupported" -> Unsupported | "gnu" -> Gnu + | "diab" -> Diab | v -> bad_config "response_file_style" [v] diff --git a/driver/Configuration.mli b/driver/Configuration.mli index 1092bf6d..7087c3c2 100644 --- a/driver/Configuration.mli +++ b/driver/Configuration.mli @@ -66,6 +66,7 @@ val struct_return_style: struct_return_style type response_file_style = | Gnu (* responsefiles in gnu compatible syntax *) + | Diab (* responsefiles in diab compatible syntax *) | Unsupported (* responsefiles are not supported *) val response_file_style: response_file_style diff --git a/driver/Driveraux.ml b/driver/Driveraux.ml index 6bd48344..1ee39e8e 100644 --- a/driver/Driveraux.ml +++ b/driver/Driveraux.ml @@ -69,14 +69,30 @@ let gnu_quote arg = Buffer.add_char buf c) arg; Buffer.contents buf +let re_whitespace = Str.regexp ".*[ \t\n\r]" + +let diab_quote arg = + let buf = Buffer.create ((String.length arg) + 8) in + let doublequote = Str.string_match re_whitespace arg 0 in + if doublequote then Buffer.add_char buf '"'; + String.iter (fun c -> + if c = '"' then Buffer.add_char buf '\\'; + Buffer.add_char buf c) arg; + if doublequote then Buffer.add_char buf '"'; + Buffer.contents buf + let command ?stdout args = 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 = match Configuration.response_file_style with + | Configuration.Unsupported -> assert false + | Configuration.Gnu -> gnu_quote + | Configuration.Diab -> 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 " (gnu_quote a)) args; + 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 |