summaryrefslogtreecommitdiff
path: root/riscv/riscv_extras.lem
diff options
context:
space:
mode:
authorThomas Bauereiss2018-02-14 19:45:07 +0000
committerThomas Bauereiss2018-02-15 20:11:21 +0000
commit737ec26cf494affb346504c482e9b91127b68636 (patch)
tree30bcac2487eb2294952624aa25321a0299c6e2e7 /riscv/riscv_extras.lem
parent9883998c6de1a0421eacb4f4c352b0aa8c4a1b5c (diff)
Rebase state monad onto prompt monad
Generate only one Lem model based on the prompt monad (instead of two models with different monads), and add a lifting from prompt to state monad. Add some Isabelle lemmas about the monad lifting. Also drop the "_embed" and "_sequential" suffixes from names of generated files.
Diffstat (limited to 'riscv/riscv_extras.lem')
-rw-r--r--riscv/riscv_extras.lem79
1 files changed, 79 insertions, 0 deletions
diff --git a/riscv/riscv_extras.lem b/riscv/riscv_extras.lem
new file mode 100644
index 00000000..49499445
--- /dev/null
+++ b/riscv/riscv_extras.lem
@@ -0,0 +1,79 @@
+open import Pervasives
+open import Pervasives_extra
+open import Sail_instr_kinds
+open import Sail_values
+open import Sail_operators_mwords
+open import Prompt_monad
+open import Prompt
+
+type bitvector 'a = mword 'a
+
+let MEM_fence_rw_rw () = barrier Barrier_RISCV_rw_rw
+let MEM_fence_r_rw () = barrier Barrier_RISCV_r_rw
+let MEM_fence_r_r () = barrier Barrier_RISCV_r_r
+let MEM_fence_rw_w () = barrier Barrier_RISCV_rw_w
+let MEM_fence_w_w () = barrier Barrier_RISCV_w_w
+let MEM_fence_i () = barrier Barrier_RISCV_i
+
+val MEMea : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e
+val MEMea_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e
+val MEMea_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e
+val MEMea_conditional : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e
+val MEMea_conditional_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e
+val MEMea_conditional_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e
+
+let MEMea addr size = write_mem_ea Write_plain addr size
+let MEMea_release addr size = write_mem_ea Write_RISCV_release addr size
+let MEMea_strong_release addr size = write_mem_ea Write_RISCV_strong_release addr size
+let MEMea_conditional addr size = write_mem_ea Write_RISCV_conditional addr size
+let MEMea_conditional_release addr size = write_mem_ea Write_RISCV_conditional_release addr size
+let MEMea_conditional_strong_release addr size
+ = write_mem_ea Write_RISCV_conditional_strong_release addr size
+
+val write_ram : forall 'rv 'a 'b 'e. Size 'a, Size 'b =>
+ integer -> integer -> bitvector 'a -> bitvector 'a -> bitvector 'b -> monad 'rv unit 'e
+let write_ram addrsize size hexRAM address value =
+ write_mem_ea Write_plain address size >>
+ write_mem_val value >>= fun _ ->
+ return ()
+
+val read_ram : forall 'rv 'a 'b 'e. Size 'a, Size 'b =>
+ integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e
+let read_ram addrsize size hexRAM address =
+ read_mem Read_plain address size
+
+let speculate_conditional_success () = excl_result ()
+
+val get_slice_int : forall 'a. Size 'a => integer -> integer -> integer -> bitvector 'a
+let get_slice_int len n lo =
+ (* TODO: Is this the intended behaviour? *)
+ let hi = lo + len - 1 in
+ let bits = bits_of_int (hi + 1) n in
+ of_bits (get_bits false bits hi lo)
+
+val sign_extend : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> integer -> bitvector 'b
+let sign_extend v len = exts_vec len v
+val zero_extend : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> integer -> bitvector 'b
+let zero_extend v len = extz_vec len v
+
+val shift_bits_right : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> bitvector 'b -> bitvector 'a
+let shift_bits_right v m = shiftr v (unsigned m)
+val shift_bits_left : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> bitvector 'b -> bitvector 'a
+let shift_bits_left v m = shiftl v (unsigned m)
+
+val prerr_endline : string -> unit
+let prerr_endline _ = ()
+declare ocaml target_rep function prerr_endline = `prerr_endline`
+
+val print_string : string -> string -> unit
+let print_string msg s = prerr_endline (msg ^ s)
+
+val print_int : string -> integer -> unit
+let print_int msg i = prerr_endline (msg ^ (stringFromInteger i))
+
+val print_bits : forall 'a. Size 'a => string -> bitvector 'a -> unit
+let print_bits msg bs = prerr_endline (msg ^ (show_bitlist (bits_of bs)))
+
+val putchar : integer -> unit
+let putchar _ = ()
+declare ocaml target_rep function putchar i = (`print_char` (`char_of_int` (`Nat_big_num.to_int` i)))