summaryrefslogtreecommitdiff
path: root/mips_new_tc/mips_extras_embed_sequential.lem
diff options
context:
space:
mode:
authorThomas Bauereiss2017-08-08 13:52:49 +0100
committerThomas Bauereiss2017-08-08 14:53:42 +0100
commit6100aecd642766252b73d3271a026d17de605fa0 (patch)
tree00f18dd834a71d133612a465caa68d11d13999b0 /mips_new_tc/mips_extras_embed_sequential.lem
parent3071a02cf521d076f1ac0f4c6069e4e943aa15e7 (diff)
Fix Lem bindings in test cases
Add a test case with the MIPS spec using the TLB stub. Use the sequential monad for Lem testing for now; the free monad (in "prompt.lem") has not been updated for machine words yet.
Diffstat (limited to 'mips_new_tc/mips_extras_embed_sequential.lem')
-rw-r--r--mips_new_tc/mips_extras_embed_sequential.lem51
1 files changed, 51 insertions, 0 deletions
diff --git a/mips_new_tc/mips_extras_embed_sequential.lem b/mips_new_tc/mips_extras_embed_sequential.lem
new file mode 100644
index 00000000..ad567598
--- /dev/null
+++ b/mips_new_tc/mips_extras_embed_sequential.lem
@@ -0,0 +1,51 @@
+open import Pervasives
+open import Pervasives_extra
+open import Sail_impl_base
+open import Sail_values
+open import State
+
+val MEMr : forall 'a 'b. Size 'b => (bitvector 'a * integer) -> M (bitvector 'b)
+val MEMr_reserve : forall 'a 'b. Size 'b => (bitvector 'a * integer) -> M (bitvector 'b)
+val MEMr_tag : forall 'a 'b. Size 'b => (bitvector 'a * integer) -> M (bitU * bitvector 'b)
+val MEMr_tag_reserve : forall 'a 'b. Size 'b => (bitvector 'a * integer) -> M (bitU * bitvector 'b)
+
+let MEMr (addr,size) = read_mem false Read_plain addr size
+let MEMr_reserve (addr,size) = read_mem false Read_reserve addr size
+
+let MEMr_tag (addr,size) =
+ read_mem false Read_plain addr size >>= fun v ->
+ read_tag false Read_plain addr >>= fun t ->
+ return (t, v)
+
+let MEMr_tag_reserve (addr,size) =
+ read_mem false Read_plain addr size >>= fun v ->
+ read_tag false Read_plain addr >>= fun t ->
+ return (t, v)
+
+
+val MEMea : forall 'a. (bitvector 'a * integer) -> M unit
+val MEMea_conditional : forall 'a. (bitvector 'a * integer) -> M unit
+val MEMea_tag : forall 'a. (bitvector 'a * integer) -> M unit
+val MEMea_tag_conditional : forall 'a. (bitvector 'a * integer) -> M unit
+
+let MEMea (addr,size) = write_mem_ea Write_plain addr size
+let MEMea_conditional (addr,size) = write_mem_ea Write_conditional addr size
+
+let MEMea_tag (addr,size) = write_mem_ea Write_plain addr size
+let MEMea_tag_conditional (addr,size) = write_mem_ea Write_conditional addr size
+
+
+val MEMval : forall 'a 'b. (bitvector 'a * integer * bitvector 'b) -> M unit
+val MEMval_conditional : forall 'a 'b. (bitvector 'a * integer * bitvector 'b) -> M bool
+val MEMval_tag : forall 'a 'b. (bitvector 'a * integer * bitU * bitvector 'b) -> M unit
+val MEMval_tag_conditional : forall 'a 'b. (bitvector 'a * integer * bitU * bitvector 'b) -> M bool
+
+let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return ()
+let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then true else false)
+let MEMval_tag (_,_,t,v) = write_mem_val v >>= fun _ -> write_tag t >>= fun _ -> return ()
+let MEMval_tag_conditional (_,_,t,v) = write_mem_val v >>= fun b -> write_tag t >>= fun _ -> return (if b then true else false)
+
+val MEM_sync : unit -> M unit
+
+let MEM_sync () = barrier Barrier_MIPS_SYNC
+