1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
|
open import Pervasives
open import Interp_ast
open import Interp_interface
open import Sail_impl_base
open import Interp_inter_imp
import Set_extra
let memory_parameter_transformer mode v =
match v with
| Interp_ast.V_tuple [location;length] ->
let (v,loc_regs) = extern_with_track mode extern_vector_value location in
match length with
| Interp_ast.V_lit (L_aux (L_num len) _) ->
(v,(natFromInteger len),loc_regs)
| Interp_ast.V_track (Interp_ast.V_lit (L_aux (L_num len) _)) size_regs ->
match loc_regs with
| Nothing -> (v,(natFromInteger len),Just (List.map (fun r -> extern_reg r Nothing) (Set_extra.toList size_regs)))
| Just loc_regs -> (v,(natFromInteger len),Just (loc_regs++(List.map (fun r -> extern_reg r Nothing) (Set_extra.toList size_regs))))
end
| _ -> Assert_extra.failwith "expected 'V_lit (L_aux (L_num _) _)' or 'V_track (V_lit (L_aux (L_num len) _)) _'"
end
| _ -> Assert_extra.failwith ("memory_parameter_transformer: expected 'V_tuple [_;_]' given " ^ (Interp.string_of_value v))
end
let memory_parameter_transformer_option_address _mode v =
match v with
| Interp_ast.V_tuple [location;_] ->
Just (extern_vector_value location)
| _ -> Assert_extra.failwith ("memory_parameter_transformer_option_address: expected 'V_tuple [_;_]' given " ^ (Interp.string_of_value v))
end
let x86_read_memory_functions : memory_reads =
[ ("rMEM", (MR Read_plain memory_parameter_transformer));
("rMEM_locked", (MR Read_X86_locked memory_parameter_transformer));
]
let x86_memory_writes : memory_writes =
[]
let x86_memory_eas : memory_write_eas =
[ ("MEMea", (MEA Write_plain memory_parameter_transformer));
("MEMea_locked", (MEA Write_X86_locked memory_parameter_transformer));
]
let x86_memory_vals : memory_write_vals =
[ ("MEMval", (MV memory_parameter_transformer_option_address Nothing));
]
let x86_barrier_functions =
[
("X86_MFENCE", Barrier_x86_MFENCE);
]
|