adbrucker
/
lh-l4v
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

SELFOUR-444: Initial updates to capDL spec.

This commit is contained in:
Thomas Sewell 2016-05-24 01:35:26 +10:00
parent 411af12ee9
commit 69f7be9917
3 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
spec/capDL/Intents_D.thy
View File

@ -119,7 +119,7 @@ datatype cdl_tcb_intent =
| TcbUnbindNTFNIntent
datatype cdl_untyped_intent =
(* Retype: (target), type, size_bits, (root), node_index, node_depth, node_offset, node_window, has_children *)
(* Retype: (target), (do_reset), type, size_bits, (root), node_index, node_depth, node_offset, node_window, has_children *)
UntypedRetypeIntent cdl_object_type word32 word32 word32 word32 word32
datatype cdl_irq_handler_intent =

2
spec/capDL/Syscall_D.thy
View File

@ -68,7 +68,7 @@ where
fun
perform_invocation :: "bool \<Rightarrow> bool \<Rightarrow> cdl_invocation \<Rightarrow> unit preempt_monad"
where
"perform_invocation is_call can_block (InvokeUntyped untyped_params) = liftE (invoke_untyped untyped_params)"
"perform_invocation is_call can_block (InvokeUntyped untyped_params) = (invoke_untyped untyped_params)"
| "perform_invocation is_call can_block (InvokeEndpoint endpoint_params) = liftE (invoke_endpoint is_call can_block endpoint_params)"
| "perform_invocation is_call can_block (InvokeNotification ntfn_params) = liftE (invoke_notification ntfn_params)"
| "perform_invocation is_call can_block (InvokeReply reply_params) = liftE (invoke_reply reply_params)"

37
spec/capDL/Untyped_D.thy
View File

@ -46,7 +46,7 @@ where
s \<leftarrow> liftE $ get;
has_kids \<leftarrow> returnOk $ has_children untyped_ref s;
returnOk $ Retype untyped_ref type (unat size_bits) slots has_kids (unat node_window)
returnOk $ Retype untyped_ref type (unat size_bits) slots has_kids (unat node_window)
odE \<sqinter> throw"
(* Zero out a set of addresses. *)
@ -132,20 +132,36 @@ where
primrec (nonexhaustive)
untyped_is_device :: "cdl_cap \<Rightarrow> bool"
where
"untyped_is_device (UntypedCap d _ _) = d"
"untyped_is_device (UntypedCap d _ _) = d"
definition
invoke_untyped :: "cdl_untyped_invocation \<Rightarrow> unit k_monad"
reset_untyped_cap :: "cdl_cap_ref \<Rightarrow> unit preempt_monad"
where
"reset_untyped_cap cref \<equiv> doE
cap \<leftarrow> liftE $ get_cap cref;
liftE $ modify (detype (cap_objects cap));
count \<leftarrow> liftE $ select UNIV;
mapME_x (\<lambda>_. doE
S \<leftarrow> liftE $ select {S. available_range cap \<subseteq> S
\<and> S \<subseteq> cap_objects cap};
liftE $ set_cap cref $ set_available_range cap S;
returnOk () \<sqinter> throw
odE) [0 ..< count];
liftE $ set_cap cref $ set_available_range cap (cap_objects cap);
returnOk ()
odE"
definition
invoke_untyped :: "cdl_untyped_invocation \<Rightarrow> unit preempt_monad"
where
"invoke_untyped params \<equiv> case params of
Retype untyped_ref new_type type_size target_slots has_kids num_objects \<Rightarrow>
do
doE
unlessE has_kids $ reset_untyped_cap untyped_ref;
liftE $ do
untyped_cap \<leftarrow> get_cap untyped_ref;
(* If the untyped hasn't already been typed into something we reuse our names. *)
unless has_kids $ modify (detype (cap_objects untyped_cap));
new_range \<leftarrow> return $ if has_kids then (available_range untyped_cap) else (cap_objects untyped_cap);
new_range \<leftarrow> return $ available_range untyped_cap;
new_obj_refs \<leftarrow> generate_object_ids num_objects new_type new_range;
update_available_range new_range (map (\<lambda>s. pick s) new_obj_refs) untyped_ref untyped_cap;
@ -159,7 +175,8 @@ where
(* Ideally, we should return back to the user how many
* objects were created. *)
return ()
od"
od
odE"
end