From e0d75707520e74b36e9b4bccac342feab138c1db Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Apr 2018 11:39:25 +0800 Subject: [PATCH 1/3] Do not run compiled programs to extract #define's Running a program to extract a #define value doesn't work in a cross compilation environment. Nevertheless, we can extract #define constants by invoking the preprocessor directly using the -E flag and doing some parsing to extract values. As a consequence, we now ignore the link_flags argument. As we're not going to be linking any executables. We aren't removing the argument altogether since it's technically a breaking change. The user will instead see a deprecation warning when ~link_flags is provided. --- src/configurator/v1.ml | 87 +++++++++++++++++++++++++++++++---------- src/configurator/v1.mli | 2 +- 2 files changed, 67 insertions(+), 22 deletions(-) diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index c1782f41..0373a4f7 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -263,6 +263,36 @@ let compile_c_prog t ?(c_flags=[]) ?(link_flags=[]) code = in if ok then Ok exe_fname else Error () +let pp_c_prog t ?(c_flags=[]) code = + let c_flags = "-E" :: c_flags in + let dir = t.dest_dir ^/ sprintf "c-test-%d" (gen_id t) in + Unix.mkdir dir 0o777; + let base = dir ^/ "test" in + let c_fname = base ^ ".c" in + Io.write_file c_fname code; + logf t "preprocessing c program:"; + List.iter (String.split_lines code) ~f:(logf t " | %s"); + let run_ok args = + try + Ok ( + run_capture_exn t ~dir + (String.concat ~sep:" " + (t.c_compiler :: List.map args ~f:Filename.quote)) + ) + with e -> + Error e + in + if need_to_compile_and_link_separately t then + run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname]) + else + run_ok + (List.concat + [ c_flags + ; [ "-I"; t.stdlib_dir + ; c_fname + ] + ]) + let c_test t ?c_flags ?link_flags code = match compile_c_prog t ?c_flags ?link_flags code with | Ok _ -> true @@ -284,42 +314,57 @@ module C_define = struct end let import t ?prelude ?c_flags ?link_flags ~includes vars = + Option.iter link_flags ~f:(fun link_flags -> + Format.eprintf + "Configurator.C_define.import: link_flags argument is always ignored@.\ + ~link_flags:[%a]" + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt " ;@,") + (fun fmt s -> Format.fprintf fmt "%S" s)) link_flags + ); let buf = Buffer.create 1024 in let pr fmt = Printf.bprintf buf (fmt ^^ "\n") in + let prefix = "--- configurator " in + let pr_cfg fmt = + Buffer.add_string buf prefix; + Printf.bprintf buf (fmt ^^ "\n") in let includes = "stdio.h" :: includes in List.iter includes ~f:(pr "#include <%s>"); pr ""; Option.iter prelude ~f:(pr "%s"); - pr "int main()"; - pr "{"; List.iter vars ~f:(fun (name, (kind : Type.t)) -> match kind with | Switch -> pr {|#if defined(%s)|} name; - pr {| printf("%s=b:true\n");|} name; + pr_cfg "%S=b:true" name; pr {|#else|}; - pr {| printf("%s=b:false\n");|} name; + pr_cfg "%S=b:false" name; pr {|#endif|} | Int -> - pr {| printf("%s=i:%%d\n", %s);|} name name + pr_cfg "%S=i:%s" name name; | String -> - pr {| printf("%s=s:%%s\n", %s);|} name name); - pr " return 0;"; - pr "}"; + pr_cfg "%S=s:%s" name name); let code = Buffer.contents buf in - match compile_c_prog t ?c_flags ?link_flags code with - | Error () -> die "failed to compile program" - | Ok exe -> - run_capture_exn t ~dir:(Filename.dirname exe) (command_line exe []) - |> String.split_lines - |> List.map ~f:(fun s -> - let var, data = String.lsplit2_exn s ~on:'=' in - (var, - match String.lsplit2_exn data ~on:':' with - | "b", s -> Value.Switch (bool_of_string s) - | "i", s -> Int (int_of_string s) - | "s", s -> String s - | _ -> assert false)) + match pp_c_prog t ?c_flags code with + | Error _ -> die "failed to compile program" + | Ok pped_lines -> + String.split_lines pped_lines + |> List.filter_map ~f:(fun l -> + try + Scanf.sscanf l "--- configurator %S=%[ibs]:%s" (fun name typ v -> + Some ( + ( name + , match typ with + | "b" -> Value.Switch (bool_of_string v) + | "i" -> Int (int_of_string v) + | "s" -> String v + | _ -> assert false) + ) + ) + with + | End_of_file + | Scanf.Scan_failure _ -> None + ) let gen_header_file t ~fname ?protection_var vars = let protection_var = diff --git a/src/configurator/v1.mli b/src/configurator/v1.mli index 28c59383..65abf615 100644 --- a/src/configurator/v1.mli +++ b/src/configurator/v1.mli @@ -48,7 +48,7 @@ module C_define : sig (** Define extra code be used with extracting values below. Note that the compiled code is never executed. *) -> ?c_flags: string list - -> ?link_flags:string list + -> ?link_flags:string list (** @deprecated, this argument is ignored *) -> includes: string list -> (string * Type.t ) list -> (string * Value.t) list From 1d33f812981a6200d8641685432fb948eb0a54d6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 7 Apr 2018 00:12:44 +0800 Subject: [PATCH 2/3] Extract #define's using @whitequark's hack --- src/configurator/extract_obj.mli | 4 + src/configurator/extract_obj.mll | 11 ++ src/configurator/jbuild | 2 + src/configurator/v1.ml | 167 +++++++++++++++++-------------- src/configurator/v1.mli | 1 - 5 files changed, 109 insertions(+), 76 deletions(-) create mode 100644 src/configurator/extract_obj.mli create mode 100644 src/configurator/extract_obj.mll diff --git a/src/configurator/extract_obj.mli b/src/configurator/extract_obj.mli new file mode 100644 index 00000000..dc8a5a93 --- /dev/null +++ b/src/configurator/extract_obj.mli @@ -0,0 +1,4 @@ +(** Read and extract the strings between a pair of BEGIN-\d+- and -END + delimiters. This is used to extract the copmile time values from .obj + files *) +val extract : (int * string) list -> Lexing.lexbuf -> (int * string) list diff --git a/src/configurator/extract_obj.mll b/src/configurator/extract_obj.mll new file mode 100644 index 00000000..a9d95ab0 --- /dev/null +++ b/src/configurator/extract_obj.mll @@ -0,0 +1,11 @@ +{} +rule extract acc = parse + | "BEGIN-" (['0' - '9']+ as i) "-" + { read acc (int_of_string i) (Buffer.create 8) lexbuf } + | _ { extract acc lexbuf } + | eof { List.rev acc } +and read acc i b = parse + | "-END" { extract ((i, Buffer.contents b) :: acc) lexbuf } + | _ as c { Buffer.add_char b c; read acc i b lexbuf } + | eof { failwith "Unterminated BEGIN-" } +{} diff --git a/src/configurator/jbuild b/src/configurator/jbuild index 2b11a82f..f083b344 100644 --- a/src/configurator/jbuild +++ b/src/configurator/jbuild @@ -1,3 +1,5 @@ +(ocamllex (extract_obj)) + (library ((name configurator) (public_name jbuilder.configurator) diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index 0373a4f7..8d114783 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -1,4 +1,5 @@ open Stdune + let sprintf = Printf.sprintf let eprintf = Printf.eprintf @@ -7,6 +8,7 @@ let ( ^/ ) = Filename.concat exception Fatal_error of string module String_map = Stdune.Map.Make(Stdune.String) +module Int_map = Stdune.Map.Make(Stdune.Int) let die fmt = Printf.ksprintf (fun s -> @@ -231,7 +233,7 @@ let need_to_compile_and_link_separately t = | "msvc" -> true | _ -> false -let compile_c_prog t ?(c_flags=[]) ?(link_flags=[]) code = +let compile_and_link_c_prog t ?(c_flags=[]) ?(link_flags=[]) code = let dir = t.dest_dir ^/ sprintf "c-test-%d" (gen_id t) in Unix.mkdir dir 0o777; let base = dir ^/ "test" in @@ -248,53 +250,47 @@ let compile_c_prog t ?(c_flags=[]) ?(link_flags=[]) code = in let ok = if need_to_compile_and_link_separately t then - run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname]) && - run_ok ("-o" :: exe_fname :: obj_fname :: link_flags) + run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname]) + && run_ok ("-o" :: exe_fname :: obj_fname :: link_flags) else run_ok (List.concat [ c_flags - ; [ "-I"; t.stdlib_dir - ; "-o"; exe_fname + ; [ "-I" ; t.stdlib_dir + ; "-o" ; exe_fname ; c_fname ] - ; link_flags ]) in - if ok then Ok exe_fname else Error () + if ok then Ok () else Error () -let pp_c_prog t ?(c_flags=[]) code = - let c_flags = "-E" :: c_flags in +let compile_c_prog t ?(c_flags=[]) code = let dir = t.dest_dir ^/ sprintf "c-test-%d" (gen_id t) in Unix.mkdir dir 0o777; let base = dir ^/ "test" in let c_fname = base ^ ".c" in + let obj_fname = base ^ t.ext_obj in Io.write_file c_fname code; - logf t "preprocessing c program:"; + logf t "compiling c program:"; List.iter (String.split_lines code) ~f:(logf t " | %s"); let run_ok args = - try - Ok ( - run_capture_exn t ~dir - (String.concat ~sep:" " - (t.c_compiler :: List.map args ~f:Filename.quote)) - ) - with e -> - Error e + run_ok t ~dir + (String.concat ~sep:" " + (t.c_compiler :: List.map args ~f:Filename.quote)) in - if need_to_compile_and_link_separately t then - run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname]) - else - run_ok - (List.concat - [ c_flags - ; [ "-I"; t.stdlib_dir - ; c_fname - ] - ]) + let ok = + run_ok (List.concat + [ c_flags + ; [ "-I" ; t.stdlib_dir + ; "-o" ; obj_fname + ; "-c" ; c_fname + ] + ]) + in + if ok then Ok obj_fname else Error () let c_test t ?c_flags ?link_flags code = - match compile_c_prog t ?c_flags ?link_flags code with + match compile_and_link_c_prog t ?c_flags ?link_flags code with | Ok _ -> true | Error _ -> false @@ -313,58 +309,80 @@ module C_define = struct | String of string end - let import t ?prelude ?c_flags ?link_flags ~includes vars = - Option.iter link_flags ~f:(fun link_flags -> - Format.eprintf - "Configurator.C_define.import: link_flags argument is always ignored@.\ - ~link_flags:[%a]" - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt " ;@,") - (fun fmt s -> Format.fprintf fmt "%S" s)) link_flags - ); + let extract_program ?prelude includes vars = + let has_type t = List.exists vars ~f:(fun (_, t') -> t = t') in let buf = Buffer.create 1024 in let pr fmt = Printf.bprintf buf (fmt ^^ "\n") in - let prefix = "--- configurator " in - let pr_cfg fmt = - Buffer.add_string buf prefix; - Printf.bprintf buf (fmt ^^ "\n") in - let includes = "stdio.h" :: includes in List.iter includes ~f:(pr "#include <%s>"); pr ""; Option.iter prelude ~f:(pr "%s"); - List.iter vars ~f:(fun (name, (kind : Type.t)) -> - match kind with - | Switch -> - pr {|#if defined(%s)|} name; - pr_cfg "%S=b:true" name; - pr {|#else|}; - pr_cfg "%S=b:false" name; - pr {|#endif|} - | Int -> - pr_cfg "%S=i:%s" name name; + if has_type Type.Int then ( + pr {| +#define D0(x) ('0'+(x/1 )%%10) +#define D1(x) ('0'+(x/10 )%%10), D0(x) +#define D2(x) ('0'+(x/100 )%%10), D1(x) +#define D3(x) ('0'+(x/1000 )%%10), D2(x) +#define D4(x) ('0'+(x/10000 )%%10), D3(x) +#define D5(x) ('0'+(x/100000 )%%10), D4(x) +#define D6(x) ('0'+(x/1000000 )%%10), D5(x) +#define D7(x) ('0'+(x/10000000 )%%10), D6(x) +#define D8(x) ('0'+(x/100000000 )%%10), D7(x) +#define D9(x) ('0'+(x/1000000000)%%10), D8(x) +|} + ); + List.iteri vars ~f:(fun i (name, t) -> + match t with + | Type.Int -> + let c_arr_i = + let b = Buffer.create 8 in + let is = string_of_int i in + for i=0 to String.length is - 1 do + Printf.bprintf b "'%c', " is.[i] + done; + Buffer.contents b + in + pr {| +const char s%i[] = { + 'B', 'E', 'G', 'I', 'N', '-', %s'-', + D9((%s)), + '-', 'E', 'N', 'D' +}; +|} i c_arr_i name | String -> - pr_cfg "%S=s:%s" name name); - let code = Buffer.contents buf in - match pp_c_prog t ?c_flags code with + pr {|const char *s%i = "BEGIN-%i-" %s "-END";|} i i name; + | Switch -> + pr {| +#ifdef %s +const char *s%i = "BEGIN-%i-true-END"; +#else +const char *s%i = "BEGIN-%i-false-END"; +#endif +|} name i i i i + ); + Buffer.contents buf + + let extract_values obj_file vars = + let values = + Io.with_lexbuf_from_file obj_file ~f:(Extract_obj.extract []) + |> Int_map.of_list_exn + in + List.mapi vars ~f:(fun i (name, t) -> + let value = + let raw_val = + match Int_map.find values i with + | None -> die "Unable to get value for %s" name + | Some v -> v in + match t with + | Type.Switch -> Value.Switch (bool_of_string raw_val) + | Int -> Int (int_of_string raw_val) + | String -> String raw_val in + (name, value)) + + let import t ?prelude ?c_flags ~includes vars = + let program = extract_program ?prelude ("stdio.h" :: includes) vars in + match compile_c_prog t ?c_flags program with | Error _ -> die "failed to compile program" - | Ok pped_lines -> - String.split_lines pped_lines - |> List.filter_map ~f:(fun l -> - try - Scanf.sscanf l "--- configurator %S=%[ibs]:%s" (fun name typ v -> - Some ( - ( name - , match typ with - | "b" -> Value.Switch (bool_of_string v) - | "i" -> Int (int_of_string v) - | "s" -> String v - | _ -> assert false) - ) - ) - with - | End_of_file - | Scanf.Scan_failure _ -> None - ) + | Ok obj -> extract_values obj vars let gen_header_file t ~fname ?protection_var vars = let protection_var = @@ -402,7 +420,6 @@ module C_define = struct Sys.rename tmp_fname fname end - let find_in_path t prog = logf t "find_in_path: %s" prog; let x = Find_in_path.find prog in diff --git a/src/configurator/v1.mli b/src/configurator/v1.mli index 65abf615..5eb9ebb7 100644 --- a/src/configurator/v1.mli +++ b/src/configurator/v1.mli @@ -48,7 +48,6 @@ module C_define : sig (** Define extra code be used with extracting values below. Note that the compiled code is never executed. *) -> ?c_flags: string list - -> ?link_flags:string list (** @deprecated, this argument is ignored *) -> includes: string list -> (string * Type.t ) list -> (string * Value.t) list From 3e1495e47ebb9c6852d7758f3925f8acecb99e46 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 17 Apr 2018 18:19:37 +0700 Subject: [PATCH 3/3] Add entry module for configurator Only expose the public api (v1) in it --- src/configurator/configurator.ml | 1 + 1 file changed, 1 insertion(+) create mode 100644 src/configurator/configurator.ml diff --git a/src/configurator/configurator.ml b/src/configurator/configurator.ml new file mode 100644 index 00000000..87183987 --- /dev/null +++ b/src/configurator/configurator.ml @@ -0,0 +1 @@ +module V1 = V1