725 lines
33 KiB
Plaintext
725 lines
33 KiB
Plaintext
(*
|
|
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
|
|
*
|
|
* SPDX-License-Identifier: GPL-2.0-only
|
|
*)
|
|
|
|
theory Arch_DP
|
|
imports Retype_DP
|
|
begin
|
|
|
|
|
|
lemma cdl_get_pde_result_pt:
|
|
"\<lbrace> < (pd, unat (ptr >> 20)) \<mapsto>c PageTableCap p b None \<and>* sep_true> \<rbrace>
|
|
cdl_get_pde (cdl_lookup_pd_slot pd ptr)
|
|
\<lbrace>\<lambda>r s. \<exists>asid. r = PageTableCap p b asid\<rbrace>"
|
|
apply (clarsimp simp:cdl_get_pde_def cdl_lookup_pd_slot_def)
|
|
apply wp
|
|
apply (clarsimp dest!:opt_cap_sep_imp)
|
|
apply (clarsimp simp:reset_cap_asid_def split:cdl_cap.splits)
|
|
done
|
|
|
|
lemma cdl_lookup_pt_slot_rv:
|
|
"\<lbrace> K (R (p, unat ((ptr >> 12) && 0xFF))) and <(pd, unat (ptr >> 20)) \<mapsto>c PageTableCap p Fake None \<and>* (\<lambda>s. True)>\<rbrace>
|
|
cdl_lookup_pt_slot pd ptr \<lbrace>\<lambda>r s. R r\<rbrace>,-"
|
|
apply (rule validE_validE_R)
|
|
apply (clarsimp simp : cdl_lookup_pt_slot_def)
|
|
apply (clarsimp simp: validE_def valid_def bindE_def
|
|
bind_def bind_assoc NonDetMonad.lift_def)
|
|
apply (case_tac a)
|
|
apply (clarsimp simp:liftE_def bindE_def bind_def return_def)
|
|
apply (clarsimp simp:liftE_def bindE_def bind_def return_def)
|
|
apply (drule use_valid[OF _ cdl_get_pde_result_pt])
|
|
apply simp
|
|
apply (clarsimp split:option.splits)
|
|
apply (clarsimp simp: returnOk_def return_def)
|
|
apply (clarsimp simp:throwError_def return_def)
|
|
done
|
|
|
|
lemma decode_invocation_invER[wp]:
|
|
"\<lbrace>P and Q\<rbrace> decode_invocation a b c d\<lbrace>\<lambda>_. P\<rbrace>, \<lbrace>\<lambda>_. Q\<rbrace>"
|
|
apply (simp add:decode_invocation_def)
|
|
apply (case_tac a,simp_all)
|
|
apply (rule hoare_pre, (wp | simp add:throw_opt_def | wpc | intro conjI impI)+)+
|
|
done
|
|
|
|
definition
|
|
"cap_mapped cap = (case cap of PageTableCap _ _ asid \<Rightarrow> asid
|
|
| FrameCap _ _ _ _ _ asid \<Rightarrow> asid)"
|
|
|
|
definition
|
|
"cap_asid cap = (case cap of PageDirectoryCap pd_ptr real' asid' \<Rightarrow> asid')"
|
|
|
|
definition
|
|
"get_mapped_asid \<equiv> \<lambda>asid vaddr. option_map (\<lambda>x. (x,vaddr)) asid"
|
|
|
|
|
|
|
|
lemma decode_page_map_intent_rv_20_24:
|
|
"\<lbrakk>n = 20 \<or> n = 24 \<rbrakk>
|
|
\<Longrightarrow> \<lbrace>\<lambda>s. R (InvokePage (PageMap (FrameCap dev frame_ptr rights n Real (get_mapped_asid asid' vaddr))
|
|
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) ref [cdl_lookup_pd_slot ptr vaddr])) \<rbrace>
|
|
decode_invocation (FrameCap dev frame_ptr rights n real_type asid) ref
|
|
[(PageDirectoryCap ptr real' asid',pdref)]
|
|
(PageIntent (PageMapIntent vaddr perms vmattr))
|
|
\<lbrace>\<lambda>r s. R r\<rbrace>, -"
|
|
apply (simp add: decode_invocation_def get_index_def get_page_intent_def throw_opt_def
|
|
cap_rights_def decode_page_invocation_def throw_on_none_def get_mapped_asid_def)
|
|
apply (wp alternativeE_wp select_wp | wpc)+
|
|
apply (rule validE_validE_R)
|
|
apply (wp alternativeE_wp)
|
|
apply (simp add:cdl_page_mapping_entries_def split del:if_split | wp | wpc)+
|
|
apply auto
|
|
done
|
|
|
|
lemma decode_page_map_intent_rv_16_12:
|
|
"\<lbrakk>n = 12 \<or> n = 16 \<rbrakk>
|
|
\<Longrightarrow> \<lbrace>\<lambda>s. R (InvokePage (PageMap (FrameCap dev frame_ptr rights n Real (get_mapped_asid asid' vaddr))
|
|
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) ref
|
|
[(p, unat ((vaddr >> 12) && 0xFF))]))
|
|
\<and> <(ptr, unat (vaddr >> 20)) \<mapsto>c PageTableCap p Fake None \<and>* (\<lambda>s. True)> s\<rbrace>
|
|
decode_invocation (FrameCap dev frame_ptr rights n real_type asid) ref
|
|
[(PageDirectoryCap ptr real' asid',pdref)]
|
|
(PageIntent (PageMapIntent vaddr perms vmattr))
|
|
\<lbrace>\<lambda>r s. R r\<rbrace>, -"
|
|
apply (simp add:decode_invocation_def get_index_def
|
|
get_page_intent_def throw_opt_def cap_rights_def
|
|
decode_page_invocation_def throw_on_none_def
|
|
get_mapped_asid_def)
|
|
apply (wp alternativeE_wp select_wp)
|
|
apply (rule validE_validE_R)
|
|
apply (wp alternativeE_wp)
|
|
apply (simp add:cdl_page_mapping_entries_def)
|
|
apply (wp cdl_lookup_pt_slot_rv | wpc | simp)+
|
|
apply auto
|
|
done
|
|
|
|
abbreviation(input)
|
|
invoke_page_map_slots :: "cdl_invocation \<Rightarrow> cdl_cap_ref list"
|
|
where "invoke_page_map_slots ivk \<equiv>
|
|
case ivk of (InvokePage (PageMap cap cap' ref xs)) \<Rightarrow> xs"
|
|
|
|
lemma invoke_page_wp:
|
|
"pinv = PageMap (FrameCap dev frame_ptr rights n fake asid)
|
|
(FrameCap False frame_ptr rights' n fake' asid') ref x
|
|
\<Longrightarrow>\<lbrace><ref \<mapsto>c - \<and>* \<And>* map sep_any_map_c (invoke_page_map_slots (InvokePage pinv))
|
|
\<and>* P (invoke_page_map_slots (InvokePage pinv)) >\<rbrace>
|
|
invoke_page pinv
|
|
\<lbrace>\<lambda>r. <\<And>* map (\<lambda>ptr. ptr\<mapsto>c (FrameCap False frame_ptr rights' n fake' asid'))
|
|
(invoke_page_map_slots (InvokePage pinv))
|
|
\<and>* ref \<mapsto>c (FrameCap dev frame_ptr rights n fake asid) \<and>* P (invoke_page_map_slots (InvokePage pinv))>\<rbrace>"
|
|
apply (simp add:invoke_page_def)
|
|
apply wp
|
|
apply (rule sep_lifted.mapM_x_sep_inv
|
|
[where lft = sep_state_projection and I' = \<top>,simplified])
|
|
apply (simp add:swp_def)
|
|
apply (rule hoare_pre)
|
|
apply (rule set_cap_wp)
|
|
apply simp
|
|
apply (wp sep_wp: set_cap_wp, sep_solve)
|
|
done
|
|
|
|
|
|
lemma invoke_page_table_wp:
|
|
"pinv = PageTableMap real_pt_cap pt_cap pt_cap_ref pt_target_slot \<Longrightarrow>
|
|
\<lbrace> < pt_cap_ref \<mapsto>c - \<and>* pt_target_slot \<mapsto>c - \<and>* P> \<rbrace>
|
|
invoke_page_table pinv
|
|
\<lbrace>\<lambda>_. <pt_cap_ref \<mapsto>c real_pt_cap \<and>* pt_target_slot \<mapsto>c pt_cap \<and>* P>\<rbrace>"
|
|
apply (clarsimp simp:invoke_page_table_def)
|
|
apply (wp sep_wp: insert_cap_orphan_wp set_cap_wp, sep_solve)
|
|
done
|
|
|
|
crunch cdl_cur_thread[wp]: invoke_page "\<lambda>s. P (cdl_current_thread s)"
|
|
(wp: crunch_wps select_wp alternative_wp simp : swp_def )
|
|
|
|
crunch cdl_cur_thread[wp]: invoke_page_table "\<lambda>s. P (cdl_current_thread s)"
|
|
(wp: crunch_wps select_wp alternative_wp simp : swp_def )
|
|
|
|
crunch cdl_cur_domain[wp]: invoke_page_table, invoke_page "\<lambda>s. P (cdl_current_domain s)"
|
|
(wp: crunch_wps select_wp alternative_wp simp : swp_def unless_def)
|
|
|
|
lemmas cap_asid_simps[simp] = cap_asid_def[split_simps cdl_cap.split]
|
|
lemmas cap_mapped_simps[simp] = cap_mapped_def[split_simps cdl_cap.split]
|
|
|
|
lemma decode_page_table_rv:
|
|
"\<lbrace>Q (InvokePageTable
|
|
(PageTableMap (PageTableCap ptr Real (get_mapped_asid (cap_asid (fst pd_cap_slot)) (vaddr && ~~ mask 20)))
|
|
(PageTableCap ptr Fake None) ref
|
|
(cdl_lookup_pd_slot (cap_object (fst pd_cap_slot)) vaddr))) \<rbrace>
|
|
decode_invocation (PageTableCap ptr b asid) ref [pd_cap_slot]
|
|
(PageTableIntent (PageTableMapIntent vaddr vmattribs))
|
|
\<lbrace>Q\<rbrace>, -"
|
|
apply (case_tac pd_cap_slot)
|
|
apply (simp add:decode_invocation_def get_page_table_intent_def
|
|
throw_opt_def decode_page_table_invocation_def)
|
|
apply (rule hoare_pre)
|
|
apply (wp alternativeE_wp throw_on_none_wp | wpc | simp)+
|
|
apply (clarsimp split:option.splits simp:get_index_def cap_object_def
|
|
cap_has_object_def get_mapped_asid_def)
|
|
done
|
|
|
|
lemma seL4_Page_Table_Map:
|
|
notes split_paired_Ex[simp del]
|
|
assumes misc:
|
|
"cap_object cnode_cap = cnode_id"
|
|
"is_cnode_cap cnode_cap"
|
|
"offset page_table root_size = pt_offset"
|
|
"offset page_directory root_size = pd_offset"
|
|
and sz: "one_lvl_lookup cnode_cap word_bits root_size"
|
|
"guard_equal cnode_cap page_directory word_bits"
|
|
"guard_equal cnode_cap page_table word_bits"
|
|
shows "\<lbrace>
|
|
\<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
|
|
\<and>* (cnode_id, pt_offset) \<mapsto>c (PageTableCap ptr Real None)
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>*R \<guillemotright>\<rbrace>
|
|
seL4_PageTable_Map page_table page_directory vaddr vmattribs
|
|
\<lbrace>\<lambda>r s.
|
|
\<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c (PageTableCap ptr Fake None)
|
|
\<and>* (cnode_id, pt_offset) \<mapsto>c (PageTableCap ptr Real None)
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>*R \<guillemotright> s \<rbrace>"
|
|
apply (simp add:seL4_PageTable_Map_def sep_state_projection2_def)
|
|
apply (rule hoare_name_pre_state)
|
|
apply (rule hoare_pre)
|
|
apply (rule do_kernel_op_pull_back)
|
|
apply (rule call_kernel_with_intent_allow_error_helper
|
|
[where check = True and Perror = \<top>,simplified])
|
|
apply fastforce
|
|
apply (rule set_cap_wp)
|
|
apply (wp+)[4]
|
|
apply (rule_tac P = "\<exists>asid'. iv = InvokePageTable (PageTableMap
|
|
(PageTableCap ptr Real asid') (PageTableCap ptr Fake None)
|
|
(cnode_id,pt_offset) (cdl_lookup_pd_slot pd_ptr vaddr))"
|
|
in hoare_gen_asmEx)
|
|
apply clarsimp
|
|
apply wp
|
|
apply (rule_tac P1 = "P1 \<and>* P2" for P1 P2 in hoare_strengthen_post
|
|
[OF invoke_page_table_wp])
|
|
apply fastforce
|
|
apply (rule conjI)
|
|
apply (sep_solve)
|
|
apply (subst sep_map_c_asid_reset [where ptr = "(cnode_id,pt_offset)"])
|
|
prefer 2
|
|
apply (sep_solve)
|
|
apply (simp add:reset_cap_asid_def)
|
|
apply (wp hoare_vcg_conj_lift)
|
|
apply (wp hoare_strengthen_post[OF set_cap_wp])
|
|
apply (sep_solve )
|
|
apply wp
|
|
apply (rule_tac P = "\<exists>asid asid'. (c = (PageTableCap ptr Real asid)
|
|
\<and> cs = [(PageDirectoryCap pd_ptr real_type asid',(cnode_id,pd_offset))]
|
|
\<and> ref = (cnode_id,pt_offset))"
|
|
in hoare_gen_asmEx)
|
|
apply (elim conjE exE)
|
|
apply simp
|
|
apply (rule_tac Q = "\<lambda>iv s. cdl_current_thread s = Some root_tcb_id \<and>
|
|
cdl_current_domain s = minBound \<and>
|
|
<(root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
|
|
\<and>* (cnode_id, pt_offset) \<mapsto>c PageTableCap ptr Real None
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real_type None
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>* R> s \<and>
|
|
iv = InvokePageTable (PageTableMap (PageTableCap ptr Real (get_mapped_asid asid' (vaddr && ~~ mask 20))) (PageTableCap ptr Fake None)
|
|
(cnode_id,pt_offset) (cdl_lookup_pd_slot pd_ptr vaddr))"
|
|
in hoare_post_impErr[rotated -1])
|
|
apply assumption
|
|
apply clarsimp
|
|
apply (rule hoare_vcg_E_elim)
|
|
apply wp
|
|
apply wp
|
|
apply (rule validE_validE_R)
|
|
apply (rule hoare_weaken_preE[where P = \<top>])
|
|
apply (wp decode_page_table_rv)[1]
|
|
apply (simp add:cap_object_def)
|
|
apply (simp add:cap_has_object_def)
|
|
apply clarsimp
|
|
apply (sep_solve)
|
|
apply (simp add:lookup_extra_caps_def conj_comms mapME_singleton)
|
|
apply (rule wp_no_exception_seq)
|
|
apply wp
|
|
apply (rule lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "PageDirectoryCap pd_ptr real_type None"])
|
|
apply (rule hoare_pre)
|
|
apply (wp lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "PageTableCap ptr Real None"])[1]
|
|
apply (erule_tac Q="cdl_current_domain sa = minBound" in conjE, assumption)
|
|
apply (wp lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "PageTableCap ptr Real None"])[1]
|
|
apply clarsimp
|
|
apply (wp update_thread_intent_update hoare_vcg_all_lift
|
|
hoare_vcg_imp_lift)
|
|
apply clarsimp
|
|
defer
|
|
apply clarsimp
|
|
using misc sz
|
|
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
|
|
apply (sep_solve)
|
|
apply simp
|
|
apply sep_solve
|
|
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
|
|
apply sep_solve
|
|
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
|
|
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
|
|
apply (sep_solve)
|
|
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
|
|
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
|
|
apply (sep_solve)
|
|
apply (drule_tac x = "PageTableCap ptr Real None" in spec)
|
|
apply clarsimp
|
|
apply (erule impE)
|
|
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
|
|
apply simp
|
|
apply clarsimp
|
|
apply (sep_solve)
|
|
done
|
|
|
|
lemma seL4_Section_Map_wp:
|
|
notes split_paired_Ex[simp del]
|
|
assumes misc:
|
|
"cap_object cnode_cap = cnode_id" "is_cnode_cap cnode_cap"
|
|
"offset sel_page root_size = frame_offset"
|
|
"offset sel4_page_directory root_size = pd_offset"
|
|
and sz: "one_lvl_lookup cnode_cap word_bits root_size"
|
|
"guard_equal cnode_cap sel4_page_directory word_bits"
|
|
"guard_equal cnode_cap sel_page word_bits"
|
|
shows "\<lbrakk>n = 20 \<or> n = 24
|
|
\<rbrakk> \<Longrightarrow> \<lbrace>
|
|
\<guillemotleft> (root_tcb_id,tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb
|
|
\<and>* (root_tcb_id,tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
|
|
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None \<and>* R \<guillemotright> \<rbrace>
|
|
seL4_Page_Map sel_page sel4_page_directory vaddr perms vmattr
|
|
\<lbrace>\<lambda>r s. \<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c
|
|
FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None
|
|
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None
|
|
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>* R \<guillemotright> s \<rbrace>"
|
|
apply (simp add:seL4_Page_Map_def sep_state_projection2_def)
|
|
apply (rule hoare_name_pre_state)
|
|
apply (rule hoare_pre)
|
|
apply (rule do_kernel_op_pull_back)
|
|
apply (rule call_kernel_with_intent_allow_error_helper
|
|
[where check = True and Perror = \<top>,simplified])
|
|
apply fastforce
|
|
apply (rule set_cap_wp)
|
|
apply (wp+)[4]
|
|
apply (rule_tac P = "\<exists>asid'. iv = InvokePage
|
|
(PageMap (FrameCap dev frame_ptr rights n Real asid')
|
|
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) (cnode_id,frame_offset)
|
|
[cdl_lookup_pd_slot pd_ptr vaddr])"
|
|
in hoare_gen_asmEx)
|
|
apply clarsimp
|
|
apply wp
|
|
apply (rule_tac P1 = "\<lambda>iv. P1 \<and>* P2" for P1 P2 in hoare_strengthen_post
|
|
[OF invoke_page_wp[where fake = Real
|
|
and fake' = Fake and x = "[cdl_lookup_pd_slot pd_ptr vaddr]" ]])
|
|
apply (rule refl)
|
|
apply simp
|
|
apply (rule conjI)
|
|
apply (sep_solve)
|
|
apply (subst sep_map_c_asid_reset [where ptr = "(cnode_id,frame_offset)"])
|
|
prefer 2
|
|
apply (sep_erule_concl refl_imp)+
|
|
apply (sep_solve)
|
|
apply (simp add:reset_cap_asid_def)
|
|
apply (wp hoare_vcg_conj_lift)
|
|
apply (wp hoare_strengthen_post[OF set_cap_wp])
|
|
apply (sep_solve)
|
|
apply wp
|
|
apply (rule_tac P = "\<exists>asid asid'. (c = (FrameCap dev frame_ptr rights n Real asid)
|
|
\<and> cs = [(PageDirectoryCap pd_ptr real_type asid',(cnode_id,pd_offset))]
|
|
\<and> ref = (cnode_id,frame_offset))"
|
|
in hoare_gen_asmEx)
|
|
apply (elim exE)+
|
|
apply simp
|
|
apply (rule_tac Q = "\<lambda>iv s. cdl_current_thread s = Some root_tcb_id \<and>
|
|
cdl_current_domain s = minBound \<and>
|
|
<(root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c -
|
|
\<and>* (cnode_id, frame_offset) \<mapsto>c -
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb \<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real_type None
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>* R> s \<and>
|
|
iv = InvokePage
|
|
(PageMap (FrameCap dev frame_ptr rights n Real (get_mapped_asid asid' vaddr))
|
|
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) (cnode_id,frame_offset)
|
|
[cdl_lookup_pd_slot pd_ptr vaddr])"
|
|
in hoare_post_impErr[rotated -1])
|
|
apply assumption
|
|
apply (rule hoare_vcg_E_elim)
|
|
apply wp
|
|
apply wp
|
|
apply (rule validE_validE_R)
|
|
apply (rule hoare_weaken_preE[where P = \<top>])
|
|
apply (wp decode_page_map_intent_rv_20_24)[1]
|
|
apply simp
|
|
apply simp
|
|
apply clarsimp
|
|
apply sep_solve
|
|
apply (simp add:lookup_extra_caps_def conj_comms mapME_singleton)
|
|
apply (rule wp_no_exception_seq)
|
|
apply wp[1]
|
|
apply (rule lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "PageDirectoryCap pd_ptr real_type None"])
|
|
apply (rule hoare_pre)
|
|
apply (wp lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "FrameCap dev frame_ptr rights n Real None"])[1]
|
|
apply (erule_tac Q="cdl_current_domain sa = minBound" in conjE, assumption)
|
|
apply (wp lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "FrameCap dev frame_ptr rights n Real None"])[1]
|
|
apply clarsimp
|
|
apply (wp update_thread_intent_update hoare_vcg_all_lift
|
|
hoare_vcg_imp_lift)
|
|
apply clarsimp
|
|
defer
|
|
apply clarsimp
|
|
using misc sz
|
|
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
|
|
apply (sep_solve)
|
|
apply simp
|
|
apply sep_solve
|
|
apply (clarsimp simp:user_pointer_at_def Let_def
|
|
word_bits_def sep_conj_assoc)
|
|
apply sep_solve
|
|
apply (clarsimp dest!:reset_cap_asid_simps2
|
|
simp:ep_related_cap_def)
|
|
apply (clarsimp simp:user_pointer_at_def Let_def
|
|
word_bits_def sep_conj_assoc)
|
|
apply (sep_solve)
|
|
apply clarsimp
|
|
apply (sep_solve)
|
|
apply (clarsimp dest!:reset_cap_asid_simps2
|
|
simp:ep_related_cap_def)
|
|
apply (clarsimp simp:user_pointer_at_def Let_def
|
|
word_bits_def sep_conj_assoc)
|
|
apply (drule_tac x = "FrameCap dev frame_ptr rights n Real None" in spec)
|
|
apply clarsimp
|
|
apply (erule impE)
|
|
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
|
|
apply simp
|
|
apply clarsimp
|
|
apply (sep_solve)
|
|
done
|
|
|
|
|
|
lemma seL4_Page_Map_wp:
|
|
notes split_paired_Ex[simp del]
|
|
assumes misc:
|
|
"cap_object cnode_cap = cnode_id" "is_cnode_cap cnode_cap"
|
|
"offset sel_page root_size = frame_offset"
|
|
"offset sel4_page_directory root_size = pd_offset"
|
|
and sz: "one_lvl_lookup cnode_cap word_bits root_size"
|
|
"guard_equal cnode_cap sel4_page_directory word_bits"
|
|
"guard_equal cnode_cap sel_page word_bits"
|
|
shows "\<lbrakk>n = 12 \<or> n = 16
|
|
\<rbrakk> \<Longrightarrow> \<lbrace>
|
|
\<guillemotleft> (root_tcb_id,tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb
|
|
\<and>* (root_tcb_id,tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>* (cdl_lookup_pd_slot pd_ptr vaddr) \<mapsto>c PageTableCap pt_ptr Fake None
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
|
|
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None
|
|
\<and>* (pt_ptr, unat ((vaddr >> 12) && 0xFF)) \<mapsto>c -
|
|
\<and>* R \<guillemotright> \<rbrace>
|
|
seL4_Page_Map sel_page sel4_page_directory vaddr perms vmattr
|
|
\<lbrace>\<lambda>r s. \<guillemotleft> (root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* (pt_ptr, unat ((vaddr >> 12) && 0xFF)) \<mapsto>c
|
|
FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None
|
|
\<and>* (cnode_id, frame_offset) \<mapsto>c FrameCap dev frame_ptr rights n Real None
|
|
\<and>* root_tcb_id \<mapsto>f (Tcb tcb)
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c PageTableCap pt_ptr Fake None
|
|
\<and>* R \<guillemotright> s \<rbrace>"
|
|
apply (simp add:seL4_Page_Map_def sep_state_projection2_def)
|
|
apply (rule hoare_name_pre_state)
|
|
apply (rule hoare_pre)
|
|
apply (rule do_kernel_op_pull_back)
|
|
apply (rule call_kernel_with_intent_allow_error_helper
|
|
[where check = True and Perror = \<top>,simplified])
|
|
apply fastforce
|
|
apply (rule set_cap_wp)
|
|
apply (wp+)[4]
|
|
apply (rule_tac P = "\<exists>asid'. iv = InvokePage
|
|
(PageMap (FrameCap dev frame_ptr rights n Real asid')
|
|
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) (cnode_id,frame_offset)
|
|
[(pt_ptr, unat ((vaddr >> 12) && 0xFF))])"
|
|
in hoare_gen_asmEx)
|
|
apply clarsimp
|
|
apply wp
|
|
apply (rule_tac P1 = "\<lambda>iv. P1 \<and>* P2" for P1 P2 in hoare_strengthen_post
|
|
[OF invoke_page_wp[where fake = Real
|
|
and fake' = Fake
|
|
and x = "[(pt_ptr, unat ((vaddr >> 12) && 0xFF))]" ]])
|
|
apply (rule refl)
|
|
apply simp
|
|
apply (rule conjI)
|
|
apply (sep_solve)
|
|
apply (subst sep_map_c_asid_reset [where ptr = "(cnode_id,frame_offset)"])
|
|
prefer 2
|
|
apply (sep_schem)
|
|
apply (simp add:reset_cap_asid_def)
|
|
apply (wp hoare_vcg_conj_lift)
|
|
apply (wp hoare_strengthen_post[OF set_cap_wp])
|
|
apply (sep_solve)
|
|
apply wp
|
|
apply (rule_tac P = "\<exists>asid asid'. (c = (FrameCap dev frame_ptr rights n Real asid)
|
|
\<and> cs = [(PageDirectoryCap pd_ptr real_type asid',(cnode_id,pd_offset))]
|
|
\<and> ref = (cnode_id,frame_offset))"
|
|
in hoare_gen_asmEx)
|
|
apply (elim exE)+
|
|
apply simp
|
|
apply (rule_tac Q = "\<lambda>iv s. cdl_current_thread s = Some root_tcb_id \<and>
|
|
cdl_current_domain s = minBound \<and>
|
|
<(root_tcb_id, tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* (pt_ptr, unat ((vaddr >> 12) && 0xFF)) \<mapsto>c -
|
|
\<and>* (cnode_id, frame_offset) \<mapsto>c -
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb
|
|
\<and>* (cnode_id, pd_offset) \<mapsto>c PageDirectoryCap pd_ptr real_type None
|
|
\<and>* cdl_lookup_pd_slot pd_ptr vaddr \<mapsto>c PageTableCap pt_ptr Fake None
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>* R> s \<and>
|
|
iv = InvokePage
|
|
(PageMap (FrameCap dev frame_ptr rights n Real (get_mapped_asid asid' vaddr))
|
|
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None)
|
|
(cnode_id,frame_offset) [ (pt_ptr, unat ((vaddr >> 12) && 0xFF))] )"
|
|
in hoare_post_impErr[rotated -1])
|
|
apply assumption
|
|
apply (rule hoare_vcg_E_elim)
|
|
apply wp
|
|
apply wp
|
|
apply (rule validE_validE_R)
|
|
apply (rule_tac P = "<P>" for P in hoare_weaken_preE)
|
|
apply (wp decode_page_map_intent_rv_16_12[where p = pt_ptr])[1]
|
|
apply simp
|
|
apply simp
|
|
apply clarsimp
|
|
apply sep_solve
|
|
apply (simp add:lookup_extra_caps_def conj_comms mapME_singleton)
|
|
apply (rule wp_no_exception_seq)
|
|
apply wp[1]
|
|
apply (rule lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "PageDirectoryCap pd_ptr real_type None"])
|
|
apply (rule hoare_pre)
|
|
apply (wp lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "FrameCap dev frame_ptr rights n Real None"])[1]
|
|
apply (erule_tac Q="cdl_current_domain sa = minBound" in conjE, assumption)
|
|
apply (wp update_thread_intent_update hoare_vcg_all_lift
|
|
hoare_vcg_imp_lift)
|
|
apply clarsimp
|
|
defer
|
|
apply clarsimp
|
|
using misc sz
|
|
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
|
|
apply (sep_solve)
|
|
apply (simp add:cdl_lookup_pd_slot_def)
|
|
apply sep_solve
|
|
apply simp
|
|
apply sep_solve
|
|
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
|
|
apply sep_solve
|
|
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
|
|
apply (clarsimp simp:user_pointer_at_def Let_def
|
|
word_bits_def sep_conj_assoc)
|
|
apply (sep_solve)
|
|
apply sep_solve
|
|
apply clarsimp
|
|
apply (drule_tac x = "FrameCap dev frame_ptr rights n Real None" in spec)
|
|
apply clarsimp
|
|
apply (erule impE)
|
|
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
|
|
apply simp
|
|
apply clarsimp
|
|
apply (sep_solve)
|
|
done
|
|
|
|
lemma decode_invocation_asid_pool_assign:
|
|
"\<lbrace> \<lambda>s. (c = AsidPoolCap p base) \<rbrace>
|
|
decode_invocation c ref [(PageDirectoryCap pd is_real sz,pd_ref)]
|
|
(AsidPoolIntent AsidPoolAssignIntent)
|
|
\<lbrace>\<lambda>iv s. \<exists>x. x < 2 ^ asid_low_bits \<and> iv = InvokeAsidPool (Assign (base, x) pd_ref (p, x)) \<rbrace>, -"
|
|
apply (rule hoare_pre)
|
|
apply (rule hoare_gen_asmE[where P =" c = AsidPoolCap p base"])
|
|
apply (simp add:decode_invocation_def get_asid_pool_intent_def
|
|
decode_asid_pool_invocation_def get_index_def
|
|
throw_opt_def throw_on_none_def)
|
|
apply (rule validE_validE_R)
|
|
apply (wp alternativeE_wp select_wp)
|
|
apply (clarsimp simp:cap_object_def cap_has_object_def)
|
|
done
|
|
|
|
crunch cdl_cur_thread[wp]: invoke_asid_pool "\<lambda>s. P (cdl_current_thread s)"
|
|
|
|
crunch cdl_cur_domain[wp]: invoke_asid_pool "\<lambda>s. P (cdl_current_domain s)"
|
|
|
|
lemma set_split_single:
|
|
"a \<in>A \<Longrightarrow> A = A - {a} \<union> {a}"
|
|
by blast
|
|
|
|
|
|
lemma invoke_asid_pool_wp:
|
|
"off < 2 ^ asid_low_bits \<Longrightarrow>
|
|
\<lbrace> <(cur_thread, tcb_pending_op_slot) \<mapsto>c RestartCap
|
|
\<and>* (\<And>* off\<in>{off. off < 2 ^ asid_low_bits}. (p, off) \<mapsto>c -)
|
|
\<and>* pd_ref \<mapsto>c (PageDirectoryCap pd Real asid')
|
|
\<and>* R > \<rbrace>
|
|
invoke_asid_pool (Assign asid pd_ref (p,off))
|
|
\<lbrace>\<lambda>rv s. <(cur_thread, tcb_pending_op_slot) \<mapsto>c RestartCap
|
|
\<and>* pd_ref \<mapsto>c (PageDirectoryCap pd Real (Some asid))
|
|
\<and>* (\<And>* off\<in>{off. off < 2 ^ asid_low_bits}. (p, off) \<mapsto>c -)
|
|
\<and>* R > s\<rbrace>"
|
|
apply (clarsimp simp:invoke_asid_pool_def | wp| wpc)+
|
|
apply (rename_tac word cdl_frame_cap_type option)
|
|
apply (rule_tac P = "word = pd" in hoare_gen_asm)
|
|
apply simp
|
|
apply (rule hoare_strengthen_post[OF set_cap_wp])
|
|
apply (subst set_split_single[where A = "(Collect (\<lambda>off. off < 2 ^ asid_low_bits))"])
|
|
apply simp
|
|
apply (subst sep.prod.union_disjoint)
|
|
apply simp+
|
|
apply (clarsimp simp: sep_conj_assoc)
|
|
apply (sep_erule_concl sep_any_imp, sep_solve)
|
|
apply (rename_tac word cdl_frame_cap_type option)
|
|
apply (wp hoare_vcg_conj_lift)
|
|
apply (rule_tac P = "word = pd" in hoare_gen_asm)
|
|
apply simp
|
|
apply (rule hoare_strengthen_post[OF set_cap_wp])
|
|
apply (sep_solve)
|
|
apply wp+
|
|
apply clarsimp
|
|
apply (safe; fastforce?)
|
|
apply (subst (asm) set_split_single[where A = "(Collect (\<lambda>off. off < 2 ^ asid_low_bits))"])
|
|
apply simp
|
|
apply (subst (asm) sep.prod.union_disjoint)
|
|
apply simp+
|
|
apply (simp add:sep_conj_assoc)
|
|
apply sep_solve
|
|
apply (sep_select_asm 3)
|
|
apply (drule opt_cap_sep_imp)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma sep_map_c_asid_simp:
|
|
"(slot \<mapsto>c FrameCap dev ptr rights sz real_type option) = (slot \<mapsto>c FrameCap dev ptr rights sz real_type None)"
|
|
"(slot \<mapsto>c PageTableCap ptr real_type option) = (slot \<mapsto>c PageTableCap ptr real_type None)"
|
|
"(slot \<mapsto>c PageDirectoryCap ptr real_type option') = (slot \<mapsto>c PageDirectoryCap ptr real_type None)"
|
|
by (simp_all add:sep_map_c_asid_reset)
|
|
|
|
|
|
lemma seL4_ASIDPool_Assign_wp:
|
|
assumes misc:
|
|
"cap_object cnode_cap = cnode_id" "is_cnode_cap cnode_cap"
|
|
"offset sel4_page_directory root_size = pd_offset"
|
|
"offset sel4_asid root_size = asid_offset"
|
|
and sz: "one_lvl_lookup cnode_cap word_bits root_size"
|
|
"guard_equal cnode_cap sel4_page_directory word_bits"
|
|
"guard_equal cnode_cap sel4_asid word_bits"
|
|
shows
|
|
"\<lbrace>
|
|
\<guillemotleft> (root_tcb_id,tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb
|
|
\<and>* (cnode_id,asid_offset) \<mapsto>c AsidPoolCap p base
|
|
\<and>* (cnode_id,pd_offset) \<mapsto>c PageDirectoryCap pd Real None
|
|
\<and>* (\<And>* off\<in>{off. off < 2 ^ asid_low_bits}. (p, off) \<mapsto>c -)
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* R \<guillemotright>\<rbrace>
|
|
seL4_ASIDPool_Assign sel4_asid sel4_page_directory
|
|
\<lbrace>\<lambda>_. \<guillemotleft> (root_tcb_id,tcb_pending_op_slot) \<mapsto>c RunningCap
|
|
\<and>* root_tcb_id \<mapsto>f Tcb tcb
|
|
\<and>* (cnode_id,asid_offset) \<mapsto>c AsidPoolCap p base
|
|
\<and>* (cnode_id,pd_offset) \<mapsto>c PageDirectoryCap pd Real None
|
|
\<and>* (\<And>* off\<in>{off. off < 2 ^ asid_low_bits}. (p, off) \<mapsto>c -)
|
|
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
|
|
\<and>* (root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap
|
|
\<and>* R\<guillemotright> \<rbrace>"
|
|
apply (simp add:seL4_ASIDPool_Assign_def sep_state_projection2_def
|
|
| wp do_kernel_op_wp)+
|
|
apply (rule call_kernel_with_intent_allow_error_helper[where check = True and Perror = \<top>,simplified])
|
|
apply fastforce
|
|
apply (rule set_cap_wp)
|
|
apply (wp+)[4]
|
|
apply (rule_tac P = "\<exists>x. x < 2 ^ asid_low_bits
|
|
\<and> iv = (InvokeAsidPool (Assign (base, x) (cnode_id,pd_offset) (p, x)))"
|
|
in hoare_gen_asmEx)
|
|
apply clarsimp
|
|
apply wp
|
|
apply (rule hoare_strengthen_post[OF invoke_asid_pool_wp[where pd = pd
|
|
and cur_thread = root_tcb_id
|
|
and R="(cnode_id, asid_offset) \<mapsto>c AsidPoolCap p base \<and>*
|
|
root_tcb_id \<mapsto>f Tcb tcb \<and>*
|
|
cnode_id \<mapsto>f CNode (empty_cnode root_size) \<and>*
|
|
(root_tcb_id, tcb_cspace_slot) \<mapsto>c cnode_cap \<and>* R"]])
|
|
apply simp
|
|
apply (rule conjI,sep_solve)
|
|
apply (subst (asm) sep_map_c_asid_simp)
|
|
apply sep_solve
|
|
apply (wp hoare_vcg_conj_lift)
|
|
apply (rule hoare_strengthen_post[OF set_cap_wp])
|
|
apply assumption
|
|
apply wp
|
|
apply (subst sep_map_c_asid_simp)
|
|
apply (wp hoare_vcg_conj_lift)
|
|
apply simp
|
|
apply (rule_tac P = "\<exists>asid. cs = [(PageDirectoryCap pd Real asid,(cnode_id,pd_offset))]" in hoare_gen_asmE)
|
|
apply clarsimp
|
|
apply (rule decode_invocation_asid_pool_assign)
|
|
apply (clarsimp simp:conj_comms lookup_extra_caps_def mapME_singleton)
|
|
apply (rule wp_no_exception_seq)
|
|
apply wp
|
|
apply (rule lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "PageDirectoryCap pd Real None"])
|
|
apply (rule hoare_pre)
|
|
apply (rule lookup_cap_and_slot_rvu[where r = root_size
|
|
and cap' = "AsidPoolCap p base"])
|
|
apply (erule_tac Q="cdl_current_domain s = minBound" in conjE, assumption)
|
|
apply clarsimp
|
|
apply (wp update_thread_intent_update hoare_vcg_all_lift
|
|
hoare_vcg_imp_lift)
|
|
apply clarsimp defer
|
|
apply clarsimp
|
|
using misc sz
|
|
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
|
|
apply sep_solve
|
|
apply sep_solve
|
|
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
|
|
apply (sep_solve)
|
|
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
|
|
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
|
|
apply (sep_solve)
|
|
apply (sep_solve)
|
|
apply clarsimp
|
|
apply (drule_tac x = "AsidPoolCap p base" in spec)
|
|
apply clarsimp
|
|
apply (erule impE)
|
|
apply (rule_tac x = "PageDirectoryCap pd Real None" in exI)
|
|
apply simp
|
|
apply clarsimp
|
|
apply (drule use_sep_true_for_sep_map_c)
|
|
apply simp
|
|
apply sep_solve
|
|
done
|
|
|
|
end
|
|
|