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

2015 update for DRefine

This commit is contained in:
Gerwin Klein 2015-05-13 09:52:32 +02:00
parent a979379e3a
commit f6124669fc
16 changed files with 2496 additions and 2650 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
proof/drefine/ADT_DR.thy
View File

@ -132,7 +132,7 @@ lemma dwp_thread_set_idle:
apply (wp)
apply (rule_tac Q = "\<lambda>s. transform s = cs \<and> thread = idle_thread s"
in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def mem_def set_object_def
apply (clarsimp simp:valid_def set_object_def
put_def get_def return_def bind_def)
apply (clarsimp simp:transform_def transform_current_thread_def transform_objects_def)
apply (assumption)

260
proof/drefine/Arch_DR.thy
View File

@ -389,11 +389,11 @@ proof -
apply (cut_tac less_kernel_base_mapping_slots[OF kb pd_aligned])
apply (drule_tac x="ucast (lookup_pd_slot pd_ptr vptr && mask pd_bits >> 2)" in bspec)
apply simp
apply (drule_tac t="pda ?v" in sym, simp)
apply (drule_tac t="pda v" for v in sym, simp)
apply (clarsimp simp: obj_at_def a_type_def del: disjCI)
apply (clarsimp split: Structures_A.kernel_object.split_asm split_if_asm
arch_kernel_obj.split_asm del: disjCI)
apply (frule_tac p="Platform.ptrFromPAddr ?v" in pspace_alignedD, simp+)
apply (frule_tac p="Platform.ptrFromPAddr v" for v in pspace_alignedD, simp+)
apply (rule disjI2, rule conjI)
apply (rule_tac x="unat (lookup_pd_slot pd_ptr vptr && mask pd_bits >> 2)"
in exI)
@ -421,6 +421,7 @@ proof -
apply (simp add: lookup_pt_slot_def liftE_bindE)
apply (rule corres_symb_exec_r[OF _ get_pde_sp get_pde_inv], simp_all)[1]
apply (clarsimp simp add: corres_alternate2 split: ARM_Structs_A.pde.split)
apply (rename_tac word1 set word2)
apply (rule corres_alternate1)
apply (rule corres_from_rdonly, simp_all)[1]
apply (wp select_wp | simp)+
@ -431,11 +432,11 @@ proof -
apply (cut_tac less_kernel_base_mapping_slots[OF kb pd_aligned])
apply (drule_tac x="ucast (lookup_pd_slot pd_ptr vptr && mask pd_bits >> 2)" in bspec)
apply simp
apply (drule_tac t="pda ?v" in sym, simp)
apply (drule_tac t="pda v" for v in sym, simp)
apply (clarsimp simp: obj_at_def a_type_def del: disjCI)
apply (clarsimp split: Structures_A.kernel_object.split_asm split_if_asm
arch_kernel_obj.split_asm del: disjCI)
apply (frule_tac p="Platform.ptrFromPAddr ?v" in pspace_alignedD, simp+)
apply (frule_tac p="Platform.ptrFromPAddr v" for v in pspace_alignedD, simp+)
apply (rule map_includedI)
apply (clarsimp simp: transform_pt_slot_ref_def all_pd_pt_slots_def
opt_object_page_directory[unfolded opt_object_def]
@ -534,7 +535,7 @@ lemma shiftl_mod:
apply (subst shiftl_t2n)
apply (clarsimp simp:unat_word_ariths)
apply (subgoal_tac "2 ^ n * unat x < 2 ^ 32")
apply (clarsimp simp: mod_less)
apply (clarsimp)
apply (subst (asm) word_unat_power)
apply (drule unat_less_helper)
apply (rule_tac y="2^n * 2 ^(32-n)" in less_le_trans)
@ -568,7 +569,6 @@ proof (induct x)
thus ?case
apply (simp add: Decode_D.decode_invocation_def
decode_invocation_def arch_decode_invocation_def
transform_cap_simps
split del: split_if)
apply (clarsimp simp: get_asid_pool_intent_def transform_intent_def
option_map_Some_eq2 throw_opt_def
@ -624,7 +624,6 @@ next
thus ?case
apply (simp add: Decode_D.decode_invocation_def
decode_invocation_def arch_decode_invocation_def
transform_cap_simps
bindE_assoc
split del: split_if)
apply (clarsimp simp: get_asid_control_intent_def transform_intent_def
@ -686,7 +685,6 @@ next
thus ?case
apply (simp add: Decode_D.decode_invocation_def
decode_invocation_def arch_decode_invocation_def
transform_cap_simps
split del: split_if)
apply (clarsimp simp: get_page_intent_def transform_intent_def
option_map_Some_eq2 throw_opt_def
@ -708,12 +706,12 @@ next
apply (clarsimp simp: neq_Nil_conv valid_cap_simps obj_at_def
opt_object_page_directory invs_valid_idle label_to_flush_type_def InvocationLabels_H.isPageFlush_def
dest!: a_type_pdD)+
apply (rule_tac r'=dc and P'="?I" and Q'="\<lambda>rv. ?I and (\<exists>\<rhd> (lookup_pd_slot rv x21 && ~~ mask pd_bits))"
apply (rule_tac r'=dc and P'="I" and Q'="\<lambda>rv. I and (\<exists>\<rhd> (lookup_pd_slot rv x21 && ~~ mask pd_bits))" for I
in corres_alternative_throw_splitE[OF _ _ returnOk_wp[where x="()"], simplified])
apply (rule corres_from_rdonly, simp_all)[1]
apply (wp | simp)+
apply (rule hoare_strengthen_post, rule hoare_post_taut)
apply (case_tac r, auto simp add: in_monad in_alternative)[1]
apply (case_tac r, auto simp add: in_monad)[1]
apply (simp add: corres_whenE_throwError_split_rhs corres_alternate2
check_vp_alignment_def unlessE_whenE)
apply (clarsimp simp add: liftE_bindE[symmetric])
@ -733,7 +731,7 @@ next
apply (wp | simp)+
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp)+
apply (clarsimp simp add: in_monad in_alternative conj_disj_distribR[symmetric])
apply (clarsimp simp add: in_monad conj_disj_distribR[symmetric])
apply (simp add: conj_disj_distribR cong: conj_cong)
apply (simp add: arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def update_cap_rights_def
@ -753,12 +751,12 @@ next
opt_object_page_directory invs_valid_idle
dest!: a_type_pdD)
apply (clarsimp simp: gets_bind_alternative corres_symb_exec_in_gets)
apply (rule_tac r'=dc and P'="?I" and Q'="\<lambda>rv. ?I and (\<exists>\<rhd> (lookup_pd_slot rv b && ~~ mask pd_bits))"
apply (rule_tac r'=dc and P'="I" and Q'="\<lambda>rv. I and (\<exists>\<rhd> (lookup_pd_slot rv b && ~~ mask pd_bits))" for I
in corres_alternative_throw_splitE[OF _ _ returnOk_wp[where x="()"], simplified])
apply (rule corres_from_rdonly, simp_all)[1]
apply (wp | simp)+
apply (rule hoare_strengthen_post, rule hoare_post_taut)
apply (case_tac r, auto simp add: in_monad in_alternative)[1]
apply (case_tac r, auto simp add: in_monad)[1]
apply (simp add: corres_whenE_throwError_split_rhs corres_alternate2
check_vp_alignment_def unlessE_whenE)
apply (clarsimp simp add: liftE_bindE[symmetric])
@ -778,7 +776,7 @@ next
apply (wp | simp)+
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp)+
apply (clarsimp simp add: in_monad in_alternative conj_disj_distribR[symmetric])
apply (clarsimp simp add: in_monad conj_disj_distribR[symmetric])
apply (simp add: conj_disj_distribR cong: conj_cong)
apply (simp add: arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def update_cap_rights_def
@ -800,7 +798,7 @@ next
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
apply (clarsimp simp: in_monad in_alternative conj_disj_distribR[symmetric])
apply (clarsimp simp: in_monad conj_disj_distribR[symmetric])
apply (safe)
apply blast
apply (metis flush.exhaust)
@ -811,7 +809,7 @@ next
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
apply (clarsimp simp: in_monad in_alternative conj_disj_distribR[symmetric])
apply (clarsimp simp: in_monad conj_disj_distribR[symmetric])
apply (safe)
apply blast
apply (metis flush.exhaust)
@ -822,18 +820,18 @@ next
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
apply (clarsimp simp: in_monad in_alternative conj_disj_distribR[symmetric])
apply (clarsimp simp: in_monad conj_disj_distribR[symmetric])
apply (safe)
apply blast
apply (metis flush.exhaust)
apply (rule corres_from_rdonly)
apply (wp, clarsimp)
apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp)
apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp)
apply (assumption)
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
apply (clarsimp simp: in_monad in_alternative conj_disj_distribR[symmetric])
apply (clarsimp simp: in_monad conj_disj_distribR[symmetric])
apply (safe)
apply blast
apply (metis flush.exhaust)
@ -847,7 +845,6 @@ next
thus ?case
apply (simp add: Decode_D.decode_invocation_def
decode_invocation_def arch_decode_invocation_def
transform_cap_simps
split del: split_if)
apply (clarsimp simp: get_page_table_intent_def transform_intent_def
option_map_Some_eq2 throw_opt_def cdl_get_pt_mapped_addr_def
@ -855,26 +852,19 @@ next
transform_intent_page_table_map_def
split del: split_if
split: invocation_label.split_asm list.split_asm)
apply (simp add: transform_cap_simps throw_on_none_def transform_cap_list_def
apply (simp add: throw_on_none_def transform_cap_list_def
get_index_def split_beta alternative_refl
transform_mapping_def corres_whenE_throwError_split_rhs corres_alternate2
split: cap.split arch_cap.split option.split cdl_frame_cap_type.splits)
apply (clarsimp simp: dc_def[symmetric] liftE_bindE
gets_the_def bind_assoc transform_mapping_def
corres_symb_exec_in_gets gets_bind_alternative)
(* apply (rule_tac F="v \<noteq> None" in corres_req)
apply (clarsimp simp: neq_Nil_conv valid_cap_simps obj_at_def
opt_object_page_directory invs_valid_idle
dest!: a_type_pdD)
apply (clarsimp simp: gets_bind_alternative corres_symb_exec_in_gets
assert_opt_def)
*)
apply (rule_tac r'=dc and P'="?I" and Q'="\<lambda>rv. ?I and (\<exists>\<rhd> (lookup_pd_slot rv ab && ~~ mask pd_bits))"
in corres_alternative_throw_splitE[OF _ _ returnOk_wp[where x="()"], simplified])
apply (rule_tac r'=dc and P'="I" and Q'="\<lambda>rv. I and (\<exists>\<rhd> (lookup_pd_slot rv ab && ~~ mask pd_bits))"
for I in corres_alternative_throw_splitE[OF _ _ returnOk_wp[where x="()"], simplified])
apply (rule corres_from_rdonly, simp_all)[1]
apply (wp | simp)+
apply (rule hoare_strengthen_post, rule hoare_post_taut)
apply (case_tac r, auto simp add: in_monad in_alternative)[1]
apply (case_tac r, auto simp add: in_monad)[1]
apply (simp add: corres_whenE_throwError_split_rhs corres_alternate2
check_vp_alignment_def unlessE_whenE)
apply clarsimp
@ -914,11 +904,11 @@ next
done
next
case (PageDirectoryCap pd_ptr asid)
thus ?case
thus ?case
(* abandon hope, all who enter here *)
apply (simp add: Decode_D.decode_invocation_def
decode_invocation_def arch_decode_invocation_def
transform_cap_simps get_page_directory_intent_def transform_intent_def
get_page_directory_intent_def transform_intent_def
isPDFlush_def
split del: split_if)
apply (clarsimp simp: get_page_directory_intent_def transform_intent_def
@ -938,11 +928,11 @@ next
apply (clarsimp simp: whenE_def)
apply (intro conjI impI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def
Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric]
in_monad conj_disj_distribR[symmetric]
split: option.splits | rule impI conjI)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp split: option.splits, safe)
@ -951,36 +941,36 @@ next
apply (intro conjI impI)
apply (wp resolve_vaddr_inv
| simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def
translate_arch_invocation_def transform_page_dir_inv_def in_monad in_alternative
translate_arch_invocation_def in_monad
conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
@ -991,40 +981,40 @@ next
apply (intro conjI impI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (wp resolve_vaddr_inv | clarsimp simp: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (clarsimp simp: whenE_def)
apply (intro conjI impI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (clarsimp split: ArchInvocation_A.flush_type.splits)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
@ -1033,60 +1023,60 @@ next
apply (clarsimp simp: whenE_def)
apply (intro conjI impI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: flush_type_map_def transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (clarsimp split: ArchInvocation_A.flush_type.splits)
apply (metis flush.exhaust)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (metis flush.exhaust)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
apply (rule corres_from_rdonly)
apply (wp valid_validE[OF whenE_inv] | clarsimp split: option.splits | safe)+
apply (rule validE_cases_valid, rule hoare_pre, wp)
apply (clarsimp simp: whenE_def)
apply (rule_tac x="Inl undefined" in exI)
apply (wp resolve_vaddr_inv | simp add: transform_page_dir_inv_def Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_dir_inv_def in_monad in_alternative conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
in_monad conj_disj_distribR[symmetric] split: option.splits | rule impI conjI allI)+
done
qed
@ -1234,14 +1224,10 @@ lemma diminished_PageTable [simp]:
apply (rule ext)
apply (case_tac c,
simp_all add: diminished_def cap_rights_update_def acap_rights_update_def mask_cap_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap, auto)
done
lemma cleanCacheRange_PoU_underlying_memory[wp]:
" \<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> cleanCacheRange_PoU p f g \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
apply (clarsimp simp: cleanCacheRange_PoU_def, wp)
done
lemma invoke_page_table_corres:
"transform_page_table_inv ptinv' = Some ptinv \<Longrightarrow>
dcorres dc \<top> (valid_pti ptinv' and invs and valid_etcbs)
@ -1250,6 +1236,7 @@ lemma invoke_page_table_corres:
apply (clarsimp simp: transform_page_table_inv_def
split: ArchInvocation_A.page_table_invocation.split_asm
split_if_asm)
apply (rename_tac word oref attribs)
apply (clarsimp simp: is_pt_cap_def valid_pti_def make_arch_duplicate_def)
apply (rule stronger_corres_guard_imp)
apply (rule corres_split [OF _ set_cap_corres])
@ -1354,6 +1341,7 @@ lemma diminished_page_is_page:
\<Longrightarrow> \<exists>rs'. c = cap.ArchObjectCap (arch_cap.PageCap x rs' sz mp)"
apply (case_tac c,
simp_all add:diminished_def cap_rights_update_def acap_rights_update_def mask_cap_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap, (clarsimp simp:validate_vm_rights_def)+)
done
@ -1571,34 +1559,43 @@ lemma pte_check_if_mapped_corres:
"dcorres dc \<top> \<top> (return a) (pte_check_if_mapped pte)"
apply (clarsimp simp add: pte_check_if_mapped_def get_master_pte_def get_pte_def get_pt_def bind_assoc in_monad get_object_def corres_underlying_def)
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad)
apply (clarsimp split: ARM_Structs_A.pte.splits)
apply (simp_all add: get_pte_def get_pt_def get_object_def in_monad bind_assoc split: kernel_object.splits arch_kernel_obj.splits)
apply clarsimp
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad)
apply (auto simp: in_monad)[2]
apply clarsimp
apply (case_tac y, simp_all add: in_monad, case_tac arch_kernel_obj, simp_all add: in_monad, auto simp: in_monad)
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad, auto simp: in_monad)
done
lemma pde_check_if_mapped_corres:
"dcorres dc \<top> \<top> (return a) (pde_check_if_mapped pde)"
apply (clarsimp simp add: pde_check_if_mapped_def get_master_pde_def get_pde_def get_pd_def bind_assoc in_monad get_object_def corres_underlying_def)
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad)
apply (clarsimp split: ARM_Structs_A.pde.splits)
apply (simp_all add: get_pde_def get_pd_def get_object_def in_monad bind_assoc)
apply clarsimp
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad)
apply (auto simp: in_monad)[1]
apply clarsimp
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad)
apply (auto simp: in_monad)[1]
apply clarsimp
apply (case_tac y, simp_all add: in_monad, case_tac arch_kernel_obj, simp_all add: in_monad, auto simp: in_monad)
apply (case_tac y, simp_all add: in_monad)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all add: in_monad, auto simp: in_monad)
done
lemma if_invalidate_equiv_return:
@ -1609,7 +1606,6 @@ lemma if_invalidate_equiv_return:
apply clarsimp
done
lemma ct_active_not_idle_etc:
"\<lbrakk> invs s; ct_active s \<rbrakk> \<Longrightarrow> not_idle_thread (cur_thread s) s"
apply (simp add: not_idle_thread_def ct_in_state_def)
@ -1624,49 +1620,50 @@ lemma invoke_page_corres:
(invoke_page ip) (perform_page_invocation ip')"
apply (clarsimp simp:invoke_page_def)
apply (case_tac ip')
apply (simp_all add:perform_page_invocation_def)
apply (simp_all add:perform_page_invocation_def transform_page_inv_def)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:valid_page_inv_def)
apply (clarsimp simp:empty_refs_def)
apply (case_tac sum)
apply (clarsimp simp: mapM_x_singleton)
apply (simp add:page_inv_duplicates_valid_def
split:if_splits)
apply (simp_all add:perform_page_invocation_def)
apply (rename_tac word cap prod sum)
apply (simp_all add:perform_page_invocation_def transform_page_inv_def)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:valid_page_inv_def)
apply (clarsimp simp:empty_refs_def)
apply (case_tac sum)
apply (clarsimp simp: mapM_x_singleton)
apply (simp add:page_inv_duplicates_valid_def
split:if_splits)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ set_cap_corres])
apply (rule corres_dummy_return_pl[where b ="()"])
apply (rule corres_split[OF _ pte_check_if_mapped_corres])
apply (simp split del: split_if)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ store_pte_set_cap_corres])
apply (rule corres_dummy_return_l)
apply (rule_tac corres_split[OF _ dcorres_store_invalid_pte_tail_large_page])
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF if_invalidate_equiv_return])
apply (rule wp_to_dcorres[where Q=\<top>])
apply (wp do_machine_op_wp mapM_wp' set_cap_idle
store_pte_page_inv_entries_safe set_cap_page_inv_entries_safe
| clarsimp simp:cleanCacheRange_PoU_def)+
apply (clarsimp simp:invs_def valid_state_def cte_wp_at_caps_of_state)
apply (frule_tac v = b in valid_idle_has_null_cap,simp+)
apply (clarsimp simp:is_arch_update_def is_arch_cap_def cap_master_cap_def split:cap.split_asm)
apply (clarsimp simp:mapM_x_singleton)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ set_cap_corres])
apply (rule corres_dummy_return_pl[where b ="()"])
apply (rule corres_split[OF _ pte_check_if_mapped_corres])
apply (rule corres_dummy_return_pl[where b="()"])
apply (rule corres_split[OF _ pde_check_if_mapped_corres])
apply (simp split del: split_if)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ store_pte_set_cap_corres])
apply (rule corres_dummy_return_l)
apply (rule_tac corres_split[OF _ dcorres_store_invalid_pte_tail_large_page])
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF if_invalidate_equiv_return])
apply (rule wp_to_dcorres[where Q=\<top>])
apply (wp do_machine_op_wp mapM_wp' set_cap_idle
store_pte_page_inv_entries_safe set_cap_page_inv_entries_safe
| clarsimp simp:cleanCacheRange_PoU_def)+
apply (clarsimp simp:invs_def valid_state_def cte_wp_at_caps_of_state)
apply (frule_tac v = b in valid_idle_has_null_cap,simp+)
apply (clarsimp simp:is_arch_update_def is_arch_cap_def cap_master_cap_def split:cap.split_asm)
apply (clarsimp simp:mapM_x_singleton)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ set_cap_corres])
apply (rule corres_dummy_return_pl[where b="()"])
apply (rule corres_split[OF _ pde_check_if_mapped_corres])
apply (simp split del: split_if)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ store_pde_set_cap_corres])
apply (rule corres_dummy_return_l)
apply (rule_tac corres_split[OF _ dcorres_store_invalid_pde_tail_super_section])
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF if_invalidate_equiv_return])
apply (rule wp_to_dcorres[where Q=\<top>])
apply (wp do_machine_op_wp mapM_wp' set_cap_idle
set_cap_page_inv_entries_safe store_pde_page_inv_entries_safe
| clarsimp simp:cleanCacheRange_PoU_def valid_slots_def)+
apply (rule corres_split[OF _ store_pde_set_cap_corres])
apply (rule corres_dummy_return_l)
apply (rule_tac corres_split[OF _ dcorres_store_invalid_pde_tail_super_section])
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF if_invalidate_equiv_return])
apply (rule wp_to_dcorres[where Q=\<top>])
apply (wp do_machine_op_wp mapM_wp' set_cap_idle
set_cap_page_inv_entries_safe store_pde_page_inv_entries_safe
| clarsimp simp:cleanCacheRange_PoU_def valid_slots_def)+
apply (simp add:page_inv_duplicates_valid_def valid_slots_def
page_inv_entries_safe_def split:if_splits)
apply (clarsimp simp:invs_def valid_state_def cte_wp_at_caps_of_state)
@ -1676,6 +1673,7 @@ lemma invoke_page_corres:
apply (frule_tac v = b in valid_idle_has_null_cap,simp+)
apply (clarsimp simp:is_arch_update_def is_arch_cap_def cap_master_cap_def split:cap.split_asm)
-- "PageRemap"
apply (rename_tac sum)
apply (case_tac sum)
apply (clarsimp simp: mapM_singleton mapM_x_mapM)
apply (simp add:page_inv_duplicates_valid_def
@ -1725,42 +1723,6 @@ lemma invoke_page_corres:
apply (clarsimp simp:is_arch_diminished_def transform_mapping_def update_map_data_def
dest!:diminished_page_is_page)
apply (wp get_cap_cte_wp_at_rv | clarsimp)+
(*
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ store_pte_set_cap_corres])
apply (rule corres_dummy_return_l)
apply (rule_tac corres_split[OF _ dcorres_store_invalid_pte_tail_large_page])
apply (rule wp_to_dcorres[where Q=\<top>])
apply (wp do_machine_op_wp mapM_wp' set_cap_idle
store_pte_page_inv_entries_safe set_cap_page_inv_entries_safe
| clarsimp simp:cleanCacheRange_PoU_def)+
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:mapM_singleton mapM_x_mapM valid_page_inv_def)
apply (rule corres_guard_imp)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ store_pde_set_cap_corres])
apply (rule corres_dummy_return_l)
apply (rule_tac corres_split[OF _ dcorres_store_invalid_pde_tail_super_section])
apply (rule wp_to_dcorres[where Q=\<top>])
apply (wp do_machine_op_wp mapM_wp' set_cap_idle
set_cap_page_inv_entries_safe store_pde_page_inv_entries_safe
| clarsimp simp:cleanCacheRange_PoU_def valid_slots_def
)+
apply (clarsimp simp:invs_def valid_state_def
cte_wp_at_caps_of_state page_inv_duplicates_valid_def)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp: valid_page_inv_def liftM_def
transform_mapping_def
split:arch_cap.splits option.splits)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ get_cap_corres])
apply (rule_tac P="\<lambda>y s. cte_wp_at (op = x) (a,b) s \<and> s = s'" in set_cap_corres_stronger)
apply clarsimp
apply (drule cte_wp_at_eqD2, simp)
apply (clarsimp simp:is_arch_diminished_def transform_mapping_def update_map_data_def
dest!:diminished_page_is_page)
apply (wp get_cap_cte_wp_at_rv | clarsimp)+
*)
apply (clarsimp simp:cte_wp_at_def is_arch_diminished_def is_arch_cap_def is_pt_cap_def
dest!:diminished_page_is_page)
apply (clarsimp simp:invs_def valid_state_def not_idle_thread_def)
@ -1940,7 +1902,7 @@ proof -
apply simp
apply (rule hoare_strengthen_post[OF hoare_TrueI[where P = \<top>]])
apply simp
apply (clarsimp simp:conj_ac
apply (clarsimp simp:conj_comms
| strengthen impI[OF invs_valid_pspace] impI[OF invs_valid_idle])+
apply (rule_tac P = "pcap = cap.UntypedCap frame pageBits idx" in hoare_gen_asm)
apply (wp max_index_upd_invs_simple set_cap_idle
@ -2077,7 +2039,7 @@ lemma invoke_arch_corres:
(arch_perform_invocation arch_invok)"
apply (clarsimp simp: arch_perform_invocation_def valid_arch_inv_def)
apply (case_tac arch_invok)
apply (simp_all add:arch_invocation_relation_def translate_arch_invocation_def arch_invocation_relation_def)
apply (simp_all add:arch_invocation_relation_def translate_arch_invocation_def)
apply (clarsimp simp:liftE_def bind_assoc)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ invoke_page_table_corres])

378
proof/drefine/CNode_DR.thy
View File

