diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_backend.ml | 3 | ||||
| -rw-r--r-- | src/isail.ml | 25 | ||||
| -rw-r--r-- | src/ocaml_backend.ml | 15 | ||||
| -rw-r--r-- | src/rewrites.ml | 1 | ||||
| -rw-r--r-- | src/value.ml | 4 |
5 files changed, 36 insertions, 12 deletions
diff --git a/src/c_backend.ml b/src/c_backend.ml index e4bbd393..cb732e2d 100644 --- a/src/c_backend.ml +++ b/src/c_backend.ml @@ -2655,7 +2655,8 @@ let instrument_tracing ctx = let module StringSet = Set.Make(String) in let traceable = StringSet.of_list ["mach_bits"; "sail_string"; "sail_bits"; "sail_int"; "unit"; "bool"] in let rec instrument = function - | (I_aux (I_funcall (clexp, _, id, args, ctyp), _) as instr) :: instrs -> + | (I_aux (I_funcall (clexp, _, id, args, ctyp), _) as instr) :: instrs when not (Env.is_extern id ctx.tc_env "c") -> + let trace_start = iraw (Printf.sprintf "trace_start(\"%s\");" (String.escaped (string_of_id id))) in diff --git a/src/isail.ml b/src/isail.ml index 593167f9..4adc1cd2 100644 --- a/src/isail.ml +++ b/src/isail.ml @@ -127,7 +127,12 @@ let rec run () = print_endline ("Result = " ^ Value.string_of_value v); current_mode := Normal | Step (out, state, _, stack) -> - current_mode := Evaluation (eval_frame !interactive_ast frame); + begin + try + current_mode := Evaluation (eval_frame !interactive_ast frame) + with + | Failure str -> print_endline str; current_mode := Normal + end; run () | Break frame -> print_endline "Breakpoint"; @@ -147,7 +152,12 @@ let rec run_steps n = print_endline ("Result = " ^ Value.string_of_value v); current_mode := Normal | Step (out, state, _, stack) -> - current_mode := Evaluation (eval_frame !interactive_ast frame); + begin + try + current_mode := Evaluation (eval_frame !interactive_ast frame) + with + | Failure str -> print_endline str; current_mode := Normal + end; run_steps (n - 1) | Break frame -> print_endline "Breakpoint"; @@ -352,9 +362,14 @@ let handle_input' input = print_endline ("Result = " ^ Value.string_of_value v); current_mode := Normal | Step (out, state, _, stack) -> - interactive_state := state; - current_mode := Evaluation (eval_frame !interactive_ast frame); - print_program () + begin + try + interactive_state := state; + current_mode := Evaluation (eval_frame !interactive_ast frame); + print_program () + with + | Failure str -> print_endline str; current_mode := Normal + end | Break frame -> print_endline "Breakpoint"; current_mode := Evaluation frame diff --git a/src/ocaml_backend.ml b/src/ocaml_backend.ml index 5ffb1647..236c4222 100644 --- a/src/ocaml_backend.ml +++ b/src/ocaml_backend.ml @@ -167,10 +167,13 @@ let ocaml_lit (L_aux (lit_aux, _)) = | L_one -> string "B1" | L_true -> string "true" | L_false -> string "false" - | L_num n -> if Big_int.equal n Big_int.zero - then string "Big_int.zero" - else parens (string "Big_int.of_int" ^^ space - ^^ string "(" ^^ string (Big_int.to_string n) ^^ string ")") + | L_num n -> + if Big_int.equal n Big_int.zero then + string "Big_int.zero" + else if Big_int.less_equal (Big_int.of_int min_int) n && Big_int.less_equal n (Big_int.of_int max_int) then + parens (string "Big_int.of_int" ^^ space ^^ parens (string (Big_int.to_string n))) + else + parens (string "Big_int.of_string" ^^ space ^^ dquotes (string (Big_int.to_string n))) | L_undef -> failwith "undefined should have been re-written prior to ocaml backend" | L_string str -> string_lit str | L_real str -> parens (string "real_of_string" ^^ space ^^ dquotes (string (String.escaped str))) @@ -389,6 +392,10 @@ let ocaml_dec_spec ctx (DEC_aux (reg, _)) = separate space [string "let"; zencode ctx id; colon; parens (ocaml_typ ctx typ); string "ref"; equals; string "ref"; parens (ocaml_exp ctx (initial_value_for id ctx.register_inits))] + | DEC_config (id, typ, exp) -> + separate space [string "let"; zencode ctx id; colon; + parens (ocaml_typ ctx typ); string "ref"; equals; + string "ref"; parens (ocaml_exp ctx exp)] | _ -> failwith "Unsupported register declaration" let first_function = ref true diff --git a/src/rewrites.ml b/src/rewrites.ml index fad1f4d2..8fe30d6b 100644 --- a/src/rewrites.ml +++ b/src/rewrites.ml @@ -2304,6 +2304,7 @@ let rewrite_type_def_typs rw_typ rw_typquant rw_typschm (TD_aux (td, annot)) = let rewrite_dec_spec_typs rw_typ (DEC_aux (ds, annot)) = match ds with | DEC_reg (typ, id) -> DEC_aux (DEC_reg (rw_typ typ, id), annot) + | DEC_config (id, typ, exp) -> DEC_aux (DEC_config (id, rw_typ typ, exp), annot) | _ -> assert false (* Remove overload definitions and cast val specs from the diff --git a/src/value.ml b/src/value.ml index 1d2346af..dccb216e 100644 --- a/src/value.ml +++ b/src/value.ml @@ -406,8 +406,8 @@ let value_read_ram = function let value_write_ram = function | [v1; v2; v3; v4; v5] -> - Sail_lib.write_ram (coerce_int v1, coerce_int v2, coerce_bv v3, coerce_bv v4, coerce_bv v5); - V_unit + let b = Sail_lib.write_ram (coerce_int v1, coerce_int v2, coerce_bv v3, coerce_bv v4, coerce_bv v5) in + V_bool(b) | _ -> failwith "value write_ram" let value_load_raw = function |