diff options
Diffstat (limited to 'driver')
-rw-r--r-- | driver/Clflags.ml | 2 | ||||
-rw-r--r-- | driver/Driver.ml | 33 | ||||
-rw-r--r-- | driver/Interp.ml | 6 |
3 files changed, 38 insertions, 3 deletions
diff --git a/driver/Clflags.ml b/driver/Clflags.ml index ead27b36..c90ff1a9 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -17,6 +17,8 @@ let linker_options = ref ([]: string list) let assembler_options = ref ([]: string list) let option_flongdouble = ref false let option_fstruct_return = ref false +let option_fstruct_return_style = ref (None: int option) +let option_fstruct_passing_style = ref (None: Machine.struct_passing_style option) let option_fbitfields = ref false let option_fvararg_calls = ref true let option_funprototyped = ref true diff --git a/driver/Driver.ml b/driver/Driver.ml index d22dd77c..e3ad4549 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -265,6 +265,7 @@ let process_c_file sourcename = let preproname = Filename.temp_file "compcert" ".i" in preprocess sourcename preproname; if !option_interp then begin + Machine.config := Machine.compcert_interpreter !Machine.config; let csyntax = parse_c_file sourcename preproname in safe_remove preproname; Interp.execute csyntax; @@ -409,6 +410,10 @@ Language support options (use -fno-<opt> to turn off -f<opt>) : -fbitfields Emulate bit fields in structs [off] -flongdouble Treat 'long double' as 'double' [off] -fstruct-return Emulate returning structs and unions by value [off] + -fstruct-return=<convention> + Set the calling conventions used to return structs by value + -fstruct-passing=<convention> + Set the calling conventions used to pass structs by value -fvararg-calls Support calls to variable-argument functions [on] -funprototyped Support calls to old-style functions without prototypes [on] -fpacked-structs Emulate packed structs [off] @@ -550,7 +555,25 @@ let cmdline_actions = Exact "-quiet", Self (fun _ -> Interp.trace := 0); Exact "-trace", Self (fun _ -> Interp.trace := 2); Exact "-random", Self (fun _ -> Interp.mode := Interp.Random); - Exact "-all", Self (fun _ -> Interp.mode := Interp.All) + Exact "-all", Self (fun _ -> Interp.mode := Interp.All); +(* Special -f options *) + Exact "-fstruct-passing=ref-callee", + Self (fun _ -> option_fstruct_passing_style := Some Machine.SP_ref_callee); + Exact "-fstruct-passing=ref-caller", + Self (fun _ -> option_fstruct_return := true; + option_fstruct_passing_style := Some Machine.SP_ref_caller); + Exact "-fstruct-passing=ints", + Self (fun _ -> option_fstruct_return := true; + option_fstruct_passing_style := Some Machine.SP_split_args); + Exact "-fstruct-return=ref", + Self (fun _ -> option_fstruct_return := true; + option_fstruct_return_style := Some 0); + Exact "-fstruct-return=int4", + Self (fun _ -> option_fstruct_return := true; + option_fstruct_return_style := Some 4); + Exact "-fstruct-return=int8", + Self (fun _ -> option_fstruct_return := true; + option_fstruct_return_style := Some 8) ] (* -f options: come in -f and -fno- variants *) (* Language support options *) @@ -605,9 +628,13 @@ let _ = Printexc.record_backtrace true; Machine.config := begin match Configuration.arch with - | "powerpc" -> Machine.ppc_32_bigendian + | "powerpc" -> if Configuration.abi = "linux" + then Machine.ppc_32_bigendian_linux + else Machine.ppc_32_bigendian | "arm" -> Machine.arm_littleendian - | "ia32" -> Machine.x86_32 + | "ia32" -> if Configuration.abi = "macosx" + then Machine.x86_32_macosx + else Machine.x86_32 | _ -> assert false end; Builtins.set C2C.builtins; diff --git a/driver/Interp.ml b/driver/Interp.ml index 2725dbfe..3ad0df8a 100644 --- a/driver/Interp.ml +++ b/driver/Interp.ml @@ -366,6 +366,7 @@ let do_printf m fmt args = let (>>=) opt f = match opt with None -> None | Some arg -> f arg +(* (* Like eventval_of_val, but accepts static globals as well *) let convert_external_arg ge v t = @@ -385,6 +386,7 @@ let rec convert_external_args ge vl tl = convert_external_arg ge v1 t1 >>= fun e1 -> convert_external_args ge vl tl >>= fun el -> Some (e1 :: el) | _, _ -> None +*) let do_external_function id sg ge w args m = match extern_atom id, args with @@ -392,8 +394,12 @@ let do_external_function id sg ge w args m = extract_string m b ofs >>= fun fmt -> print_string (do_printf m fmt args'); flush stdout; + Some(((w, [Event_syscall(id, [], EVint Int.zero)]), Vint Int.zero), m) +(* convert_external_args ge args sg.sig_args >>= fun eargs -> Some(((w, [Event_syscall(id, eargs, EVint Int.zero)]), Vint Int.zero), m) +*) + | _ -> None |