@ -44,6 +44,7 @@ lemma ex_cte_cap_to_not_idle:
apply (clarsimp simp: ex_cte_cap_wp_to_def cte_wp_at_caps_of_state)
apply (drule(1) valid_global_refsD2)
apply (case_tac cap, simp_all add: cap_range_def global_refs_def)
apply (rename_tac word)
apply (clarsimp simp: valid_idle_def valid_irq_node_def st_tcb_at_def
obj_at_def is_cap_table_def)
apply (drule_tac x=word in spec, simp)
@ -58,8 +59,7 @@ definition
lemma option_return_modify_modify:
"case_option (return ()) (\<lambda>x. modify (f x))
= (\<lambda>opt. modify (case_option id f opt))"
apply (rule ext)
by (simp split: option.split add: modify_id_return)
by (auto split: option.split simp: modify_id_return)
lemma update_cdt_modify:
"update_cdt f = modify (cdt_update f)"
@ -90,7 +90,7 @@ lemma dcorres_set_untyped_cap_as_full:
(CSpace_D.set_untyped_cap_as_full (transform_cap src_cap) (transform_cap cap) (transform_cslot_ptr src))
(CSpace_A.set_untyped_cap_as_full src_cap cap src)"
apply (simp add:set_untyped_cap_as_full_def CSpace_D.set_untyped_cap_as_full_def
split del:if_splits)
split del:split_if)
apply (case_tac "is_untyped_cap src_cap \<and> is_untyped_cap cap")
apply (rule dcorres_expand_pfx)
apply (rule corres_guard_imp)
@ -106,15 +106,11 @@ lemma dcorres_set_untyped_cap_as_full:
apply (simp add:valid_cap_def word_bits_def cap_aligned_def)
apply simp
apply simp
apply (rule_tac F = "is_untyped_cap src_cap
\<and> is_untyped_cap cap"
in corres_gen_asm)
apply (rule_tac F = "is_untyped_cap src_cap \<and> is_untyped_cap cap" in corres_gen_asm)
apply (clarsimp dest!:is_untyped_cap_eqD)
apply (rule set_cap_corres)
apply (clarsimp simp:transform_cap_def
free_range_of_untyped_def cap_aligned_def
max_free_index_def
dest!:is_untyped_cap_eqD)
apply (clarsimp simp:transform_cap_def free_range_of_untyped_def cap_aligned_def max_free_index_def
dest!:is_untyped_cap_eqD)
apply (cut_tac sz = sz in p2_less_minus)
apply simp
apply simp
@ -195,20 +191,19 @@ lemma insert_cap_sibling_corres:
apply (clarsimp simp:gets_fold_into_modify dc_def[symmetric]
option_return_modify_modify modify_modify bind_assoc
cong:option.case_cong)
apply (rule_tac P=\<top> and P'="(\<lambda>s. \<not> should_be_parent_of src_capa (is_original_cap s src) cap ?orig')
apply (rule_tac P=\<top> and P'="(\<lambda>s. \<not> should_be_parent_of src_capa (is_original_cap s src) cap orig')
and cte_at src and cte_at sibling
and (\<lambda>s. mdb_cte_at (swp cte_at s) (cdt s))
and (\<lambda>s. cdt s sibling = None)"
and (\<lambda>s. cdt s sibling = None)" for orig'
in corres_modify)
apply (clarsimp split del: if_splits)
apply (clarsimp split del: split_if)
apply (subst if_not_P, assumption)+
apply (clarsimp simp: opt_parent_def transform_def
transform_objects_def transform_cdt_def
transform_current_thread_def
transform_asid_table_def
split: option.split)
apply (clarsimp simp: fun_upd_def[symmetric]
cong:if_cong)
apply (clarsimp simp: fun_upd_def[symmetric] cong:if_cong)
apply (subgoal_tac "inj_on transform_cslot_ptr ({src, sibling} \<union> dom (cdt s') \<union> ran (cdt s'))")
apply (subst map_lift_over_f_eq map_lift_over_upd,
erule subset_inj_on, fastforce)+
@ -224,7 +219,7 @@ lemma insert_cap_sibling_corres:
apply ((wp set_cap_caps_of_state2 get_cap_wp static_imp_wp
| simp add: swp_def cte_wp_at_caps_of_state)+)
apply (wp set_cap_idle |
simp add:set_untyped_cap_as_full_def split del:if_splits)+
simp add:set_untyped_cap_as_full_def split del: split_if)+
apply (rule_tac Q = "\<lambda>r s. cdt s sibling = None
\<and> \<not> should_be_parent_of src_capa (is_original_cap s sibling) cap (cap_insert_dest_original cap src_capa)
\<and> mdb_cte_at (swp (cte_wp_at (op \<noteq> cap.NullCap)) s) (cdt s)"
@ -236,7 +231,7 @@ lemma insert_cap_sibling_corres:
apply fastforce
apply (wp get_cap_wp set_cap_idle static_imp_wp
| simp add:set_untyped_cap_as_full_def
split del:if_splits)+
split del: split_if)+
apply (rule_tac Q = "\<lambda>r s. cdt s sibling = None
\<and> (\<exists>cap. caps_of_state s src = Some cap)
\<and> \<not> should_be_parent_of src_capa (is_original_cap s src) cap (cap_insert_dest_original cap src_capa)
@ -247,7 +242,7 @@ lemma insert_cap_sibling_corres:
cte_wp_at_caps_of_state has_parent_cte_at is_physical_def
dest!:is_untyped_cap_eqD)
apply fastforce
apply (wp get_cap_wp set_cap_idle | simp)+
apply (wp get_cap_wp set_cap_idle | simp)+
apply clarsimp
apply (rule conjI)
apply (clarsimp simp: not_idle_thread_def)
@ -288,17 +283,16 @@ lemma insert_cap_child_corres:
apply (rule corres_split[OF _ dcorres_set_untyped_cap_as_full])
apply (rule corres_split[OF _ set_cap_corres[OF refl refl]])
apply (rule dcorres_set_parent_helper)
apply (rule_tac P=\<top> and P'="(\<lambda>s. should_be_parent_of src_capa (?orig s) cap ?orig')
apply (rule_tac P=\<top> and P'="(\<lambda>s. should_be_parent_of src_capa (orig s) cap orig')
and cte_at src and cte_at child
and (\<lambda>s. mdb_cte_at (swp cte_at s) (cdt s))"
and (\<lambda>s. mdb_cte_at (swp cte_at s) (cdt s))" for orig orig'
in corres_modify)
apply (clarsimp split del: if_splits)
apply (clarsimp split del: split_if)
apply (subst if_P, assumption)+
apply (clarsimp simp: opt_parent_def transform_def transform_asid_table_def
transform_objects_def transform_cdt_def
transform_current_thread_def)
apply (clarsimp simp: fun_upd_def[symmetric]
cong:if_cong)
apply (clarsimp simp: fun_upd_def[symmetric] cong:if_cong)
apply (subgoal_tac "inj_on transform_cslot_ptr ({src, child} \<union> dom (cdt s') \<union> ran (cdt s'))")
apply (subst map_lift_over_f_eq map_lift_over_upd,
erule subset_inj_on, fastforce)+
@ -309,7 +303,7 @@ lemma insert_cap_child_corres:
apply (wp set_cap_caps_of_state2 get_cap_wp static_imp_wp
| simp add: swp_def cte_wp_at_caps_of_state)+
apply (wp set_cap_idle |
simp add:set_untyped_cap_as_full_def split del:if_splits)+
simp add:set_untyped_cap_as_full_def split del:split_if)+
apply (rule_tac Q = "\<lambda>r s. not_idle_thread (fst child) s
\<and> should_be_parent_of src_capa (is_original_cap s child) cap (cap_insert_dest_original cap src_capa)
\<and> mdb_cte_at (swp (cte_wp_at (op \<noteq> cap.NullCap)) s) (cdt s)"
@ -318,7 +312,7 @@ lemma insert_cap_child_corres:
apply (clarsimp simp:mdb_cte_at_def cte_wp_at_caps_of_state)
apply fastforce
apply (wp get_cap_wp set_cap_idle static_imp_wp
| simp split del:if_splits add:set_untyped_cap_as_full_def)+
| simp split del:split_if add:set_untyped_cap_as_full_def)+
apply (rule_tac Q = "\<lambda>r s. not_idle_thread (fst child) s
\<and> (\<exists>cap. caps_of_state s src = Some cap)
\<and> should_be_parent_of src_capa (is_original_cap s src) cap (cap_insert_dest_original cap src_capa)
@ -506,6 +500,7 @@ lemma cap_null_reply_case_If:
else h)"
by (simp add: is_reply_cap_def is_master_reply_cap_def split: cap.split)
(* FIXME: move *)
lemma corres_if_rhs2:
"\<lbrakk> G \<Longrightarrow> corres_underlying sr nf rvr P Q a b;
\<not> G \<Longrightarrow> corres_underlying sr nf rvr P' Q' a c \<rbrakk>
@ -1126,6 +1121,7 @@ lemma set_get_set_asid_pool:
apply (simp add: get_asid_pool_def set_asid_pool_def get_object_def bind_assoc exec_gets)
apply (case_tac "kheap xa a", simp_all)
apply (case_tac aa, simp_all)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all)
apply (simp add:set_object_def exec_gets bind_assoc exec_get exec_put)
apply (simp add: put_def)
@ -1174,6 +1170,7 @@ lemma get_set_asid_pool:
apply (simp add: get_asid_pool_def set_asid_pool_def get_object_def bind_assoc exec_gets)
apply (case_tac "kheap xa a", simp_all)
apply (case_tac aa, simp_all)
apply (rename_tac arch_kernel_obj)
apply (case_tac arch_kernel_obj, simp_all)
apply (simp add:exec_gets)
done
@ -1556,31 +1553,32 @@ ucast (y && mask pd_bits >> 2) \<notin> kernel_mapping_slots
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp:assert_opt_def opt_cap_pd_Some split:option.splits)
apply (intro conjI,clarsimp)
apply (clarsimp simp:set_object_def get_def put_def bind_def return_def)
apply (clarsimp simp:corres_underlying_def transform_def cur_tcb_def tcb_at_def dest!:get_tcb_SomeD)
apply (clarsimp simp:transform_current_thread_def)
apply (rule ext)
apply (case_tac x)
apply (frule(1) arch_obj_not_idle)
apply (clarsimp simp: not_idle_thread_def transform_objects_def restrict_map_def map_add_def)
apply (rule ext)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def
kernel_pde_mask_def ucast_nat_def transform_pde_def
split: if_splits ARM_Structs_A.pte.split_asm)
apply (clarsimp simp:)+
apply (clarsimp simp:set_object_def get_def put_def bind_def return_def)
apply (clarsimp simp:corres_underlying_def transform_def cur_tcb_def tcb_at_def dest!:get_tcb_SomeD)
apply (clarsimp simp:transform_current_thread_def)
apply (rule ext)
apply (case_tac x)
apply (frule(1) arch_obj_not_idle)
apply (clarsimp simp: not_idle_thread_def transform_objects_def restrict_map_def map_add_def)
apply (rule ext)
apply (clarsimp simp: transform_page_directory_contents_def unat_map_def
kernel_pde_mask_def ucast_nat_def transform_pde_def
split: if_splits ARM_Structs_A.pte.split_asm)
apply (clarsimp simp:)+
apply (rule corres_dummy_return_pr)
apply (rule_tac P'="\<lambda>r. op = s'" in corres_underlying_split[where r'=dc])
apply (rule corres_guard_imp[OF dummy_remove_cdt_pd_slot])
apply (rule corres_guard_imp[OF dummy_remove_cdt_pd_slot])
apply simp+
apply (clarsimp simp:transform_objects_def restrict_map_def)
apply (simp add:obj_at_def a_type_def)
apply (clarsimp simp:transform_objects_def restrict_map_def)
apply (simp add:obj_at_def a_type_def)
apply (rule hoare_TrueI)
apply wp
apply wp
apply clarsimp
apply (clarsimp simp:KHeap_D.set_cap_def gets_the_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp:update_slots_def assert_opt_def opt_cap_def slots_of_def opt_object_page_directory has_slots_def
object_slots_def split:option.splits)
apply (clarsimp simp:update_slots_def assert_opt_def opt_cap_def slots_of_def
opt_object_page_directory has_slots_def object_slots_def
split:option.splits)
apply (clarsimp simp:KHeap_D.set_object_def set_object_def simpler_modify_def get_def put_def bind_def return_def)
apply (clarsimp simp:corres_underlying_def transform_def cur_tcb_def tcb_at_def dest!:get_tcb_SomeD)
apply (clarsimp simp:transform_current_thread_def)
@ -1589,7 +1587,7 @@ ucast (y && mask pd_bits >> 2) \<notin> kernel_mapping_slots
apply (clarsimp simp: not_idle_thread_def transform_objects_def restrict_map_def map_add_def)
apply (subst transform_page_directory_contents_upd[symmetric])
apply (clarsimp simp:transform_pde_def)+
done
done
lemma dcorres_empty_pte_slot:
" dcorres dc \<top> (valid_idle and cur_tcb and (\<lambda>s. mdb_cte_at (swp (cte_wp_at (op \<noteq> cap.NullCap)) s) (cdt s)))
@ -1606,30 +1604,30 @@ lemma dcorres_empty_pte_slot:
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp:assert_opt_def opt_cap_pt_Some split:option.splits)
apply (intro conjI,clarsimp)
apply (clarsimp simp:set_object_def get_def put_def bind_def return_def)
apply (clarsimp simp:corres_underlying_def transform_def cur_tcb_def tcb_at_def dest!:get_tcb_SomeD)
apply (clarsimp simp:transform_current_thread_def)
apply (rule ext)
apply (case_tac x)
apply (frule(1) arch_obj_not_idle)
apply (clarsimp simp: not_idle_thread_def transform_objects_def restrict_map_def map_add_def)
apply (rule ext)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def transform_pte_def ucast_nat_def
split: if_splits ARM_Structs_A.pte.split_asm)
apply (clarsimp simp: )+
apply (clarsimp simp:set_object_def get_def put_def bind_def return_def)
apply (clarsimp simp:corres_underlying_def transform_def cur_tcb_def tcb_at_def dest!:get_tcb_SomeD)
apply (clarsimp simp:transform_current_thread_def)
apply (rule ext)
apply (case_tac x)
apply (frule(1) arch_obj_not_idle)
apply (clarsimp simp: not_idle_thread_def transform_objects_def restrict_map_def map_add_def)
apply (rule ext)
apply (clarsimp simp:transform_page_table_contents_def unat_map_def transform_pte_def ucast_nat_def
split: if_splits ARM_Structs_A.pte.split_asm)
apply (clarsimp simp: )+
apply (rule corres_dummy_return_pr)
apply (rule_tac P'="\<lambda>r. op = s'" in corres_underlying_split[where r'=dc])
apply (rule corres_guard_imp[OF dummy_remove_cdt_pt_slot])
apply (rule corres_guard_imp[OF dummy_remove_cdt_pt_slot])
apply simp+
apply (clarsimp simp:transform_objects_def restrict_map_def)
apply (simp add:obj_at_def a_type_def)
apply (clarsimp simp:transform_objects_def restrict_map_def)
apply (simp add:obj_at_def a_type_def)
apply (rule hoare_TrueI)
apply wp
apply wp
apply clarsimp
apply (clarsimp simp:KHeap_D.set_cap_def gets_the_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp:update_slots_def assert_opt_def opt_cap_def slots_of_def opt_object_page_table has_slots_def
object_slots_def split:option.splits)
apply (clarsimp simp:update_slots_def assert_opt_def opt_cap_def slots_of_def opt_object_page_table
has_slots_def object_slots_def split:option.splits)
apply (clarsimp simp:KHeap_D.set_object_def set_object_def simpler_modify_def get_def put_def bind_def return_def)
apply (clarsimp simp:corres_underlying_def transform_def cur_tcb_def tcb_at_def dest!:get_tcb_SomeD)
apply (clarsimp simp:transform_current_thread_def)
@ -1638,38 +1636,34 @@ lemma dcorres_empty_pte_slot:
apply (clarsimp simp: not_idle_thread_def transform_objects_def restrict_map_def map_add_def)
apply (subst transform_page_table_contents_upd[symmetric])
apply (clarsimp simp:transform_pte_def)
done
done
lemma store_pte_ct:
"\<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> store_pte x y \<lbrace>\<lambda>r s. P (cur_thread s)\<rbrace>"
apply (clarsimp simp:store_pte_def)
apply wp
apply (simp add:set_pt_def)
apply wp
apply (rule_tac Q = "\<lambda>r s. P (cur_thread s)" in hoare_strengthen_post)
apply (simp add:set_pt_def)
apply wp
apply (rule_tac Q = "\<lambda>r s. P (cur_thread s)" in hoare_strengthen_post)
apply (wp|clarsimp)+
done
done
lemma invalidate_tlb_by_asid_dwp:
"\<lbrace>\<lambda>a. transform a = cs\<rbrace> invalidate_tlb_by_asid aa \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
apply (simp add:invalidate_tlb_by_asid_def)
apply (wp do_machine_op_wp|wpc)+
apply clarsimp
apply (wp)
apply clarsimp
apply (wp)
apply (rule_tac Q = "\<lambda>r s. transform s = cs" in hoare_strengthen_post)
apply (simp add:load_hw_asid_def)
apply (wp|clarsimp)+
done
apply (simp add:load_hw_asid_def)
apply (wp|clarsimp)+
done
lemma page_table_mapped_dwp:
"\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> page_table_mapped aa ba w \<lbrace>\<lambda>a b. transform b = cs\<rbrace>"
apply (simp add:page_table_mapped_def)
apply (wp|wpc)+
apply (rule_tac Q ="\<lambda>r x. transform x = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
done
by (rule page_table_mapped_inv)
lemma store_pde_set_cap_corres:
"\<lbrakk>ucast (ptr && mask pd_bits >> 2) \<in> kernel_mapping_slots \<rbrakk> \<Longrightarrow>
@ -1681,44 +1675,43 @@ lemma store_pde_set_cap_corres:
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp:corres_free_fail)
apply (frule arch_obj_not_idle)
apply simp
apply simp
apply (simp add:not_idle_thread_def)
apply (clarsimp simp:set_object_def return_def get_def put_def corres_underlying_def
bind_def )
apply (clarsimp simp:set_object_def return_def get_def put_def corres_underlying_def bind_def)
apply (simp add:transform_def transform_current_thread_def)
apply (rule ext)
apply (clarsimp simp:transform_objects_def restrict_map_def map_add_def)
apply (rule ext)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def kernel_pde_mask_def )
apply (simp add:kernel_mapping_slots_def)
done
done
lemma copy_global_mappings_dwp:
"is_aligned word pd_bits\<Longrightarrow> \<lbrace>\<lambda>ps. valid_idle (ps :: det_state) \<and> transform ps = cs\<rbrace> copy_global_mappings word \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
apply (simp add:copy_global_mappings_def)
apply wp
apply (rule_tac Q = "\<lambda>r s. valid_idle s \<and> transform s = cs" in hoare_strengthen_post)
apply (rule mapM_x_wp')
apply wp
apply (rule_tac Q="\<lambda>s. valid_idle s \<and> transform s = cs" in hoare_vcg_precond_imp)
apply (rule dcorres_to_wp)
apply (rule corres_guard_imp[OF store_pde_set_cap_corres])
apply (clarsimp simp:kernel_mapping_slots_def)
apply (simp add:ucast_def kernel_base_def pd_bits_def pageBits_def)
apply (simp add:mask_add_aligned)
apply (subst less_mask_eq,simp)
apply (simp add:shiftl_t2n)
apply (subst mult.commute)
apply (rule div_lt_mult,simp+,unat_arith,simp+)
apply (simp add:shiftl_shiftr1 word_size)
apply (subst less_mask_eq,simp)
apply unat_arith
apply (fold ucast_def)
apply (subst ucast_le_migrate[symmetric])
apply (simp add:word_size,unat_arith)
apply (simp add:word_size)+
apply (rule_tac Q = "\<lambda>r s. valid_idle s \<and> transform s = cs" in hoare_strengthen_post)
apply (rule mapM_x_wp')
apply wp
apply (rule_tac Q="\<lambda>s. valid_idle s \<and> transform s = cs" in hoare_vcg_precond_imp)
apply (rule dcorres_to_wp)
apply (rule corres_guard_imp[OF store_pde_set_cap_corres])
apply (clarsimp simp:kernel_mapping_slots_def)
apply (simp add:ucast_def kernel_base_def pd_bits_def pageBits_def)
apply (simp add:mask_add_aligned)
apply (subst less_mask_eq,simp)
apply (simp add:shiftl_t2n)
apply (subst mult.commute)
apply (rule div_lt_mult,simp+,unat_arith,simp+)
apply (simp add:shiftl_shiftr1 word_size)
apply (subst less_mask_eq,simp)
apply unat_arith
apply (fold ucast_def)
apply (subst ucast_le_migrate[symmetric])
apply (simp add:word_size,unat_arith)
apply (simp add:word_size)+
apply (wp|clarsimp)+
done
done
lemma opt_cap_pd_not_None:
"\<lbrakk>ko_at (ArchObj (arch_kernel_obj.PageDirectory ptx)) w s'; valid_idle s';ba<4096\<rbrakk>
@ -1738,12 +1731,12 @@ lemma transform_pde_NullCap:
apply (clarsimp simp:kernel_pde_mask_def kernel_base_def)
apply (subst ucast_le_migrate[symmetric])
apply (simp add:word_size,unat_arith)
apply (simp add:word_size)+
apply (drule word_of_nat_le,simp add:transform_pde_def)
apply (simp add:word_size)+
apply (drule word_of_nat_le,simp add:transform_pde_def)
apply (subst ucast_le_migrate[symmetric])
apply (simp_all add:word_size)
apply unat_arith
done
apply unat_arith
done
lemma dcorres_dummy_empty_slot_pd:
"\<lbrakk>0xF00 \<le> unat xa ; unat xa < 0x1000\<rbrakk> \<Longrightarrow> dcorres dc \<top> (valid_idle and page_directory_at w)
@ -1756,11 +1749,11 @@ lemma dcorres_dummy_empty_slot_pd:
apply (subst opt_object_page_directory)
apply (simp add:obj_at_def)+
apply (clarsimp simp:assert_opt_def object_slots_def)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def)
apply (clarsimp simp:transform_page_directory_contents_def unat_map_def)
apply (drule transform_pde_NullCap)
apply (simp add:ucast_nat_def)+
apply (simp add:ucast_nat_def)+
apply fastforce
done
done
lemma dcorres_dummy_empty_slot_pd_mapM_x:
"\<forall>x\<in> set ls. 0xF00 \<le> unat x \<and> unat x < 4096
@ -2223,7 +2216,7 @@ definition
where
"object_at P obj_id s \<equiv> \<exists>object. cdl_objects s obj_id = Some object \<and> P object"
(* MOVE *)
(* FIXME: MOVE *)
definition
"transform_cnode sz cn \<equiv>
if sz = 0
@ -2276,7 +2269,7 @@ lemma arch_recycle_cap_dcorres:
shows "dcorres (\<lambda>x. (\<lambda>cap'. x = transform_cap cap') \<circ> cap.ArchObjectCap)
\<top> (invs and cte_wp_at (op = (cap.ArchObjectCap arch_cap)) slot and valid_pdpt_objs and valid_etcbs)
(CSpace_D.recycle_cap is_final' (transform_cap (cap.ArchObjectCap arch_cap))) (arch_recycle_cap is_final' arch_cap)"
apply (cases arch_cap, simp_all del: transform_cap_simps)
apply (cases arch_cap; simp only:)
-- "asid pool"
apply (rule corres_guard_imp)
apply (rule dcorres_recycle_asid_pool_caps [where slot = slot, OF refl], simp, simp)
@ -2293,9 +2286,10 @@ lemma arch_recycle_cap_dcorres:
lemma recycle_cap_idle_thread: "\<lbrace> \<lambda>s. P (idle_thread s) \<rbrace> recycle_cap a b \<lbrace> \<lambda>_ s. P (idle_thread s) \<rbrace>"
unfolding recycle_cap_def
apply (case_tac b)
apply (wp | simp)+
apply (case_tac option)
apply (wp get_thread_state_it dxo_wp_weak | rule hoare_drop_imps | simp)+
apply (wp | simp)+
apply (rename_tac option nat)
apply (case_tac option)
apply (wp get_thread_state_it dxo_wp_weak | rule hoare_drop_imps | simp)+
done
lemma recycle_cap_corres_pre:
@ -2303,43 +2297,43 @@ lemma recycle_cap_corres_pre:
(\<lambda>s. invs s \<and> cte_wp_at (op = cap) ptr s \<and> valid_pdpt_objs s \<and> valid_etcbs s)
(CSpace_D.recycle_cap x (transform_cap cap)) (CSpace_A.recycle_cap x cap)"
apply (case_tac cap)
apply (rule corres_guard_imp)
prefer 14 (* Using an explict goal number is so incredibly brittle *)
apply (simp add:recycle_cap_def)
apply (rule corres_guard_imp)
apply (rule arch_recycle_cap_dcorres)
apply (wp recycle_cap_invs [where slot = "(a, b)"] recycle_cap_idle_thread
| strengthen valid_idle_invs_strg | fastforce)+
apply (simp_all add:recycle_cap_def CSpace_D.recycle_cap_def
split del:if_splits)
apply (rule corres_guard_imp[OF corres_free_fail [where P = \<top> and P' = \<top>]],simp+)
apply (rule corres_guard_imp)
apply (rule corres_split [where R = "\<top>\<top>" and R' = "\<top>\<top>"])
apply simp
apply (rule corres_when)
apply simp
apply (rule dcorres_ep_cancel_badge_sends)
apply (wp|clarsimp)+
apply (case_tac option,simp+)
apply (rule corres_guard_imp)
prefer 14 -- Recycle
apply (simp add:recycle_cap_def)
apply (rule corres_guard_imp)
apply (rule arch_recycle_cap_dcorres)
apply (wp recycle_cap_invs recycle_cap_idle_thread
| strengthen valid_idle_invs_strg | fastforce)+
apply (simp_all add:recycle_cap_def CSpace_D.recycle_cap_def
split del: split_if)
apply (rule corres_guard_imp[OF corres_free_fail [where P = \<top> and P' = \<top>]],simp+)
apply (rule corres_guard_imp)
apply (rule corres_split [where R = "\<top>\<top>" and R' = "\<top>\<top>"])
apply simp
apply (rule corres_when)
apply simp
apply (rule dcorres_ep_cancel_badge_sends)
apply (wp|clarsimp)+
apply (rename_tac option nat)
apply (case_tac option,simp+)
apply (simp add: get_thread_state_def)
apply (rule corres_guard_imp)
apply (rule dcorres_thread_get_get_object_split)
apply simp
apply (rule corres_assert_rhs)
apply (rule dcorres_thread_set_default_tcb)
apply (wp|simp)+
apply (clarsimp dest!:cte_wp_at_zombie_not_idle)
apply (rule corres_guard_imp[where P= \<top>])
apply (rule dcorres_get_object_cnode_split[where P = \<top>])
apply (rule_tac F = "cdl_cnode_size_bits cnode = a" in corres_gen_asm2)
apply (rule dcorres_thread_set_default_tcb)
apply (wp|simp)+
apply (clarsimp dest!:cte_wp_at_zombie_not_idle)
apply (rule corres_guard_imp[where P= \<top>])
apply (rule dcorres_get_object_cnode_split[where P = \<top>])
apply (rule_tac F = "cdl_cnode_size_bits cnode = a" in corres_gen_asm2)
apply clarsimp+
apply (frule zombie_get_cnode)
apply clarsimp+
apply (rule conjI,simp)
apply (drule cte_wp_valid_cap)
apply fastforce
apply (clarsimp simp:get_cnode'_def
valid_cap_def obj_at_def split:Structures_A.kernel_object.splits)
apply (frule zombie_get_cnode)
apply clarsimp+
apply (rule conjI,simp)
apply (drule cte_wp_valid_cap)
apply fastforce
apply (clarsimp simp:get_cnode'_def valid_cap_def obj_at_def split:Structures_A.kernel_object.splits)
apply (clarsimp simp:transform_cnode_def is_cap_table_def invs_valid_idle cnode_size_bits_def)
done
@ -2663,13 +2657,14 @@ lemma derive_cap_dummy:
apply (clarsimp simp: corres_underlying_def lift_def return_def split: sum.splits)
apply (fastforce simp: in_monad)
apply wp
apply simp
apply simp
apply (simp add: liftME_def)
apply (clarsimp simp: arch_derive_cap_def)
apply (case_tac arch_cap, simp_all split: option.splits)
apply (simp_all add: returnOk_def throwError_def)
done
apply simp
apply (simp add: liftME_def)
apply (clarsimp simp: arch_derive_cap_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap, simp_all split: option.splits)
apply (simp_all add: returnOk_def throwError_def)
done
lemma cdt_transform:
"cdl_cdt (transform s) = map_lift_over transform_cslot_ptr (cdt s)"
@ -2706,7 +2701,7 @@ lemma dcorres_ensure_no_children:
apply (drule (1) wf_cs_nD)+
apply simp
apply clarsimp
apply (thin_tac "?P \<or> ?Q")
apply (thin_tac "P \<or> Q" for P Q)
apply (clarsimp simp: tcb_cap_cases_def tcb_cnode_index_def split: if_splits)
apply simp
done
@ -2731,6 +2726,7 @@ lemma derive_cap_dcorres:
apply simp
apply fastforce
apply (simp add: arch_derive_cap_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap, simp_all add: dcorres_returnOk')
apply (rule dcorres_returnOk')
apply (clarsimp simp:transform_mapping_def)
@ -2766,17 +2762,17 @@ lemma dcorres_update_cap_data:
apply (unfold CSpace_D.update_cap_data_def)
apply (simp add:gets_the_def gets_def bind_assoc)
apply (case_tac cap')
apply (simp_all add:transform_cap_def update_cap_data_def
CSpace_A.update_cap_data_def is_cap_simps Let_def)
apply (simp_all add:transform_cap_def update_cap_data_def is_cap_simps Let_def)
apply (simp add: CSpace_D.badge_update_def update_cap_badge_def
Structures_A.badge_update_def Types_D.badge_bits_def)
Structures_A.badge_update_def Types_D.badge_bits_def)
apply (simp add: CSpace_D.badge_update_def update_cap_badge_def
Structures_A.badge_update_def Types_D.badge_bits_def)
Structures_A.badge_update_def Types_D.badge_bits_def)
apply (simp add: bind_assoc gets_the_def gets_def the_cnode_cap_def)
apply (clarsimp simp:word_bits_def Types_D.word_bits_def dest!:leI)
apply (simp add:of_drop_to_bl)
apply (simp add:mask_twice)
apply (clarsimp simp:word_size opt_object_def Types_D.word_bits_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap, simp_all add: arch_update_cap_data_def)
done
@ -2792,8 +2788,7 @@ lemma dcorres_update_cap_data_bind:
apply (rule dcorres_update_cap_data, simp)
apply simp
apply assumption
apply (clarsimp simp:
CSpace_D.update_cap_data_def)
apply (clarsimp simp: CSpace_D.update_cap_data_def)
apply (wp | wpc)+
apply simp
apply simp
@ -2891,7 +2886,7 @@ lemma decode_cnode_corres:
(invs and valid_cap cap' and (\<lambda>s. \<forall>e\<in>set excaps'. valid_cap (fst e) s) and valid_etcbs)
(CNode_D.decode_cnode_invocation cap slot excaps ui)
(Decode_A.decode_cnode_invocation label' args' cap' (map fst excaps'))"
apply (drule_tac s="Some ?x" in sym)
apply (drule_tac s="Some x" for x in sym)
apply (rule_tac label=label' and args=args' and exs="map fst excaps'"
in decode_cnode_cases2)
apply (clarsimp simp: transform_intent_def unlessE_whenE
@ -3251,7 +3246,6 @@ lemma decode_cnode_corres:
apply (case_tac list)
apply clarsimp
apply (simp add: transform_intent_def upto_enum_def toEnum_def fromEnum_def
enum_invocation_label
enum_invocation_label transform_cnode_index_and_depth_def
transform_intent_cnode_copy_def
transform_intent_cnode_mint_def
@ -3280,38 +3274,38 @@ lemma decode_cnode_corres:
lemma decode_cnode_label_not_match:
"\<lbrakk>Some intent = transform_intent (invocation_type label) args; \<forall>ui. intent \<noteq> CNodeIntent ui\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_cnode_invocation label args (cap.CNodeCap a b c) (e) \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>e. op = s\<rbrace>"
apply (case_tac "invocation_type label = CNodeRevoke")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeDelete")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeRecycle")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeCopy")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_copy_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeMint")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_mint_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeMove")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_move_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeMutate")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_mutate_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeRotate")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_rotate_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeSaveCaller")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (clarsimp simp:Decode_A.decode_cnode_invocation_def unlessE_def)
apply (subgoal_tac "\<not> invocation_type label \<in> set [CNodeRevoke .e. CNodeSaveCaller]")
apply clarsimp
apply wp
apply (clarsimp simp: upto_enum_def fromEnum_def toEnum_def enum_invocation_label)
done
apply (case_tac "invocation_type label = CNodeRevoke")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeDelete")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeRecycle")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeCopy")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_copy_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeMint")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_mint_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeMove")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_move_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeMutate")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_mutate_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeRotate")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_intent_cnode_rotate_def split:option.splits list.splits)
apply (case_tac "invocation_type label = CNodeSaveCaller")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)
apply (clarsimp simp:transform_cnode_index_and_depth_def split:option.splits list.splits)
apply (clarsimp simp:Decode_A.decode_cnode_invocation_def unlessE_def)
apply (subgoal_tac "\<not> invocation_type label \<in> set [CNodeRevoke .e. CNodeSaveCaller]")
apply clarsimp
apply wp
apply (clarsimp simp: upto_enum_def fromEnum_def toEnum_def enum_invocation_label)
done
end

258
proof/drefine/Finalise_DR.thy
View File

@ -12,7 +12,6 @@ theory Finalise_DR
imports
KHeap_DR
"../invariant-abstract/PDPTEntries_AI"
"../../lib/Apply_Trace"
begin
declare dxo_wp_weak[wp del]
@ -201,7 +200,7 @@ lemma delete_cap_one_shrink_descendants:
apply (rule_tac P="\<lambda>s. valid_mdb s \<and> cdt s = xa \<and> cdt pres = xa \<and> slot \<in> CSpaceAcc_A.descendants_of p (cdt s)
\<and> mdb_cte_at (swp (cte_wp_at (op\<noteq> cap.NullCap)) s) (cdt s)"
in hoare_vcg_precond_imp)
apply (rule_tac Q ="\<lambda>r s. (?Q r s) \<and> (mdb_cte_at (swp (cte_wp_at (op\<noteq> cap.NullCap)) s) (cdt s))" in hoare_strengthen_post)
apply (rule_tac Q ="\<lambda>r s. Q r s \<and> (mdb_cte_at (swp (cte_wp_at (op\<noteq> cap.NullCap)) s) (cdt s))" for Q in hoare_strengthen_post)
apply (rule hoare_vcg_conj_lift)
apply (rule delete_cdt_slot_shrink_descendants[where y= "cdt pres" and p = p])
apply (rule_tac Q="\<lambda>s. mdb_cte_at (swp (cte_wp_at (op\<noteq>cap.NullCap)) s ) xa" in hoare_vcg_precond_imp)
@ -286,14 +285,14 @@ lemma caps_of_state_transform_opt_cap_no_idle:
transform_def object_slots_def transform_objects_def
valid_irq_node_def obj_at_def is_cap_table_def
transform_tcb_def tcb_slot_defs
tcb_pending_op_slot_def tcb_cap_cases_def
bl_to_bin_tcb_cnode_index bl_to_bin_tcb_cnode_index_le0
tcb_cap_cases_def bl_to_bin_tcb_cnode_index bl_to_bin_tcb_cnode_index_le0
split: split_if_asm option.splits)
done
lemma transform_cap_Null [simp]:
"(transform_cap cap = cdl_cap.NullCap) = (cap = cap.NullCap)"
apply (cases cap, simp_all)
apply (rename_tac arch_cap)
apply (case_tac arch_cap, simp_all)
done
@ -380,7 +379,7 @@ lemma finalise_ipc_cancel:
apply clarsimp
apply (rule corres_dummy_return_pr)
apply (rule corres_split [OF _ dcorres_revoke_cap_unnecessary])
apply (simp add:K_bind_def when_def dc_def[symmetric])
apply (simp add: when_def dc_def[symmetric])
apply (rule set_thread_state_corres)
apply (wp sts_only_idle sts_st_tcb_at' valid_ep_queue_subset | clarsimp simp:not_idle_thread_def)+
apply (simp add:get_blocking_ipc_endpoint_def | wp)+
@ -703,7 +702,7 @@ lemma dcorres_delete_asid_pool:
apply (rule conjI)
prefer 2
apply (clarsimp, rule corres_alternate2)
apply (clarsimp simp: corres_return)
apply (clarsimp)
apply clarsimp
apply (rule corres_alternate1)
apply (rule dcorres_absorb_get_l)
@ -1317,9 +1316,9 @@ lemma page_directory_address_eq:
"\<lbrakk>is_aligned ptr 6; t \<in> set [0 , 4 .e. 0x3C]\<rbrakk> \<Longrightarrow> ptr && ~~ mask pd_bits = ptr + t && ~~ mask pd_bits"
apply (drule large_frame_range_helper)
using mask_lower_twice[where m = 14 and n = 6 and x= ptr,symmetric]
apply (clarsimp simp:pd_bits_def pageBits_def pageBits_def)
apply (clarsimp simp:pd_bits_def pageBits_def)
using mask_lower_twice[where m = 14 and n = 6 and x= "ptr+t",symmetric]
apply (clarsimp simp:pd_bits_def pageBits_def pageBits_def)
apply (clarsimp simp:pd_bits_def pageBits_def)
apply (subgoal_tac "(ptr && ~~ mask 6) = (ptr + t && ~~ mask 6)")
apply simp
apply (frule is_aligned_neg_mask_eq)
@ -1333,9 +1332,9 @@ lemma page_table_address_eq:
"\<lbrakk>is_aligned ptr 6; t \<in> set [0 , 4 .e. 0x3C]\<rbrakk> \<Longrightarrow> ptr && ~~ mask pt_bits = ptr + t && ~~ mask pt_bits"
apply (drule large_frame_range_helper)
using mask_lower_twice[where m = 10 and n = 6 and x= ptr,symmetric]
apply (clarsimp simp:pt_bits_def pageBits_def pageBits_def)
apply (clarsimp simp:pt_bits_def pageBits_def)
using mask_lower_twice[where m = 10 and n = 6 and x= "ptr+t",symmetric]
apply (clarsimp simp:pt_bits_def pageBits_def pageBits_def)
apply (clarsimp simp:pt_bits_def pageBits_def)
apply (subgoal_tac "(ptr && ~~ mask 6) = (ptr + t && ~~ mask 6)")
apply simp
apply (frule is_aligned_neg_mask_eq)
@ -1563,16 +1562,15 @@ lemma dcorres_store_invalid_pde_super_section:
and K (ucast (ptr && mask pd_bits >> 2) \<notin> kernel_mapping_slots))
(delete_cap_simple (ptr && ~~ mask pd_bits, unat (ptr && mask pd_bits >> 2)))
(store_pde ptr ARM_Structs_A.pde.InvalidPDE)"
apply (simp add:K_def)
apply simp
apply (rule corres_gen_asm2)
apply (rule corres_guard_imp)
apply (simp add:store_pde_def)
apply (rule corres_symb_exec_r)
apply (rule dcorres_delete_cap_simple_set_pde[where oid = pg_id])
apply simp
apply (wp|simp)+
apply (clarsimp simp: invs_def valid_mdb_def
valid_state_def valid_pspace_def)
apply (rule dcorres_delete_cap_simple_set_pde[where oid = pg_id])
apply simp
apply (wp|simp)+
apply (clarsimp simp: invs_def valid_mdb_def valid_state_def valid_pspace_def)
done
lemma dcorres_store_invalid_pte:
@ -1583,10 +1581,9 @@ lemma dcorres_store_invalid_pte:
apply (rule corres_guard_imp)
apply (simp add:store_pte_def)
apply (rule corres_symb_exec_r)
apply (rule dcorres_delete_cap_simple_set_pt[where pg_id = pg_id])
apply (wp|simp)+
apply (clarsimp simp: invs_def valid_mdb_def
valid_state_def valid_pspace_def)
apply (rule dcorres_delete_cap_simple_set_pt[where pg_id = pg_id])
apply (wp|simp)+
apply (clarsimp simp: invs_def valid_mdb_def valid_state_def valid_pspace_def)
done
lemma dcorres_store_pde_non_sense:
@ -1595,23 +1592,20 @@ lemma dcorres_store_pde_non_sense:
\<and> (f (ucast (slot && mask pd_bits >> 2)) = pde)))
(return a) (store_pde slot pde)"
apply (simp add:store_pde_def)
apply (simp add:get_pd_def bind_assoc
get_object_def set_pd_def gets_def)
apply (simp add:get_pd_def bind_assoc get_object_def set_pd_def gets_def)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp add:assert_def corres_free_fail
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp:corres_free_fail
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
apply (simp add:set_object_def put_def)
apply (rule dcorres_absorb_get_r)
apply (simp add:corres_underlying_def
return_def transform_def transform_current_thread_def)
apply (simp add:corres_underlying_def return_def transform_def transform_current_thread_def)
apply (frule page_directory_at_rev)
apply (drule(1) page_directory_not_idle[rotated])
apply (rule ext)+
apply (simp add:transform_objects_def
not_idle_thread_def obj_at_def)
apply (simp add:transform_objects_def not_idle_thread_def obj_at_def)
done
lemma dcorres_store_pte_non_sense:
@ -1620,23 +1614,20 @@ lemma dcorres_store_pte_non_sense:
\<and> (f (ucast (slot && mask pt_bits >> 2)) = pte)))
(return a) (store_pte slot pte)"
apply (simp add:store_pte_def)
apply (simp add:get_pt_def bind_assoc
get_object_def set_pt_def gets_def)
apply (simp add:get_pt_def bind_assoc get_object_def set_pt_def gets_def)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp add:assert_def corres_free_fail
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp:corres_free_fail
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
split:Structures_A.kernel_object.splits arch_kernel_obj.splits)
apply (simp add:set_object_def put_def)
apply (rule dcorres_absorb_get_r)
apply (simp add:corres_underlying_def
return_def transform_def transform_current_thread_def)
apply (simp add:corres_underlying_def return_def transform_def transform_current_thread_def)
apply (frule page_table_at_rev)
apply (drule(1) page_table_not_idle[rotated])
apply (rule ext)+
apply (simp add:transform_objects_def
not_idle_thread_def obj_at_def)
apply (simp add:transform_objects_def not_idle_thread_def obj_at_def)
done
lemma store_pde_non_sense_wp:
@ -1645,11 +1636,9 @@ lemma store_pde_non_sense_wp:
store_pde x ARM_Structs_A.pde.InvalidPDE
\<lbrace>\<lambda>r s. (\<exists>f. ko_at (ArchObj (arch_kernel_obj.PageDirectory f)) (slot && ~~ mask pd_bits) s
\<and> (\<forall>slot\<in>set xs. f (ucast (slot && mask pd_bits >> 2)) = ARM_Structs_A.pde.InvalidPDE))\<rbrace>"
apply (simp add:store_pde_def get_object_def
get_pde_def set_pd_def set_object_def)
apply (simp add:store_pde_def get_object_def get_pde_def set_pd_def set_object_def)
apply wp
apply (clarsimp simp:obj_at_def
split:Structures_A.kernel_object.splits arch_kernel_object.splits)
apply (clarsimp simp:obj_at_def split:Structures_A.kernel_object.splits arch_kernel_object.splits)
done
lemma dcorres_store_invalid_pde_tail_super_section:
@ -1805,8 +1794,8 @@ lemma dcorres_unmap_large_section:
in valid_entriesD[rotated])
apply (rule ccontr)
apply simp
apply (drule_tac x="ucast ?v" in arg_cong[where f = "ucast::(12 word\<Rightarrow>word32)"])
apply (drule_tac x="ucast ?v" in arg_cong[where f = "\<lambda>x. shiftl x 2"])
apply (drule_tac x="ucast v" for v in arg_cong[where f = "ucast::(12 word\<Rightarrow>word32)"])
apply (drule_tac x="ucast v" for v in arg_cong[where f = "\<lambda>x. shiftl x 2"])
apply (subst (asm) ucast_ucast_len)
apply (rule shiftr_less_t2n)
apply (rule less_le_trans[OF and_mask_less'])
@ -1917,8 +1906,8 @@ lemma dcorres_unmap_large_page:
in valid_entriesD[rotated])
apply (rule ccontr)
apply simp
apply (drule_tac x="ucast ?v" in arg_cong[where f = "ucast::(word8\<Rightarrow>word32)"])
apply (drule_tac x="ucast ?v" in arg_cong[where f = "\<lambda>x. shiftl x 2"])
apply (drule_tac x="ucast v" for v in arg_cong[where f = "ucast::(word8\<Rightarrow>word32)"])
apply (drule_tac x="ucast v" for v in arg_cong[where f = "\<lambda>x. shiftl x 2"])
apply (subst (asm) ucast_ucast_len)
apply (rule shiftr_less_t2n)
apply (rule less_le_trans[OF and_mask_less'])
@ -1986,7 +1975,7 @@ lemma mdb_cte_at_flush_page[wp]:
apply (simp add:mdb_cte_at_def)
apply (simp only: imp_conv_disj)
apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
done
done
crunch pd_pt_relation[wp]: flush_table "pd_pt_relation a b c"
(wp: crunch_wps simp: crunch_simps)
@ -2128,8 +2117,7 @@ lemma dcorres_find_pd_for_asid:
apply (rule dcorres_get)
apply (clarsimp simp:cdl_asid_table_transform liftE_bindE
transform_asid_table_entry_def split:option.splits)
apply (simp add:get_asid_pool_def get_object_def gets_the_def
gets_def bind_assoc get_asid_pool_def)
apply (simp add:get_asid_pool_def get_object_def gets_the_def gets_def bind_assoc)
apply (rule dcorres_get)
apply (clarsimp simp: obj_at_def opt_object_asid_pool
assert_opt_def has_slots_def opt_cap_def slots_of_def assert_def
@ -2414,8 +2402,8 @@ prefer 2
apply (wp do_machine_op_wp | clarsimp)+
apply (simp add: imp_conjR)
apply ((wp check_mapping_pptr_pt_relation | wp_once hoare_drop_imps)+)[1]
apply (simp del: swp_apply | wp lookup_pt_slot_inv)+
apply (simp del: swp_apply
apply (simp | wp lookup_pt_slot_inv)+
apply (simp
| wp lookup_pt_slot_inv find_pd_for_asid_kernel_mapping_help
| safe)+
apply ((simp add:dc_def,wp)+)[3]
@ -2453,8 +2441,8 @@ prefer 2
apply (wp hoare_drop_imps)[1]
apply (rule hoare_strengthen_post[OF check_mapping_pptr_pt_relation])
apply fastforce
apply (simp del: swp_apply | wp lookup_pt_slot_inv)+
apply (simp del: swp_apply
apply (simp | wp lookup_pt_slot_inv)+
apply (simp
| wp lookup_pt_slot_inv hoare_drop_imps
find_pd_for_asid_kernel_mapping_help
| safe)+
@ -2484,8 +2472,8 @@ prefer 2
apply (wp do_machine_op_wp | clarsimp)+
apply (simp add: imp_conjR)
apply ((wp check_mapping_pptr_section_relation | wp_once hoare_drop_imps)+)[1]
apply (simp del: swp_apply | wp lookup_pt_slot_inv)+
apply (simp del: swp_apply
apply (simp | wp lookup_pt_slot_inv)+
apply (simp
| wp lookup_pt_slot_inv find_pd_for_asid_kernel_mapping_help
| safe)+
apply ((simp add:dc_def,wp)+)[2]
@ -2523,7 +2511,7 @@ prefer 2
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_strengthen_post[OF check_mapping_pptr_super_section_relation])
apply clarsimp
apply (simp del: swp_apply add:is_aligned_mask[symmetric]
apply (simp add:is_aligned_mask[symmetric]
| wp lookup_pt_slot_inv hoare_drop_imps
find_pd_for_asid_kernel_mapping_help
| safe)+
@ -2623,7 +2611,7 @@ lemma dcorres_finalise_cap:
(CSpace_D.finalise_cap cdlcap final)
(CSpace_A.finalise_cap cap final)"
apply (case_tac cap)
apply (simp_all add:transform_cap_simps when_def)
apply (simp_all add: when_def)
apply clarsimp
apply (rule corres_rel_imp)
apply (rule corres_guard_imp[OF dcorres_ep_cancel_all])
@ -2653,37 +2641,38 @@ lemma dcorres_finalise_cap:
apply (rule corres_split[OF _ dcorres_deleting_irq_handler])
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply (wp|clarsimp)+
apply (clarsimp simp:assert_def corres_free_fail)
apply (case_tac arch_cap)
apply (simp_all add: transform_cap_simps arch_finalise_cap_def split:arch_cap.split_asm)
apply clarsimp
-- arch_cap.ASIDPoolCap
apply (rule corres_guard_imp)
apply (simp add:transform_asid_def)
apply (rule corres_split[OF _ dcorres_delete_asid_pool])
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply (wp|clarsimp)+
apply (clarsimp simp:assert_def corres_free_fail)
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (simp_all add: arch_finalise_cap_def split:arch_cap.split_asm)
apply clarsimp
-- arch_cap.ASIDPoolCap
apply (rule corres_guard_imp)
apply (simp add:transform_asid_def)
apply (rule corres_split[OF _ dcorres_delete_asid_pool])
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply (wp|clarsimp)+
apply (clarsimp split:option.splits | rule conjI)+
-- arch_cap.PageCap
apply (simp add:transform_mapping_def)
apply (clarsimp simp:transform_mapping_def)
apply (rule corres_guard_imp)
apply (clarsimp split:option.splits | rule conjI)+
-- arch_cap.PageCap
apply (simp add:transform_mapping_def)
apply (clarsimp simp:transform_mapping_def)
apply (rule corres_guard_imp)
apply (rule_tac corres_split[OF _ dcorres_unmap_page])
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply (wp | clarsimp )+
apply simp
--arch_cap.PageTableCap
apply (clarsimp simp:transform_mapping_def split:option.splits)
apply (rule dcorres_expand_pfx)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ dcorres_unmap_page_table])
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply ((wp|clarsimp )+)[4]
apply (rule iffD1[OF le_mask_iff_lt_2n,THEN iffD2],simp add:word_size asid_bits_def)
apply simp
--arch_cap.PageTableCap
apply (clarsimp simp:transform_mapping_def split:option.splits)
apply (rule dcorres_expand_pfx)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ dcorres_unmap_page_table])
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply ((wp|clarsimp )+)[4]
apply (rule iffD1[OF le_mask_iff_lt_2n,THEN iffD2],simp add:word_size asid_bits_def)
apply (clarsimp simp:valid_cap_def cap_aligned_def )+
apply (simp add:vmsz_aligned_def)
apply (wp|clarsimp)+
@ -2693,7 +2682,7 @@ lemma dcorres_finalise_cap:
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply (wp|clarsimp split:option.splits)+
done
done
lemma dcorres_splits:
"\<lbrakk> T a \<Longrightarrow> dcorres r P (Q a) f (g a);
@ -2718,25 +2707,26 @@ where "remainder_cap final c\<equiv> case c of
lemma finalise_cap_remainder:
"\<lbrace>\<top>\<rbrace>CSpace_A.finalise_cap cap final \<lbrace>\<lambda>r s. fst (r) = (remainder_cap final cap) \<rbrace>"
apply (case_tac cap)
apply (simp_all add:CSpace_A.finalise_cap.simps remainder_cap_def)
apply (wp|clarsimp)+
apply (fastforce simp:valid_def)
apply (simp|clarify)+
apply (wp|clarsimp)+
apply (fastforce simp:valid_def)
apply (simp|clarify)+
apply (wp|clarsimp|rule conjI)+
apply (simp add:arch_finalise_cap_def)
apply (cases final)
apply (case_tac arch_cap)
apply (simp_all)
apply (wp|clarsimp)+
apply (simp_all split:option.splits)
apply (wp | clarsimp | rule conjI)+
apply (case_tac arch_cap)
apply simp_all
apply (wp|clarsimp split:option.splits | rule conjI)+
done
apply (simp_all add: remainder_cap_def)
apply (wp|clarsimp)+
apply (fastforce simp:valid_def)
apply (simp|clarify)+
apply (wp|clarsimp)+
apply (fastforce simp:valid_def)
apply (simp|clarify)+
apply (wp|clarsimp|rule conjI)+
apply (simp add:arch_finalise_cap_def)
apply (cases final)
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (simp_all)
apply (wp|clarsimp)+
apply (simp_all split:option.splits)
apply (wp | clarsimp | rule conjI)+
apply (rename_tac arch_cap)
apply (case_tac arch_cap; simp)
apply (wp|clarsimp split:option.splits | rule conjI)+
done
lemma obj_ref_not_idle:
"\<lbrakk>valid_objs s;valid_global_refs s;cte_at slot s\<rbrakk> \<Longrightarrow> cte_wp_at (\<lambda>cap. \<forall>x\<in>obj_refs cap. not_idle_thread x s) slot s"
@ -2746,7 +2736,7 @@ lemma obj_ref_not_idle:
apply (drule_tac x = a in spec)
apply (drule_tac x = b in spec)
apply (clarsimp simp:cte_wp_at_def not_idle_thread_def cap_range_def global_refs_def)
done
done
lemma singleton_set_eq:
@ -2781,33 +2771,31 @@ lemma zombie_cap_has_all:
(w,x) \<notin> cte_refs (cap.Zombie w option n) f \<rbrakk>
\<Longrightarrow> caps_of_state s (w,x) = None \<or> caps_of_state s (w,x) = Some cap.NullCap"
apply (clarsimp simp:if_unsafe_then_cap_def valid_cap_def split:option.splits)
apply (drule_tac x = w in spec,drule_tac x = x in spec)
apply (rule ccontr)
apply clarsimp
apply (clarsimp simp:ex_cte_cap_wp_to_def appropriate_cte_cap_def)
apply (drule iffD1[OF cte_wp_at_caps_of_state])
apply clarsimp
apply (frule_tac p = slot and p'="(a,b)" in zombies_final_ccontr)
apply (drule_tac x = w in spec,drule_tac x = x in spec)
apply (rule ccontr)
apply clarsimp
apply (clarsimp simp:ex_cte_cap_wp_to_def appropriate_cte_cap_def)
apply (drule iffD1[OF cte_wp_at_caps_of_state])
apply clarsimp
apply (frule_tac p = slot and p'="(a,b)" in zombies_final_ccontr)
apply simp+
apply (simp add:is_zombie_def)
apply simp+
apply (case_tac cap)
apply simp_all
apply (case_tac y)
apply simp_all
apply (frule_tac p = "(a,b)" in caps_of_state_valid_cap)
apply simp
apply (frule_tac p = slot in caps_of_state_valid_cap)
apply simp
apply (clarsimp simp:valid_cap_def tcb_at_def dest!:get_tcb_SomeD)
apply (drule_tac p = "(interrupt_irq_node s word,[])" in caps_of_state_cteD)
apply (clarsimp simp:cte_wp_at_cases)
apply (clarsimp simp:obj_at_def is_tcb_def tcb_cap_cases_def tcb_cnode_index_def to_bl_1
split:if_splits)
apply (drule valid_globals_irq_node[OF _ caps_of_state_cteD])
apply (simp add:is_zombie_def)
apply simp+
apply (case_tac cap; simp)
apply (case_tac y; simp)
apply (frule_tac p = "(a,b)" in caps_of_state_valid_cap)
apply simp
apply (fastforce simp:cap_range_def)
done
apply (frule_tac p = slot in caps_of_state_valid_cap)
apply simp
apply (rename_tac word w2 w3 rights)
apply (clarsimp simp:valid_cap_def tcb_at_def dest!:get_tcb_SomeD)
apply (drule_tac p = "(interrupt_irq_node s word,[])" in caps_of_state_cteD)
apply (clarsimp simp:cte_wp_at_cases)
apply (clarsimp simp:obj_at_def is_tcb_def tcb_cap_cases_def tcb_cnode_index_def to_bl_1 split:if_splits)
apply (drule valid_globals_irq_node[OF _ caps_of_state_cteD])
apply simp
apply (fastforce simp:cap_range_def)
done
lemma monadic_trancl_steps:
"monadic_rewrite False False \<top>
@ -3452,12 +3440,12 @@ lemma opt_cap_cnode:
apply (case_tac "sz = 0")
apply (clarsimp, rule conjI)
apply (metis nat_to_bl_id2 option.distinct(1) wf_cs_nD)
apply (metis (full_types) nat_to_bl_bl_to_bin nat_to_bl_id2
apply (metis (full_types) nat_to_bl_to_bin nat_to_bl_id2
option.inject wf_cs_nD)
(* "sz \<noteq> 0" *)
apply (clarsimp, rule conjI)
apply (metis nat_to_bl_id2 option.distinct(1) wf_cs_nD)
apply (metis (full_types) nat_to_bl_bl_to_bin nat_to_bl_id2
apply (metis (full_types) nat_to_bl_to_bin nat_to_bl_id2
option.inject wf_cs_nD)
done
@ -3562,6 +3550,7 @@ next
apply (clarsimp simp: remainder_cap_def valid_cap_simps
cte_wp_at_caps_of_state
split: cap.split_asm split_if_asm)
apply (rename_tac word nat option)
apply (frule valid_global_refsD2, clarsimp)
apply (clarsimp simp: CSpace_D.cap_removeable_def)
apply (subgoal_tac "\<exists>x cap. (word, b) = transform_cslot_ptr (word, x)
@ -3683,7 +3672,7 @@ next
apply (simp add: cutMon_walk_bind)
apply (rule corres_drop_cutMon_bind)
apply (rule corres_split[OF _ set_cap_corres])
apply (rule_tac P="dcorres ?r ?P ?P' ?f" in subst)
apply (rule_tac P="dcorres r P P' f" for r P P' f in subst)
apply (rule_tac f="\<lambda>_. ()" in gets_bind_ign)
apply (rule_tac r'="\<lambda>rv rv'. transform_cslot_ptr `
(case fst fin' of cap.Zombie p zb (Suc n) \<Rightarrow>
@ -3704,8 +3693,7 @@ next
prefer 2
apply (rule "2.hyps"[simplified, folded dc_def],
(assumption | simp | rule conjI refl)+)
apply (clarsimp simp del: transform_cap_simps
split: cap.split nat.split)
apply (clarsimp split: cap.split nat.split)
apply (rule corres_cutMon)
apply (simp add: cutMon_walk_bindE dc_def[symmetric])
apply (rule corres_drop_cutMon_bindE)
@ -3729,7 +3717,7 @@ next
apply (clarsimp simp: cte_wp_at_caps_of_state caps_of_state_transform_opt_cap)
apply (clarsimp simp: transform_cslot_ptr_def)
apply (wp | simp)+
apply (simp add: conj_ac)
apply (simp add: conj_comms)
apply (wp replace_cap_invs final_cap_same_objrefs set_cap_cte_wp_at
hoare_vcg_const_Ball_lift set_cap_cte_cap_wp_to static_imp_wp
| erule finalise_cap_not_reply_master[simplified in_monad, simplified]
@ -3753,7 +3741,7 @@ next
apply (frule valid_global_refsD2, clarsimp+)
apply (erule disjE[where P="c = cap.NullCap \<and> P" for c P])
apply clarsimp
apply (clarsimp simp: conj_ac invs_valid_idle global_refs_def cap_range_def
apply (clarsimp simp: conj_comms invs_valid_idle global_refs_def cap_range_def
dest!: is_cap_simps' [THEN iffD1])
apply (frule trans [OF _ appropriate_Zombie, OF sym])
apply (case_tac cap,
@ -3782,7 +3770,7 @@ next
apply (simp add: finalise_slot_inner2_def[unfolded split_def])
apply (rule corres_alternate1, rule corres_alternate1, rule corres_alternate2)
apply simp
apply (rule_tac x="(?p, ?p')" in select_pick_corres)
apply (rule_tac x="(p, p')" for p p' in select_pick_corres)
apply (simp add: liftM_def[symmetric] o_def dc_def[symmetric])
apply (rule swap_for_delete_corres)
apply (clarsimp simp: cte_wp_at_caps_of_state)

491
proof/drefine/Intent_DR.thy
View File

@ -230,7 +230,7 @@ lemma update_tcb_cxt_eq_dupdate_tcb_intent:
not_idle_thread_def transform_objects_def)
apply (rule ext, clarsimp)
apply (rule conjI)
apply (clarsimp simp:transform_objects_simps restrict_map_Some_iff)
apply (clarsimp simp:restrict_map_Some_iff)
apply (clarsimp simp:transform_tcb_def restrict_map_def map_add_def)
apply (clarsimp simp:transform_tcb_def restrict_map_def map_add_def)
done
@ -244,13 +244,13 @@ lemma duplicate_corrupt_tcb_intent:
apply (rule set_eqI)
apply clarsimp
apply (auto simp:corrupt_tcb_intent_def update_thread_def select_def gets_the_def
assert_opt_def return_def fail_def gets_def get_def assert_opt_def bind_def
return_def fail_def gets_def get_def assert_opt_def bind_def
put_def modify_def KHeap_D.set_object_def opt_object_def split_def
split:option.splits cdl_object.splits)[1]
apply clarsimp
apply (rule iffI)
apply (auto simp:corrupt_tcb_intent_def update_thread_def select_def gets_the_def
assert_opt_def return_def fail_def gets_def get_def assert_opt_def bind_def
return_def fail_def gets_def get_def assert_opt_def bind_def
put_def modify_def KHeap_D.set_object_def opt_object_def split_def
split:option.splits cdl_object.splits)
done
@ -270,7 +270,7 @@ lemma corres_corrupt_tcb_intent_return:
apply (clarsimp simp: corres_underlying_def)
apply (clarsimp simp: return_def corrupt_tcb_intent_def)
apply (clarsimp simp:corrupt_tcb_intent_def update_thread_def select_def gets_the_def
assert_opt_def return_def fail_def gets_def get_def assert_opt_def bind_def
return_def fail_def gets_def get_def assert_opt_def bind_def
put_def modify_def KHeap_D.set_object_def opt_object_def)
apply (clarsimp split:option.splits
simp:transform_def tcb_at_def is_tcb_def
@ -281,7 +281,7 @@ lemma corres_corrupt_tcb_intent_return:
apply (rule exI)
apply (auto simp: transform_def transform_tcb_def
transform_objects_def not_idle_thread_def is_tcb_def
tcb_at_def obj_at_def intro:exI split:cdl_object.splits)
tcb_at_def obj_at_def split:cdl_object.splits)
done
lemma dcorres_set_object_tcb:
@ -389,7 +389,7 @@ lemma dummy_corrupt_tcb_intent_corres:
apply (clarsimp simp:update_thread_def gets_the_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp:opt_object_tcb assert_opt_def transform_tcb_def)
apply (clarsimp simp:KHeap_D.set_object_def get_def put_def bind_def modify_def assert_def bind_def return_def)
apply (clarsimp simp:KHeap_D.set_object_def get_def put_def modify_def assert_def bind_def return_def)
apply (subst corres_singleton)
apply (clarsimp simp:dc_def)
apply (clarsimp simp:transform_def)
@ -479,7 +479,7 @@ lemma dcorres_dummy_corrupt_frame: "dcorres dc \<top> valid_etcbs
apply (rule corres_guard_imp)
apply (rule_tac P="op=(transform s')" and Q="op=s'"
and x = "\<lambda>x. transform_full_intent (machine_state s') x (the (get_tcb x s'))" in select_pick_corres)
apply (clarsimp simp:get_def put_def bind_def modify_def assert_def bind_def return_def)
apply (clarsimp simp:get_def put_def modify_def assert_def bind_def return_def)
apply (subst corres_singleton)
apply (clarsimp simp:corrupt_intents_def Let_def transform_def transform_objects_def)
apply (rule ext)
@ -923,11 +923,6 @@ lemma evalMonad_compose:
apply (clarsimp simp:bind_def)
done
lemma evalMonad_return [simp]:
"evalMonad (return x) s = Some x"
unfolding evalMonad_def
by (simp add: return_def)
lemma evalMonad_thread_get:
"evalMonad (thread_get f thread) sa = Some x \<Longrightarrow> \<exists>tcb. get_tcb thread sa = Some tcb \<and> f tcb = x"
by (clarsimp simp:thread_get_def evalMonad_def gets_def gets_the_def
@ -952,32 +947,29 @@ lemma evalMonad_loadWord:
(if x && mask 2 = 0 then
Some (word_rcat [underlying_memory ms (x + 3), underlying_memory ms (x + 2), underlying_memory ms (x + 1), underlying_memory ms x])
else None)"
by (clarsimp simp:word_zero_le loadWord_def gets_def get_def
return_def bind_def assert_def fail_def evalMonad_def)
by (clarsimp simp: loadWord_def gets_def get_def return_def bind_def assert_def fail_def evalMonad_def)
lemma weak_det_spec_lookup_ipc_buffer:
"weak_det_spec P (lookup_ipc_buffer a b)"
apply (simp add:lookup_ipc_buffer_def)
apply (rule weak_det_spec_compose)+
apply (simp_all add: empty_when_fail_simps empty_when_fail_get_cap empty_when_fail_thread_get
weak_det_spec_simps weak_det_spec_thread_get weak_det_spec_get_cap)
apply (case_tac ra)
apply (simp_all add:weak_det_spec_simps)
apply (case_tac arch_cap)
apply (simp_all add:weak_det_spec_simps)
done
apply (simp_all add: empty_when_fail_simps empty_when_fail_get_cap empty_when_fail_thread_get
weak_det_spec_simps weak_det_spec_thread_get weak_det_spec_get_cap)
apply (case_tac ra; simp add:weak_det_spec_simps)
apply (rename_tac arch_cap)
apply (case_tac arch_cap; simp add:weak_det_spec_simps)
done
lemma empty_when_fail_lookup_ipc_buffer:
"empty_when_fail (lookup_ipc_buffer a b)"
apply (simp add:lookup_ipc_buffer_def)
apply (rule empty_when_fail_compose)+
apply (simp_all add: empty_when_fail_simps empty_when_fail_get_cap empty_when_fail_thread_get
weak_det_spec_simps weak_det_spec_thread_get weak_det_spec_get_cap)
apply (case_tac ra)
apply (simp_all add:empty_when_fail_simps)
apply (case_tac arch_cap)
apply (simp_all add:empty_when_fail_simps)
done
apply (simp_all add: empty_when_fail_simps empty_when_fail_get_cap empty_when_fail_thread_get
weak_det_spec_simps weak_det_spec_thread_get weak_det_spec_get_cap)
apply (case_tac ra; simp add:empty_when_fail_simps)
apply (rename_tac arch_cap)
apply (case_tac arch_cap; simp add:empty_when_fail_simps)
done
abbreviation
"\<lambda>s. ipc_frame_cte_at thread buf rights sz s \<equiv>
@ -1100,14 +1092,15 @@ lemma get_tcb_mrs_wp:
apply (clarsimp simp:get_mrs_def thread_get_def gets_the_def)
apply (wp|wpc)+
apply (clarsimp simp:get_tcb_mrs_def Let_def)
apply (clarsimp simp:Suc_leI[OF msg_registers_lt_msg_max_length] split del:if_splits)
apply (clarsimp simp:Suc_leI[OF msg_registers_lt_msg_max_length] split del:split_if)
apply (clarsimp simp:get_tcb_message_info_def get_ipc_buffer_words_empty)
apply (clarsimp dest!:get_tcb_SomeD simp:obj_at_def)
apply (clarsimp simp:get_mrs_def thread_get_def gets_the_def)
apply (clarsimp simp:Suc_leI[OF msg_registers_lt_msg_max_length] split del:if_splits)
apply (clarsimp simp:Suc_leI[OF msg_registers_lt_msg_max_length] split del:split_if)
apply (wp|wpc)+
apply (rule_tac P = "tcb = obj" in hoare_gen_asm)
apply (clarsimp simp: get_tcb_mrs_def Let_def get_tcb_message_info_def Suc_leI[OF msg_registers_lt_msg_max_length] split del:if_splits)
apply (clarsimp simp: get_tcb_mrs_def Let_def get_tcb_message_info_def Suc_leI[OF msg_registers_lt_msg_max_length]
split del:split_if)
apply (rule_tac Q="\<lambda>buf_mrs s. buf_mrs =
(get_ipc_buffer_words (machine_state sa) obj ([Suc (length msg_registers)..<msg_max_length] @ [msg_max_length]))"
in hoare_strengthen_post)
@ -1120,9 +1113,7 @@ done
(* Following is the proof of set_mrs *)
lemma pbfs_word_bits [simp]:
"pageBitsForSize sz < word_bits"
by (cases sz, simp_all add: word_bits_conv)
declare pbfs_less_wb' [simp]
lemma mab_le_pbfs [simp]:
"msg_align_bits \<le> pageBitsForSize sz"
@ -1561,94 +1552,99 @@ lemma store_word_corres_helper:
apply (clarsimp simp:restrict_map_def map_add_def)
apply clarsimp
apply (rule conjI)
apply (clarsimp simp:restrict_map_def transform_object_def transform_tcb_def
split:cdl_object.split_asm Structures_A.kernel_object.split_asm split_if_asm)
apply (drule(1) valid_etcbs_tcb_etcb, clarsimp simp:restrict_map_def transform_object_def transform_tcb_def
split:cdl_object.split_asm Structures_A.kernel_object.split_asm split_if_asm)+
defer
apply (drule(1) valid_etcbs_tcb_etcb, clarsimp simp:restrict_map_def transform_object_def transform_tcb_def
split:cdl_object.split_asm Structures_A.kernel_object.split_asm split_if_asm)+
defer
apply (simp add:tcb_ipcframe_id_def split:split_if_asm)
apply (simp add:tcb_ipcbuffer_slot_def tcb_pending_op_slot_def)
apply (frule_tac thread = thread in valid_tcb_objs)
apply (simp add: get_tcb_rev)
apply (clarsimp simp:valid_tcb_def tcb_cap_cases_def)
apply (case_tac "\<not> is_arch_page_cap (tcb_ipcframe tcb_ext)")
apply (simp add:transform_full_intent_no_ipc_buffer)
apply (clarsimp simp del:upt.simps simp:transform_full_intent_def Let_def get_tcb_mrs_def is_arch_page_cap_def
split:cap.split_asm arch_cap.split_asm split del:if_splits)
apply (clarsimp simp:transform_cap_def arch_cap.split_asm simp del:upt.simps)
apply (frule_tac thread = thread and ptr = ptr and sz = sz
and ms = "machine_state s" and tcb_type = tcb_ext and b = b and s_id = s_id
apply (clarsimp simp:restrict_map_def transform_object_def transform_tcb_def
split:cdl_object.split_asm Structures_A.kernel_object.split_asm split_if_asm)
apply (drule(1) valid_etcbs_tcb_etcb,
clarsimp simp:restrict_map_def transform_object_def transform_tcb_def
split:cdl_object.split_asm Structures_A.kernel_object.split_asm split_if_asm)+
defer
apply (drule(1) valid_etcbs_tcb_etcb,
clarsimp simp:restrict_map_def transform_object_def transform_tcb_def
split:cdl_object.split_asm Structures_A.kernel_object.split_asm split_if_asm)+
defer
apply (simp add:tcb_ipcframe_id_def split:split_if_asm)
apply (simp add:tcb_ipcbuffer_slot_def tcb_pending_op_slot_def)
apply (frule_tac thread = thread in valid_tcb_objs)
apply (simp add: get_tcb_rev)
apply (clarsimp simp:valid_tcb_def tcb_cap_cases_def)
apply (rename_tac tcb etcb)
apply (case_tac "\<not> is_arch_page_cap (tcb_ipcframe tcb)")
apply (simp add:transform_full_intent_no_ipc_buffer)
apply (clarsimp simp del:upt.simps simp:transform_full_intent_def Let_def get_tcb_mrs_def is_arch_page_cap_def
split:cap.split_asm arch_cap.split_asm split del:split_if)
apply (rename_tac word cap_rights vmpage_size option)
apply (clarsimp simp:transform_cap_def arch_cap.split_asm simp del:upt.simps)
apply (frule_tac thread = thread and ptr = ptr and sz = sz
and ms = "machine_state s" and tcb_type = tcb and b = b and s_id = s_id
and xs = "[Suc (length msg_registers)..<Suc msg_max_length]"
in get_ipc_buffer_words_separate_frame)
apply (erule get_tcb_rev)
apply ((simp add:ipc_frame_wp_at_def obj_at_def)+)[8]
apply (clarsimp simp del:upt.simps)
apply (rule_tac y = thread in within_page_ipc_buf)
apply (simp add:ipc_frame_wp_at_def obj_at_def ipc_buffer_wp_at_def)+
apply (simp add:msg_max_length_def msg_align_bits)
apply simp
apply (clarsimp simp:transform_cap_def split:cap.splits arch_cap.splits)
apply (rule conjI)
apply (frule_tac thread = thread and ptr = ptr and sz = sz and ms = "machine_state s" and
tcb_type = tcb_ext and b = b and s_id = s_id
and xs = "[buffer_cptr_index..<buffer_cptr_index + unat (mi_extra_caps (get_tcb_message_info tcb_ext))]"
apply (clarsimp simp del:upt.simps)
apply (rule_tac y = thread in within_page_ipc_buf)
apply (simp add:ipc_frame_wp_at_def obj_at_def ipc_buffer_wp_at_def)+
apply (simp add:msg_max_length_def msg_align_bits)
apply simp
apply (clarsimp simp:transform_cap_def split:cap.splits arch_cap.splits)
apply (rule conjI)
apply (frule_tac thread = thread and ptr = ptr and sz = sz and ms = "machine_state s" and
tcb_type = tcb and b = b and s_id = s_id
and xs = "[buffer_cptr_index..<buffer_cptr_index + unat (mi_extra_caps (get_tcb_message_info tcb))]"
in get_ipc_buffer_words_separate_frame)
apply (erule get_tcb_rev)
apply ((simp add:ipc_frame_wp_at_def obj_at_def)+)[8]
apply (clarsimp simp del:upt.simps)
apply (rule_tac sz = vmpage_size and y = thread in within_page_ipc_buf)
apply (simp add:ipc_frame_wp_at_def obj_at_def ipc_buffer_wp_at_def)+
apply (clarsimp simp del:upt.simps)
apply (rule_tac sz = vmpage_size and y = thread in within_page_ipc_buf)
apply (simp add:ipc_frame_wp_at_def obj_at_def ipc_buffer_wp_at_def)+
apply (simp add:msg_max_length_def msg_align_bits buffer_cptr_index_def)
apply (case_tac "(get_tcb_message_info tcb_ext)")
apply (case_tac "(get_tcb_message_info tcb)")
apply (clarsimp simp add: get_tcb_message_info_def data_to_message_info_def)
apply (erule order_less_le_trans)
apply simp
apply (rule iffD1[OF word_le_nat_alt[where b = "0x6::word32",simplified]])
apply (rule less_less_trans)
apply (rule word_and_le1[where a = 3])
apply ((clarsimp simp:ipc_frame_wp_at_def obj_at_def)+)[4]
apply ((clarsimp simp:ipc_frame_wp_at_def obj_at_def)+)[4]
apply (frule_tac thread = thread and ptr = ptr and sz = sz and ms = "machine_state s" and
tcb_type = tcb_ext and b = b and s_id = s_id
tcb_type = tcb and b = b and s_id = s_id
and xs = "[Suc (Suc (msg_max_length + msg_max_extra_caps))..<5 + (msg_max_length + msg_max_extra_caps)]"
in get_ipc_buffer_words_separate_frame)
apply (erule get_tcb_rev)
apply ((simp add:ipc_frame_wp_at_def obj_at_def)+)[8]
apply (clarsimp simp del:upt.simps)
apply (rule_tac y = thread and sz = vmpage_size in within_page_ipc_buf)
apply (rule_tac y = thread and sz = vmpage_size in within_page_ipc_buf)
apply (simp add:ipc_frame_wp_at_def obj_at_def ipc_buffer_wp_at_def)+
apply (clarsimp simp:msg_align_bits msg_max_length_def msg_max_extra_caps_def)
apply simp+
apply (clarsimp simp: tcb_ipcframe_id_def split: cdl_object.splits option.split_asm cdl_cap.split_asm)
apply (clarsimp simp:transform_object_def split:Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm nat.splits)
apply (simp add:transform_tcb_def)
apply (drule sym)
apply (clarsimp simp:tcb_pending_op_slot_def restrict_map_def tcb_ipcbuffer_slot_def split:if_splits)
apply (clarsimp simp: tcb_ipcframe_id_def split: cdl_object.splits option.split_asm cdl_cap.split_asm)
apply (clarsimp simp: transform_object_def split:Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm nat.splits)
apply (rename_tac tcb)
apply (simp add:transform_tcb_def)
apply (drule sym)
apply (clarsimp simp:tcb_pending_op_slot_def restrict_map_def tcb_ipcbuffer_slot_def split:if_splits)
apply (frule(1) valid_etcbs_tcb_etcb[OF _ eq_sym_helper])
apply clarsimp
apply (subgoal_tac "(get_tcb thread s) = Some tcb_ext")
apply (clarsimp dest!:get_tcb_SomeD)
apply (subgoal_tac "tcb_ext = the (get_tcb thread s)")
apply (subgoal_tac "(get_tcb thread s) = Some tcb")
apply (clarsimp dest!:get_tcb_SomeD)
apply (subgoal_tac "tcb = the (get_tcb thread s)")
apply (subgoal_tac "etcb = the (get_etcb thread s)")
apply simp
apply (simp add: get_etcb_rev)
apply (simp add:get_tcb_rev)+
done
apply (simp add:get_tcb_rev)+
done
lemma select_f_store_word:
"(select_f (storeWord p w ms)) = (do assert (p && mask 2 = 0);
return ((),storeWord_ms p w ms) od)"
apply (clarsimp simp:assert_def select_f_def
storeWord_def bind_def assert_def fail_def simpler_modify_def storeWord_ms_def return_def)
done
apply (clarsimp simp: assert_def select_f_def storeWord_def bind_def fail_def simpler_modify_def
storeWord_ms_def return_def)
done
lemma select_f_get_register:
"(as_user thread (get_register register)) =
(do tcb\<leftarrow>gets_the (get_tcb thread);return (tcb_context tcb register) od)"
apply (simp add:assert_opt_def as_user_def set_object_def gets_the_def
put_def select_f_def get_register_def gets_def get_def return_def bind_def)
apply (simp add: assert_opt_def as_user_def set_object_def gets_the_def
put_def select_f_def get_register_def gets_def get_def return_def bind_def)
apply (rule ext)
apply (case_tac "get_tcb thread s")
apply (clarsimp simp:fail_def return_def)+
@ -1693,16 +1689,18 @@ lemma dcorres_store_word_safe:
apply (clarsimp simp del:upt.simps
simp: Let_def get_tcb_mrs_def is_arch_page_cap_def
split:cap.split_asm arch_cap.split_asm
split del:if_splits)
split del: split_if)
apply (frule valid_tcb_objs, erule get_tcb_rev)
apply (clarsimp simp:valid_tcb_def tcb_cap_cases_def valid_ipc_buffer_cap_def simp del:upt.simps)
apply (erule disjE)
apply (clarsimp simp:is_arch_cap_def split:cap.split_asm simp del:upt.simps)
apply (rename_tac tcb arch_cap)
apply (case_tac arch_cap)
apply ((simp add:get_ipc_buffer_words_def)+)[2]
apply (rename_tac word rights vmpage_size option)
apply (simp add:Suc_leI[OF msg_registers_lt_msg_max_length] del:upt.simps)
apply (frule_tac thread = thread and ptr = ptr and ms = "machine_state s'"
and tcb_type = tcb_ext and b = b
and tcb_type = tcb and b = b
and xs = "[Suc (length msg_registers)..<Suc msg_max_length]"
in get_ipc_buffer_words_helper)
apply (erule get_tcb_rev)
@ -1721,9 +1719,9 @@ lemma dcorres_store_word_safe:
apply (rule conjI)
apply (frule_tac thread = thread and ptr = ptr and ms = "machine_state s'"
and tcb_type = tcb_ext and b = b
and tcb_type = tcb and b = b
and xs = "[buffer_cptr_index..<buffer_cptr_index +
unat (mi_extra_caps (get_tcb_message_info tcb_ext))]"
unat (mi_extra_caps (get_tcb_message_info tcb))]"
in get_ipc_buffer_words_helper)
apply (erule get_tcb_rev)
apply ((simp add:ipc_frame_wp_at_def obj_at_def is_aligned_mask)+)[7]
@ -1731,7 +1729,7 @@ lemma dcorres_store_word_safe:
apply (rule_tac sz = vmpage_size and y = thread in within_page_ipc_buf)
apply (simp add:ipc_frame_wp_at_def obj_at_def ipc_buffer_wp_at_def)+
apply (simp add:msg_max_length_def msg_align_bits buffer_cptr_index_def)
apply (case_tac "(get_tcb_message_info tcb_ext)")
apply (case_tac "get_tcb_message_info tcb")
apply (clarsimp simp add: get_tcb_message_info_def data_to_message_info_def)
apply (erule order_less_le_trans)
apply simp
@ -1745,7 +1743,7 @@ lemma dcorres_store_word_safe:
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
apply simp
apply (frule_tac thread = thread and ptr = ptr and sz = sz and ms = "machine_state s'"
and tcb_type = tcb_ext and b = b
and tcb_type = tcb and b = b
and xs = "[Suc (Suc (msg_max_length + msg_max_extra_caps))..<
5 + (msg_max_length + msg_max_extra_caps)]"
in get_ipc_buffer_words_helper)
@ -1836,7 +1834,7 @@ lemma zip_cpy_word_corres:
apply simp
using Cons.prems
apply (clarsimp simp: within_page_def in_user_frame_def)
apply (thin_tac "Ball ?S ?P")
apply (thin_tac "Ball S P" for S P)
apply (rule_tac x=sz in exI)
apply (frule (2) ipc_frame_ptr_at_frame_at)
apply (simp add: obj_at_def a_type_simps)
@ -1854,39 +1852,37 @@ lemma zip_store_word_corres:
and (ipc_frame_sz_at sz s_id) and (ipc_frame_ptr_at buf s_id) and valid_etcbs)
(corrupt_frame buf)
(zipWithM_x (store_word_offs base) xs ys)"
apply (clarsimp simp:zipWithM_x_mapM_x split del: split_if)
apply (induct xs arbitrary: ys)
apply (clarsimp simp: mapM_x_Cons)
apply (clarsimp simp: mapM_x_Nil)
apply (rule corres_guard_imp[OF dcorres_dummy_corrupt_frame])
apply (simp+)[2]
apply (clarsimp simp:zipWithM_x_mapM_x split del: split_if)
apply (induct xs arbitrary: ys)
apply (clarsimp simp: mapM_x_Cons)
apply (clarsimp simp: mapM_x_Nil)
apply (rule corres_guard_imp[OF dcorres_dummy_corrupt_frame])
apply (simp+)[2]
apply (case_tac ys)
apply (clarsimp simp: mapM_x_Cons mapM_x_Nil)
apply (rule corres_guard_imp[OF dcorres_dummy_corrupt_frame])
apply (clarsimp simp: mapM_x_Cons mapM_x_Nil)
apply (rule corres_guard_imp[OF dcorres_dummy_corrupt_frame])
apply clarsimp+
apply (subst mapM_x_Cons)
apply clarify
apply (subst corrupt_frame_duplicate[symmetric])
apply (subst mapM_x_Cons)
apply clarify
apply (subst corrupt_frame_duplicate[symmetric])
apply (rule corres_guard_imp)
apply (rule corres_split [where P="\<top>" and r'="dc"])
apply clarsimp
apply (drule allI)
apply (drule_tac x = list in spec)
apply simp
apply clarsimp
apply (drule allI)
apply (drule_tac x = list in spec)
apply simp
apply (clarsimp simp:store_word_offs_def)
apply (simp add: store_word_offs_def bind_assoc[symmetric]
state_assert_def[symmetric])
apply (rule corres_state_assert)
apply (rule_tac s_id = s_id and sz = sz in store_word_corres)
apply simp
apply (clarsimp simp: within_page_def in_user_frame_def)
apply (thin_tac "Ball ?S ?P")
apply (rule_tac x=sz in exI)
apply (frule (2) ipc_frame_ptr_at_frame_at)
apply (simp add: obj_at_def a_type_simps)
apply (wp store_word_offs_ipc_frame_wp)
apply clarsimp+
done
apply (simp add: store_word_offs_def bind_assoc[symmetric] state_assert_def[symmetric])
apply (rule corres_state_assert)
apply (rule_tac s_id = s_id and sz = sz in store_word_corres)
apply simp
apply (clarsimp simp: within_page_def in_user_frame_def)
apply (rule_tac x=sz in exI)
apply (frule (2) ipc_frame_ptr_at_frame_at)
apply (simp add: obj_at_def a_type_simps)
apply (wp store_word_offs_ipc_frame_wp)
apply clarsimp+
done
lemma ex_cte_cap_wp_to_not_idle:
"\<lbrakk> ex_cte_cap_wp_to P r s; valid_global_refs s; valid_objs s;
@ -1897,54 +1893,50 @@ lemma ex_cte_cap_wp_to_not_idle:
apply (drule_tac x = a in spec, drule_tac x = b in spec)
apply (clarsimp simp:global_refs_def cte_wp_at_cases dest!:get_tcb_SomeD split:if_splits)
apply (erule disjE)
apply clarsimp
apply (case_tac cap)
apply (clarsimp simp:cap_range_def)+
apply (clarsimp simp:valid_idle_def valid_irq_node_def)
apply (drule_tac x = word in spec)
apply (clarsimp simp:st_tcb_at_def obj_at_def is_cap_table_def)
apply (clarsimp simp:cap_range_def)+
apply (case_tac "get tcb")
apply clarsimp+
apply (clarsimp simp:valid_idle_def valid_irq_node_def)
apply (drule_tac x = word in spec)
apply (clarsimp simp:st_tcb_at_def obj_at_def is_cap_table_def)
apply clarsimp+
apply clarsimp
apply (case_tac cap)
apply (clarsimp simp:cap_range_def)+
apply (rename_tac word)
apply (clarsimp simp:valid_idle_def valid_irq_node_def)
apply (drule_tac x = word in spec)
apply (clarsimp simp:st_tcb_at_def obj_at_def is_cap_table_def)
apply (clarsimp simp:cap_range_def)+
apply (case_tac "get tcb")
apply clarsimp+
apply (rename_tac word)
apply (clarsimp simp:valid_idle_def valid_irq_node_def)
apply (drule_tac x = word in spec)
apply (clarsimp simp:st_tcb_at_def obj_at_def is_cap_table_def)
apply clarsimp+
done
lemma ex_cte_cap_to_not_idle:
"\<lbrakk>valid_global_refs s; valid_objs s; valid_idle s;ex_cte_cap_to r s;valid_irq_node s\<rbrakk>
\<Longrightarrow> not_idle_thread (fst r) s"
by (simp add: ex_cte_cap_wp_to_not_idle)
lemma pspace_aligned_set_cxt_mrs[wp]:
"\<lbrace>ko_at (TCB tcb) thread and pspace_aligned\<rbrace> KHeap_A.set_object thread (TCB (tcb\<lparr>tcb_context := t \<rparr>))\<lbrace>\<lambda>rv. pspace_aligned\<rbrace>"
apply (wp set_object_aligned)
apply (clarsimp simp:obj_at_def)
done
apply (wp set_object_aligned)
apply (clarsimp simp:obj_at_def)
done
lemma pspace_distinct_set_cxt_mrs[wp]:
"\<lbrace>ko_at (TCB tcb) thread and pspace_distinct\<rbrace> KHeap_A.set_object thread (TCB (tcb\<lparr>tcb_context := t \<rparr>))
\<lbrace>\<lambda>rv. pspace_distinct\<rbrace>"
apply (wp set_object_distinct)
apply (clarsimp simp:obj_at_def)
done
apply (wp set_object_distinct)
apply (clarsimp simp:obj_at_def)
done
lemma valid_objs_set_cxt_mrs[wp]:
"\<lbrace>ko_at (TCB tcb) thread and valid_objs\<rbrace> KHeap_A.set_object thread (TCB (tcb\<lparr>tcb_context := t \<rparr>))\<lbrace>\<lambda>rv. valid_objs\<rbrace>"
apply (wp set_object_valid_objs)
apply (clarsimp simp:obj_at_def)
apply (clarsimp simp:valid_objs_def)
apply (drule_tac x=thread in bspec)
apply (clarsimp simp:dom_def)
apply (clarsimp simp:valid_obj_def valid_tcb_def)
apply (drule_tac x="(a,aa,b)" in bspec)
apply simp
apply (clarsimp simp:tcb_cap_cases_def)
apply (erule disjE|clarsimp)+
done
apply (wp set_object_valid_objs)
apply (clarsimp simp:obj_at_def)
apply (clarsimp simp:valid_objs_def)
apply (drule_tac x=thread in bspec)
apply (clarsimp simp:dom_def)
apply (clarsimp simp:valid_obj_def valid_tcb_def)
apply (drule_tac x="(a,aa,b)" in bspec)
apply simp
apply (clarsimp simp:tcb_cap_cases_def)
apply (erule disjE|clarsimp)+
done
lemma ipc_frame_set_cxt_mrs[wp]:
"\<lbrace>ko_at (TCB tcb) thread and ipc_frame_wp_at P a\<rbrace> KHeap_A.set_object thread (TCB (tcb\<lparr>tcb_context := t \<rparr>))\<lbrace>\<lambda>rv. ipc_frame_wp_at P a\<rbrace>"
@ -1976,45 +1968,45 @@ lemma set_mrs_corres:
apply (rule dcorres_absorb_gets_the)
apply (rule corres_guard_imp)
apply (rule corres_split [where r'=dc])
apply (rule corres_dummy_return_l)
apply (rule corres_split [where r'=dc and R'="%x. \<top>" and R="%x. \<top>"])
apply (rule corres_free_return)
apply (rule_tac s_id = y and sz = sz in zip_store_word_corres)
apply (clarsimp simp del:upt.simps)
apply (rule within_page_ipc_buf)
apply ((simp add:msg_align_bits msg_max_length_def)+)[7]
apply (rule corres_dummy_return_l)
apply (rule corres_split [where r'=dc and R'="%x. \<top>" and R="%x. \<top>"])
apply (rule corres_free_return)
apply (rule_tac s_id = y and sz = sz in zip_store_word_corres)
apply (clarsimp simp del:upt.simps)
apply (rule within_page_ipc_buf)
apply ((simp add:msg_align_bits msg_max_length_def)+)[7]
apply wp
apply (clarsimp, drule(1) valid_etcbs_get_tcb_get_etcb)
apply (rule_tac s'=s' in set_cxt_none_det_intent_corres)
apply (clarsimp dest!:get_tcb_SomeD get_etcb_SomeD)+
apply (clarsimp, drule(1) valid_etcbs_get_tcb_get_etcb)
apply (rule_tac s'=s' in set_cxt_none_det_intent_corres)
apply (clarsimp dest!:get_tcb_SomeD get_etcb_SomeD)+
apply (wp set_object_valid_etcbs)
apply (simp del:upt.simps)
apply (auto dest!:get_tcb_SomeD simp:obj_at_def ipc_frame_wp_at_def)
done
apply (simp del:upt.simps)
apply (auto dest!:get_tcb_SomeD simp:obj_at_def ipc_frame_wp_at_def)
done
lemma set_registers_ipc_frame_ptr_at[wp]:
"\<lbrace>ipc_frame_wp_at buf y\<rbrace>as_user thread (set_register r rv) \<lbrace>%x. ipc_frame_wp_at buf y\<rbrace>"
apply (clarsimp simp:as_user_def select_f_def set_register_def simpler_modify_def)
apply wp
apply clarsimp
apply wp
apply (clarsimp simp:valid_def)
apply (assumption)
apply clarsimp
apply wp
apply (clarsimp simp:valid_def)
apply (assumption)
apply wp
apply clarsimp
done
done
lemma set_registers_ipc_buffer_ptr_at[wp]:
"\<lbrace>ipc_buffer_wp_at buf y\<rbrace>as_user thread (set_register r rv) \<lbrace>%x. ipc_buffer_wp_at buf y\<rbrace>"
apply (clarsimp simp:as_user_def select_f_def set_register_def simpler_modify_def)
apply wp
apply clarsimp
apply wp
apply (clarsimp simp:valid_def)
apply (assumption)
apply clarsimp
apply wp
apply (clarsimp simp:valid_def)
apply (assumption)
apply wp
apply clarsimp
done
done
lemma copy_mrs_corres:
@ -2027,39 +2019,39 @@ lemma copy_mrs_corres:
apply (simp add:copy_mrs_def del:upt.simps)
apply (rule dcorres_expand_pfx)
apply (rule corres_guard_imp)
apply (rule corres_split [where r'="dc"])
apply (wpc)
apply (rule corres_dummy_return_l)
apply (rule corres_split [where r'="dc"])
apply (rule corres_free_return[where P="\<top>" and P'="\<top>"])
apply (rule dcorres_dummy_corrupt_frame)
apply wp
apply (clarify,simp del:upt.simps )
apply (rule corres_dummy_return_l)
apply (rule corres_split[where r'="dc"])
apply (rule corres_free_return[where P="\<top>" and P'="\<top>"])
apply (rule_tac s_id = y and sz = sz in zip_cpy_word_corres)
apply (clarsimp simp del:upt.simps)
apply (rule within_page_ipc_buf)
apply simp+
apply (clarsimp simp:msg_align_bits valid_message_info_def msg_max_length_def)
apply (erule less_trans)
apply (rule le_less_trans[where y = "Suc (unat (0x78))"])
apply (rule iffD2[OF Suc_le_mono])
apply (erule iffD1[OF word_le_nat_alt])
apply simp
apply wp
apply (rule set_registers_corres)
apply ((clarsimp|wp)+)[1]
apply (rule corres_split [where r'="dc"])
apply (wpc)
apply (rule corres_dummy_return_l)
apply (rule corres_split [where r'="dc"])
apply (rule corres_free_return[where P="\<top>" and P'="\<top>"])
apply (rule dcorres_dummy_corrupt_frame)
apply wp
apply (clarify,simp del:upt.simps )
apply (rule corres_dummy_return_l)
apply (rule corres_split[where r'="dc"])
apply (rule corres_free_return[where P="\<top>" and P'="\<top>"])
apply (rule_tac s_id = y and sz = sz in zip_cpy_word_corres)
apply (clarsimp simp del:upt.simps)
apply (rule within_page_ipc_buf)
apply simp+
apply (clarsimp simp:msg_align_bits valid_message_info_def msg_max_length_def)
apply (erule less_trans)
apply (rule le_less_trans[where y = "Suc (unat (0x78))"])
apply (rule iffD2[OF Suc_le_mono])
apply (erule iffD1[OF word_le_nat_alt])
apply simp
apply wp
apply (rule set_registers_corres)
apply ((clarsimp|wp)+)[1]
apply (rule mapM_wp_inv)
apply (case_tac rv)
apply clarsimp
apply (wp_once+)[1]
apply clarsimp
apply (wp_once+)[1]
apply (clarsimp|rule conjI)+
apply ((wp|clarsimp)+)[3]
apply (case_tac rv)
apply (clarsimp simp: ipc_buffer_wp_at_def obj_at_def tcb_at_def)+
done
apply (clarsimp simp: ipc_buffer_wp_at_def obj_at_def tcb_at_def)+
done
lemmas transform_cap_simps [simp] = transform_cap_def [split_simps cap.split arch_cap.split]
@ -2072,10 +2064,10 @@ shows "dcorres dc \<top> P (corrupt_frame buf) g"
apply (frule imp)
apply (erule allE, erule (1) impE)
apply (drule_tac x = "(a,ba)" in bspec)
apply simp+
apply simp+
apply (clarsimp simp:bind_def)
apply (rule_tac x = "((),transform ba)" in bexI)
apply simp
apply simp
apply (clarsimp simp:corrupt_tcb_intent_def bind_def)
apply (clarsimp simp:update_thread_def gets_the_def gets_def get_def bind_def in_monad)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
@ -2085,25 +2077,25 @@ shows "dcorres dc \<top> P (corrupt_frame buf) g"
apply (clarsimp simp:simpler_modify_def corrupt_intents_def)
apply (drule(1) valid_etcbs_tcb_etcb, clarsimp)
apply (subst(asm) opt_object_tcb)
apply (erule get_tcb_rev)
apply (erule get_tcb_rev)
apply (erule get_etcb_rev)
apply (simp add:not_idle_thread_def)
apply (simp add:not_idle_thread_def)
apply (clarsimp simp:transform_tcb_def in_monad set_object_def)
apply (rule_tac x = x in exI)
apply (clarsimp simp:transform_def KHeap_D.set_object_def simpler_modify_def)
apply (case_tac "transform b")
apply (clarsimp simp:transform_def map_add_def)
apply (clarsimp simp:transform_def map_add_def)
apply (rule ext)
apply (drule_tac x = xa in fun_cong)
apply (case_tac xa)
apply (clarsimp simp:not_idle_thread_def tcb_ipcframe_id_def restrict_map_def transform_objects_def
split: split_if)
apply (clarsimp dest!:get_tcb_rev simp: transform_objects_tcb
tcb_ipcbuffer_slot_def tcb_pending_op_slot_def)
split: split_if)
apply (clarsimp dest!:get_tcb_rev simp: transform_objects_tcb tcb_ipcbuffer_slot_def
tcb_pending_op_slot_def)
apply (clarsimp simp: tcb_ipcbuffer_slot_def tcb_ipcframe_id_def | rule conjI)+
apply (clarsimp simp:transform_def transform_object_def transform_tcb_def tcb_ipcframe_id_def
tcb_ipcbuffer_slot_def tcb_pending_op_slot_def dest!:get_tcb_SomeD)
done
done
lemma corrupt_frame_include_self':
assumes corres:"dcorres dc \<top> P (do corrupt_frame buf; corrupt_tcb_intent y od) g"
@ -2114,29 +2106,28 @@ shows "dcorres dc \<top> P (corrupt_frame buf) g"
apply (frule imp)
apply (erule allE, erule (1) impE)
apply (drule_tac x = "(a,ba)" in bspec)
apply simp+
apply simp+
apply (clarsimp)
apply (rule_tac x = "((),transform ba)" in bexI)
apply simp+
apply simp+
apply (clarsimp simp:corrupt_frame_def select_def bind_def simpler_modify_def)
apply (clarsimp simp:corrupt_tcb_intent_def update_thread_def
select_def gets_the_def KHeap_D.set_object_def
bind_def gets_def get_def return_def assert_opt_def
fail_def simpler_modify_def split:option.splits)
apply (rule_tac x = "\<lambda>t. if t = y then ?T else x t" in exI)
apply (rule_tac x = "\<lambda>t. if t = y then T else x t" for T in exI)
apply (clarsimp simp:corrupt_intents_def transform_def not_idle_thread_def
restrict_map_def map_add_def opt_object_def
ipc_frame_wp_at_def obj_at_def
split:option.split_asm cdl_object.split_asm)
apply (rule ext)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def tcb_ipcframe_id_def tcb_pending_op_slot_def
transform_object_def not_idle_thread_def transform_tcb_def tcb_ipcbuffer_slot_def)
apply (clarsimp simp: transform_objects_def)
apply (clarsimp split:cap.splits arch_cap.splits)
apply (drule(1) valid_etcbs_tcb_etcb)
apply (fastforce simp:opt_object_def transform_tcb_def tcb_ipcframe_id_def tcb_pending_op_slot_def
tcb_ipcbuffer_slot_def)+
done
restrict_map_def map_add_def opt_object_def ipc_frame_wp_at_def obj_at_def
split:option.split_asm cdl_object.split_asm)
apply (rule ext)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def tcb_ipcframe_id_def tcb_pending_op_slot_def
transform_object_def not_idle_thread_def transform_tcb_def tcb_ipcbuffer_slot_def)
apply (clarsimp simp: transform_objects_def)
apply (clarsimp split:cap.splits arch_cap.splits)
apply (drule(1) valid_etcbs_tcb_etcb)
apply (fastforce simp:opt_object_def transform_tcb_def tcb_ipcframe_id_def tcb_pending_op_slot_def
tcb_ipcbuffer_slot_def)+
done
lemma dcorres_set_mrs:
"dcorres dc \<top>
@ -2145,9 +2136,9 @@ lemma dcorres_set_mrs:
(corrupt_frame buf)
(set_mrs y (Some (buf + (bptr && mask (pageBitsForSize sz)))) b)"
apply (rule corrupt_frame_include_self)
apply (rule corres_guard_imp[OF set_mrs_corres])
apply clarsimp+
done
apply (rule corres_guard_imp[OF set_mrs_corres])
apply clarsimp+
done
lemma dcorres_copy_mrs:
"valid_message_info mi \<Longrightarrow>
@ -2157,20 +2148,20 @@ lemma dcorres_copy_mrs:
(copy_mrs thread rv y (Some (buf + (bptr && mask (pageBitsForSize sz))))
(mi_length mi))"
apply (rule corrupt_frame_include_self)
apply (rule corres_guard_imp[OF copy_mrs_corres])
apply auto
done
apply (rule corres_guard_imp[OF copy_mrs_corres])
apply auto
done
lemma ipc_frame_ptr_at_sz_at:
"\<lbrakk>ko_at (ArchObj (DataPage sz)) obuf s; valid_objs s;ipc_frame_ptr_at obuf thread s \<rbrakk> \<Longrightarrow> ipc_frame_sz_at sz thread s"
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
apply (clarsimp split:cap.splits arch_cap.splits)
apply (frule valid_tcb_objs)
apply (erule get_tcb_rev)
apply (erule get_tcb_rev)
apply (subgoal_tac "valid_cap (tcb_ipcframe tcb) s")
apply (clarsimp simp:valid_cap_def obj_at_def a_type_def split:arch_kernel_obj.splits)
apply (clarsimp simp:valid_cap_def obj_at_def a_type_def split:arch_kernel_obj.splits)
apply (clarsimp simp:valid_tcb_def tcb_cap_cases_def)
done
done
lemma dcorres_store_word_conservative:
" within_page obuf ptr sz \<Longrightarrow>
@ -2181,18 +2172,18 @@ lemma dcorres_store_word_conservative:
(corrupt_frame obuf) (do_machine_op (storeWord ptr b))"
apply (rule dcorres_expand_pfx,clarsimp)
apply (case_tac "\<forall>buf. (\<exists>thread. ipc_frame_ptr_at buf thread s') \<longrightarrow> buf \<noteq> obuf")
apply (rule corres_dummy_return_pl)
apply (rule corres_dummy_return_r)
apply (rule corres_underlying_split)
apply (rule corres_guard_imp[OF dcorres_store_word_safe])
apply simp+
apply (rule hoare_TrueI)[1]
apply (wp do_machine_op_valid_etcbs, simp)
apply (clarsimp simp:dcorres_dummy_corrupt_frame)
apply (rule corres_dummy_return_pl)
apply (rule corres_dummy_return_r)
apply (rule corres_underlying_split)
apply (rule corres_guard_imp[OF dcorres_store_word_safe])
apply simp+
apply (rule hoare_TrueI)[1]
apply (wp do_machine_op_valid_etcbs, simp)
apply (clarsimp simp:dcorres_dummy_corrupt_frame)
apply (clarsimp)
apply (frule ipc_frame_ptr_at_sz_at,simp+)
apply (rule corres_guard_imp[OF store_word_corres])
apply simp+
done
done
end

106
proof/drefine/Interrupt_DR.thy
View File

@ -25,7 +25,7 @@ lemma decode_irq_control_error_corres:
(* Interrupt Control Invocations *)
primrec
primrec (nonexhaustive)
translate_irq_control_invocation :: "Invocations_A.irq_control_invocation \<Rightarrow> cdl_irq_control_invocation"
where
"translate_irq_control_invocation (IRQControl irq p slot) =
@ -188,18 +188,20 @@ lemma option_get_cap_corres:
apply (clarsimp simp:assert_def corres_free_fail assert_opt_def)
apply (case_tac y)
apply (simp_all add:assert_def corres_free_fail)
apply (rename_tac "fun")
apply (case_tac "fun b")
apply (simp add:corres_free_fail)
apply clarsimp
apply (subst cap_slot_cnode_property_lift, assumption, simp_all)[1]
apply fastforce
apply fastforce
apply (clarsimp simp: transform_cap_def)
apply (clarsimp simp:transform_tcb_slot_simp[simplified])
apply (subgoal_tac "get_tcb a x = Some tcb_ext")
apply (rename_tac tcb)
apply (subgoal_tac "get_tcb a x = Some tcb")
apply (frule(1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp:lift_simp not_idle_thread_def)
apply (clarsimp simp: get_tcb_def)
done
done
lemma maskInterrupt_underlying_memory[wp]:
"\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> maskInterrupt a x \<lbrace>\<lambda>x ms. underlying_memory ms = m\<rbrace>"
@ -289,50 +291,50 @@ lemma handle_interrupt_corres:
apply (clarsimp simp:get_irq_state_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_r)+
apply (clarsimp split:irq_state.splits simp:corres_free_fail | rule conjI)+
apply (simp add:Interrupt_D.handle_interrupt_def bind_assoc)
apply (rule corres_guard_imp)
apply (rule_tac Q'="op=s'" in corres_split[OF _ dcorres_get_irq_slot])
apply (rule_tac R'="\<lambda>rv. (\<lambda>s. (is_aep_cap rv \<longrightarrow> aep_at (obj_ref_of rv) s)) and invs and valid_etcbs"
apply (simp add:Interrupt_D.handle_interrupt_def bind_assoc)
apply (rule corres_guard_imp)
apply (rule_tac Q'="op=s'" in corres_split[OF _ dcorres_get_irq_slot])
apply (rule_tac R'="\<lambda>rv. (\<lambda>s. (is_aep_cap rv \<longrightarrow> aep_at (obj_ref_of rv) s)) and invs and valid_etcbs"
in corres_split[OF _ option_get_cap_corres])
apply (case_tac rv'a)
prefer 4
apply (simp_all add:when_def)
apply (clarsimp simp:transform_cap_def when_def is_aep_cap_def | rule conjI)+
apply (rule corres_dummy_return_l)
apply (rule corres_underlying_split [where P'="\<lambda>rv. \<top>" and P = "\<lambda>rv. \<top>"])
apply (rule corres_guard_imp[OF send_async_ipc_corres])
apply (simp+)
apply (clarsimp simp:handle_interrupt_corres_branch dc_def[symmetric])+
apply (simp add: corres_guard_imp[OF handle_interrupt_corres_branch])+
apply (clarsimp simp:transform_cap_def when_def is_aep_cap_def
apply (case_tac rv'a)
prefer 4
apply (simp_all add:when_def)
apply (clarsimp simp:transform_cap_def when_def is_aep_cap_def | rule conjI)+
apply (rule corres_dummy_return_l)
apply (rule corres_underlying_split [where P'="\<lambda>rv. \<top>" and P = "\<lambda>rv. \<top>"])
apply (rule corres_guard_imp[OF send_async_ipc_corres])
apply (simp+)
apply (clarsimp simp:handle_interrupt_corres_branch dc_def[symmetric])+
apply (simp add: corres_guard_imp[OF handle_interrupt_corres_branch])+
apply (clarsimp simp:transform_cap_def when_def is_aep_cap_def
split:arch_cap.splits)+
apply (simp add: corres_guard_imp[OF handle_interrupt_corres_branch])+
apply (simp add: corres_guard_imp[OF handle_interrupt_corres_branch])+
apply (wp valid_state_get_cap_wp|simp add:get_irq_slot_def)+
apply (clarsimp simp:invs_def )
apply (rule irq_node_image_not_idle,simp_all add:valid_state_def)
apply (simp add:invs_def valid_state_def)
apply (simp add:invs_def valid_state_def)
apply (clarsimp simp:Interrupt_D.handle_interrupt_def gets_def)
apply (rule dcorres_absorb_get_l)+
apply (clarsimp simp:CSpace_D.get_irq_slot_def)
apply (subgoal_tac "caps_of_state s'b (interrupt_irq_node s'b x,[])\<noteq> None")
apply (drule irq_state_IRQNotifyAEP_NullCap)
apply ((simp add:invs_def valid_state_def)+)
apply (frule caps_of_state_transform_opt_cap)
apply clarsimp
apply clarsimp
apply (drule(1) irq_node_image_not_idle[where y = x])
apply (clarsimp simp:not_idle_thread_def)
apply (clarsimp simp:transform_cslot_ptr_def)
apply (subgoal_tac "cdl_irq_node (transform s'b) x = (interrupt_irq_node s'b x)")
apply clarsimp
apply (rule corres_guard_imp,rule corres_dummy_return_pl)
apply (simp add: nested_bind bind_assoc)
apply (drule irq_state_IRQNotifyAEP_NullCap)
apply ((simp add:invs_def valid_state_def)+)
apply (frule caps_of_state_transform_opt_cap)
apply clarsimp
apply clarsimp
apply (drule(1) irq_node_image_not_idle[where y = x])
apply (clarsimp simp:not_idle_thread_def)
apply (clarsimp simp:transform_cslot_ptr_def)
apply (subgoal_tac "cdl_irq_node (transform s'b) x = (interrupt_irq_node s'b x)")
apply clarsimp
apply (rule corres_guard_imp,rule corres_dummy_return_pl)
apply (simp add: bind_assoc)
apply (rule dcorres_rhs_noop_above[OF timer_tick_dcorres])
apply (rule dcorres_symb_exec_r[OF dcorres_machine_op_noop])
apply (wp dmo_dwp hoare_TrueI| simp)+
apply (clarsimp simp:transform_def invs_def valid_state_def dest!: valid_irq_node_cte_at_irq_slot )+
apply (rule dcorres_symb_exec_r[OF dcorres_machine_op_noop])
apply (wp dmo_dwp hoare_TrueI| simp)+
apply (clarsimp simp:transform_def invs_def valid_state_def dest!: valid_irq_node_cte_at_irq_slot )+
apply (simp add:cte_wp_at_caps_of_state)
done
done
lemma set_irq_state_original:
"\<lbrace>\<lambda>s. P (is_original_cap s slot)\<rbrace> set_irq_state a b
@ -356,6 +358,7 @@ lemma dcorres_invoke_irq_control:
(Interrupt_A.invoke_irq_control irq_control_invocation)"
apply (case_tac irq_control_invocation)
apply (simp_all add:arch_invoke_irq_control_def corres_free_fail)
apply (rename_tac word p1 p2)
apply (clarsimp simp:liftE_def bind_assoc)
apply (rule dcorres_symb_exec_r_strong)
apply (simp add:Interrupt_D.invoke_irq_control_def)
@ -380,7 +383,7 @@ lemma dcorres_invoke_irq_control:
apply wp
apply (strengthen impI[OF invs_valid_idle] impI[OF invs_mdb])
apply (wp set_irq_state_invs)
apply (clarsimp simp:invs_def valid_state_def valid_pspace_def)
apply (clarsimp simp:invs_def valid_state_def valid_pspace_def)
apply (rule conjI)
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (erule irq_revocableD)
@ -391,22 +394,19 @@ lemma dcorres_invoke_irq_control:
apply clarsimp
apply simp
apply (drule_tac r = "(aa,ba)" in ex_cte_cap_wp_to_not_idle)
apply (clarsimp simp:not_idle_thread_def)+
apply (clarsimp simp:not_idle_thread_def)+
apply (wp set_irq_state_dwp,simp)
done
lemma op_eq_simp:"(op = y) = (\<lambda>x. x = y)"
apply (rule ext)
apply auto
done
lemma op_eq_simp: "(op = y) = (\<lambda>x. x = y)" by auto
lemma get_irq_slot_not_idle_wp:
"\<lbrace>valid_idle and valid_irq_node \<rbrace> KHeap_A.get_irq_slot word \<lbrace>\<lambda>rv. not_idle_thread (fst rv)\<rbrace>"
apply (clarsimp simp:get_irq_slot_def)
apply (rule irq_node_image_not_idle)
apply simp+
done
apply simp+
done
lemma get_irq_slot_ex_cte_cap_wp_to:
"\<lbrace>\<lambda>s. valid_irq_node s \<and> (\<exists>slot. cte_wp_at (op = (cap.IRQHandlerCap w)) slot s)\<rbrace> KHeap_A.get_irq_slot w
@ -415,8 +415,8 @@ lemma get_irq_slot_ex_cte_cap_wp_to:
apply (clarsimp simp:ex_cte_cap_wp_to_def valid_irq_node_def)
apply (rule exI)+
apply (erule cte_wp_at_weakenE)
apply clarsimp
done
apply clarsimp
done
crunch is_original[wp] : fast_finalise "\<lambda>s. is_original_cap s slot"
@ -427,11 +427,11 @@ lemma cap_delete_one_original:
\<lbrace>\<lambda>r s. is_original_cap s slot\<rbrace>"
apply (clarsimp simp:cap_delete_one_def unless_def)
apply (wp hoare_when_wp)
apply (clarsimp simp:empty_slot_def)
apply wp
apply (clarsimp simp:set_cdt_def)
apply (wp dxo_wp_weak | clarsimp)+
done
apply (clarsimp simp:empty_slot_def)
apply wp
apply (clarsimp simp:set_cdt_def)
apply (wp dxo_wp_weak | clarsimp)+
done
lemma cte_wp_at_neq_slot_set_cap:
@ -439,7 +439,7 @@ lemma cte_wp_at_neq_slot_set_cap:
CSpaceAcc_A.set_cap cap.NullCap slot' \<lbrace>\<lambda>rv. cte_wp_at P slot\<rbrace>"
apply (wp set_cap_cte_wp_at_cases)
apply (clarsimp simp:cte_wp_at_def)
done
done
lemma cte_wp_at_neq_slot_cap_delete_one:
"slot\<noteq> slot' \<Longrightarrow> \<lbrace>cte_wp_at P slot\<rbrace> cap_delete_one slot'

395
proof/drefine/Ipc_DR.thy
View File

@ -12,8 +12,6 @@ theory Ipc_DR
imports CNode_DR
begin
declare option.weak_case_cong[cong]
abbreviation
"thread_is_running y s \<equiv> st_tcb_at (op=Structures_A.thread_state.Running) y s"
@ -28,7 +26,7 @@ lemma set_thread_state_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s) \<rbrace> set_thread_state thread x \<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (simp add:set_thread_state_def)
apply (wp set_object_cur_thread_idle_thread dxo_wp_weak | simp)+
done
done
lemma thread_set_cur_thread_idle_thread:
" \<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> thread_set (tcb_fault_update Map.empty) word \<lbrace>\<lambda>xg s. P (cur_thread s) (idle_thread s)\<rbrace>"
@ -518,7 +516,7 @@ lemma dcorres_do_async_transfer:
apply (wp | clarsimp simp:not_idle_thread_def)+
apply (simp add:gets_the_def gets_def bind_assoc get_def split_def get_ipc_buffer_def tcb_at_def
exs_valid_def fail_def return_def bind_def assert_opt_def split:cdl_cap.splits)
apply (rule_tac x = "(?a,?b)" in bexI)
apply (rule_tac x = "(a,b)" for a b in bexI)
apply (rule conjI|fastforce simp:fail_def return_def split:option.splits)+
apply (clarsimp split:option.splits simp:fail_def | rule conjI)+
apply (subst opt_cap_tcb)
@ -712,52 +710,53 @@ lemma recv_async_ipc_corres:
(recv_async_ipc thread cap)
(receive_async_ipc thread cap')"
apply (clarsimp simp:receive_async_ipc_def invs_def recv_async_ipc_def corres_free_fail split:cap.splits)
apply (rename_tac word1 word2 rights)
apply (rule dcorres_expand_pfx)
apply (rule_tac Q' = "\<lambda>r. op = s' and ko_at (kernel_object.AsyncEndpoint r) word1 and valid_aep r" in corres_symb_exec_r)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:obj_at_def is_aep_def)
apply (simp add:gets_def bind_assoc option_select_def)
apply (rule dcorres_absorb_get_l)
apply (frule get_async_ep_pick,simp)
apply (case_tac rv)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def cap_object_simps
valid_aep_abstract_def none_is_waiting_aep_def)
apply (rule corres_guard_imp)
apply (rule corres_alternate1)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ set_thread_state_block_on_async_recv_corres])
apply (rule corres_dummy_set_async_ep,simp)
apply (wp|simp)+
apply (clarsimp simp:st_tcb_at_def tcb_at_def obj_at_def get_tcb_rev)
(* WaitingAEP *)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:obj_at_def is_aep_def)
apply (simp add:gets_def bind_assoc option_select_def)
apply (rule dcorres_absorb_get_l)
apply (frule get_async_ep_pick,simp)
apply (case_tac rv)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def cap_object_simps valid_aep_abstract_def
none_is_waiting_aep_def)
apply (rule corres_guard_imp)
apply (rule corres_alternate1)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ set_thread_state_block_on_async_recv_corres])
apply (rule corres_dummy_set_async_ep,simp)
apply (wp|simp)+
apply (clarsimp simp:st_tcb_at_def tcb_at_def obj_at_def get_tcb_rev)
(* WaitingAEP *)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def
valid_aep_abstract_def none_is_waiting_aep_def cap_object_simps)
valid_aep_abstract_def none_is_waiting_aep_def cap_object_simps)
apply (rule conjI)
apply (clarsimp simp:neq_Nil_conv)
apply (clarsimp simp:neq_Nil_conv)
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ set_thread_state_block_on_async_recv_corres])
apply (rule corres_dummy_set_async_ep,simp+)
apply (rule corres_dummy_set_async_ep,simp+)
apply (fastforce simp:st_tcb_at_def obj_at_def get_tcb_rev)
(* Active AEP list *)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def
valid_aep_abstract_def none_is_waiting_aep_def cap_object_simps)
apply (rule corres_alternate2)
apply (rule corres_guard_imp )
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF corres_dummy_set_async_ep dcorres_do_async_transfer])
apply (wp|clarsimp)+
apply (clarsimp simp:valid_pspace_def st_tcb_at_tcb_at)
apply wp
apply (rule_tac Q="\<lambda>r. ko_at (kernel_object.AsyncEndpoint r) word1 and valid_state" in hoare_strengthen_post)
apply (wp get_aep_ko | clarsimp)+
apply (rule valid_objs_valid_aep_simp)
apply (clarsimp simp:valid_objs_valid_aep_simp valid_state_def valid_pspace_def)
apply (simp add:obj_at_def)
(* Active AEP list *)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def
valid_aep_abstract_def none_is_waiting_aep_def cap_object_simps)
apply (rule corres_alternate2)
apply (rule corres_guard_imp )
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF corres_dummy_set_async_ep dcorres_do_async_transfer])
apply (wp|clarsimp)+
apply (clarsimp simp:valid_pspace_def st_tcb_at_tcb_at)
apply wp
apply (rule_tac Q="\<lambda>r. ko_at (kernel_object.AsyncEndpoint r) word1 and valid_state" in hoare_strengthen_post)
apply (wp get_aep_ko | clarsimp)+
apply (rule valid_objs_valid_aep_simp)
apply (clarsimp simp:valid_objs_valid_aep_simp valid_state_def valid_pspace_def)
apply (simp add:obj_at_def)
apply (clarsimp|wp)+
done
done
lemma send_async_ipc_corres:
"ep_id = epptr \<Longrightarrow> dcorres dc \<top> (invs and valid_etcbs)
@ -771,34 +770,35 @@ lemma send_async_ipc_corres:
apply (rule dcorres_absorb_get_l)
apply clarsimp
apply (frule valid_objs_valid_aep_simp[rotated])
apply (simp add:valid_state_def valid_pspace_def)
apply (simp add:valid_state_def valid_pspace_def)
apply (rename_tac async_ep s)
apply (case_tac async_ep)
apply (simp add:gets_def bind_assoc option_select_def)
apply (frule get_async_ep_pick,simp)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def valid_aep_abstract_def none_is_waiting_aep_def)
apply (rule corres_guard_imp,rule corres_dummy_set_async_ep,simp+)
(* Waiting AEP list *)
apply (simp add:gets_def bind_assoc option_select_def)
apply (frule get_async_ep_pick,simp)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def valid_aep_abstract_def)
apply (rule conjI)
apply (clarsimp simp: dest!:not_empty_list_not_empty_set)
apply (clarsimp simp:neq_Nil_conv)
apply (rule corres_guard_imp)
apply (rule select_pick_corres)
apply (rule corres_update_waiting_aep_do_async_transfer)
apply (drule_tac s = "insert y (set ys)" in sym)
apply (clarsimp simp:image_def)
apply (drule_tac s = "insert y (set ys)" in sym)
apply (drule_tac x = y in eqset_imp_iff)
apply (clarsimp simp:valid_pspace_def aep_waiting_set_def)
apply (clarsimp simp: st_tcb_at_def obj_at_def valid_aep_def split:list.splits)
(* ActiveAEP *)
apply (clarsimp simp:gets_def bind_assoc option_select_def)
apply (simp add:gets_def bind_assoc option_select_def)
apply (frule get_async_ep_pick,simp)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def valid_aep_abstract_def none_is_waiting_aep_def)
apply (rule corres_guard_imp,rule corres_dummy_set_async_ep,simp+)
done
(* Waiting AEP list *)
apply (simp add:gets_def bind_assoc option_select_def)
apply (frule get_async_ep_pick,simp)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def valid_aep_abstract_def)
apply (rule conjI)
apply (clarsimp simp: dest!:not_empty_list_not_empty_set)
apply (clarsimp simp:neq_Nil_conv)
apply (rule corres_guard_imp)
apply (rule select_pick_corres)
apply (rule corres_update_waiting_aep_do_async_transfer)
apply (drule_tac s = "insert y (set ys)" in sym)
apply (clarsimp simp:image_def)
apply (drule_tac s = "insert y (set ys)" in sym)
apply (drule_tac x = y in eqset_imp_iff)
apply (clarsimp simp:valid_pspace_def aep_waiting_set_def)
apply (clarsimp simp: st_tcb_at_def obj_at_def valid_aep_def split:list.splits)
(* ActiveAEP *)
apply (clarsimp simp:gets_def bind_assoc option_select_def)
apply (frule get_async_ep_pick,simp)
apply (clarsimp simp:aep_waiting_set_lift valid_state_def valid_aep_abstract_def none_is_waiting_aep_def)
apply (rule corres_guard_imp,rule corres_dummy_set_async_ep,simp+)
done
lemma set_thread_state_block_on_send_corres:
"dcorres dc \<top>
@ -840,15 +840,15 @@ lemma corres_setup_caller_cap:
apply (clarsimp simp:not_idle_thread_def tcb_at_def obj_at_def st_tcb_at_def)
apply (rule conjI|clarsimp simp:is_tcb_def)+
apply (drule valid_tcb_objs)
apply (erule get_tcb_rev)
apply (simp add:valid_tcb_state_def)
done
apply (erule get_tcb_rev)
apply (simp add:valid_tcb_state_def)
done
lemma seq_alt_when:"(do a \<leftarrow> when c (f \<sqinter> g); h a od) = ((do a\<leftarrow>when c f ; h a od)\<sqinter> (do a\<leftarrow>when c g; h a od))"
apply (clarsimp simp:when_def)
apply (subst alternative_bind_distrib)+
apply (clarsimp simp:alternative_def)
done
apply (clarsimp simp:when_def)
apply (subst alternative_bind_distrib)+
apply (clarsimp simp:alternative_def)
done
lemma evalMonad_mapM:
assumes as:"evalMonad (mapM f ls) s = Some v"
@ -942,46 +942,48 @@ lemma dcorres_set_extra_badge:
(set_extra_badge rcv_buffer w n)"
apply (clarsimp simp:set_extra_badge_def corrupt_ipc_buffer_def)
apply (rule dcorres_expand_pfx)
apply clarsimp
apply (frule lookup_ipc_buffer_SomeB_evalMonad)
apply clarsimp
apply (rule corres_guard_imp)
apply clarsimp
apply (frule lookup_ipc_buffer_SomeB_evalMonad)
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_symb_exec_l)
apply (rule_tac F = "rv = Some b" in corres_gen_asm)
apply (clarsimp)
apply (rule dcorres_store_word_offs_spec)
apply (drule_tac x = "buffer_cptr_index + n" and sz = sz in within_page_ipc_buf)
apply (simp add:of_nat_add)+
apply (simp add:obj_at_def cte_wp_at_cases)
apply (drule_tac t = "tcb_ipcframe obj" in sym)
apply (fastforce simp:ipc_frame_wp_at_def obj_at_def)
apply (simp add:obj_at_def cte_wp_at_cases)
apply (drule_tac t = "tcb_ipcframe obj" in sym)
apply (fastforce simp:ipc_frame_wp_at_def obj_at_def)
apply (simp add:ipc_buffer_wp_at_def obj_at_def)
apply (rule_tac F = "rv = Some b" in corres_gen_asm)
apply (clarsimp)
apply (rule dcorres_store_word_offs_spec)
apply (drule_tac x = "buffer_cptr_index + n" and sz = sz in within_page_ipc_buf)
apply (simp)+
apply (simp add:obj_at_def cte_wp_at_cases)
apply (drule_tac t = "tcb_ipcframe obj" in sym)
apply (fastforce simp:ipc_frame_wp_at_def obj_at_def)
apply (simp add:obj_at_def cte_wp_at_cases)
apply (drule_tac t = "tcb_ipcframe obj" in sym)
apply (fastforce simp:ipc_frame_wp_at_def obj_at_def)
apply (simp add:ipc_buffer_wp_at_def obj_at_def)
apply (clarsimp simp:msg_max_length_def max_ipc_words_def buffer_cptr_index_def
capTransferDataSize_def msgMaxLength_def msgMaxExtraCaps_def msgExtraCapBits_def msg_align_bits)
apply (simp add:of_nat_mult)
capTransferDataSize_def msgMaxLength_def msgMaxExtraCaps_def
msgExtraCapBits_def msg_align_bits)
apply (simp)
apply (clarsimp simp:get_ipc_buffer_def gets_the_def exs_valid_def gets_def
get_def bind_def return_def assert_opt_def fail_def split:option.splits | rule conjI)+
apply (subgoal_tac "s = transform s'")
prefer 2
apply simp+
apply (rule exI)
apply (clarsimp simp: obj_at_def, frule(1) valid_etcbs_tcb_etcb)
apply (subst opt_cap_tcb)
apply (rule get_tcb_rev, simp)
apply (clarsimp simp: get_etcb_def)
get_def bind_def return_def assert_opt_def fail_def
split:option.splits | rule conjI)+
apply (subgoal_tac "s = transform s'")
prefer 2
apply simp+
apply (rule exI)
apply (clarsimp simp: obj_at_def, frule(1) valid_etcbs_tcb_etcb)
apply (subst opt_cap_tcb)
apply (rule get_tcb_rev, simp)
apply (clarsimp simp: get_etcb_def)
apply (simp add:obj_at_def not_idle_thread_def)+
apply (simp split:cdl_cap.splits)
apply (wp cdl_get_ipc_buffer_Some)
apply (drule lookup_ipc_buffer_SomeB_evalMonad)
apply (fastforce simp:cte_wp_at_def)
apply (clarsimp simp:tcb_at_def get_tcb_SomeD obj_at_def not_idle_thread_def)+
apply (simp split:cdl_cap.splits)
apply (wp cdl_get_ipc_buffer_Some)
apply (drule lookup_ipc_buffer_SomeB_evalMonad)
apply (fastforce simp:cte_wp_at_def)
apply (clarsimp simp:tcb_at_def get_tcb_SomeD obj_at_def not_idle_thread_def)+
apply (clarsimp simp:cte_wp_at_cases obj_at_def)
apply (drule_tac t = "tcb_ipcframe obj" in sym)
apply (fastforce simp:ipc_frame_wp_at_def obj_at_def)
done
done
definition
"dest_of xs \<equiv> case xs of [] \<Rightarrow> None | [r] \<Rightarrow> Some (transform_cslot_ptr r)"
@ -1007,49 +1009,50 @@ lemma evalMonad_thread_get_eq:
"evalMonad (thread_get f x) b = (case (get_tcb x b) of None \<Rightarrow> None | Some t \<Rightarrow> Some (f t))"
apply (simp add:thread_get_def)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_simps weak_det_spec_simps)+
apply wp
apply clarsimp
apply (simp add:empty_when_fail_simps weak_det_spec_simps)+
apply wp
apply clarsimp
apply (clarsimp simp:gets_the_def gets_def get_def bind_def return_def assert_opt_def)
apply (case_tac "get_tcb x b")
apply (clarsimp simp:return_def fail_def evalMonad_def split:option.splits)+
done
apply (clarsimp simp:return_def fail_def evalMonad_def split:option.splits)+
done
lemma evalMonad_lookup_ipc_buffer_wp:
assumes cte_wp:"\<And>P slot. (\<And>c. P c \<Longrightarrow> \<not> is_untyped_cap c)
\<Longrightarrow> \<lbrace>cte_wp_at (P and op\<noteq> cap.NullCap) slot\<rbrace> f \<lbrace>\<lambda>r. cte_wp_at P slot\<rbrace>"
assumes tcb_wp:"\<And>P buf t. \<lbrace>ipc_buffer_wp_at buf t\<rbrace> f \<lbrace>\<lambda>r. ipc_buffer_wp_at buf t \<rbrace>"
assumes tcb_wp:"\<And>buf t. \<lbrace>ipc_buffer_wp_at buf t\<rbrace> f \<lbrace>\<lambda>r. ipc_buffer_wp_at buf t \<rbrace>"
shows "\<lbrace>\<lambda>s. evalMonad (lookup_ipc_buffer in_receive x) s = Some (Some buf)\<rbrace> f \<lbrace>\<lambda>rv s. evalMonad (lookup_ipc_buffer in_receive x) s = Some (Some buf)\<rbrace>"
apply (simp add:valid_def lookup_ipc_buffer_def)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_thread_get weak_det_spec_thread_get)+
apply wp
apply (clarsimp split:option.split_asm simp:evalMonad_thread_get_eq)
apply (frule use_valid[OF _ tcb_wp])
apply (clarsimp dest!:get_tcb_SomeD simp:ipc_buffer_wp_at_def obj_at_def)
apply (fastforce)
apply (clarsimp simp:ipc_buffer_wp_at_def obj_at_def dest!:get_tcb_rev)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_thread_get weak_det_spec_thread_get)+
apply wp
apply (subst (asm) evalMonad_compose)
apply (simp add:empty_when_fail_get_cap weak_det_spec_get_cap)+
apply wp
apply (clarsimp simp:evalMonad_get_cap split:option.split_asm cap.split_asm)
apply (drule caps_of_state_cteD)
apply (frule_tac P1 = "op = (cap.ArchObjectCap arch_cap)" in use_valid[OF _ cte_wp])
apply (clarsimp simp:is_cap_simps)
apply (erule cte_wp_at_weakenE)
apply clarsimp
apply (clarsimp simp:cte_wp_at_caps_of_state evalMonad_thread_get_eq)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_get_cap weak_det_spec_get_cap)+
apply wp
apply (simp add:evalMonad_get_cap)
apply (case_tac arch_cap)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_thread_get weak_det_spec_thread_get)+
apply wp
apply (clarsimp split:option.split_asm simp:evalMonad_thread_get_eq)
apply (frule use_valid[OF _ tcb_wp])
apply (clarsimp dest!:get_tcb_SomeD simp:ipc_buffer_wp_at_def obj_at_def)
apply (fastforce)
apply (clarsimp simp:ipc_buffer_wp_at_def obj_at_def dest!:get_tcb_rev)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_thread_get weak_det_spec_thread_get)+
apply wp
apply (subst (asm) evalMonad_compose)
apply (simp add:empty_when_fail_get_cap weak_det_spec_get_cap)+
apply wp
apply (clarsimp simp:evalMonad_get_cap split:option.split_asm cap.split_asm)
apply (drule caps_of_state_cteD)
apply (rename_tac arch_cap)
apply (frule_tac P1 = "op = (cap.ArchObjectCap arch_cap)" in use_valid[OF _ cte_wp])
apply (clarsimp simp:is_cap_simps)
apply (erule cte_wp_at_weakenE)
apply clarsimp
apply (clarsimp simp:cte_wp_at_caps_of_state evalMonad_thread_get_eq)
apply (subst evalMonad_compose)
apply (simp add:empty_when_fail_get_cap weak_det_spec_get_cap)+
apply wp
apply (simp add:evalMonad_get_cap)
apply (case_tac arch_cap)
apply simp_all
apply (clarsimp simp:evalMonad_def return_def split:if_splits)
done
apply (clarsimp simp:evalMonad_def return_def split:if_splits)
done
crunch ipc_buffer_wp_at[wp]: update_cdt "ipc_buffer_wp_at buf t"
(wp: crunch_wps simp: crunch_simps Retype_A.detype_def set_cdt_def ipc_buffer_wp_at_def ignore:clearMemory)
@ -1065,7 +1068,7 @@ lemma ipc_buffer_wp_set_cap[wp]:
apply (simp add:get_object_def gets_def get_def bind_def return_def assert_def fail_def valid_def)
apply (clarsimp split:Structures_A.kernel_object.splits simp:return_def set_object_def fail_def get_def put_def bind_def)
apply (rule conjI|clarsimp simp:ipc_buffer_wp_at_def obj_at_def)+
done
done
lemma ipc_buffer_wp_at_cap_insert_ext[wp]:
"\<lbrace>ipc_buffer_wp_at buf t \<rbrace> cap_insert_ext src_parent src_slot dest_slot src_p dest_p \<lbrace>\<lambda>r. ipc_buffer_wp_at buf t\<rbrace>"
@ -1159,17 +1162,17 @@ next
apply (rule dcorres_set_extra_badge,simp)
apply wp[1]
apply (simp add: store_word_offs_def set_extra_badge_def
not_idle_thread_def ipc_frame_wp_at_def
split_def)
not_idle_thread_def ipc_frame_wp_at_def
split_def)
apply (wp evalMonad_lookup_ipc_buffer_wp)
apply (erule cte_wp_at_weakenE)
apply (simp add:ipc_buffer_wp_at_def)+
apply wp
apply (wp hoare_vcg_ex_lift valid_irq_node_typ hoare_vcg_ball_lift)[3]
apply simp
apply (erule cte_wp_at_weakenE)
apply (simp add:ipc_buffer_wp_at_def)+
apply wp
apply (wp hoare_vcg_ex_lift valid_irq_node_typ hoare_vcg_ball_lift)[3]
apply simp
apply (fastforce simp: not_idle_thread_def ipc_frame_wp_at_def ipc_buffer_def)
apply (subgoal_tac "\<not>(Types_D.is_ep_cap (transform_cap cap) \<and>
(\<exists>z. ep' = Some z \<and> z = cap_object (transform_cap cap)))")
(\<exists>z. ep' = Some z \<and> z = cap_object (transform_cap cap)))")
prefer 2
apply (clarsimp simp: is_cap_simps cap_type_simps split: cdl_cap.splits)
apply (simp del: de_Morgan_conj split del: split_if)
@ -1218,40 +1221,36 @@ next
apply wp[1]
apply (simp add: split_def not_idle_thread_def)
apply (wp evalMonad_lookup_ipc_buffer_wp )
apply (rule hoare_pre)
apply (rule cap_insert_weak_cte_wp_at_not_null)
apply clarsimp+
apply (wp cap_insert_idle valid_irq_node_typ
hoare_vcg_ball_lift cap_insert_cte_wp_at)
apply (rule validE_validE_R)
apply (rule hoare_pre)
apply (rule cap_insert_weak_cte_wp_at_not_null)
apply clarsimp+
apply (wp cap_insert_idle valid_irq_node_typ hoare_vcg_ball_lift cap_insert_cte_wp_at)
apply (rule validE_validE_R)
apply (wp whenE_throwError_wp)[1]
apply wp
apply (clarsimp)
apply (rule hoareE_TrueI)
apply (rule validE_R_validE)
apply (simp add:conj_ac ball_conj_distrib
split del:if_splits
del:split_paired_Ex split_paired_All split_paired_Ball split_paired_Bex
split_paired_all)
apply (rule_tac Q' ="\<lambda>cap' s. (cap'\<noteq> cap.NullCap \<longrightarrow>(
(cte_wp_at (is_derived (cdt s) (slot_ptr, slot_idx) cap') (slot_ptr, slot_idx) s)
\<and> pspace_aligned s \<and> pspace_distinct s \<and> valid_objs s \<and> valid_idle s
\<and> valid_mdb s \<and> ?QM s cap'))"
in hoare_post_imp_R)
prefer 2
apply (subgoal_tac "r\<noteq> cap.NullCap \<longrightarrow> cte_wp_at (op \<noteq> cap.NullCap) (slot_ptr, slot_idx) s")
apply (intro impI)
apply simp
apply (elim conjE)
apply (erule conjE)
apply simp
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (subst imp_conjR)
apply (rule hoare_vcg_conj_liftE_R)
apply (rule derive_cap_is_derived)
apply (rule derive_cap_is_derived_foo)
apply wp
apply (simp split del: split_if)
apply (clarsimp)
apply (rule hoareE_TrueI)
apply (rule validE_R_validE)
apply (simp add:conj_comms ball_conj_distrib split del:split_if)
apply (rule_tac Q' ="\<lambda>cap' s. (cap'\<noteq> cap.NullCap \<longrightarrow>(
(cte_wp_at (is_derived (cdt s) (slot_ptr, slot_idx) cap') (slot_ptr, slot_idx) s)
\<and> pspace_aligned s \<and> pspace_distinct s \<and> valid_objs s \<and> valid_idle s
\<and> valid_mdb s \<and> QM s cap'))" for QM
in hoare_post_imp_R)
prefer 2
apply (subgoal_tac "r\<noteq> cap.NullCap \<longrightarrow> cte_wp_at (op \<noteq> cap.NullCap) (slot_ptr, slot_idx) s")
apply (intro impI)
apply simp
apply (elim conjE)
apply (erule conjE)
apply simp
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (subst imp_conjR)
apply (rule hoare_vcg_conj_liftE_R)
apply (rule derive_cap_is_derived)
apply (rule derive_cap_is_derived_foo)
apply wp
apply (simp split del: split_if)
apply (clarsimp split del: split_if cong: conj_cong)
apply (rule conjI)
apply (clarsimp simp: valid_mdb_def mdb_cte_at_def cte_wp_at_caps_of_state)
@ -1266,14 +1265,11 @@ next
apply (clarsimp split del: split_if)
apply (clarsimp simp: cte_wp_at_caps_of_state not_idle_thread_def)
apply (rule conjI)
apply (clarsimp simp: not_idle_thread_def valid_idle_def st_tcb_at_def
obj_at_def is_cap_table_def)
apply (clarsimp simp: not_idle_thread_def valid_idle_def st_tcb_at_def obj_at_def is_cap_table_def)
apply (rule conjI)
apply (clarsimp simp: not_idle_thread_def valid_idle_def st_tcb_at_def
obj_at_def is_cap_table_def)
apply (clarsimp simp: not_idle_thread_def valid_idle_def st_tcb_at_def obj_at_def is_cap_table_def)
apply (rule conjI)
apply (clarsimp simp: not_idle_thread_def valid_idle_def st_tcb_at_def
obj_at_def is_cap_table_def)
apply (clarsimp simp: not_idle_thread_def valid_idle_def st_tcb_at_def obj_at_def is_cap_table_def)
apply (rule conjI)
apply (rule rev_mp[OF _ real_cte_tcb_valid])
apply simp
@ -1360,9 +1356,11 @@ lemma get_receive_slot_dcorres:
apply (simp add:tcb_slot_pending_ipc_neq[symmetric])
apply (case_tac "tcb_ipcframe obj")
apply (simp_all add:dest_of_def)
apply (rename_tac arch_cap)
apply (case_tac "arch_cap")
apply (simp_all add:dest_of_def)
apply (clarsimp simp:transform_cap_def)
apply (rename_tac word set vm opt)
apply (drule_tac x = word in spec)
apply (drule_tac x = "set" in spec)
apply (clarsimp simp:cte_wp_at_cases dest!:get_tcb_SomeD)
@ -1451,6 +1449,7 @@ lemma dcorres_dummy_corrupt_ipc_buffer:
apply simp_all
apply (rule corres_guard_imp[OF dummy_corrupt_tcb_intent_corres]
,(clarsimp simp:not_idle_thread_def tcb_at_def)+)+
apply (rename_tac arch_cap etcb)
apply (case_tac "arch_cap")
apply simp_all
apply (rule corres_guard_imp[OF dummy_corrupt_tcb_intent_corres]
@ -1609,7 +1608,7 @@ lemma dcorres_copy_mrs':
apply (rule corres_split[OF _ set_registers_corres])
apply (rule corres_symb_exec_r)+
apply (rule corres_trivial[OF corres_free_return])
apply (wp|clarsimp simp:option.cases split:option.splits)+
apply (wp|clarsimp split:option.splits)+
apply (clarsimp simp:get_ipc_buffer_def gets_the_def exs_valid_def gets_def
get_def bind_def return_def assert_opt_def fail_def split:option.splits | rule conjI)+
apply (frule(1) tcb_at_is_etcb_at, clarsimp simp: is_etcb_at_def, fold get_etcb_def)
@ -1644,7 +1643,10 @@ lemma dcorres_copy_mrs':
done
lemma opt_cap_valid_etcbs: "\<lbrakk>tcb_at ptr s; valid_etcbs s; ptr \<noteq> idle_thread s; sl \<in> tcb_abstract_slots \<or> sl = tcb_pending_op_slot\<rbrakk> \<Longrightarrow> \<exists>cap. opt_cap (ptr, sl) (transform s) = Some cap"
lemma opt_cap_valid_etcbs:
"\<lbrakk>tcb_at ptr s; valid_etcbs s; ptr \<noteq> idle_thread s;
sl \<in> tcb_abstract_slots \<or> sl = tcb_pending_op_slot\<rbrakk> \<Longrightarrow>
\<exists>cap. opt_cap (ptr, sl) (transform s) = Some cap"
apply (clarsimp simp: tcb_at_def)
apply (frule(1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp: opt_cap_tcb)
@ -1741,6 +1743,7 @@ shows "\<lbrace>\<lambda>s. evalMonad (lookup_ipc_buffer in_receive x) s = Some
apply (fastforce simp:evalMonad_def return_def)
apply (clarsimp simp:evalMonad_get_cap split:option.split_asm cap.split_asm)
apply (drule caps_of_state_cteD)
apply (rename_tac arch_cap)
apply (frule_tac P1 = "op = (cap.ArchObjectCap arch_cap)" in use_valid[OF _ cte_wp])
apply (erule cte_wp_at_weakenE)
apply clarsimp
@ -1757,19 +1760,20 @@ done
lemma ipc_buffer_wp_at_copy_mrs[wp]:
"\<lbrace>ipc_buffer_wp_at buf t \<rbrace> copy_mrs send rva recv rv (mi_length (data_to_message_info (tcb_context obj' msg_info_register)))
\<lbrace>\<lambda>r. ipc_buffer_wp_at buf t\<rbrace>"
apply (simp add:copy_mrs_def)
apply (wp|wpc)+
unfolding copy_mrs_def
apply (wp|wpc)+
apply (wp mapM_wp)
apply (simp add:store_word_offs_def ipc_buffer_wp_at_def)
apply wp
prefer 2
apply fastforce
apply (clarsimp simp:ipc_buffer_wp_at_def)
apply (rule_tac Q="\<lambda>rv. ipc_buffer_wp_at buf t" in hoare_strengthen_post)
apply (rule_tac Q="\<lambda>rv. ipc_buffer_wp_at buf t" in hoare_strengthen_post)
apply (wp mapM_wp)
apply fastforce
apply (clarsimp)
done
apply fastforce
apply (clarsimp)
apply wp
done
lemma copy_mrs_valid_irq_node:
"\<lbrace>valid_irq_node\<rbrace> copy_mrs a b c d e
@ -2207,6 +2211,7 @@ lemma recv_sync_ipc_corres:
apply (simp add:valid_state_def)
apply simp
apply (clarsimp simp:option_select_def valid_ep_abstract_def)
apply (rename_tac list)
apply (drule_tac s = "set list" in sym)
apply (rule conjI, clarsimp dest!: not_empty_list_not_empty_set)
apply (clarsimp simp:neq_Nil_conv)
@ -2386,6 +2391,7 @@ lemma send_sync_ipc_corres:
apply (clarsimp simp:valid_ep_abstract_def split del:if_splits)
apply (subst option_select_not_empty)
apply (clarsimp simp: dest!: not_empty_list_not_empty_set)
apply (rename_tac list)
apply (drule_tac s = "set list" in sym)
apply (clarsimp simp: bind_assoc neq_Nil_conv)
apply (rule_tac P1="\<top>" and P'="op = s'a" and x1 = y
@ -2452,11 +2458,6 @@ lemma send_sync_ipc_corres:
apply fastforce
done
lemma dcorres_injection_handler_rhs:
"dcorres (dc \<oplus> r) P P' f g
\<Longrightarrow> dcorres (dc \<oplus> r) P P' f (injection_handler h g)"
by (rule KHeap_DR.dcorres_injection_handler_rhs)
lemma not_idle_thread_resolve_address_bits:
"\<lbrace>valid_global_refs and valid_objs and valid_idle and valid_irq_node and ko_at (TCB obj) thread\<rbrace>
CSpace_A.resolve_address_bits (tcb_ctable obj, blist)

1216
proof/drefine/KHeap_DR.thy
View File

File diff suppressed because it is too large Load Diff

4
proof/drefine/MoreCorres.thy
View File

@ -72,12 +72,12 @@ lemma corres_if_rhs:
(* Bind distributes over non-deterministic choice. *)
lemma alternative_bind_distrib: "((f \<sqinter> g) >>= h) = ((f >>= h) \<sqinter> (g >>= h))"
apply (auto simp: alternative_def bind_def split_def intro!: ext prod_eqI)
apply (auto simp: alternative_def bind_def split_def intro!: prod_eqI)
done
(* Bind distributes over non-deterministic choice. *)
lemma alternative_bind_distrib_2: "(do f; (a \<sqinter> b) od) = ((do f; a od) \<sqinter> (do f; b od))"
apply (auto simp: alternative_def bind_def split_def intro!: ext prod_eqI)
apply (auto simp: alternative_def bind_def split_def intro!: prod_eqI)
done
(* "bindE" distributes over non-deterministic choice. *)

2
proof/drefine/Refine_D.thy
View File

@ -53,7 +53,7 @@ lemma dcorres_call_kernel:
apply (clarsimp simp: invs_def valid_state_def)
apply (wp hoare_vcg_if_lift2 hoare_drop_imp he_invs
| strengthen valid_etcbs_sched valid_idle_invs_strg
| simp add: conj_ac cong: conj_cong)+
| simp add: conj_comms cong: conj_cong)+
apply (rule valid_validE2)
apply (rule hoare_vcg_conj_lift)
apply (rule he_invs)

398
proof/drefine/Schedule_DR.thy
View File

@ -201,18 +201,18 @@ lemma switch_to_thread_same_corres:
Schedule_A.switch_to_thread_def)
apply (rule corres_dummy_return_pl)
apply (rule corres_symb_exec_r)
apply (rule corres_symb_exec_r)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ arch_switch_to_thread_dcorres])
apply simp
apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres])
apply (rule corres_symb_exec_r)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ arch_switch_to_thread_dcorres])
apply simp
apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres])
apply (rule corres_modify [where P'="\<lambda>s. idle_thread s \<noteq> x"])
apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def)
apply (simp add: transform_current_thread_def transform_asid_table_def)
apply wp[4]
apply simp
apply assumption
apply (clarsimp|wp)+
apply simp
apply assumption
apply (clarsimp|wp)+
done
lemma set_scheduler_action_dcorres:
@ -237,8 +237,8 @@ lemma switch_to_thread_None_dcorres:
od)
(return ())"
apply (rule_tac Q="\<lambda>s. cdl_current_thread s = None" and Q'="\<top>" in stronger_corres_guard_imp)
apply (rule switch_to_thread_None_dcorres_L)
apply (clarsimp simp: transform_def transform_current_thread_def)+
apply (rule switch_to_thread_None_dcorres_L)
apply (clarsimp simp: transform_def transform_current_thread_def)+
done
lemma schedule_resume_cur_thread_dcorres_L:
@ -252,37 +252,36 @@ lemma schedule_resume_cur_thread_dcorres_L:
od)"
unfolding Schedule_D.schedule_def
apply (rule corres_either_alternate2)
apply (rule corres_guard_imp)
apply (rule corres_symb_exec_l_Ex)
apply (clarsimp)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: assert_def)
apply (rule conjI, clarsimp)
apply (fold dc_def)
apply (rule switch_to_thread_idempotent_corres)
apply (rule conjI, clarsimp)
apply (rule switch_to_thread_idempotent_corres)
apply (clarsimp simp: corres_underlying_def fail_def)
apply (wp | simp)+
apply (fastforce simp: select_def gets_def active_tcbs_in_domain_def bind_def return_def domIff
get_def fst_def modify_def put_def change_current_domain_def)
apply simp
apply (rule corres_guard_imp)
apply (rule corres_symb_exec_l_Ex)
apply (clarsimp simp: K_bind_def)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: assert_def)
apply (rule conjI, clarsimp)
apply (fold dc_def)
apply (rule switch_to_thread_idempotent_corres)
apply (rule conjI, clarsimp)
apply (rule switch_to_thread_idempotent_corres)
apply (clarsimp simp: corres_underlying_def fail_def)
apply (wp | simp)+
apply (fastforce simp: select_def gets_def active_tcbs_in_domain_def bind_def return_def domIff get_def fst_def
modify_def put_def change_current_domain_def)
apply simp
apply (rule corres_guard_imp)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: assert_def)
apply (rule conjI, clarsimp)
apply (rule switch_to_thread_None_dcorres_L)
apply (rule conjI, clarsimp)
apply (rule switch_to_thread_None_dcorres_L)
apply (clarsimp simp: corres_underlying_def fail_def)
apply (wp | simp | fastforce)+
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: assert_def)
apply (rule conjI, clarsimp)
apply (rule switch_to_thread_None_dcorres_L)
apply (rule conjI, clarsimp)
apply (rule switch_to_thread_None_dcorres_L)
apply (clarsimp simp: corres_underlying_def fail_def)
apply (wp | simp | fastforce)+
done
lemma schedule_resume_cur_thread_dcorres:
"\<And>cur cur_ts. dcorres dc \<top> (\<lambda>s. cur = cur_thread s \<and> st_tcb_at (op = cur_ts) cur s \<and> valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = resume_cur_thread)
Schedule_D.schedule
@ -290,18 +289,18 @@ lemma schedule_resume_cur_thread_dcorres:
assert (runnable cur_ts \<or> cur = idle_t)
od)"
apply (rule stronger_corres_guard_imp)
apply (rule schedule_resume_cur_thread_dcorres_L)
apply (case_tac "cur \<noteq> idle_thread s'")
apply (clarsimp simp: valid_sched_def valid_sched_action_def is_activatable_def invs_def valid_state_def
st_tcb_at_def obj_at_def ct_in_cur_domain_def in_cur_domain_def)
apply (frule(1) valid_etcbs_tcb_etcb)
apply (auto simp: transform_def transform_current_thread_def all_active_tcbs_def transform_objects_def active_tcbs_in_domain_def etcb_at_def
apply (rule schedule_resume_cur_thread_dcorres_L)
apply (case_tac "cur \<noteq> idle_thread s'")
apply (clarsimp simp: valid_sched_def valid_sched_action_def is_activatable_def invs_def valid_state_def
st_tcb_at_def obj_at_def ct_in_cur_domain_def in_cur_domain_def)
apply (frule(1) valid_etcbs_tcb_etcb)
apply (auto simp: transform_def transform_current_thread_def all_active_tcbs_def transform_objects_def active_tcbs_in_domain_def etcb_at_def
map_add_def restrict_map_def option_map_def transform_object_def transform_tcb_def valid_idle_def st_tcb_def2 get_tcb_def
transform_cnode_contents_def infer_tcb_pending_op_def transform_cap_def domIff st_tcb_at_kh_def obj_at_def only_idle_def
split: option.splits split_if Structures_A.kernel_object.splits Structures_A.thread_state.splits)[1]
(* cur = idle_thread s' *)
apply (subgoal_tac "cdl_current_thread s = None")
apply (clarsimp simp: transform_def transform_current_thread_def)+
apply (clarsimp simp: transform_def transform_current_thread_def)+
done
lemma schedule_switch_thread_helper:
@ -330,40 +329,40 @@ lemma schedule_switch_thread_dcorres:
od)"
unfolding Schedule_D.schedule_def
apply (rule_tac Q="\<top>" in corres_guard_imp)
apply (rule_tac Pa'="\<lambda>s. valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = switch_thread t \<and> t \<noteq> idle_thread s"
and Pb'="\<lambda>s. valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = switch_thread t \<and> t = idle_thread s"
in corres_either_alternate)
(* t \<noteq> idle_thread s *)
apply (rule stronger_corres_guard_imp)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: guarded_switch_to_def bind_assoc nested_bind)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule switch_to_thread_same_corres)
apply (wp gts_wp tcb_sched_action_transform hoare_drop_imp hoare_vcg_all_lift | clarsimp)+
apply (frule schedule_switch_thread_helper, simp,simp,simp)
apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
apply (rule_tac Pa'="\<lambda>s. valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = switch_thread t \<and> t \<noteq> idle_thread s"
and Pb'="\<lambda>s. valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = switch_thread t \<and> t = idle_thread s"
in corres_either_alternate)
(* t \<noteq> idle_thread s *)
apply (rule stronger_corres_guard_imp)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: guarded_switch_to_def bind_assoc)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule switch_to_thread_same_corres)
apply (wp gts_wp tcb_sched_action_transform hoare_drop_imp hoare_vcg_all_lift | clarsimp)+
apply (frule schedule_switch_thread_helper, simp,simp,simp)
apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
invs_def valid_state_def valid_objs_def change_current_domain_def
Schedule_D.switch_to_thread_def modify_def put_def
option_map_def restrict_map_def map_add_def get_tcb_def
transform_def transform_current_thread_def cur_tcb_def tcb_at_def)[1]
apply simp
apply fastforce
(* t = idle_thread s *)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: guarded_switch_to_def bind_assoc nested_bind)
apply (rule_tac Q'="\<lambda>ts s. idle ts" in dcorres_symb_exec_r)
apply (clarsimp simp: assert_def)
apply (rule conjI, clarsimp)
apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
apply (clarsimp simp: corres_underlying_def) (* contradiction *)
apply (clarsimp simp: corres_underlying_def fail_def)
apply (wp tcb_sched_action_transform| fastforce simp: invs_def valid_state_def)+
apply simp
apply fastforce
(* t = idle_thread s *)
apply (rule dcorres_symb_exec_r)
apply (clarsimp simp: guarded_switch_to_def bind_assoc)
apply (rule_tac Q'="\<lambda>ts s. idle ts" in dcorres_symb_exec_r)
apply (clarsimp simp: assert_def)
apply (rule conjI, clarsimp)
apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
apply (clarsimp simp: corres_underlying_def) (* contradiction *)
apply (clarsimp simp: corres_underlying_def fail_def)
apply (wp tcb_sched_action_transform| fastforce simp: invs_def valid_state_def)+
done
lemma schedule_choose_new_thread_helper:
@ -395,7 +394,7 @@ lemma idle_thread_not_in_queue:
apply (erule_tac x="p" in allE)
apply clarsimp
apply (erule_tac x="idle_thread s" in ballE)
apply clarsimp
apply clarsimp
apply (frule hd_in_set)
apply clarsimp
done
@ -405,9 +404,10 @@ lemma change_current_domain_dcorres: "dcorres dc \<top> \<top> change_current_do
get_def transform_def trans_state_def transform_objects_def transform_cdt_def transform_current_thread_def
transform_asid_table_def)
lemma max_set_not_empty: "\<And>x::'a::{linorder,finite}. f x \<noteq> [] \<Longrightarrow> f (Max {x. f x \<noteq> []}) \<noteq> []"
apply (rule_tac S="{x. f x \<noteq> []}" in Max_prop)
apply auto
lemma max_set_not_empty:
"\<And>x::'a::{linorder,finite}. f x \<noteq> [] \<Longrightarrow> f (Max {x. f x \<noteq> []}) \<noteq> []"
apply (rule_tac S="{x. f x \<noteq> []}" in Max_prop)
apply auto
done
lemma next_domain_valid_sched_except_blocked[wp]:
@ -432,7 +432,7 @@ lemma schedule_def_2:
done
lemma schedule_choose_new_thread_dcorres_fragment:
"\<And>cur_ts cur. dcorres dc \<top>
"dcorres dc \<top>
(\<lambda>s. valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread)
Schedule_D.schedule
(do dom_time \<leftarrow> gets domain_time;
@ -440,92 +440,92 @@ lemma schedule_choose_new_thread_dcorres_fragment:
y \<leftarrow> choose_thread;
set_scheduler_action resume_cur_thread
od)"
apply (clarsimp simp: guarded_switch_to_def bind_assoc nested_bind choose_thread_def)
apply (clarsimp simp: guarded_switch_to_def bind_assoc choose_thread_def)
apply (rule dcorres_symb_exec_r, rename_tac dom_t)
apply (case_tac "dom_t \<noteq> 0")
apply (clarsimp)
apply (rule dcorres_symb_exec_r, rename_tac cur_dom)
apply (rule dcorres_symb_exec_r, rename_tac rq)
apply (rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
(* No threads in ready_queues *)
apply (rule corres_guard_imp)
apply (rule corres_if_rhs)
apply (clarsimp simp: Schedule_D.schedule_def)
apply (rule corres_alternate2)
apply (rule change_current_domain_and_switch_to_idle_thread_dcorres)
(* Threads in ready_queues *)
apply (simp only: Schedule_D.schedule_def)
unfolding max_non_empty_queue_def
apply (rule corres_alternate1)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule_tac P'="\<lambda>s. ready_queues s (cur_domain s) = rq \<and> valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
in stronger_corres_guard_imp)
apply (rule corres_symb_exec_l_Ex)
apply (clarsimp simp: K_bind_def)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule switch_to_thread_same_corres)
apply clarsimp
apply (frule_tac prio="(Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []})" in schedule_choose_new_thread_helper,simp,simp,simp,simp,simp)
apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_def max_non_empty_queue_def)
apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
apply (case_tac "dom_t \<noteq> 0")
apply (clarsimp)
apply (rule dcorres_symb_exec_r, rename_tac cur_dom)
apply (rule dcorres_symb_exec_r, rename_tac rq)
apply (rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
(* No threads in ready_queues *)
apply (rule corres_guard_imp)
apply (rule corres_if_rhs)
apply (clarsimp simp: Schedule_D.schedule_def)
apply (rule corres_alternate2)
apply (rule change_current_domain_and_switch_to_idle_thread_dcorres)
(* Threads in ready_queues *)
apply (simp only: Schedule_D.schedule_def)
unfolding max_non_empty_queue_def
apply (rule corres_alternate1)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule_tac P'="\<lambda>s. ready_queues s (cur_domain s) = rq \<and> valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
in stronger_corres_guard_imp)
apply (rule corres_symb_exec_l_Ex)
apply (clarsimp)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule switch_to_thread_same_corres)
apply clarsimp
apply (frule_tac prio="(Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []})" in schedule_choose_new_thread_helper,simp,simp,simp,simp,simp)
apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_def max_non_empty_queue_def)
apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
invs_def valid_state_def valid_objs_def change_current_domain_def
Schedule_D.switch_to_thread_def modify_def put_def
option_map_def restrict_map_def map_add_def get_tcb_def
transform_def transform_current_thread_def cur_tcb_def tcb_at_def)[1]
apply (clarsimp simp: invs_def valid_state_def valid_sched_def max_non_empty_queue_def)
apply (frule_tac p="Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []}" in idle_thread_not_in_queue,simp,simp)
apply (clarsimp)
apply (wp hoare_drop_imp| simp | clarsimp simp: valid_sched_def)+
apply (frule max_set_not_empty, fastforce)
apply (wp hoare_drop_imp| simp)+
apply (clarsimp simp: valid_sched_def)
(* dom_t = 0 *)
apply (simp only: schedule_def_2)
apply (rule corres_guard_imp)
apply (rule_tac r'="\<lambda>_ _. True" and P=\<top> and P'=\<top> and R="\<lambda>_. \<top>" and R'="\<lambda>_ s. valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread" in corres_split)
apply (clarsimp simp: K_bind_def)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r, rename_tac rq)
apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
apply (rule corres_guard_imp)
apply (clarsimp simp: invs_def valid_state_def valid_sched_def max_non_empty_queue_def)
apply (frule_tac p="Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []}" in idle_thread_not_in_queue,simp,simp)
apply (clarsimp)
apply (wp hoare_drop_imp| simp | clarsimp simp: valid_sched_def)+
apply (frule max_set_not_empty, fastforce)
apply (wp hoare_drop_imp| simp)+
apply (clarsimp simp: valid_sched_def)
(* dom_t = 0 *)
apply (simp only: schedule_def_2)
apply (rule corres_guard_imp)
apply (rule_tac r'="\<lambda>_ _. True" and P=\<top> and P'=\<top> and R="\<lambda>_. \<top>" and R'="\<lambda>_ s. valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread" in corres_split)
apply (clarsimp simp: K_bind_def)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r, rename_tac rq)
apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
apply (rule corres_guard_imp)
apply (rule corres_if_rhs)
(* No threads in ready queues *)
apply (rule corres_alternate2)
apply (rule switch_to_idle_thread_dcorres)
(* threads in ready queues *)
apply (rule corres_alternate1)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule_tac P'="\<lambda>s. ready_queues s (cur_domain s) = rq \<and> valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
in stronger_corres_guard_imp)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule switch_to_thread_same_corres)
apply clarsimp
apply (frule_tac prio="(Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []})" in schedule_choose_new_thread_helper,simp,simp,simp,simp,simp)
apply (clarsimp simp: invs_def valid_state_def valid_sched_def)
apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
apply (rule corres_if_rhs)
(* No threads in ready queues *)
apply (rule corres_alternate2)
apply (rule switch_to_idle_thread_dcorres)
(* threads in ready queues *)
apply (rule corres_alternate1)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule_tac P'="\<lambda>s. ready_queues s (cur_domain s) = rq \<and> valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
in stronger_corres_guard_imp)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule corres_symb_exec_l_Ex)
apply (rule switch_to_thread_same_corres)
apply clarsimp
apply (frule_tac prio="(Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []})" in schedule_choose_new_thread_helper,simp,simp,simp,simp,simp)
apply (clarsimp simp: invs_def valid_state_def valid_sched_def)
apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
invs_def valid_state_def valid_objs_def change_current_domain_def
Schedule_D.switch_to_thread_def modify_def put_def
option_map_def restrict_map_def map_add_def get_tcb_def
transform_def transform_current_thread_def cur_tcb_def tcb_at_def)[1]
apply (clarsimp simp: invs_def valid_state_def valid_sched_def max_non_empty_queue_def)
apply (frule_tac p="Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []}" in idle_thread_not_in_queue,simp,simp)
apply (clarsimp)
apply (wp hoare_drop_imp | clarsimp)+
apply (frule max_set_not_empty, fastforce)
apply (wp hoare_drop_imp | clarsimp)+
apply simp
apply (wp | clarsimp)+
apply (rule change_current_domain_dcorres)
unfolding dc_def
apply (wp next_domain_valid_etcbs | simp)+
apply (wp tcb_sched_action_transform | clarsimp simp: valid_sched_def)+
Schedule_D.switch_to_thread_def modify_def put_def
option_map_def restrict_map_def map_add_def get_tcb_def
transform_def transform_current_thread_def cur_tcb_def tcb_at_def)[1]
apply (clarsimp simp: invs_def valid_state_def valid_sched_def max_non_empty_queue_def)
apply (frule_tac p="Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []}" in idle_thread_not_in_queue,simp,simp)
apply (clarsimp)
apply (wp hoare_drop_imp | clarsimp)+
apply (frule max_set_not_empty, fastforce)
apply (wp hoare_drop_imp | clarsimp)+
apply simp
apply (wp | clarsimp)+
apply (rule change_current_domain_dcorres)
unfolding dc_def
apply (wp next_domain_valid_etcbs | simp)+
apply (wp tcb_sched_action_transform | clarsimp simp: valid_sched_def)+
done
lemma schedule_choose_new_thread_dcorres:
@ -538,10 +538,10 @@ lemma schedule_choose_new_thread_dcorres:
y \<leftarrow> choose_thread;
set_scheduler_action resume_cur_thread
od)"
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule corres_guard_imp)
apply (rule schedule_choose_new_thread_dcorres_fragment)
apply (wp tcb_sched_action_transform| simp add: valid_sched_def st_tcb_at_def obj_at_def not_cur_thread_def| clarsimp simp: transform_def)+
apply (rule schedule_choose_new_thread_dcorres_fragment)
apply (wp tcb_sched_action_transform| simp add: valid_sched_def st_tcb_at_def obj_at_def not_cur_thread_def| clarsimp simp: transform_def)+
done
@ -558,21 +558,21 @@ lemma schedule_dcorres:
"dcorres dc \<top> (invs and valid_sched and valid_etcbs) Schedule_D.schedule Schedule_A.schedule"
apply (clarsimp simp: Schedule_A.schedule_def)
apply (rule dcorres_symb_exec_r)
apply (rename_tac cur)
apply (rule dcorres_symb_exec_r)
apply (rename_tac cur_ts)
apply (rule dcorres_symb_exec_r)
apply (rename_tac "sa", case_tac "sa")
(* sa = resume_cur_thread *)
apply clarsimp
apply (rule schedule_resume_cur_thread_dcorres)
(* sa = switch_thread *)
apply clarsimp
apply (rule schedule_switch_thread_dcorres)
(* sa = choose_new_thread *)
apply clarsimp
apply (rule schedule_choose_new_thread_dcorres)
apply (wp gts_st_tcb | simp )+
apply (rename_tac cur)
apply (rule dcorres_symb_exec_r)
apply (rename_tac cur_ts)
apply (rule dcorres_symb_exec_r)
apply (rename_tac "sa", case_tac "sa")
(* sa = resume_cur_thread *)
apply clarsimp
apply (rule schedule_resume_cur_thread_dcorres)
(* sa = switch_thread *)
apply clarsimp
apply (rule schedule_switch_thread_dcorres)
(* sa = choose_new_thread *)
apply clarsimp
apply (rule schedule_choose_new_thread_dcorres)
apply (wp gts_st_tcb | simp )+
done
(*
@ -652,8 +652,7 @@ lemma activate_thread_corres:
od | None \<Rightarrow> return ()
od)
activate_thread"
apply (simp add: activate_thread_def has_restart_cap_def
gets_def bind_assoc)
apply (simp add: activate_thread_def has_restart_cap_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (rule dcorres_absorb_get_l)
apply (simp add:get_thread_state_def bind_assoc thread_get_def)
@ -666,32 +665,31 @@ lemma activate_thread_corres:
apply clarsimp
apply (subgoal_tac "not_idle_thread (cur_thread s'b) s'b")
prefer 2
apply (clarsimp simp:transform_def transform_current_thread_def)
apply (clarsimp simp:not_idle_thread_def)+
apply (frule(1) valid_etcbs_get_tcb_get_etcb, clarsimp)
apply (frule opt_object_tcb)
apply (clarsimp simp:transform_def transform_current_thread_def)
apply (clarsimp simp:not_idle_thread_def)+
apply (frule(1) valid_etcbs_get_tcb_get_etcb, clarsimp)
apply (frule opt_object_tcb)
apply simp
apply simp
apply (clarsimp simp:transform_tcb_def gets_def gets_the_def has_restart_cap_def
apply simp
apply (clarsimp simp:transform_tcb_def gets_def gets_the_def has_restart_cap_def
get_thread_def bind_assoc cdl_current_thread transform_current_thread_def)
apply (rule dcorres_absorb_get_l)
apply (simp add:assert_opt_def when_def)
apply (case_tac "tcb_state obj'")
apply (clarsimp simp:infer_tcb_pending_op_def
when_def st_tcb_at_def ct_in_state_def obj_at_def
dest!:get_tcb_SomeD)+
apply (rule corres_guard_imp)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_absorb_get_l)
apply (simp add:assert_opt_def when_def)
apply (case_tac "tcb_state obj'")
apply (clarsimp simp:infer_tcb_pending_op_def when_def st_tcb_at_def ct_in_state_def obj_at_def
dest!:get_tcb_SomeD)+
apply (rule corres_guard_imp)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r)
apply (rule set_thread_state_corres)
apply simp
apply (wp dcorres_to_wp[OF as_user_setNextPC_corres,simplified])
apply (wp getRestartPC_inv as_user_inv)
apply (simp add:invs_mdb st_tcb_at_def obj_at_def invs_valid_idle
generates_pending_def not_idle_thread_def)
apply (clarsimp simp:infer_tcb_pending_op_def arch_activate_idle_thread_def
when_def st_tcb_at_def ct_in_state_def obj_at_def
dest!:get_tcb_SomeD)+
apply (wp dcorres_to_wp[OF as_user_setNextPC_corres,simplified])
apply (wp getRestartPC_inv as_user_inv)
apply (simp add: invs_mdb st_tcb_at_def obj_at_def invs_valid_idle generates_pending_def
not_idle_thread_def)
apply (clarsimp simp:infer_tcb_pending_op_def arch_activate_idle_thread_def
when_def st_tcb_at_def ct_in_state_def obj_at_def
dest!:get_tcb_SomeD)+
done
end

14
proof/drefine/StateTranslationProofs_DR.thy
View File

@ -78,7 +78,7 @@ done
lemma msg_registers_lt_msg_max_length [simp]:
"length msg_registers < msg_max_length"
by (simp add: msg_registers_def msgRegisters_unfold msg_max_length_def )
by (simp add: msgRegisters_unfold msg_max_length_def)
lemma get_tcb_mrs_update_state :
"get_tcb_mrs ms (tcb_state_update f tcb) = get_tcb_mrs ms tcb"
@ -171,27 +171,27 @@ lemmas caps_of_state_upds = caps_of_state_update_tcb caps_of_state_update_same_c
lemma transform_cdt_kheap_update [simp]:
"transform_cdt (kheap_update f s) = transform_cdt s"
by (clarsimp simp: transform_cdt_def cong: if_cong)
by (clarsimp simp: transform_cdt_def)
lemma transform_cdt_update_machine [simp]:
"transform_cdt (update_machine ms s) = transform_cdt s "
by (clarsimp simp: transform_cdt_def cong: if_cong)
by (clarsimp simp: transform_cdt_def)
lemma transform_cdt_update_original_cap [simp]:
"transform_cdt (b\<lparr>is_original_cap := x\<rparr>) = transform_cdt b"
by (clarsimp simp: transform_cdt_def cong: if_cong)
by (clarsimp simp: transform_cdt_def)
lemma transform_asid_table_kheap_update [simp]:
"transform_asid_table (kheap_update f s) = transform_asid_table s"
by (clarsimp simp: transform_asid_table_def cong: if_cong)
by (clarsimp simp: transform_asid_table_def)
lemma transform_asid_table_update_machine [simp]:
"transform_asid_table (update_machine ms s) = transform_asid_table s "
by (clarsimp simp: transform_asid_table_def cong: if_cong)
by (clarsimp simp: transform_asid_table_def)
lemma transform_asid_table_update_original_cap [simp]:
"transform_asid_table (b\<lparr>is_original_cap := x\<rparr>) = transform_asid_table b"
by (clarsimp simp: transform_asid_table_def cong: if_cong)
by (clarsimp simp: transform_asid_table_def)
lemma transform_objects_update_kheap_same_caps:
"\<lbrakk> kh ptr = Some ko; caps_of_object ko' = caps_of_object ko; a_type ko' = a_type ko\<rbrakk> \<Longrightarrow>

3
proof/drefine/StateTranslation_D.thy
View File

@ -429,8 +429,7 @@ lemma transform_intent_isnot_UntypedIntent:
apply(unfold transform_intent_untyped_retype_def)
apply (clarsimp split: list.split, safe, simp_all)[1]
apply (clarsimp simp: transform_type_def)
apply (simp add: linorder_not_less eval_nat_numeral word_le_nat_alt
le_Suc_eq unat_arith_simps)
apply (simp add: linorder_not_less eval_nat_numeral le_Suc_eq unat_arith_simps)
apply(erule disjE)
apply(auto simp: transform_intent_def option_map_def split: invocation_label.split option.split_asm)[1]
apply (erule disjE)

682
proof/drefine/Syscall_DR.thy
View File

@ -8,14 +8,13 @@
* @TAG(NICTA_GPL)
*)
theory Syscall_DR imports
theory Syscall_DR
imports
Tcb_DR
Schedule_DR
Interrupt_DR
begin
declare option.weak_case_cong[cong]
(*
* Translate an abstract invocation into a corresponding
* CDL invocation.
@ -227,11 +226,11 @@ lemma decode_domain_corres:
(Decode_A.decode_domain_invocation label' args' excaps')"
apply (unfold Tcb_D.decode_domain_invocation_def Decode_A.decode_domain_invocation_def)
apply (unfold transform_cap_list_def)
apply (case_tac "invocation_type label'")
apply simp_all
apply (clarsimp simp: transform_intent_def option_map_def split: option.splits)+
defer
apply (clarsimp simp: transform_intent_def option_map_def split: option.splits)+
apply (case_tac "invocation_type label'"; simp)
apply (clarsimp simp: transform_intent_def option_map_def
split: option.splits)+
defer
apply (clarsimp simp: transform_intent_def option_map_def split: option.splits)+
apply (clarsimp simp: transform_intent_domain_def)
apply (case_tac "args'")
apply simp
@ -245,8 +244,7 @@ lemma decode_domain_corres:
apply (rule dcorres_whenE_throwError_abstract')
apply (rule corres_alternate2)
apply simp
apply (case_tac "fst (hd (excaps'))")
apply simp_all
apply (case_tac "fst (hd (excaps'))"; simp)
apply ((rule corres_alternate2, simp)+)[6]
apply (rule corres_alternate1)
apply (clarsimp simp: returnOk_def cdl_invocation_relation_def translate_invocation_def split: list.splits)
@ -260,9 +258,9 @@ lemma decode_domain_cap_label_not_match:
"\<lbrakk>\<forall>ui. Some (DomainIntent ui) \<noteq> transform_intent (invocation_type label') args'\<rbrakk>
\<Longrightarrow> \<lbrace>op=s\<rbrace>Decode_A.decode_domain_invocation label' args' excaps' \<lbrace>\<lambda>r. \<bottom>\<rbrace>,\<lbrace>\<lambda>e. op=s\<rbrace>"
apply (case_tac "invocation_type label' = DomainSetSet")
apply (clarsimp simp: Decode_A.decode_domain_invocation_def transform_intent_def)+
apply (clarsimp simp: transform_intent_domain_def split: option.splits list.splits)
apply wp
apply (clarsimp simp: Decode_A.decode_domain_invocation_def transform_intent_def)+
apply (clarsimp simp: transform_intent_domain_def split: option.splits list.splits)
apply wp
apply (simp add: Decode_A.decode_domain_invocation_def)
apply wp
done
@ -279,13 +277,13 @@ lemma decode_invocation_domaincap_corres:
apply (case_tac "\<exists>ti. intent = (DomainIntent ti)")
apply (clarsimp simp: Decode_A.decode_invocation_def Decode_D.decode_invocation_def)
apply (clarsimp simp: throw_opt_def get_domain_intent_def split: cdl_intent.split)
apply (rule corres_rel_imp[OF decode_domain_corres],simp+)
apply (clarsimp simp:Decode_D.decode_invocation_def throw_opt_def get_domain_intent_def Decode_A.decode_invocation_def
split:cdl_intent.splits)
apply (rule absorb_imp,clarsimp)+
apply (rule dcorres_free_throw)
apply (rule decode_domain_cap_label_not_match)
apply (drule sym,clarsimp)
apply (rule corres_rel_imp[OF decode_domain_corres],simp+)
apply (clarsimp simp:Decode_D.decode_invocation_def throw_opt_def get_domain_intent_def Decode_A.decode_invocation_def
split:cdl_intent.splits)
apply (rule absorb_imp,clarsimp)+
apply (rule dcorres_free_throw)
apply (rule decode_domain_cap_label_not_match)
apply (drule sym,clarsimp)
done
(* Decoding IRQ Control invocations is equivalent. *)
@ -327,7 +325,7 @@ lemma decode_invocation_irqhandlercap_corres:
apply (clarsimp simp: Decode_A.decode_invocation_def Decode_D.decode_invocation_def)
apply (clarsimp simp: throw_opt_def get_irq_handler_intent_def split: option.splits)
apply (rule conjI)
apply (auto simp: decode_irq_handler_invocation_def transform_intent_def
apply (auto simp: decode_irq_handler_invocation_def transform_intent_def
transform_intent_irq_set_mode_def
split del: split_if
split: invocation_label.splits cdl_intent.splits list.splits)[1]
@ -348,26 +346,27 @@ lemma transform_type_eq_None:
apply (simp add:unat_arith_simps)
apply (clarsimp simp:arch_data_to_obj_type_def)
apply (rule conjI,arith,clarsimp)+
done
done
lemma transform_intent_untyped_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.UntypedCap w n idx\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
apply (clarsimp simp:Decode_A.decode_invocation_def)
apply wp
apply (case_tac "invocation_type label")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def unlessE_def)
apply wp
apply (case_tac "invocation_type label")
(* 43 subgoals *)
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def unlessE_def)
apply wp
apply (clarsimp simp:transform_intent_def Decode_A.decode_untyped_invocation_def unlessE_def split del:if_splits)
apply (clarsimp simp:transform_intent_untyped_retype_def split del:if_splits)
apply (case_tac "args")
apply (clarsimp,wp)[1]
apply (clarsimp split:list.split_asm split del:if_splits)
apply wp[5]
apply (clarsimp simp: transform_type_eq_None split del:if_splits split:option.splits)
apply (wp|clarsimp simp:whenE_def|rule conjI)+
apply (clarsimp simp: Decode_A.decode_untyped_invocation_def unlessE_def split del:if_splits,wp)+
done
apply (clarsimp simp:transform_intent_def Decode_A.decode_untyped_invocation_def unlessE_def split del:split_if)
apply (clarsimp simp:transform_intent_untyped_retype_def split del:split_if)
apply (case_tac "args")
apply (clarsimp,wp)[1]
apply (clarsimp split:list.split_asm split del:split_if)
apply wp[5]
apply (clarsimp simp: transform_type_eq_None split del:split_if split:option.splits)
apply (wp|clarsimp simp:whenE_def|rule conjI)+
apply (clarsimp simp: Decode_A.decode_untyped_invocation_def unlessE_def split del:split_if,wp)+
done
lemma transform_intent_cnode_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.CNodeCap w n list\<rbrakk>
@ -711,6 +710,7 @@ lemma perform_invocation_corres:
apply (wp | clarsimp)+
(* invoke_reply *)
apply (rename_tac word a b)
apply (clarsimp simp:invoke_reply_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ get_cur_thread_corres])
@ -748,6 +748,7 @@ lemma perform_invocation_corres:
(* invoke_irq *)
apply (simp add:liftE_def bindE_def)
apply (rename_tac irq_control_invocation)
apply (case_tac irq_control_invocation)
apply (rule corres_guard_imp)
apply (rule corres_split[where r'=dc])
@ -856,7 +857,7 @@ lemma get_ipc_buffer_noop:
apply (simp add:gets_the_def gets_def bind_assoc get_def split_def get_ipc_buffer_def tcb_at_def
exs_valid_def fail_def return_def bind_def assert_opt_def split:cdl_cap.splits)
apply clarsimp
apply (rule_tac x = "(the (opt_cap (t, tcb_ipcbuffer_slot) ?s),?s)" in bexI)
apply (rule_tac x = "(the (opt_cap (t, tcb_ipcbuffer_slot) s),s)" for s in bexI)
apply (rule conjI|fastforce simp:fail_def return_def split:option.splits)+
apply (clarsimp split:option.splits simp:fail_def return_def)
apply (frule(1) valid_etcbs_get_tcb_get_etcb)
@ -864,67 +865,66 @@ lemma get_ipc_buffer_noop:
done
lemma dcorres_reply_from_kernel:
(* FIXME: this is incomprehensible. fix a bit when auto-indenting is fixed? *)
"dcorres dc \<top> (invs and tcb_at oid and not_idle_thread oid and valid_etcbs) (corrupt_ipc_buffer oid True) (reply_from_kernel oid msg_rv)"
apply (simp add:reply_from_kernel_def)
apply (case_tac msg_rv)
apply (clarsimp simp:corrupt_ipc_buffer_def)
apply (rule dcorres_expand_pfx)
apply (rule_tac Q' = "\<lambda>r. op = s' and K_bind (evalMonad (lookup_ipc_buffer True oid) s' = Some r)"
in corres_symb_exec_r)
apply (rule dcorres_expand_pfx)
apply (clarsimp)
apply (case_tac rv)
apply (rule corres_symb_exec_l)
apply (rule_tac F="rva = None" in corres_gen_asm)
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_corrupt_tcb_intent_dupl)
apply (rule corres_split[OF _ set_register_corres])
unfolding K_bind_def
apply (rule corres_corrupt_tcb_intent_dupl)
apply (rule corres_split[OF _ set_mrs_corres_no_recv_buffer])
unfolding K_bind_def
apply (rule set_message_info_corres)
apply (wp | clarsimp simp:not_idle_thread_def)+
apply (wp get_ipc_buffer_noop, clarsimp)
apply (fastforce simp: not_idle_thread_def)
apply (wp cdl_get_ipc_buffer_None | simp)+
apply clarsimp
apply (drule lookup_ipc_buffer_SomeB_evalMonad)
apply clarsimp
apply (rule corres_symb_exec_l)
apply (rule_tac F = "rv = Some ba" in corres_gen_asm)
apply clarsimp
apply (rule corrupt_frame_include_self[where y = oid])
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ set_register_corres])
unfolding K_bind_def
apply (rule_tac y = oid in corrupt_frame_include_self')
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ dcorres_set_mrs])
unfolding K_bind_def
apply (rule set_message_info_corres)
apply (wp| simp add:not_idle_thread_def)+
apply (clarsimp simp:not_idle_thread_def)
apply (clarsimp simp:invs_def not_idle_thread_def valid_state_def valid_pspace_def
ipc_frame_wp_at_def ipc_buffer_wp_at_def obj_at_def)
apply (clarsimp simp:cte_wp_at_cases obj_at_def)
apply (drule_tac s="cap.ArchObjectCap ?c" in sym)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def cte_wp_at_cases)
apply (drule_tac s="cap.ArchObjectCap ?c" in sym)
apply simp
apply (wp get_ipc_buffer_noop, clarsimp)
apply fastforce
apply simp
apply (rule cdl_get_ipc_buffer_Some)
apply fastforce
apply (simp add:tcb_at_def not_idle_thread_def get_tcb_rev)+
in corres_symb_exec_r)
apply (rule dcorres_expand_pfx)
apply (clarsimp)
apply (case_tac rv)
apply (rule corres_symb_exec_l)
apply (rule_tac F="rva = None" in corres_gen_asm)
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_corrupt_tcb_intent_dupl)
apply (rule corres_split[OF _ set_register_corres])
unfolding K_bind_def
apply (rule corres_corrupt_tcb_intent_dupl)
apply (rule corres_split[OF _ set_mrs_corres_no_recv_buffer])
unfolding K_bind_def
apply (rule set_message_info_corres)
apply (wp | clarsimp simp:not_idle_thread_def)+
apply (wp get_ipc_buffer_noop, clarsimp)
apply (fastforce simp: not_idle_thread_def)
apply (wp cdl_get_ipc_buffer_None | simp)+
apply clarsimp
apply (drule lookup_ipc_buffer_SomeB_evalMonad)
apply clarsimp
apply (rule corres_symb_exec_l)
apply (rule_tac F = "rv = Some ba" in corres_gen_asm)
apply clarsimp
apply (rule corrupt_frame_include_self[where y = oid])
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ set_register_corres])
unfolding K_bind_def
apply (rule_tac y = oid in corrupt_frame_include_self')
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ dcorres_set_mrs])
unfolding K_bind_def
apply (rule set_message_info_corres)
apply (wp| simp add:not_idle_thread_def)+
apply (clarsimp simp:not_idle_thread_def)
apply (clarsimp simp:invs_def not_idle_thread_def valid_state_def valid_pspace_def
ipc_frame_wp_at_def ipc_buffer_wp_at_def obj_at_def)
apply (clarsimp simp:cte_wp_at_cases obj_at_def)
apply (drule_tac s="cap.ArchObjectCap c" for c in sym)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def cte_wp_at_cases)
apply (drule_tac s="cap.ArchObjectCap c" for c in sym)
apply simp
apply (wp get_ipc_buffer_noop, clarsimp)
apply fastforce
apply simp
apply (rule cdl_get_ipc_buffer_Some)
apply fastforce
apply (simp add:tcb_at_def not_idle_thread_def get_tcb_rev)+
apply wp
apply (rule evalMonad_wp)
apply (rule evalMonad_wp)
apply (simp add:empty_when_fail_lookup_ipc_buffer weak_det_spec_lookup_ipc_buffer)+
apply (wp|clarsimp)+
apply (wp|clarsimp)+
done
lemma dcorres_set_intent_error:
@ -932,18 +932,18 @@ lemma dcorres_set_intent_error:
(invs and valid_etcbs and (\<lambda>s. \<exists>tcb. guess_error (mi_label (get_tcb_message_info tcb)) = er
\<and> ko_at (TCB tcb) oid s) and not_idle_thread oid) (mark_tcb_intent_error oid er) (return a)"
apply (clarsimp simp:mark_tcb_intent_error_def bind_assoc
gets_the_def update_thread_def gets_def )
gets_the_def update_thread_def gets_def )
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp: not_idle_thread_def)
apply (frule ko_at_tcb_at)
apply (frule(1) tcb_at_is_etcb_at)
apply (clarsimp simp:tcb_at_def is_etcb_at_def, fold get_etcb_def)
apply (clarsimp simp:opt_object_tcb assert_opt_def transform_tcb_def
KHeap_D.set_object_def simpler_modify_def corres_underlying_def)
apply (clarsimp simp:opt_object_tcb assert_opt_def transform_tcb_def KHeap_D.set_object_def
simpler_modify_def corres_underlying_def)
apply (simp add:transform_def return_def)
apply (rule ext)
apply (clarsimp simp:transform_objects_def transform_tcb_def
dest!:get_tcb_SomeD get_etcb_SomeD)
dest!:get_tcb_SomeD get_etcb_SomeD)
apply (simp add:transform_full_intent_def Let_def obj_at_def)
done
@ -960,42 +960,44 @@ lemma evalMonad_from_wp:
done
lemma empty_when_fail_get_mrs:
"empty_when_fail (get_mrs a b c)"
notes option.case_cong_weak [cong]
shows "empty_when_fail (get_mrs a b c)"
apply (clarsimp simp:get_mrs_def)
apply (rule empty_when_fail_compose)+
apply (simp add:empty_when_fail_return split:option.splits)+
apply (rule conjI)
apply clarsimp
apply (rule empty_when_fail_mapM)
apply (simp add:empty_when_fail_load_word_offs weak_det_spec_load_word_offs)
apply clarsimp
apply (rule empty_when_fail_mapM)
apply (simp add:empty_when_fail_load_word_offs weak_det_spec_load_word_offs)
apply (clarsimp simp:empty_when_fail_return weak_det_spec_simps split:option.splits)
apply (rule conjI)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply (simp add:empty_when_fail_thread_get)
apply (simp add:weak_det_spec_thread_get)
apply (simp add:empty_when_fail_return split:option.splits)+
apply (rule conjI)
apply clarsimp
apply (rule empty_when_fail_mapM)
apply (simp add:empty_when_fail_load_word_offs weak_det_spec_load_word_offs)
apply clarsimp
apply (rule empty_when_fail_mapM)
apply (simp add:empty_when_fail_load_word_offs weak_det_spec_load_word_offs)
apply (clarsimp simp:empty_when_fail_return weak_det_spec_simps split:option.splits)
apply (rule conjI)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply (simp add:empty_when_fail_thread_get)
apply (simp add:weak_det_spec_thread_get)
done
lemma weak_det_spec_get_mrs:
"weak_det_spec P (get_mrs a b c)"
notes option.case_cong_weak [cong]
shows "weak_det_spec P (get_mrs a b c)"
apply (clarsimp simp:get_mrs_def)
apply (rule weak_det_spec_compose)+
apply (simp add:weak_det_spec_simps split:option.splits)+
apply (rule conjI)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply (simp add:weak_det_spec_thread_get)
apply (simp add:weak_det_spec_simps split:option.splits)+
apply (rule conjI)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply clarsimp
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply (simp add:weak_det_spec_thread_get)
done
lemma lookup_cap_and_slot_inv:
@ -1005,9 +1007,9 @@ lemma lookup_cap_and_slot_inv:
apply (simp add:validE_def)
apply (rule hoare_drop_imp)
apply (wp lookup_slot_for_thread_inv)
done
done
(* We need folloing lemma because we need to match get_mrs in abstract and cdl_intent_op in capdl after state s is fixed *)
(* We need following lemma because we need to match get_mrs in abstract and cdl_intent_op in capdl after state s is fixed *)
lemma decode_invocation_corres':
"\<lbrakk>(\<lambda>(cap, slot, extra) (slot', cap', extra', buffer).
cap = transform_cap cap' \<and> slot = transform_cslot_ptr slot' \<and> extra = transform_cap_list extra')
@ -1029,25 +1031,27 @@ lemma decode_invocation_corres':
od)
rv')"
apply (rule dcorres_expand_pfx)
apply (clarsimp split del:if_splits)
apply (rule_tac Q' ="\<lambda>r ns. ns = s
\<and> r = get_tcb_mrs (machine_state s) ctcb"
in corres_symb_exec_r)
apply (clarsimp split:option.split | rule conjI)+
apply (rule corres_guard_imp[OF decode_invocation_ep_related_branch])
apply clarsimp+
defer
apply (clarsimp split del:split_if)
apply (rule_tac Q' ="\<lambda>r ns. ns = s
\<and> r = get_tcb_mrs (machine_state s) ctcb"
in corres_symb_exec_r)
apply (clarsimp split:option.split | rule conjI)+
apply (rule corres_guard_imp[OF decode_invocation_ep_related_branch])
apply clarsimp+
defer
apply clarsimp
apply (rule dcorres_expand_pfx)
apply (rule corres_guard_imp[OF decode_invocation_corres])
apply (clarsimp simp:transform_full_intent_def Let_def get_tcb_message_info_def)+
apply (wp get_tcb_mrs_wp | clarsimp)+
apply (clarsimp simp:transform_full_intent_def Let_def get_tcb_message_info_def)+
apply (wp get_tcb_mrs_wp | clarsimp)+
apply (rule dcorres_expand_pfx)
apply (rule dcorres_free_throw[OF decode_invocation_error_branch])
apply (clarsimp simp:transform_full_intent_def Let_def get_tcb_message_info_def)+
done
apply (clarsimp simp:transform_full_intent_def Let_def get_tcb_message_info_def)+
done
lemma reply_from_kernel_error:
notes option.case_cong_weak [cong]
shows
"\<lbrace>tcb_at oid and K (fst e \<le> mask 19 \<and> 0 < fst e = er)\<rbrace>reply_from_kernel oid e
\<lbrace>\<lambda>rv s. (\<exists>tcb. guess_error (mi_label (get_tcb_message_info tcb)) = er \<and>
ko_at (TCB tcb) oid s)\<rbrace>"
@ -1066,8 +1070,8 @@ lemma reply_from_kernel_error:
apply (rule exI)
apply (rule conjI[rotated])
apply (simp add:obj_at_def)
apply (simp add:get_tcb_message_info_def data_to_message_info_def word_neq0)
apply (simp add:shiftr_over_or_dist le_mask_iff word_neq0)
apply (simp add:get_tcb_message_info_def data_to_message_info_def word_neq_0_conv)
apply (simp add:shiftr_over_or_dist le_mask_iff word_neq_0_conv)
apply (subst shiftl_shiftr_id)
apply (simp add:WordSetup.word_bits_def mask_def le_mask_iff[symmetric])+
apply unat_arith
@ -1079,7 +1083,7 @@ lemma reply_from_kernel_error:
apply (rule le_trans[OF min.cobounded1])
apply (simp add:mask_def)
apply (rule le_trans)
apply (rule less_imp_le[OF msg_registers_lt_msg_max_length])
apply (rule less_imp_le[OF msg_registers_lt_msg_max_length])
apply (simp add:msg_max_length_def)
apply (rule plus_one_helper)
apply (simp add:mask_def)
@ -1229,23 +1233,25 @@ lemma invoke_domain_idle:
lemma perform_invocation_idle[wp]:
"\<lbrace>not_idle_thread x :: det_ext state \<Rightarrow> bool\<rbrace> Syscall_A.perform_invocation blocking call i \<lbrace>\<lambda>rv. not_idle_thread x\<rbrace>"
apply (case_tac i)
apply (simp_all add:not_idle_thread_def)
apply (wp invoke_cnode_idle invoke_domain_idle |clarsimp)+
apply (simp_all add:not_idle_thread_def)
apply (wp invoke_cnode_idle invoke_domain_idle |clarsimp)+
apply (rename_tac irq_control_invocation)
apply (case_tac irq_control_invocation)
apply (simp_all add:invoke_irq_control.simps | wp)+
apply (simp add:arch_invoke_irq_control_def)
apply (case_tac irq_handler_invocation)
apply (simp_all | wp)+
apply (simp add: arch_invoke_irq_control_def)
apply (rename_tac irq_handler_invocation)
apply (case_tac irq_handler_invocation)
apply simp_all
apply (wp|simp)+
done
apply (wp|simp)+
done
lemma msg_from_syscall_error_simp:
"fst (msg_from_syscall_error rv) \<le> mask 19"
"0 < fst (msg_from_syscall_error rv)"
apply (case_tac rv)
apply (clarsimp simp:mask_def)+
apply (case_tac rv)
apply (clarsimp simp:mask_def)+
apply (case_tac rv)
apply simp+
apply simp+
done
lemma not_master_reply_cap_lcs[wp]:
@ -1253,32 +1259,32 @@ lemma not_master_reply_cap_lcs[wp]:
\<lbrace>\<lambda>rv s. \<not> is_master_reply_cap (fst rv)\<rbrace>,-"
apply (rule hoare_pre)
apply (simp add:lookup_cap_and_slot_def)
apply wp
apply wp
apply (simp add:split_def)
apply wp
apply (rule_tac Q ="\<lambda>cap. cte_wp_at (\<lambda>x. x = cap) (fst x) and real_cte_at (fst x)
and valid_reply_masters and valid_objs" in hoare_strengthen_post)
apply (wp get_cap_cte_wp_at)
apply clarify
apply (drule real_cte_not_reply_masterD)
apply clarsimp+
and valid_reply_masters and valid_objs" in hoare_strengthen_post)
apply (wp get_cap_cte_wp_at)
apply clarify
apply (drule real_cte_not_reply_masterD)
apply clarsimp+
apply (simp add:cte_wp_at_def)
apply wp
apply wp
apply simp
done
done
lemma not_master_reply_cap_lcs'[wp]:
"\<lbrace>valid_reply_masters and valid_objs\<rbrace> CSpace_A.lookup_cap_and_slot t ptr
\<lbrace>\<lambda>rv s. cte_wp_at (Not \<circ> is_master_reply_cap) (snd rv) s\<rbrace>,-"
apply (rule_tac Q' = "\<lambda>rv s. \<not> is_master_reply_cap (fst rv) \<and> cte_wp_at (diminished (fst rv)) (snd rv) s" in hoare_post_imp_R)
apply (rule hoare_pre,wp,simp)
apply (rule hoare_pre,wp,simp)
apply (clarsimp simp:cte_wp_at_def)
apply (case_tac cap)
apply (simp_all add:is_master_reply_cap_def)
apply (case_tac cap)
apply (simp_all add:is_master_reply_cap_def)
apply clarsimp
apply (case_tac a)
apply (simp_all add:diminished_def mask_cap_def cap_rights_update_def)
done
apply (simp_all add:diminished_def mask_cap_def cap_rights_update_def)
done
lemma set_thread_state_ct_active:
"\<lbrace>\<lambda>s. cur_thread s = cur_thread s'\<rbrace>
@ -1286,7 +1292,7 @@ lemma set_thread_state_ct_active:
apply (simp add:set_thread_state_def)
apply (wp dxo_wp_weak
| clarsimp simp: set_object_def trans_state_def ct_in_state_def st_tcb_at_def obj_at_def)+
done
done
crunch valid_etcbs[wp]: cap_recycle valid_etcbs
(simp: unless_def ignore: without_preemption)
@ -1419,25 +1425,26 @@ lemma receive_ipc_cur_thread:
" \<lbrace>\<lambda>s. valid_objs s \<and> P (cur_thread (s :: det_ext state))\<rbrace> receive_ipc a b \<lbrace>\<lambda>xg s. P (cur_thread s)\<rbrace>"
apply (simp add:receive_ipc_def bind_assoc)
apply (wp|wpc|clarsimp)+
apply (simp add:setup_caller_cap_def)
apply wp
apply (rule_tac Q="\<lambda>r s. P (cur_thread s)" in hoare_strengthen_post)
apply (simp add:setup_caller_cap_def)
apply wp
apply (rule_tac Q="\<lambda>r s. P (cur_thread s)" in hoare_strengthen_post)
apply wp
apply clarsimp
apply (wp|wpc)+
apply (rule_tac Q="\<lambda>r s. P (cur_thread s)" in hoare_strengthen_post)
apply wp
apply clarsimp
apply (wp|wpc)+
apply (rule_tac Q="\<lambda>r s. P (cur_thread s)" in hoare_strengthen_post)
apply wp
apply clarsimp
apply clarsimp
apply (clarsimp simp:neq_Nil_conv)
apply (rename_tac list)
apply (rule_tac Q="\<lambda>r s. P (cur_thread s) \<and> tcb_at (hd list) s" in hoare_strengthen_post)
apply wp
apply (clarsimp simp:st_tcb_at_def tcb_at_def)
apply wp
apply (rule_tac Q="\<lambda>r s. valid_ep r s \<and> P (cur_thread s)" in hoare_strengthen_post)
apply (wp valid_ep_get_ep2)
apply (clarsimp simp:valid_ep_def)
apply (clarsimp simp:valid_def return_def fail_def split:option.splits cap.splits)
done
apply wp
apply (clarsimp simp:st_tcb_at_def tcb_at_def)
apply wp
apply (rule_tac Q="\<lambda>r s. valid_ep r s \<and> P (cur_thread s)" in hoare_strengthen_post)
apply (wp valid_ep_get_ep2)
apply (clarsimp simp:valid_ep_def)
apply (clarsimp simp:valid_def return_def fail_def split:option.splits cap.splits)
done
lemma cap_delete_one_st_tcb_at_and_valid_etcbs:
"\<lbrace>st_tcb_at P t and K (\<forall>st. active st \<longrightarrow> P st) and valid_etcbs\<rbrace> cap_delete_one ptr \<lbrace>\<lambda>rv s. st_tcb_at P t s \<and> valid_etcbs s\<rbrace>"
@ -1447,41 +1454,41 @@ lemma handle_wait_corres:
"dcorres dc \<top> (invs and (\<lambda>s. not_idle_thread (cur_thread s) s \<and> st_tcb_at active (cur_thread s) s) and valid_etcbs)
Syscall_D.handle_wait Syscall_A.handle_wait"
apply (simp add: Syscall_D.handle_wait_def Syscall_A.handle_wait_def delete_caller_cap_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ get_cur_thread_corres])
apply (rule_tac P'="\<lambda>rv. invs and not_idle_thread thread and valid_etcbs
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ get_cur_thread_corres])
apply (rule_tac P'="\<lambda>rv. invs and not_idle_thread thread and valid_etcbs
and (\<lambda>s. thread = cur_thread s \<and> st_tcb_at active thread s )"
in corres_underlying_split[where r'="dc" and P="\<lambda>rv. \<top>"])
prefer 3
apply (simp add:not_idle_thread_def)
apply wp
apply (rule_tac t1 = thread in hoare_post_imp[OF _ cap_delete_one_st_tcb_at_and_valid_etcbs])
apply (fastforce simp:obj_at_def generates_pending_def st_tcb_at_def)
apply (simp add: transform_tcb_slot_simp[symmetric])
apply (rule corres_guard_imp[OF delete_cap_simple_corres])
prefer 3
apply wp
apply (wp | clarsimp simp:emptyable_def not_idle_thread_def)+
apply (simp add:liftM_def select_f_get_register get_thread_def bind_assoc)
apply (rule dcorres_gets_the)
apply (clarsimp, frule(1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp:opt_object_tcb gets_def transform_tcb_def)
apply (simp add:transform_full_intent_def Let_def cap_fault_injection)
apply (rule corres_guard_imp)
apply (rule corres_split_catch[where f= dc,OF handle_fault_corres])
apply (rule dcorres_injection_handler_rhs)
apply (rule_tac R' ="\<lambda>rv s. (\<forall>ref badge rights. rv = cap.EndpointCap ref badge rights \<longrightarrow> (ep_at ref s)) \<and> not_idle_thread (cur_thread s') s
prefer 3
apply (simp add:not_idle_thread_def)
apply wp
apply (rule_tac t1 = thread in hoare_post_imp[OF _ cap_delete_one_st_tcb_at_and_valid_etcbs])
apply (fastforce simp:obj_at_def generates_pending_def st_tcb_at_def)
apply (simp add: transform_tcb_slot_simp[symmetric])
apply (rule corres_guard_imp[OF delete_cap_simple_corres])
prefer 3
apply wp
apply (wp | clarsimp simp:emptyable_def not_idle_thread_def)+
apply (simp add:liftM_def select_f_get_register get_thread_def bind_assoc)
apply (rule dcorres_gets_the)
apply (clarsimp, frule(1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp:opt_object_tcb gets_def transform_tcb_def)
apply (simp add:transform_full_intent_def Let_def cap_fault_injection)
apply (rule corres_guard_imp)
apply (rule corres_split_catch[where f= dc,OF handle_fault_corres])
apply (rule dcorres_injection_handler_rhs)
apply (rule_tac R' ="\<lambda>rv s. (\<forall>ref badge rights. rv = cap.EndpointCap ref badge rights \<longrightarrow> (ep_at ref s)) \<and> not_idle_thread (cur_thread s') s
\<and> not_idle_thread (cur_thread s) s
\<and> (st_tcb_at active (cur_thread s') s \<and> invs s \<and> valid_etcbs s) \<and> ko_at (TCB obj') (cur_thread s') s " and R= "\<lambda>r. \<top>"
in corres_splitEE[where r'="\<lambda>x y. x = transform_cap y"])
apply (rule dcorres_expand_pfx)
apply (clarsimp split:cap.splits arch_cap.splits
simp:transform_cap_def)
apply (rule corres_guard_imp)
apply (rule_tac epptr = word1 in recv_sync_ipc_corres)
apply (simp add:cap_ep_ptr_def )+
apply (clarsimp simp:st_tcb_at_def obj_at_def dest!:get_tcb_SomeD get_etcb_SomeD)
defer(* NEED RECEIVE ASYNC IPC *)
apply (rule dcorres_expand_pfx)
apply (clarsimp split:cap.splits arch_cap.splits simp:transform_cap_def)
apply (rename_tac word1 word2 set)
apply (rule corres_guard_imp)
apply (rule_tac epptr = word1 in recv_sync_ipc_corres)
apply (simp add:cap_ep_ptr_def )+
apply (clarsimp simp:st_tcb_at_def obj_at_def dest!:get_tcb_SomeD get_etcb_SomeD)
defer(* NEED RECEIVE ASYNC IPC *)
apply (rule lookup_cap_corres, simp)
apply (simp add: Types_D.word_bits_def)
apply wp
@ -1509,10 +1516,10 @@ defer(* NEED RECEIVE ASYNC IPC *)
valid_irq_node s" in hoare_strengthen_post)
apply wp
apply (clarsimp simp add: valid_fault_def)
apply clarsimp+
apply clarsimp+
apply (clarsimp dest!: get_tcb_SomeD
simp: invs_valid_tcb_ctable valid_state_def invs_def
obj_at_def valid_pspace_def not_idle_thread_def)
simp: invs_valid_tcb_ctable valid_state_def invs_def
obj_at_def valid_pspace_def not_idle_thread_def)
apply (clarsimp, frule(1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp:opt_object_tcb)
apply wp
@ -1537,156 +1544,90 @@ lemma handle_reply_corres:
in corres_split [OF _ get_cap_corres])
apply (simp add: transform_cap_def corres_fail split: cap.split)
apply (clarsimp simp: corres_fail dc_def[symmetric] split: bool.split)
apply (rename_tac word)
apply (rule corres_guard_imp)
apply (rule do_reply_transfer_corres)
apply (simp add: transform_tcb_slot_simp)
apply simp
apply (clarsimp simp:ct_running_not_idle_etc)
apply (frule caps_of_state_valid(1))
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (simp add:valid_cap_def)+
apply (clarsimp simp:valid_state_def invs_def valid_reply_caps_def dest!:has_reply_cap_cte_wpD)
apply (drule_tac x = word in spec,simp)
apply (clarsimp simp:not_idle_thread_def st_tcb_at_def obj_at_def valid_idle_def)
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (simp add:valid_cap_def)+
apply (clarsimp simp:valid_state_def invs_def valid_reply_caps_def dest!:has_reply_cap_cte_wpD)
apply (drule_tac x = word in spec,simp)
apply (clarsimp simp:not_idle_thread_def st_tcb_at_def obj_at_def valid_idle_def)
apply (clarsimp simp: transform_tcb_slot_simp|wp get_cap_wp)+
apply (clarsimp simp:ct_in_state_def invs_def valid_state_def st_tcb_at_def tcb_at_def obj_at_def)
apply (clarsimp simp:ct_in_state_def invs_def valid_state_def st_tcb_at_def tcb_at_def obj_at_def)
done
lemma set_object_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> KHeap_A.set_object word x
\<lbrace>\<lambda>yb s. P (cur_thread s) (idle_thread s)\<rbrace>"
by (fastforce simp:set_object_def valid_def get_def put_def return_def bind_def)
lemma set_thread_state_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread (s :: det_ext state)) \<rbrace> set_thread_state thread x \<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (simp add:set_thread_state_def)
apply (wp set_object_cur_thread_idle_thread)
apply simp
done
lemma thread_set_cur_thread_idle_thread:
" \<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> thread_set (tcb_fault_update Map.empty) word \<lbrace>\<lambda>xg s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (simp add:thread_set_def)
apply (wp set_object_cur_thread_idle_thread)
apply simp
done
lemma as_user_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> as_user thread x \<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (clarsimp simp:as_user_def)
apply (wp set_object_cur_thread_idle_thread)+
apply (fastforce simp:set_object_def valid_def get_def put_def return_def bind_def)
apply (simp add:select_f_def)
apply (simp add:valid_def)
apply (auto|wp)+
done
lemma do_fault_transfer_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> do_fault_transfer c a e recv_buffer \<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (simp add:do_fault_transfer_def set_message_info_def)
apply (wp as_user_cur_thread_idle_thread |wpc|clarsimp)+
apply (wps | wp transfer_caps_it copy_mrs_it | simp )+
apply wpc
apply (wp | simp add:thread_get_def)+
done
lemma do_normal_transfer_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s) \<rbrace> Ipc_A.do_normal_transfer a b c d e f g h\<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (simp add:do_normal_transfer_def set_message_info_def)
apply (wp as_user_cur_thread_idle_thread |wpc|clarsimp)+
apply (wps | wp transfer_caps_it copy_mrs_it)+
apply clarsimp
done
lemma do_ipc_transfer_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s) \<rbrace> Ipc_A.do_ipc_transfer a b c d e f\<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (simp add:do_ipc_transfer_def)
apply (wp do_fault_transfer_cur_thread_idle_thread do_normal_transfer_cur_thread_idle_thread|wpc)+
apply (wp | simp add:thread_get_def)+
done
lemma handle_reply_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread (s :: det_ext state)) (idle_thread s)\<rbrace> Syscall_A.handle_reply
\<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s) \<rbrace>"
apply (simp add:handle_reply_def)
apply (wp do_ipc_transfer_cur_thread_idle_thread|wpc)+
apply (clarsimp simp:Ipc_A.do_reply_transfer_def)
apply (wp set_thread_state_cur_thread_idle_thread|wpc)+
apply ((wps|wp cap_delete_one_it)+)[1]
apply (wp hoare_vcg_if_lift thread_set_cur_thread_idle_thread
do_ipc_transfer_cur_thread_idle_thread
set_thread_state_cur_thread_idle_thread)
apply ((wps | wp handle_fault_reply_it)+)[1]
apply wp
apply ((wps | wp cap_delete_one_it)+)[1]
apply (rule hoare_drop_imp | rule hoare_conjI | rule hoare_allI | wp)+
apply simp+
done
apply (wp | simp add:thread_get_def)+
done
lemma handle_vm_fault_wp:
"\<lbrace>P\<rbrace> handle_vm_fault thread vmfault_type \<lbrace>\<lambda>_. Q\<rbrace>,\<lbrace>\<lambda>rv. P\<rbrace>"
apply (case_tac vmfault_type)
apply (simp add:handle_vm_fault.simps)
apply wp
apply (simp)
apply wp
apply (clarsimp simp:do_machine_op_def getDFSR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp
apply (clarsimp simp:gets_def alternative_def get_def bind_def select_def return_def)
apply (clarsimp simp:do_machine_op_def getFAR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp
apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def)
apply simp
apply (simp add:handle_vm_fault.simps)
apply simp
apply (simp)
apply wp
apply (clarsimp simp:do_machine_op_def getIFSR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (clarsimp simp:do_machine_op_def getIFSR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp
apply (clarsimp simp: gets_def get_def bind_def return_def)
apply (clarsimp simp: as_user_def getRestartPC_def set_object_def get_def put_def bind_assoc)
apply wp
apply (case_tac x)
apply (clarsimp simp:bind_def return_def)
apply (rule_tac P="P and ko_at (TCB tcb) thread and (\<lambda>s. (tcb\<lparr>tcb_context := snd(aa,ba)\<rparr>) = tcb)" in hoare_post_imp)
apply (clarsimp simp: gets_def get_def bind_def return_def)
apply (clarsimp simp: as_user_def getRestartPC_def set_object_def get_def put_def bind_assoc)
apply wp
apply (case_tac x)
apply (clarsimp simp:bind_def return_def)
apply (rule_tac P="P and ko_at (TCB tcb) thread and (\<lambda>s. (tcb\<lparr>tcb_context := snd(aa,ba)\<rparr>) = tcb)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:obj_at_def valid_def simpler_modify_def return_def bind_def)
apply (clarsimp simp:obj_at_def valid_def simpler_modify_def return_def bind_def)
apply wp
apply (clarsimp simp:getRegister_def gets_def alternative_def select_def bind_def get_def return_def obj_at_def)
apply (simp add:get_tcb_SomeD)
apply (clarsimp simp:getRegister_def gets_def alternative_def select_def bind_def get_def return_def obj_at_def)
apply (simp add:get_tcb_SomeD)
apply simp
done
done
lemma get_active_irq_corres:
"dcorres (\<lambda>r r'. r' = r) \<top> \<top> get_active_irq (do_machine_op getActiveIRQ)"
apply (clarsimp simp: corres_underlying_def do_machine_op_def
select_f_def bind_def in_monad getActiveIRQ_def
return_def get_active_irq_def in_alternative select_def
return_def get_active_irq_def select_def
split: if_splits)
apply (rule_tac x="(None, transform b)" in bexI
, (simp add: in_alternative)+)
apply (rule_tac x="(Some (irq_oracle (Suc (irq_state (machine_state b)))),
transform b)" in bexI
, (simp add: in_alternative)+)
done
done
crunch valid_etcbs[wp]: "handle_reply" "valid_etcbs"
@ -1696,12 +1637,7 @@ lemma hr_ct_active_and_valid_etcbs:
"\<lbrace>invs and ct_active and valid_etcbs\<rbrace> Syscall_A.handle_reply \<lbrace>\<lambda>rv. ct_active and valid_etcbs\<rbrace>"
by (wp, simp+)
find_theorems transform valid
lemma tcb_sched_action_transform_inv[wp]:"\<lbrace>\<lambda>s. transform s = cs\<rbrace> tcb_sched_action a b \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
apply (clarsimp simp: tcb_sched_action_def)
apply (wp | simp)+
done
declare tcb_sched_action_transform[wp]
crunch transform_inv[wp]: reschedule_required "\<lambda>s. transform s = cs"
@ -1710,27 +1646,28 @@ lemma handle_event_corres:
(invs and valid_pdpt_objs and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_running s) and valid_etcbs)
(Syscall_D.handle_event ev) (Syscall_A.handle_event ev)"
apply (cases ev, simp_all add: Syscall_D.handle_event_def)
apply (case_tac syscall)
apply (simp_all add:handle_syscall_def handle_send_def handle_call_def)
apply (rule handle_invocation_corres[THEN corres_guard_imp] | simp)+
apply (rule corres_guard_imp[OF handle_wait_corres])
apply simp+
apply (simp add: ct_running_not_idle_etc)
apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def generates_pending_def)
apply (rule corres_guard_imp[OF handle_reply_corres])
apply simp
apply (simp add: ct_running_not_idle_etc)
apply (rule corres_guard_imp)
apply (rule corres_split[OF handle_wait_corres handle_reply_corres])
apply (wp handle_reply_cur_thread_idle_thread)
apply (simp add:not_idle_thread_def)
apply (wp handle_reply_cur_thread_idle_thread handle_reply_valid_etcbs)
apply (rule hoare_post_imp[OF _ hr_ct_active_and_valid_etcbs])
apply (clarsimp simp:ct_in_state_def)
apply clarsimp+
apply (frule (1) ct_running_not_idle_etc)
apply (clarsimp simp:not_idle_thread_def ct_in_state_def st_tcb_at_def)
apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def)+)[2]
apply (rename_tac syscall)
apply (case_tac syscall)
apply (simp_all add:handle_syscall_def handle_send_def handle_call_def)
apply (rule handle_invocation_corres[THEN corres_guard_imp] | simp)+
apply (rule corres_guard_imp[OF handle_wait_corres])
apply simp+
apply (simp add: ct_running_not_idle_etc)
apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def generates_pending_def)
apply (rule corres_guard_imp[OF handle_reply_corres])
apply simp
apply (simp add: ct_running_not_idle_etc)
apply (rule corres_guard_imp)
apply (rule corres_split[OF handle_wait_corres handle_reply_corres])
apply (wp handle_reply_cur_thread_idle_thread)
apply (simp add:not_idle_thread_def)
apply (wp handle_reply_cur_thread_idle_thread handle_reply_valid_etcbs)
apply (rule hoare_post_imp[OF _ hr_ct_active_and_valid_etcbs])
apply (clarsimp simp:ct_in_state_def)
apply clarsimp+
apply (frule (1) ct_running_not_idle_etc)
apply (clarsimp simp:not_idle_thread_def ct_in_state_def st_tcb_at_def)
apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def)+)[2]
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_return, simp)
apply (wp hoare_TrueI)
@ -1739,30 +1676,29 @@ lemma handle_event_corres:
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def gets_def get_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (rule corres_symb_exec_r[OF handle_fault_corres])
apply wp[1]
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (simp add:handle_pending_interrupts_def)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ get_active_irq_corres])
apply (clarsimp simp:option.splits)
apply (rule handle_interrupt_corres)
apply (wp | simp)+
apply (rule corres_symb_exec_r)
apply (rule corres_symb_exec_catch_r)
apply (rule handle_fault_corres)
apply (simp only: conj_ac)
apply (rule hoare_vcg_E_conj)
apply (wp handle_vm_fault_wp)
apply (simp add:no_fail_def)
apply wp
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (clarsimp simp:invs_def valid_state_def st_tcb_at_def
generates_pending_def obj_at_def)
apply (wp|simp)+
done
apply (rule corres_symb_exec_r[OF handle_fault_corres])
apply wp[1]
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (simp add:handle_pending_interrupts_def)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ get_active_irq_corres])
apply (clarsimp simp:option.splits)
apply (rule handle_interrupt_corres)
apply (wp | simp)+
apply (rule corres_symb_exec_r)
apply (rule corres_symb_exec_catch_r)
apply (rule handle_fault_corres)
apply (simp only: conj_ac)
apply (rule hoare_vcg_E_conj)
apply (wp handle_vm_fault_wp)
apply (simp add:no_fail_def)
apply wp
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (clarsimp simp:invs_def valid_state_def st_tcb_at_def generates_pending_def obj_at_def)
apply (wp|simp)+
done
end

794
proof/drefine/Tcb_DR.thy
View File

File diff suppressed because it is too large Load Diff

143
proof/drefine/Untyped_DR.thy
View File

@ -71,8 +71,7 @@ next
apply (case_tac "is_aligned a 2")
apply (simp add: loadWord_def is_aligned_mask exec_gets)
apply (simp add: return_def)
apply (simp add: loadWord_def exec_gets fail_def is_aligned_mask
del: word_neq_0_conv)
apply (simp add: loadWord_def exec_gets fail_def is_aligned_mask)
done
have loadWord_atMostOneResult:
@ -80,8 +79,7 @@ next
apply (case_tac "is_aligned a 2")
apply (simp add: loadWord_def is_aligned_mask exec_gets)
apply (simp add: return_def)
apply (simp add: loadWord_def exec_gets fail_def is_aligned_mask
del: word_neq_0_conv)
apply (simp add: loadWord_def exec_gets fail_def is_aligned_mask)
done
have mapM_loadWord_atMostOneResult[rule_format]:
@ -288,7 +286,7 @@ lemma freeMemory_dcorres:
\<lambda>_ _. is_arch_cap or op = cap.NullCap)" in bspec)
apply (simp add: ran_tcb_cap_cases)
apply clarsimp
apply (thin_tac "case_option ?x ?y ?z")
apply (thin_tac "case_option x y z" for x y z)
apply (simp add: valid_ipc_buffer_cap_def)
apply (drule valid_page_cap_imp_valid_buf)
apply (frule_tac transform_full_intent_machine_state_eq, simp_all)
@ -299,7 +297,7 @@ lemma freeMemory_dcorres:
mask_2pm1[symmetric])
apply (erule_tac x="(p && ~~ mask (pageBitsForSize sz))" in allE)
apply clarsimp
apply (thin_tac "length ?xs = ?y")
apply (thin_tac "length xs = y" for xs y)
apply (clarsimp simp:is_aligned_neg_mask_eq)
apply (erule impE)
apply (simp add:mask_def[unfolded shiftl_t2n,simplified,symmetric] p_assoc_help)
@ -309,7 +307,7 @@ lemma freeMemory_dcorres:
apply simp
apply (cut_tac ptr = p and n = "pageBitsForSize sz" in word_neg_and_le)
apply (simp add:mask_def[unfolded shiftl_t2n,simplified,symmetric] p_assoc_help)
apply (thin_tac "?x\<noteq>?y")
apply (thin_tac "x\<noteq>y" for x y)
apply (erule notE)
apply (rule is_aligned_no_wrap'[OF is_aligned_neg_mask])
apply (rule le_refl)
@ -403,7 +401,7 @@ definition
lemma transform_empty_cnode:
"transform_cnode_contents o_bits (empty_cnode o_bits) = empty_cap_map o_bits"
apply (simp add: transform_cnode_contents_def wf_empty dom_empty_cnode)
apply (simp add: transform_cnode_contents_def dom_empty_cnode)
apply (rule ext, simp add: option_map_join_def empty_cap_map_def
nat_to_bl_def len_bin_to_bl_aux)
done
@ -420,7 +418,7 @@ lemma transform_default_tcb:
get_ipc_buffer_words_def)
apply (simp add: transform_intent_def invocation_type_def fromEnum_def
enum_invocation_label toEnum_def)
apply (simp add: fun_eq_iff tcb_slot_defs tcb_pending_op_slot_def)
apply (simp add: fun_eq_iff tcb_slot_defs)
apply (simp add: infer_tcb_pending_op_def guess_error_def default_etcb_def default_domain_def)
done
@ -448,20 +446,20 @@ lemma obj_bits_bound32:
type = Invariants_AI.CapTableObject \<longrightarrow> us < 28\<rbrakk>
\<Longrightarrow>obj_bits_api type us < WordSetup.word_bits"
apply (case_tac type)
apply (simp_all add:obj_bits_api_def word_bits_def slot_bits_def)
apply (simp_all add:obj_bits_api_def word_bits_def slot_bits_def)
apply (rename_tac aobject_type)
apply (case_tac aobject_type)
apply (simp_all add:arch_kobj_size_def
default_arch_object_def pageBits_def)
apply (simp_all add:arch_kobj_size_def default_arch_object_def pageBits_def)
done
lemma obj_bits_bound4:
"\<lbrakk>type = Invariants_AI.Untyped \<longrightarrow> 4 \<le> us\<rbrakk> \<Longrightarrow>
4 \<le> obj_bits_api type us"
apply (case_tac type)
apply (simp_all add:obj_bits_api_def word_bits_def slot_bits_def)
apply (simp_all add:obj_bits_api_def word_bits_def slot_bits_def)
apply (rename_tac aobject_type)
apply (case_tac aobject_type)
apply (simp_all add:arch_kobj_size_def
default_arch_object_def pageBits_def)
apply (simp_all add:arch_kobj_size_def default_arch_object_def pageBits_def)
done
lemma distinct_retype_addrs:
@ -483,7 +481,7 @@ lemma distinct_retype_addrs:
apply (erule Retype_AI.range_cover.range_cover_le_n_less(2))
apply simp
apply (rule shiftl_shiftr_id)
apply (simp add:range_cover_def)
apply (simp add:range_cover_def)
apply (rule word_of_nat_less)
apply (subst unat_power_lower)
apply (rule diff_less)
@ -540,7 +538,7 @@ lemma retype_transform_obj_ref_pick_id:
"type \<noteq> Structures_A.Untyped
\<Longrightarrow> map (\<lambda>x. {pick x}) (map (retype_transform_obj_ref type us) xs)
= map (retype_transform_obj_ref type us) xs"
by (simp add:retype_transform_obj_ref_def map_map)
by (simp add:retype_transform_obj_ref_def)
lemma translate_object_type_not_untyped:
"type \<noteq> Invariants_AI.Untyped
@ -593,49 +591,44 @@ lemma retype_region_dcorres:
us (translate_object_type type) (map (retype_transform_obj_ref type us) (retype_addrs ptr type n us)))
(Retype_A.retype_region ptr n us type)"
apply (simp add: retype_region_def Untyped_D.retype_region_def
split del: split_if)
split del: split_if)
apply (clarsimp simp:when_def generate_object_ids_def bind_assoc
split del:if_splits)
apply (simp add:retype_addrs_fold split del:if_splits)
split del:split_if)
apply (simp add:retype_addrs_fold split del:split_if)
apply (case_tac "type = Invariants_AI.Untyped")
apply (rule corres_guard_imp)
apply (simp add:translate_object_type_def)
apply (intro conjI impI ballI | simp)+
apply (simp add:gets_fold_into_modify retype_addrs_fold retype_region_ext_def modify_modify
create_objects_def)
apply (rule dcorres_expand_pfx)
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_split)
apply (rule corres_trivial)
apply simp
apply (rule_tac r = dc and Q = \<top> and Q' = "op = s'" in corres_guard_imp)
apply (clarsimp simp: transform_def bind_def simpler_modify_def corres_underlying_def
apply (simp add:gets_fold_into_modify retype_addrs_fold retype_region_ext_def modify_modify
create_objects_def)
apply (rule dcorres_expand_pfx)
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_split)
apply (rule corres_trivial)
apply simp
apply (rule_tac r = dc and Q = \<top> and Q' = "op = s'" in corres_guard_imp)
apply (clarsimp simp: transform_def bind_def simpler_modify_def corres_underlying_def
transform_current_thread_def transform_cdt_def transform_asid_table_def)
apply (rule ext)
apply (clarsimp simp:foldr_upd_app_if foldr_fun_upd_value restrict_map_def map_add_def
apply (rule ext)
apply (clarsimp simp:foldr_upd_app_if foldr_fun_upd_value restrict_map_def map_add_def
transform_objects_def retype_transform_obj_ref_def image_def)
apply (subgoal_tac "idle_thread s' \<notin> set (retype_addrs ptr type n us)")
apply (subgoal_tac "type = Structures_A.CapTableObject \<longrightarrow> us \<noteq> 0")
apply (clarsimp simp:transform_default_object translate_object_type_not_untyped)
defer
apply clarsimp
apply (frule invs_valid_idle,clarsimp simp:valid_idle_def st_tcb_at_def obj_at_def)
apply (erule(3) pspace_no_overlapC)
apply clarsimp
apply simp
apply assumption
apply wp
apply fastforce
apply simp
apply (case_tac type,
simp_all add:translate_object_type_def)
apply (subgoal_tac "idle_thread s' \<notin> set (retype_addrs ptr type n us)")
apply (subgoal_tac "type = Structures_A.CapTableObject \<longrightarrow> us \<noteq> 0")
apply (clarsimp simp:transform_default_object translate_object_type_not_untyped)
defer
apply clarsimp
apply (frule invs_valid_idle,clarsimp simp:valid_idle_def st_tcb_at_def obj_at_def)
apply (erule(3) pspace_no_overlapC)
apply clarsimp
apply simp
apply assumption
apply wp
apply fastforce
apply simp
apply (case_tac type, simp_all add:translate_object_type_def)
apply (rename_tac aobject_type)
apply (case_tac aobject_type,simp_all)
done
lemma page_objects_default_object:
@ -679,7 +672,7 @@ lemma clearMemory_unused_corres_noop:
apply (subgoal_tac "y && ~~ mask (obj_bits_api ty us) = p")
apply (clarsimp simp: ipc_frame_wp_at_def obj_at_def ran_null_filter
split: cap.split_asm arch_cap.split_asm)
apply (cut_tac t="(?t, tcb_cnode_index 4)" and P="op = ?cap"
apply (cut_tac t="(t, tcb_cnode_index 4)" and P="op = cap" for t cap
in cte_wp_at_tcbI, simp, fastforce, simp)
apply (clarsimp simp: cte_wp_at_caps_of_state)
apply (drule(1) bspec)
@ -701,12 +694,6 @@ lemma clearMemory_unused_corres_noop:
apply (wp | simp)+
done
lemma word_neq0:
"(a \<noteq> (0::word32)) = ((0::word32) < a)"
apply (rule ccontr)
apply (simp add:not_less)
done
lemma dcorres_create_word_objects:
"\<lbrakk> 0 < n; ty \<in> ArchObject ` {SmallPageObj, LargePageObj, SectionObj, SuperSectionObj};
xsz = obj_bits_api ty us \<rbrakk>
@ -730,7 +717,7 @@ lemma dcorres_create_word_objects:
apply (rule corres_split[OF corres_trivial])
apply simp
apply (rule corres_mapM_to_mapM_x)
apply (rule_tac P=\<top> and P'="?P" and S = "{(x,y). y \<in> set ?M}"
apply (rule_tac P=\<top> and P'="P" and S = "{(x,y). y \<in> set M}" for P M
in corres_mapM_x[where f="\<lambda>_. return ()", OF _ _ _ refl,
simplified mapM_x_return])
apply clarsimp
@ -740,8 +727,7 @@ lemma dcorres_create_word_objects:
apply simp
apply wp
apply (wp hoare_vcg_ball_lift | simp)+
apply (clarsimp simp:zip_same retype_addrs_def ptr_add_def
image_def shiftl_t2n)
apply (clarsimp simp:zip_same retype_addrs_def ptr_add_def image_def shiftl_t2n)
apply (rule_tac x = "unat x" in bexI)
apply simp
apply clarsimp
@ -1304,7 +1290,7 @@ lemma free_range_of_untyped_pick_retype_addrs:
apply (subst group_add_class.add_diff_eq[symmetric])
apply (frule range_cover_not_zero_shift[rotated,OF _ le_refl])
apply simp
apply (thin_tac "\<not> ?P")
apply (thin_tac "\<not>P" for P)
apply (subst add.assoc[symmetric])
apply (subst AND_NOT_mask_plus_AND_mask_eq[symmetric,where n = sz])
apply (subst add.commute[where a = "(ptr && mask sz)"])
@ -1740,7 +1726,7 @@ lemma descendants_of_empty_lift :
apply clarsimp
apply (frule transform_cdt_dom_standard)
apply (clarsimp simp:descendants_of_def)
apply (thin_tac "(a,b) = ?P")
apply (thin_tac "(a,b) = P" for P)
apply (drule(1) transform_cdt_some_rev)
apply (clarsimp simp:valid_mdb_def)
apply clarsimp
@ -1815,6 +1801,7 @@ lemma decode_untyped_corres:
unlessE_whenE
split del: split_if
split: invocation_label.split_asm)
apply (rename_tac a list w1 w2 w3 w4 w5 apiobject_type)
apply (cases excaps')
apply (simp add: get_index_def transform_cap_list_def
alternative_refl)
@ -1840,7 +1827,7 @@ lemma decode_untyped_corres:
apply auto[1]
apply (rename_tac cnode_cap cnode_cap')
apply (simp add: bindE_assoc split del: split_if)
apply (simp add: if_to_top_of_bindE is_cnode_cap_eq[symmetric]
apply (simp add: if_to_top_of_bindE is_cnode_cap_transform_cap[symmetric]
split del: split_if)
apply (rule corres_if_rhs[rotated])
apply (rule corres_trivial, simp add: alternative_refl)
@ -1866,7 +1853,7 @@ lemma decode_untyped_corres:
apply (erule is_aligned_weaken)
apply (simp add:range_cover_def)
apply (simp add:has_children_def KHeap_D.is_cdt_parent_def
descendants_of_empty_lift word_neq0)
descendants_of_empty_lift word_neq_0_conv)
apply (subst alignUp_gt_0[where x = "2 ^ sz"])
apply (rule is_aligned_weaken[where x = sz])
apply (simp add:is_aligned_def)
@ -1900,10 +1887,10 @@ lemma decode_untyped_corres:
apply (rule corres_guard_imp)
apply (rule_tac F="cap_aligned cnode_cap' \<and> is_cnode_cap cnode_cap'" in corres_gen_asm2)
apply (subgoal_tac "map (Pair (cap_object (transform_cap cnode_cap')))
[unat word4 ..< unat word4 + unat word5]
[unat w4 ..< unat w4 + unat w5]
= map (\<lambda>x. transform_cslot_ptr (obj_ref_of (cnode_cap'),
(nat_to_cref (bits_of cnode_cap') x)))
[unat word4 ..< unat word4 + unat word5]")
[unat w4 ..< unat w4 + unat w5]")
apply (simp del: map_eq_conv)
apply (simp add: mapME_x_map_simp)
apply (rule mapME_x_corres_inv)
@ -1919,7 +1906,7 @@ lemma decode_untyped_corres:
apply (rule hoare_pre)
apply (wp hoare_drop_imp | simp)+
apply fastforce
apply (clarsimp simp:is_cnode_cap_eq conj_ac split del:if_splits)
apply (clarsimp simp: conj_comms is_cnode_cap_transform_cap split del: split_if)
apply (rule validE_R_validE)
apply (rule_tac Q' = "\<lambda>a s. invs s \<and> valid_etcbs s \<and> valid_cap a s \<and> cte_wp_at (op = (cap.UntypedCap ptr sz idx)) slot' s
\<and> (Structures_A.is_cnode_cap a \<longrightarrow> not_idle_thread (obj_ref_of a) s)"
@ -1930,7 +1917,7 @@ lemma decode_untyped_corres:
in hoare_post_imp_R)
apply wp
apply (clarsimp simp: cte_wp_at_caps_of_state)
apply (frule_tac p = "(?x,?y)" in caps_of_state_valid[rotated])
apply (frule_tac p = "(x,y)" for x y in caps_of_state_valid[rotated])
apply simp
apply (clarsimp simp:valid_cap_def obj_at_def valid_idle_def st_tcb_at_def
is_cap_simps not_idle_thread_def is_cap_table_def dest!:invs_valid_idle)
@ -1941,8 +1928,8 @@ lemma decode_untyped_corres:
apply (rule ccontr)
apply (clarsimp simp:valid_cap_simps cap_aligned_def)
apply (frule cte_wp_at_caps_descendants_range_inI[where ptr = ptr and cref = slot' and sz = sz])
apply (clarsimp simp:cte_wp_at_caps_of_state is_aligned_neg_mask_eq)
apply simp+
apply (clarsimp simp:cte_wp_at_caps_of_state is_aligned_neg_mask_eq)
apply simp+
apply (simp add:is_aligned_neg_mask_eq)
apply (drule descendants_range_imply_no_descendants[rotated 3])
apply clarsimp+
@ -1951,7 +1938,7 @@ lemma decode_untyped_corres:
apply simp
apply simp
apply (rule hoare_pre,wp,simp)
apply (wp hoare_drop_imp mapME_x_inv_wp2 | simp add:whenE_def split del:split_if)+
apply (wp hoare_drop_imp mapME_x_inv_wp2 | simp add:whenE_def split del:split_if)+
apply (rule hoare_pre,wp,simp)
done
@ -1960,11 +1947,11 @@ lemma decode_untyped_label_not_match:
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_untyped_invocation label args ref (cap.UntypedCap a b idx) e
\<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>e. op = s\<rbrace>"
apply (case_tac "invocation_type label = UntypedRetype")
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)+
apply (clarsimp simp:transform_intent_untyped_retype_def split:option.splits list.splits)
apply (simp add:Decode_A.decode_untyped_invocation_def unlessE_def)
apply wp
done
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def transform_intent_def)+
apply (clarsimp simp:transform_intent_untyped_retype_def split:option.splits list.splits)
apply (simp add:Decode_A.decode_untyped_invocation_def unlessE_def)
apply wp
done
end