From b614d7ec9c08db68cae95b191d3ef80aceee0d61 Mon Sep 17 00:00:00 2001 From: Corey Lewis Date: Wed, 5 Oct 2022 12:28:12 +1100 Subject: [PATCH] arm-hyp refine: update for changed corres split rules Signed-off-by: Corey Lewis --- proof/refine/ARM_HYP/Arch_R.thy | 161 ++-- proof/refine/ARM_HYP/Bits_R.thy | 22 +- proof/refine/ARM_HYP/CNodeInv_R.thy | 306 ++++---- proof/refine/ARM_HYP/CSpace1_R.thy | 648 ++++++++-------- proof/refine/ARM_HYP/CSpace_R.thy | 265 ++++--- proof/refine/ARM_HYP/Detype_R.thy | 2 +- proof/refine/ARM_HYP/Finalise_R.thy | 14 +- proof/refine/ARM_HYP/InterruptAcc_R.thy | 18 +- proof/refine/ARM_HYP/Interrupt_R.thy | 396 +++++----- proof/refine/ARM_HYP/IpcCancel_R.thy | 195 +++-- proof/refine/ARM_HYP/Ipc_R.thy | 893 +++++++++++----------- proof/refine/ARM_HYP/Refine.thy | 27 +- proof/refine/ARM_HYP/Retype_R.thy | 107 +-- proof/refine/ARM_HYP/Schedule_R.thy | 209 ++--- proof/refine/ARM_HYP/Syscall_R.thy | 256 ++++--- proof/refine/ARM_HYP/TcbAcc_R.thy | 339 +++++---- proof/refine/ARM_HYP/Tcb_R.thy | 378 +++++----- proof/refine/ARM_HYP/Untyped_R.thy | 508 ++++++------- proof/refine/ARM_HYP/VSpace_R.thy | 965 ++++++++++++------------ 19 files changed, 2885 insertions(+), 2824 deletions(-) diff --git a/proof/refine/ARM_HYP/Arch_R.thy b/proof/refine/ARM_HYP/Arch_R.thy index f97ceef4d..bf3ea0283 100644 --- a/proof/refine/ARM_HYP/Arch_R.thy +++ b/proof/refine/ARM_HYP/Arch_R.thy @@ -153,89 +153,89 @@ lemma performASIDControlInvocation_corres: apply (erule deleteObjects_corres) apply (simp add:pageBits_def) apply (rule corres_split[OF getSlotCap_corres]) - apply (rule_tac F = " pcap = (cap.UntypedCap False word1 pageBits idxa)" in corres_gen_asm) - apply (rule corres_split[OF updateFreeIndex_corres]) - apply (rule corres_split) - apply (simp add: retype_region2_ext_retype_region_ArchObject ) - apply (rule corres_retype [where ty="Inl (KOArch (KOASIDPool F))", - unfolded APIType_map2_def makeObjectKO_def, - THEN createObjects_corres',simplified, - where val = "makeObject::asidpool"]) - apply simp - apply (simp add: objBits_simps obj_bits_api_def arch_kobj_size_def - default_arch_object_def archObjSize_def)+ - apply (simp add: obj_relation_retype_def default_object_def - default_arch_object_def objBits_simps archObjSize_def) - apply (simp add: other_obj_relation_def asid_pool_relation_def) - apply (simp add: makeObject_asidpool const_def inv_def) - apply (rule range_cover_full) - apply (simp add:obj_bits_api_def arch_kobj_size_def default_arch_object_def)+ - apply (rule corres_split) - apply (rule cteInsert_simple_corres, simp, rule refl, rule refl) - apply (rule_tac F="is_aligned word2 asid_low_bits" in corres_gen_asm) - apply (simp add: is_aligned_mask dc_def[symmetric]) - apply (rule corres_split[where P=\ and P'=\ and r'="\t t'. t = t' o ucast"]) - apply (clarsimp simp: state_relation_def arch_state_relation_def) - apply (rule corres_trivial) - apply (rule corres_modify) - apply (thin_tac "x \ state_relation" for x) - apply (clarsimp simp: state_relation_def arch_state_relation_def o_def) - apply (rule ext) - apply clarsimp - apply (erule_tac P = "x = asid_high_bits_of word2" in notE) - apply (rule word_eqI[rule_format]) - apply (drule_tac x1="ucast x" in bang_eq [THEN iffD1]) - apply (erule_tac x=n in allE) - apply (simp add: word_size nth_ucast) - apply wp+ - apply (strengthen safe_parent_strg[where idx = "2^pageBits"]) - apply (strengthen invs_valid_objs invs_distinct - invs_psp_aligned invs_mdb - | simp cong:conj_cong)+ - apply (wp retype_region_plain_invs[where sz = pageBits] - retype_cte_wp_at[where sz = pageBits])+ - apply (strengthen vp_strgs' - safe_parent_strg'[where idx = "2^pageBits"]) - apply (simp cong: conj_cong) - apply (wp createObjects_valid_pspace' - [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"]) - apply (simp add: makeObjectKO_def)+ - apply (simp add:objBits_simps archObjSize_def range_cover_full)+ - apply (clarsimp simp:valid_cap'_def) - apply (wp createObject_typ_at' - createObjects_orig_cte_wp_at'[where sz = pageBits]) - apply (rule descendants_of'_helper) - apply (wp createObjects_null_filter' - [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"]) + apply simp + apply (rule_tac F = " pcap = (cap.UntypedCap False word1 pageBits idxa)" in corres_gen_asm) + apply (rule corres_split[OF updateFreeIndex_corres]) apply (clarsimp simp:is_cap_simps) apply (simp add: free_index_of_def) - - apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def - objBits_simps archObjSize_def default_arch_object_def - pred_conj_def) - apply (clarsimp simp: conj_comms - | strengthen invs_mdb invs_valid_pspace)+ - apply (simp add:region_in_kernel_window_def) - apply (wp set_untyped_cap_invs_simple[where sz = pageBits] - set_cap_cte_wp_at - set_cap_caps_no_overlap[where sz = pageBits] - set_cap_no_overlap - set_cap_device_and_range_aligned[where dev = False,simplified] - set_untyped_cap_caps_overlap_reserved[where sz = pageBits])+ + apply (rule corres_split) + apply (simp add: retype_region2_ext_retype_region_ArchObject ) + apply (rule corres_retype [where ty="Inl (KOArch (KOASIDPool F))", + unfolded APIType_map2_def makeObjectKO_def, + THEN createObjects_corres',simplified, + where val = "makeObject::asidpool"]) + apply simp + apply (simp add: objBits_simps obj_bits_api_def arch_kobj_size_def + default_arch_object_def archObjSize_def)+ + apply (simp add: obj_relation_retype_def default_object_def + default_arch_object_def objBits_simps archObjSize_def) + apply (simp add: other_obj_relation_def asid_pool_relation_def) + apply (simp add: makeObject_asidpool const_def inv_def) + apply (rule range_cover_full) + apply (simp add:obj_bits_api_def arch_kobj_size_def default_arch_object_def)+ + apply (rule corres_split) + apply (rule cteInsert_simple_corres, simp, rule refl, rule refl) + apply (rule_tac F="is_aligned word2 asid_low_bits" in corres_gen_asm) + apply (simp add: is_aligned_mask dc_def[symmetric]) + apply (rule corres_split[where P=\ and P'=\ and r'="\t t'. t = t' o ucast"]) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (rule corres_trivial) + apply (rule corres_modify) + apply (thin_tac "x \ state_relation" for x) + apply (clarsimp simp: state_relation_def arch_state_relation_def o_def) + apply (rule ext) + apply clarsimp + apply (erule_tac P = "x = asid_high_bits_of word2" in notE) + apply (rule word_eqI[rule_format]) + apply (drule_tac x1="ucast x" in bang_eq [THEN iffD1]) + apply (erule_tac x=n in allE) + apply (simp add: word_size nth_ucast) + apply wp+ + apply (strengthen safe_parent_strg[where idx = "2^pageBits"]) + apply (strengthen invs_valid_objs invs_distinct + invs_psp_aligned invs_mdb + | simp cong:conj_cong)+ + apply (wp retype_region_plain_invs[where sz = pageBits] + retype_cte_wp_at[where sz = pageBits])+ + apply (strengthen vp_strgs' + safe_parent_strg'[where idx = "2^pageBits"]) + apply (simp cong: conj_cong) + apply (wp createObjects_valid_pspace' + [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"]) + apply (simp add: makeObjectKO_def)+ + apply (simp add:objBits_simps archObjSize_def range_cover_full)+ + apply (clarsimp simp:valid_cap'_def) + apply (wp createObject_typ_at' + createObjects_orig_cte_wp_at'[where sz = pageBits]) + apply (rule descendants_of'_helper) + apply (wp createObjects_null_filter' + [where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"]) apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def - objBits_simps archObjSize_def default_arch_object_def - makeObjectKO_def range_cover_full - simp del: capFreeIndex_update.simps - | strengthen invs_valid_pspace' invs_pspace_aligned' - invs_pspace_distinct' - exI[where x="makeObject :: asidpool"])+ - apply (wp updateFreeIndex_forward_invs' - updateFreeIndex_pspace_no_overlap' - updateFreeIndex_caps_no_overlap'' - updateFreeIndex_descendants_of2 - updateFreeIndex_cte_wp_at - updateFreeIndex_caps_overlap_reserved - | simp add: descendants_of_null_filter' split del: if_split)+ + objBits_simps archObjSize_def default_arch_object_def + pred_conj_def) + apply (clarsimp simp: conj_comms + | strengthen invs_mdb invs_valid_pspace)+ + apply (simp add:region_in_kernel_window_def) + apply (wp set_untyped_cap_invs_simple[where sz = pageBits] + set_cap_cte_wp_at + set_cap_caps_no_overlap[where sz = pageBits] + set_cap_no_overlap + set_cap_device_and_range_aligned[where dev = False,simplified] + set_untyped_cap_caps_overlap_reserved[where sz = pageBits])+ + apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def + objBits_simps archObjSize_def default_arch_object_def + makeObjectKO_def range_cover_full + simp del: capFreeIndex_update.simps + | strengthen invs_valid_pspace' invs_pspace_aligned' + invs_pspace_distinct' + exI[where x="makeObject :: asidpool"])+ + apply (wp updateFreeIndex_forward_invs' + updateFreeIndex_pspace_no_overlap' + updateFreeIndex_caps_no_overlap'' + updateFreeIndex_descendants_of2 + updateFreeIndex_cte_wp_at + updateFreeIndex_caps_overlap_reserved + | simp add: descendants_of_null_filter' split del: if_split)+ apply (wp get_cap_wp)+ apply (subgoal_tac "word1 && ~~ mask pageBits = word1 \ pageBits \ word_bits \ word_size_bits \ pageBits") prefer 2 @@ -527,6 +527,7 @@ lemma resolveVAddr_corres: and R'="\_ s. pspace_distinct' s \ pspace_aligned' s \ vs_valid_duplicates' (ksPSpace s)" in corres_split[OF get_master_pde_corres]) + apply simp apply (case_tac rv; clarsimp simp: master_pde_relation_def pde_relation'_def isSuperSection_def' page_base_def split: if_split_asm) diff --git a/proof/refine/ARM_HYP/Bits_R.thy b/proof/refine/ARM_HYP/Bits_R.thy index 9c512e720..6ffa1f190 100644 --- a/proof/refine/ARM_HYP/Bits_R.thy +++ b/proof/refine/ARM_HYP/Bits_R.thy @@ -234,14 +234,13 @@ lemma corres_injection: \ corres (f \ r) P P' (t m) (t' m')" apply (simp add: injection_handler_def handleE'_def x y) apply (rule corres_guard_imp) - apply (rule corres_split_deprecated) - defer + apply (rule corres_split) apply assumption - apply (rule wp_post_taut) + apply (case_tac v, (clarsimp simp: z)+) apply (rule wp_post_taut) - apply simp + apply (rule wp_post_taut) apply simp - apply (case_tac v, (clarsimp simp: z)+) + apply simp done lemma rethrowFailure_injection: @@ -427,9 +426,8 @@ lemma corres_empty_on_failure: apply (simp add: empty_on_failure_def emptyOnFailure_def) apply (rule corres_guard_imp) apply (rule corres_split_catch) - apply (rule corres_trivial, simp) - apply (erule corres_rel_imp) - apply (case_tac x; simp) + apply assumption + apply (rule corres_trivial, simp) apply wp+ apply simp+ done @@ -468,11 +466,9 @@ lemma corres_const_on_failure: apply (simp add: const_on_failure_def constOnFailure_def) apply (rule corres_guard_imp) apply (rule corres_split_catch) - apply (rule corres_trivial, simp) - apply (erule corres_rel_imp) - apply (case_tac xa) - apply (clarsimp simp: const_def) - apply simp + apply assumption + apply (rule corres_trivial, simp) + apply (clarsimp simp: const_def) apply wp+ apply simp+ done diff --git a/proof/refine/ARM_HYP/CNodeInv_R.thy b/proof/refine/ARM_HYP/CNodeInv_R.thy index ffce4cdf5..6e259112c 100644 --- a/proof/refine/ARM_HYP/CNodeInv_R.thy +++ b/proof/refine/ARM_HYP/CNodeInv_R.thy @@ -172,50 +172,52 @@ lemma decodeCNodeInvocation_corres: split del: if_split cong: if_cong list.case_cong) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (rule corres_splitEE[OF ensureEmptySlot_corres]) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (simp(no_asm) add: liftE_bindE del: de_Morgan_conj split del: if_split) - apply (rule corres_split[OF get_cap_corres']) - apply (simp add: split_def) - apply (rule whenE_throwError_corres) - apply (simp add: lookup_failure_map_def) - apply auto[1] - apply (rule_tac r'="\a b. fst b = rights_mask_map (fst a) - \ snd b = fst (snd a) - \ snd (snd a) = (gen_invocation_type (mi_label mi) - \ {CNodeMove, CNodeMutate})" - in corres_splitEE) - apply (rule corres_trivial) - subgoal by (auto split: list.split gen_invocation_labels.split, - auto simp: returnOk_def all_rights_def - rightsFromWord_correspondence) - apply (rule_tac r'=cap_relation in corres_splitEE) - apply (simp add: returnOk_def del: imp_disjL) - apply (rule conjI[rotated], rule impI) - apply (rule deriveCap_corres) - apply (clarsimp simp: cap_relation_mask - cap_map_update_data - split: option.split) - apply clarsimp - apply (clarsimp simp: cap_map_update_data - split: option.split) - apply (rule corres_trivial) - subgoal by (auto simp add: whenE_def, auto simp add: returnOk_def) - apply (wp | wpc | simp(no_asm))+ - apply (wp hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift - hoare_vcg_all_lift_R hoare_vcg_all_lift lsfco_cte_at' hoare_drop_imps - | clarsimp)+ + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (rule corres_splitEE) + apply (rule ensureEmptySlot_corres; simp) + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (simp(no_asm) add: liftE_bindE del: de_Morgan_conj split del: if_split) + apply (rule corres_split[OF get_cap_corres']) + apply (simp add: split_def) + apply (rule whenE_throwError_corres) + apply (simp add: lookup_failure_map_def) + apply auto[1] + apply (rule_tac r'="\a b. fst b = rights_mask_map (fst a) + \ snd b = fst (snd a) + \ snd (snd a) = (gen_invocation_type (mi_label mi) + \ {CNodeMove, CNodeMutate})" + in corres_splitEE) + apply (rule corres_trivial) + subgoal by (auto split: list.split gen_invocation_labels.split, + auto simp: returnOk_def all_rights_def + rightsFromWord_correspondence) + apply (rule_tac r'=cap_relation in corres_splitEE) + apply (simp add: returnOk_def del: imp_disjL) + apply (rule conjI[rotated], rule impI) + apply (rule deriveCap_corres) + apply (clarsimp simp: cap_relation_mask + cap_map_update_data + split: option.split) + apply clarsimp + apply (clarsimp simp: cap_map_update_data + split: option.split) + apply (rule corres_trivial) + subgoal by (auto simp add: whenE_def, auto simp add: returnOk_def) + apply (wp | wpc | simp(no_asm))+ + apply (wp hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift + hoare_vcg_all_lift_R hoare_vcg_all_lift lsfco_cte_at' hoare_drop_imps + | clarsimp)+ subgoal by (auto elim!: valid_cnode_capI) apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def) \ \Revoke\ apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split) - apply (rule corres_guard_imp, rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (simp add: split_beta) - apply (rule corres_returnOkTT) - apply simp - apply simp + apply (rule corres_guard_imp, rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (simp add: split_beta) + apply (rule corres_returnOkTT) apply simp apply wp+ apply (auto elim!: valid_cnode_capI)[1] @@ -224,11 +226,10 @@ lemma decodeCNodeInvocation_corres: apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (simp add: split_beta) - apply (rule corres_returnOkTT) - apply simp - apply simp + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (simp add: split_beta) + apply (rule corres_returnOkTT) apply simp apply wp+ apply (auto elim!: valid_cnode_capI)[1] @@ -237,33 +238,31 @@ lemma decodeCNodeInvocation_corres: apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (simp add: split_beta) - apply (rule corres_split_norE) - apply (rule corres_returnOkTT) - apply simp - apply (rule ensureEmptySlot_corres) - apply simp - apply wp+ + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (simp add: split_beta) + apply (rule corres_split_norE) + apply (rule ensureEmptySlot_corres) + apply simp + apply (rule corres_returnOkTT) apply simp - apply simp - apply simp - apply (wp hoare_drop_imps)+ + apply (wp hoare_drop_imps)+ apply (auto elim!: valid_cnode_capI)[1] apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def) \ \CancelBadgedSends\ apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (simp(no_asm) add: split_beta liftE_bindE) - apply (rule corres_split[OF get_cap_corres']) - apply (rule corres_split_norE) - apply (rule corres_trivial) - apply (clarsimp simp add: returnOk_def) - apply (simp add: cancelSendRightsEq) - apply (rule corres_trivial, auto simp add: whenE_def returnOk_def)[1] - apply (wp get_cap_wp getCTE_wp | simp only: whenE_def | clarsimp)+ + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (simp(no_asm) add: split_beta liftE_bindE) + apply (rule corres_split[OF get_cap_corres'], simp) + apply (rule corres_split_norE) + apply (simp add: cancelSendRightsEq) + apply (rule corres_trivial, auto simp add: whenE_def returnOk_def)[1] + apply (rule corres_trivial) + apply (clarsimp simp add: returnOk_def) + apply (wp get_cap_wp getCTE_wp | simp only: whenE_def | clarsimp)+ apply (rule hoare_trivE_R[where P="\"]) apply (simp add: cte_wp_at_ctes_of pred_conj_def cong: conj_cong) apply (fastforce elim!: valid_cnode_capI simp: invs_def valid_state_def valid_pspace_def) @@ -274,64 +273,62 @@ lemma decodeCNodeInvocation_corres: apply (simp add: le_diff_conv2 split_def decode_cnode_invocation_def decodeCNodeInvocation_def isCap_simps Let_def unlessE_whenE whenE_whenE_body del: disj_not1 ser_def split del: if_split) - apply (rule corres_guard_imp, rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (rename_tac dest_slot destSlot) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])+ - apply (rule_tac R = "\s. cte_at pivot_slot s \ cte_at dest_slot s - \ cte_at src_slot s \ invs s" in - whenE_throwError_corres' [where R' = \]) - apply simp - apply (elim conjE) - apply rule - apply fastforce - apply (erule disjE) - apply (clarsimp simp add: split_def) - apply (drule (2) cte_map_inj_eq, clarsimp+)[1] - apply (clarsimp simp add: split_def) - apply (drule (2) cte_map_inj_eq, clarsimp+)[1] - apply (rule corres_split_norE) - apply (simp add: liftE_bindE del: de_Morgan_conj disj_not1 split del: if_split) - apply (rule corres_split_liftM2, simp only: split_beta, rule get_cap_corres) - apply (rule whenE_throwError_corres) - apply (simp add: lookup_failure_map_def) - apply (erule cap_relation_NullCapI) - apply (rule corres_split_liftM2, simp only: split_beta, rule get_cap_corres) - apply (rule whenE_throwError_corres) - apply (simp add: lookup_failure_map_def) - apply (erule cap_relation_NullCapI) - apply (rule whenE_throwError_corres) - apply simp - apply (simp add: cap_relation_NullCap) - apply (rule corres_returnOkTT) - apply simp - apply (intro conjI) - apply (erule cap_map_update_data)+ - apply (wp hoare_drop_imps)+ - apply (rule_tac F = "(src_slot \ dest_slot) = (srcSlot \ destSlot)" - and P = "\s. cte_at src_slot s \ cte_at dest_slot s \ invs s" and P' = invs' in corres_req) - apply simp - apply rule - apply clarsimp - apply clarsimp - apply (drule (2) cte_map_inj_eq, clarsimp+)[1] - apply (rule corres_guard_imp) - apply (erule corres_whenE) - apply (rule ensureEmptySlot_corres) - apply clarsimp - apply simp - apply clarsimp - apply clarsimp - apply (wp hoare_whenE_wp)+ - apply simp + apply (rule corres_guard_imp, rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (rename_tac dest_slot destSlot) + apply (rule corres_splitEE, (rule lookupSlotForCNodeOp_corres; simp))+ + apply (rule_tac R = "\s. cte_at pivot_slot s \ cte_at dest_slot s + \ cte_at src_slot s \ invs s" in + whenE_throwError_corres' [where R' = \]) + apply simp + apply (elim conjE) + apply rule + apply fastforce + apply (erule disjE) + apply (clarsimp simp add: split_def) + apply (drule (2) cte_map_inj_eq, clarsimp+)[1] + apply (clarsimp simp add: split_def) + apply (drule (2) cte_map_inj_eq, clarsimp+)[1] + apply (rule corres_split_norE) + apply (rule_tac F = "(src_slot \ dest_slot) = (srcSlot \ destSlot)" + and P = "\s. cte_at src_slot s \ cte_at dest_slot s \ invs s" and P' = invs' in corres_req) apply simp - apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid') - apply (simp add: if_apply_def2) - apply (wp hoare_drop_imps) - apply wp - apply simp - apply simp - apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid' hoare_drop_imps - | simp add: if_apply_def2 del: de_Morgan_conj split del: if_split)+ + apply rule + apply clarsimp + apply clarsimp + apply (drule (2) cte_map_inj_eq, clarsimp+)[1] + apply (rule corres_guard_imp) + apply (erule corres_whenE) + apply (rule ensureEmptySlot_corres) + apply clarsimp + apply simp + apply clarsimp + apply clarsimp + apply (simp add: liftE_bindE del: de_Morgan_conj disj_not1 split del: if_split) + apply (rule corres_split_liftM2, simp only: split_beta, rule get_cap_corres) + apply (rule whenE_throwError_corres) + apply (simp add: lookup_failure_map_def) + apply (erule cap_relation_NullCapI) + apply (rule corres_split_liftM2, simp only: split_beta, rule get_cap_corres) + apply (rule whenE_throwError_corres) + apply (simp add: lookup_failure_map_def) + apply (erule cap_relation_NullCapI) + apply (rule whenE_throwError_corres) + apply simp + apply (simp add: cap_relation_NullCap) + apply (rule corres_returnOkTT) + apply simp + apply (intro conjI) + apply (erule cap_map_update_data)+ + apply (wp hoare_drop_imps)+ + apply simp + apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid') + apply (simp add: if_apply_def2) + apply (wp hoare_drop_imps) + apply wp + apply simp + apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid' hoare_drop_imps + | simp add: if_apply_def2 del: de_Morgan_conj split del: if_split)+ apply (auto elim!: valid_cnode_capI)[1] apply (clarsimp dest!: list_all2_lengthD simp: invs'_def valid_state'_def valid_pspace'_def) \ \Errors\ @@ -350,9 +347,9 @@ lemma decodeCNodeInvocation_corres: cnode_invok_case_cleanup split del: if_split cong: if_cong) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (rule corres_trivial, clarsimp split: list.split_asm) - apply simp+ + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (rule corres_trivial, clarsimp split: list.split_asm) apply wp+ apply (auto elim!: valid_cnode_capI)[1] apply fastforce @@ -360,11 +357,11 @@ lemma decodeCNodeInvocation_corres: isCNodeCap_CNodeCap split_def unlessE_whenE split del: if_split cong: if_cong) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres _ wp_post_tautE wp_post_tautE]) - apply (clarsimp simp: list_all2_Cons1 list_all2_Nil - split: list.split_asm split del: if_split) + apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres _ wp_post_tautE wp_post_tautE]) + apply simp apply simp - apply simp + apply (clarsimp simp: list_all2_Cons1 list_all2_Nil + split: list.split_asm split del: if_split) apply (auto elim!: valid_cnode_capI)[1] apply fastforce done @@ -6792,9 +6789,9 @@ proof - show ?thesis unfolding spec_corres_def apply (rule corres_guard_imp) - apply (rule corres_split_deprecated) - apply (erule w) - apply (rule x[unfolded spec_corres_def]) + apply (rule corres_split) + apply (rule x[unfolded spec_corres_def]) + apply (erule w) apply (wp z) apply (rule univ_wp) apply (rule z) @@ -8765,8 +8762,8 @@ lemma invokeCNode_corres: apply simp apply simp apply (rule corres_guard_imp) - apply (rule corres_split_deprecated [OF cteMove_corres]) - apply assumption + apply (rule corres_split) + apply (erule cteMove_corres) apply (erule cteMove_corres) apply wp apply (simp add: cte_wp_at_caps_of_state) @@ -8794,27 +8791,28 @@ lemma invokeCNode_corres: apply (simp add: getThreadCallerSlot_def locateSlot_conv objBits_simps) apply (rule corres_guard_imp) apply (rule corres_split[OF getCurThread_corres]) - apply (subgoal_tac "thread + 2^cte_level_bits * tcbCallerSlot = cte_map (thread, tcb_cnode_index 3)") - prefer 2 - apply (simp add: cte_map_def tcb_cnode_index_def tcbCallerSlot_def) - apply (rule corres_split[OF getSlotCap_corres]) - apply (rule_tac P="\s. (is_reply_cap cap \ cap = cap.NullCap) \ - (is_reply_cap cap \ - (einvs and cte_at (threada, tcb_cnode_index 3) and - cte_wp_at (\c. c = cap.NullCap) prod and - real_cte_at prod and valid_cap cap and - K ((threada, tcb_cnode_index 3) \ prod)) s)" and - P'="\s. (isReplyCap rv' \ \ capReplyMaster rv') \ (invs' and - cte_wp_at' - (\c. weak_derived' rv' (cteCap c) \ - cteCap c \ capability.NullCap) - (cte_map (threada, tcb_cnode_index 3)) and - cte_wp_at' (\c. cteCap c = capability.NullCap) (cte_map prod)) s" in corres_inst) - apply (case_tac cap, simp_all add: isCap_simps is_cap_simps split: bool.split)[1] - apply clarsimp - apply (rule corres_guard_imp) - apply (rule cteMove_corres) - apply (simp add: real_cte_tcb_valid)+ + apply (subgoal_tac "thread + 2^cte_level_bits * tcbCallerSlot = cte_map (thread, tcb_cnode_index 3)") + prefer 2 + apply (simp add: cte_map_def tcb_cnode_index_def tcbCallerSlot_def) + apply (rule corres_split[OF getSlotCap_corres]) + apply simp + apply (rule_tac P="\s. (is_reply_cap cap \ cap = cap.NullCap) \ + (is_reply_cap cap \ + (einvs and cte_at (threada, tcb_cnode_index 3) and + cte_wp_at (\c. c = cap.NullCap) prod and + real_cte_at prod and valid_cap cap and + K ((threada, tcb_cnode_index 3) \ prod)) s)" and + P'="\s. (isReplyCap rv' \ \ capReplyMaster rv') \ (invs' and + cte_wp_at' + (\c. weak_derived' rv' (cteCap c) \ + cteCap c \ capability.NullCap) + (cte_map (threada, tcb_cnode_index 3)) and + cte_wp_at' (\c. cteCap c = capability.NullCap) (cte_map prod)) s" in corres_inst) + apply (case_tac cap, simp_all add: isCap_simps is_cap_simps split: bool.split)[1] + apply clarsimp + apply (rule corres_guard_imp) + apply (rule cteMove_corres) + apply (simp add: real_cte_tcb_valid)+ apply (wp get_cap_wp) apply (simp add: getSlotCap_def) apply (wp getCTE_wp)+ diff --git a/proof/refine/ARM_HYP/CSpace1_R.thy b/proof/refine/ARM_HYP/CSpace1_R.thy index 9ec55ac0f..6ded3048f 100644 --- a/proof/refine/ARM_HYP/CSpace1_R.thy +++ b/proof/refine/ARM_HYP/CSpace1_R.thy @@ -3927,10 +3927,7 @@ lemma getCTE_get: done lemma setUntypedCapAsFull_corres: - "\cap_relation c c'; src' = cte_map src; dest' = cte_map dest; - cap_relation src_cap (cteCap srcCTE); rv = cap.NullCap; - cteCap rv' = capability.NullCap; mdbPrev (cteMDBNode rv') = nullPointer \ - mdbNext (cteMDBNode rv') = nullPointer\ + "\cap_relation c c'; cap_relation src_cap (cteCap srcCTE)\ \ corres dc (cte_wp_at ((=) src_cap) src and valid_objs and pspace_aligned and pspace_distinct) (cte_wp_at' ((=) srcCTE) (cte_map src) and @@ -5204,193 +5201,148 @@ lemma cteInsert_corres: R'="\r. ?P' and cte_wp_at' ((=) rv') (cte_map dest) and cte_wp_at' ((=) (CTE (maskedAsFull (cteCap srcCTE) c') (cteMDBNode srcCTE))) (cte_map src)" - in corres_split_deprecated[where r'=dc]) - apply (rule corres_stronger_no_failI) - apply (rule no_fail_pre) - apply (wp hoare_weak_lift_imp) - apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def) - apply (erule_tac valid_dlistEn[where p = "cte_map src"]) - apply (simp+)[3] - apply (clarsimp simp: corres_underlying_def state_relation_def - in_monad valid_mdb'_def valid_mdb_ctes_def) - apply (drule (1) pspace_relationsD) - apply (drule (18) set_cap_not_quite_corres) - apply (rule refl) - apply (elim conjE exE) - apply (rule bind_execI, assumption) - apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") - prefer 2 - apply (erule mdb_insert_abs.intro) + in corres_split[where r'=dc]) + apply (rule setUntypedCapAsFull_corres; simp) + apply (rule corres_stronger_no_failI) + apply (rule no_fail_pre) + apply (wp hoare_weak_lift_imp) + apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def) + apply (erule_tac valid_dlistEn[where p = "cte_map src"]) + apply (simp+)[3] + apply (clarsimp simp: corres_underlying_def state_relation_def + in_monad valid_mdb'_def valid_mdb_ctes_def) + apply (drule (1) pspace_relationsD) + apply (drule (18) set_cap_not_quite_corres) + apply (rule refl) + apply (elim conjE exE) + apply (rule bind_execI, assumption) + apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") + prefer 2 + apply (erule mdb_insert_abs.intro) apply (rule mdb_Null_None) - apply (simp add: op_equal) + apply (simp add: op_equal) apply simp - apply (rule mdb_Null_descendants) + apply (rule mdb_Null_descendants) apply (simp add: op_equal) - apply simp - apply (subgoal_tac "no_mloop (cdt a)") - prefer 2 - apply (simp add: valid_mdb_def) - apply (clarsimp simp: exec_gets update_cdt_def bind_assoc - set_cdt_def - exec_get exec_put set_original_def modify_def simp del: fun_upd_apply - | (rule bind_execI[where f="cap_insert_ext x y z i p" for x y z i p], clarsimp simp: exec_gets exec_get put_def mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def set_cdt_list_def, rule refl))+ - apply (clarsimp simp: put_def state_relation_def) - apply (drule updateCap_stuff) - apply clarsimp - apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) - apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) - apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) - apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def - prev_update_modify_mdb_relation) - apply (subgoal_tac "cte_map dest \ 0") - prefer 2 - subgoal by (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def) - apply (subgoal_tac "cte_map src \ 0") - prefer 2 - subgoal by (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def) - apply (thin_tac "ksMachineState t = p" for p t)+ - apply (thin_tac "ksCurThread t = p" for p t)+ - apply (thin_tac "ksIdleThread t = p" for p t)+ - apply (thin_tac "ksReadyQueues t = p" for p t)+ - apply (thin_tac "ksSchedulerAction t = p" for p t)+ - apply (clarsimp simp: pspace_relations_def) - apply (rule conjI) - subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) - apply (thin_tac "gsCNodes t = p" for t p)+ - apply (thin_tac "ksWorkUnitsCompleted t = p" for t p)+ - apply (thin_tac "cur_thread t = p" for t p)+ - apply (thin_tac "domain_index t = p" for t p)+ - apply (thin_tac "domain_time t = p" for t p)+ - apply (thin_tac "cur_domain t = p" for t p)+ - apply (thin_tac "scheduler_action t = p" for t p)+ - apply (thin_tac "ready_queues t = p" for t p)+ - apply (thin_tac "idle_thread t = p" for t p)+ - apply (thin_tac "machine_state t = p" for t p)+ - apply (thin_tac "work_units_completed t = p" for t p)+ - apply (thin_tac "ksArchState t = p" for t p)+ - apply (thin_tac "gsUserPages t = p" for t p)+ - apply (thin_tac "ksCurDomain t = p" for t p)+ - apply (thin_tac "ksInterruptState t = p" for t p)+ - apply (thin_tac "ksDomScheduleIdx t = p" for t p)+ - apply (thin_tac "ksDomainTime t = p" for t p)+ - apply (thin_tac "ksDomSchedule t = p" for t p)+ - apply (thin_tac "ctes_of t = p" for t p)+ - apply (thin_tac "ekheap_relation t p" for t p)+ - apply (thin_tac "pspace_relation t p" for t p)+ - apply (thin_tac "interrupt_state_relation s t p" for s t p)+ - apply (thin_tac "sched_act_relation t p" for t p)+ - apply (thin_tac "ready_queues_relation t p" for t p)+ - apply (rule conjI) - defer - apply(rule conjI) - apply (case_tac "srcCTE") - apply (rename_tac src_cap' src_node) - apply (case_tac "rv'") - apply (rename_tac dest_node) - apply (clarsimp simp: in_set_cap_cte_at_swp) - apply (subgoal_tac "cte_at src a \ is_derived (cdt a) src c src_cap") - prefer 2 - apply (fastforce simp: cte_wp_at_def) - apply (erule conjE) - apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node - (cte_map dest) NullCap dest_node") - prefer 2 - apply (rule mdb_insert.intro) - apply (rule mdb_ptr.intro) - apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) - apply (erule mdb_ptr_axioms.intro) + apply simp + apply (subgoal_tac "no_mloop (cdt a)") + prefer 2 + apply (simp add: valid_mdb_def) + apply (clarsimp simp: exec_gets update_cdt_def bind_assoc + set_cdt_def + exec_get exec_put set_original_def modify_def simp del: fun_upd_apply + | (rule bind_execI[where f="cap_insert_ext x y z i p" for x y z i p], clarsimp simp: exec_gets exec_get put_def mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def set_cdt_list_def, rule refl))+ + apply (clarsimp simp: put_def state_relation_def) + apply (drule updateCap_stuff) + apply clarsimp + apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) + apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) + apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) + apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def + prev_update_modify_mdb_relation) + apply (subgoal_tac "cte_map dest \ 0") + prefer 2 + subgoal by (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def) + apply (subgoal_tac "cte_map src \ 0") + prefer 2 + subgoal by (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def) + apply (thin_tac "ksMachineState t = p" for p t)+ + apply (thin_tac "ksCurThread t = p" for p t)+ + apply (thin_tac "ksIdleThread t = p" for p t)+ + apply (thin_tac "ksReadyQueues t = p" for p t)+ + apply (thin_tac "ksSchedulerAction t = p" for p t)+ + apply (clarsimp simp: pspace_relations_def) + apply (rule conjI) + subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) + apply (thin_tac "gsCNodes t = p" for t p)+ + apply (thin_tac "ksWorkUnitsCompleted t = p" for t p)+ + apply (thin_tac "cur_thread t = p" for t p)+ + apply (thin_tac "domain_index t = p" for t p)+ + apply (thin_tac "domain_time t = p" for t p)+ + apply (thin_tac "cur_domain t = p" for t p)+ + apply (thin_tac "scheduler_action t = p" for t p)+ + apply (thin_tac "ready_queues t = p" for t p)+ + apply (thin_tac "idle_thread t = p" for t p)+ + apply (thin_tac "machine_state t = p" for t p)+ + apply (thin_tac "work_units_completed t = p" for t p)+ + apply (thin_tac "ksArchState t = p" for t p)+ + apply (thin_tac "gsUserPages t = p" for t p)+ + apply (thin_tac "ksCurDomain t = p" for t p)+ + apply (thin_tac "ksInterruptState t = p" for t p)+ + apply (thin_tac "ksDomScheduleIdx t = p" for t p)+ + apply (thin_tac "ksDomainTime t = p" for t p)+ + apply (thin_tac "ksDomSchedule t = p" for t p)+ + apply (thin_tac "ctes_of t = p" for t p)+ + apply (thin_tac "ekheap_relation t p" for t p)+ + apply (thin_tac "pspace_relation t p" for t p)+ + apply (thin_tac "interrupt_state_relation s t p" for s t p)+ + apply (thin_tac "sched_act_relation t p" for t p)+ + apply (thin_tac "ready_queues_relation t p" for t p)+ + apply (rule conjI) + defer + apply(rule conjI) + apply (case_tac "srcCTE") + apply (rename_tac src_cap' src_node) + apply (case_tac "rv'") + apply (rename_tac dest_node) + apply (clarsimp simp: in_set_cap_cte_at_swp) + apply (subgoal_tac "cte_at src a \ is_derived (cdt a) src c src_cap") + prefer 2 + apply (fastforce simp: cte_wp_at_def) + apply (erule conjE) + apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node + (cte_map dest) NullCap dest_node") + prefer 2 + apply (rule mdb_insert.intro) apply (rule mdb_ptr.intro) apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) apply (erule mdb_ptr_axioms.intro) - apply (rule mdb_insert_axioms.intro) - apply (rule refl) - apply assumption + apply (rule mdb_ptr.intro) + apply (rule vmdb.intro, simp add: valid_mdb_ctes_def) + apply (erule mdb_ptr_axioms.intro) + apply (rule mdb_insert_axioms.intro) + apply (rule refl) apply assumption apply assumption apply assumption - apply (erule (5) cte_map_inj) - apply (frule mdb_insert_der.intro) - apply (rule mdb_insert_der_axioms.intro) - apply (simp add: is_derived_eq) - apply (simp (no_asm_simp) add: cdt_relation_def split: if_split) - apply (subgoal_tac "descendants_of dest (cdt a) = {}") - prefer 2 - apply (drule mdb_insert.dest_no_descendants) - apply (fastforce simp add: cdt_relation_def) - apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") - prefer 2 - apply (erule mdb_insert_abs.intro) - apply (rule mdb_None) - apply (erule(1) mdb_insert.descendants_not_dest) - apply assumption + apply assumption + apply (erule (5) cte_map_inj) + apply (frule mdb_insert_der.intro) + apply (rule mdb_insert_der_axioms.intro) + apply (simp add: is_derived_eq) + apply (simp (no_asm_simp) add: cdt_relation_def split: if_split) + apply (subgoal_tac "descendants_of dest (cdt a) = {}") + prefer 2 + apply (drule mdb_insert.dest_no_descendants) + apply (fastforce simp add: cdt_relation_def) + apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") + prefer 2 + apply (erule mdb_insert_abs.intro) + apply (rule mdb_None) + apply (erule(1) mdb_insert.descendants_not_dest) apply assumption apply assumption - apply(simp add: cdt_list_relation_def) - apply(subgoal_tac "no_mloop (cdt a) \ finite_depth (cdt a)") + apply assumption + apply(simp add: cdt_list_relation_def) + apply(subgoal_tac "no_mloop (cdt a) \ finite_depth (cdt a)") + prefer 2 + apply(simp add: finite_depth valid_mdb_def) + apply(intro conjI impI allI) + apply(simp cong: option.case_cong) + apply(simp split: option.split) + apply(subgoal_tac "\aa. cdt a src = Some aa \ src \ aa") prefer 2 - apply(simp add: finite_depth valid_mdb_def) - apply(intro conjI impI allI) - apply(simp cong: option.case_cong) - apply(simp split: option.split) - apply(subgoal_tac "\aa. cdt a src = Some aa \ src \ aa") - prefer 2 - apply(fastforce simp: no_mloop_weaken) - apply(simp add: fun_upd_twist) - apply(rule allI) - apply(case_tac "next_child src (cdt_list (a))") - apply(frule next_child_NoneD) - apply(subst mdb_insert_abs.next_slot) - apply(simp_all)[5] - apply(case_tac "ca=src") - apply(simp) - apply(clarsimp simp: modify_map_def) - apply(fastforce split: if_split_asm) - apply(case_tac "ca = dest") - apply(simp) - apply(rule impI) - apply(clarsimp simp: modify_map_def const_def) - apply(simp split: if_split_asm) - apply(drule_tac p="cte_map src" in valid_mdbD1') - subgoal by(simp) - subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) - subgoal by(clarsimp) - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(erule_tac x=src in allE)+ - subgoal by(fastforce) - apply(simp) - apply(rule impI) - apply(subgoal_tac "cte_at ca a") - prefer 2 - apply(rule cte_at_next_slot) - apply(simp_all)[4] - apply(clarsimp simp: modify_map_def const_def) - apply(simp split: if_split_asm) - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(drule_tac p="cte_map src" in valid_mdbD1') - subgoal by(simp) - subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) - subgoal by(clarsimp) - apply(clarsimp) - apply(case_tac z) - apply(erule_tac x="(aa, bb)" in allE)+ - subgoal by(fastforce) - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(erule_tac x="(aa, bb)" in allE)+ - subgoal by(fastforce) - - apply(frule(1) next_childD) - apply(simp add: mdb_insert_abs.next_slot) + apply(fastforce simp: no_mloop_weaken) + apply(simp add: fun_upd_twist) + apply(rule allI) + apply(case_tac "next_child src (cdt_list (a))") + apply(frule next_child_NoneD) + apply(subst mdb_insert_abs.next_slot) + apply(simp_all)[5] apply(case_tac "ca=src") apply(simp) apply(clarsimp simp: modify_map_def) - subgoal by(fastforce split: if_split_asm) + apply(fastforce split: if_split_asm) apply(case_tac "ca = dest") apply(simp) apply(rule impI) @@ -5398,10 +5350,10 @@ lemma cteInsert_corres: apply(simp split: if_split_asm) apply(drule_tac p="cte_map src" in valid_mdbD1') subgoal by(simp) - apply(simp add: valid_mdb'_def valid_mdb_ctes_def) + subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) subgoal by(clarsimp) apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(erule_tac x=src in allE)+ subgoal by(fastforce) apply(simp) @@ -5413,7 +5365,7 @@ lemma cteInsert_corres: apply(clarsimp simp: modify_map_def const_def) apply(simp split: if_split_asm) apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(drule_tac p="cte_map src" in valid_mdbD1') subgoal by(simp) subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) @@ -5423,123 +5375,117 @@ lemma cteInsert_corres: apply(erule_tac x="(aa, bb)" in allE)+ subgoal by(fastforce) apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(erule_tac x="(aa, bb)" in allE)+ subgoal by(fastforce) - apply(subgoal_tac "mdb_insert_sib (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') - src_node (cte_map dest) capability.NullCap dest_node c'") - prefer 2 - apply(simp add: mdb_insert_sib_def) - apply(rule mdb_insert_sib_axioms.intro) - apply (subst can_be_is [symmetric]) - apply simp - apply (rule cap_relation_masked_as_full) - apply (simp+)[3] - apply simp - apply simp - apply simp - apply (subst (asm) revokable_eq, assumption, assumption) - apply (rule derived_sameRegionAs) - apply (subst is_derived_eq[symmetric], assumption, - assumption, assumption, assumption, assumption) - apply assumption - subgoal by (clarsimp simp: cte_wp_at_def is_derived_def is_cap_simps cap_master_cap_simps - dest!:cap_master_cap_eqDs) - apply (subgoal_tac "is_original_cap a src = mdbRevocable src_node") - apply (frule(4) iffD1[OF is_derived_eq]) - apply (drule_tac src_cap' = src_cap' in - maskedAsFull_revokable[where a = c',symmetric]) - subgoal by(simp) - apply (simp add: revokable_relation_def) - apply (erule_tac x=src in allE)+ - apply simp - apply (erule impE) - apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state split: if_splits) - subgoal by (clarsimp simp: masked_as_full_def is_cap_simps free_index_update_def split: if_splits) - apply(simp) - - apply(subgoal_tac "cdt_list (a) src = []") - prefer 2 - apply(rule ccontr) - apply(simp add: empty_list_empty_desc) - apply(simp add: no_children_empty_desc[symmetric]) - apply(erule exE) - apply(drule_tac p="cte_map caa" in mdb_insert_sib.src_no_parent) - apply(subgoal_tac "cte_map caa\descendants_of' (cte_map src) (ctes_of b)") - subgoal by(simp add: descendants_of'_def) - apply(simp add: cdt_relation_def) - apply(erule_tac x=src in allE) - apply(drule child_descendant)+ - apply(drule_tac x=caa and f=cte_map in imageI) - subgoal by(simp) - - apply(case_tac "cdt a src") - apply(simp) - apply(subst mdb_insert_abs_sib.next_slot_no_parent') - apply(simp add: mdb_insert_abs_sib_def) - apply(simp_all add: fun_upd_idem)[5] - - apply(case_tac "ca=src") - subgoal by(simp add: next_slot_def no_parent_next_not_child_None) - apply(case_tac "ca = dest") - subgoal by(simp add: next_slot_def no_parent_next_not_child_None - mdb_insert_abs.dest empty_list_empty_desc) - apply(case_tac "next_slot ca (cdt_list (a)) (cdt a)") - subgoal by(simp) - apply(simp) - apply(subgoal_tac "cte_at ca a") - prefer 2 - apply(rule cte_at_next_slot) - apply(simp_all)[4] - apply(clarsimp simp: modify_map_def const_def) - apply(simp split: if_split_asm) - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(drule_tac p="cte_map src" in valid_mdbD1') - apply(simp) - subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) - subgoal by(clarsimp) - apply(clarsimp) - apply(case_tac z) - apply(erule_tac x="(aa, bb)" in allE)+ - subgoal by(fastforce) - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(drule cte_map_inj_eq') - apply(simp_all)[2] - apply(erule_tac x="(aa, bb)" in allE)+ - subgoal by(fastforce) - - apply(simp add: fun_upd_idem) - apply(subst mdb_insert_abs_sib.next_slot') - subgoal by(simp add: mdb_insert_abs_sib_def) - apply(simp_all)[5] + apply(frule(1) next_childD) + apply(simp add: mdb_insert_abs.next_slot) apply(case_tac "ca=src") + apply(simp) apply(clarsimp simp: modify_map_def) subgoal by(fastforce split: if_split_asm) apply(case_tac "ca = dest") apply(simp) - apply(case_tac "next_slot src (cdt_list (a)) (cdt a)") - subgoal by(simp) - apply(simp) + apply(rule impI) apply(clarsimp simp: modify_map_def const_def) apply(simp split: if_split_asm) apply(drule_tac p="cte_map src" in valid_mdbD1') subgoal by(simp) - apply(simp add: valid_mdb'_def valid_mdb_ctes_def) + subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) subgoal by(clarsimp) apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(erule_tac x=src in allE)+ subgoal by(fastforce) apply(simp) + apply(rule impI) + apply(subgoal_tac "cte_at ca a") + prefer 2 + apply(rule cte_at_next_slot) + apply(simp_all)[4] + apply(clarsimp simp: modify_map_def const_def) + apply(simp split: if_split_asm) + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(drule_tac p="cte_map src" in valid_mdbD1') + subgoal by(simp) + subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) + subgoal by(clarsimp) + apply(clarsimp) + apply(case_tac z) + apply(erule_tac x="(aa, bb)" in allE)+ + subgoal by(fastforce) + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(erule_tac x="(aa, bb)" in allE)+ + subgoal by(fastforce) + + apply(subgoal_tac "mdb_insert_sib (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') + src_node (cte_map dest) capability.NullCap dest_node c'") + prefer 2 + apply(simp add: mdb_insert_sib_def) + apply(rule mdb_insert_sib_axioms.intro) + apply (subst can_be_is [symmetric]) + apply simp + apply (rule cap_relation_masked_as_full) + apply (simp+)[3] + apply simp + apply simp + apply simp + apply (subst (asm) revokable_eq, assumption, assumption) + apply (rule derived_sameRegionAs) + apply (subst is_derived_eq[symmetric]; assumption) + apply assumption + subgoal by (clarsimp simp: cte_wp_at_def is_derived_def is_cap_simps cap_master_cap_simps + dest!:cap_master_cap_eqDs) + apply (subgoal_tac "is_original_cap a src = mdbRevocable src_node") + apply (frule(4) iffD1[OF is_derived_eq]) + apply (drule_tac src_cap' = src_cap' in + maskedAsFull_revokable[where a = c',symmetric]) + subgoal by(simp) + apply (simp add: revokable_relation_def) + apply (erule_tac x=src in allE)+ + apply simp + apply (erule impE) + apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state split: if_splits) + subgoal by (clarsimp simp: masked_as_full_def is_cap_simps free_index_update_def split: if_splits) + apply(simp) + + apply(subgoal_tac "cdt_list (a) src = []") + prefer 2 + apply(rule ccontr) + apply(simp add: empty_list_empty_desc) + apply(simp add: no_children_empty_desc[symmetric]) + apply(erule exE) + apply(drule_tac p="cte_map caa" in mdb_insert_sib.src_no_parent) + apply(subgoal_tac "cte_map caa\descendants_of' (cte_map src) (ctes_of b)") + subgoal by(simp add: descendants_of'_def) + apply(simp add: cdt_relation_def) + apply(erule_tac x=src in allE) + apply(drule child_descendant)+ + apply(drule_tac x=caa and f=cte_map in imageI) + subgoal by(simp) + + apply(case_tac "cdt a src") + apply(simp) + apply(subst mdb_insert_abs_sib.next_slot_no_parent') + apply(simp add: mdb_insert_abs_sib_def) + apply(simp_all add: fun_upd_idem)[5] + + apply(case_tac "ca=src") + subgoal by(simp add: next_slot_def no_parent_next_not_child_None) + apply(case_tac "ca = dest") + subgoal by(simp add: next_slot_def no_parent_next_not_child_None + mdb_insert_abs.dest empty_list_empty_desc) apply(case_tac "next_slot ca (cdt_list (a)) (cdt a)") subgoal by(simp) apply(simp) @@ -5550,9 +5496,9 @@ lemma cteInsert_corres: apply(clarsimp simp: modify_map_def const_def) apply(simp split: if_split_asm) apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(drule_tac p="cte_map src" in valid_mdbD1') - subgoal by(simp) + apply(simp) subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) subgoal by(clarsimp) apply(clarsimp) @@ -5560,59 +5506,107 @@ lemma cteInsert_corres: apply(erule_tac x="(aa, bb)" in allE)+ subgoal by(fastforce) apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(drule cte_map_inj_eq') - apply(simp_all)[2] + apply(simp_all)[2] apply(erule_tac x="(aa, bb)" in allE)+ subgoal by(fastforce) - apply (clarsimp simp: modify_map_apply) - apply (clarsimp simp: revokable_relation_def split: if_split) - apply (rule conjI) + + apply(simp add: fun_upd_idem) + apply(subst mdb_insert_abs_sib.next_slot') + subgoal by(simp add: mdb_insert_abs_sib_def) + apply(simp_all)[5] + apply(case_tac "ca=src") + apply(clarsimp simp: modify_map_def) + subgoal by(fastforce split: if_split_asm) + apply(case_tac "ca = dest") + apply(simp) + apply(case_tac "next_slot src (cdt_list (a)) (cdt a)") + subgoal by(simp) + apply(simp) + apply(clarsimp simp: modify_map_def const_def) + apply(simp split: if_split_asm) + apply(drule_tac p="cte_map src" in valid_mdbD1') + subgoal by(simp) + apply(simp add: valid_mdb'_def valid_mdb_ctes_def) + subgoal by(clarsimp) + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(erule_tac x=src in allE)+ + subgoal by(fastforce) + apply(simp) + apply(case_tac "next_slot ca (cdt_list (a)) (cdt a)") + subgoal by(simp) + apply(simp) + apply(subgoal_tac "cte_at ca a") + prefer 2 + apply(rule cte_at_next_slot) + apply(simp_all)[4] + apply(clarsimp simp: modify_map_def const_def) + apply(simp split: if_split_asm) + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(drule_tac p="cte_map src" in valid_mdbD1') + subgoal by(simp) + subgoal by(simp add: valid_mdb'_def valid_mdb_ctes_def) + subgoal by(clarsimp) + apply(clarsimp) + apply(case_tac z) + apply(erule_tac x="(aa, bb)" in allE)+ + subgoal by(fastforce) + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(drule cte_map_inj_eq') + apply(simp_all)[2] + apply(erule_tac x="(aa, bb)" in allE)+ + subgoal by(fastforce) + apply (clarsimp simp: modify_map_apply) + apply (clarsimp simp: revokable_relation_def split: if_split) + apply (rule conjI) apply clarsimp - apply (subgoal_tac "mdbRevocable node = revokable' (cteCap srcCTE) c'") - prefer 2 - apply (case_tac rv') - subgoal by (clarsimp simp add: const_def modify_map_def split: if_split_asm) - apply simp - apply (rule revokable_eq, assumption, assumption) - apply (rule derived_sameRegionAs) - apply (drule(3) is_derived_eq[THEN iffD1,rotated -1]) - subgoal by (simp add: cte_wp_at_def) - apply assumption + apply (subgoal_tac "mdbRevocable node = revokable' (cteCap srcCTE) c'") + prefer 2 + apply (case_tac rv') + subgoal by (clarsimp simp add: const_def modify_map_def split: if_split_asm) + apply simp + apply (rule revokable_eq, assumption, assumption) + apply (rule derived_sameRegionAs) + apply (drule(3) is_derived_eq[THEN iffD1,rotated -1]) + subgoal by (simp add: cte_wp_at_def) apply assumption - subgoal by (clarsimp simp: cap_master_cap_simps cte_wp_at_def is_derived_def is_cap_simps - split:if_splits dest!:cap_master_cap_eqDs) - apply clarsimp - apply (case_tac srcCTE) - apply (case_tac rv') - apply clarsimp - apply (subgoal_tac "\cap' node'. ctes_of b (cte_map (aa,bb)) = Some (CTE cap' node')") - prefer 2 - apply (clarsimp simp: modify_map_def split: if_split_asm) - apply (case_tac z) - subgoal by clarsimp - apply clarsimp - apply (drule set_cap_caps_of_state_monad)+ - apply (subgoal_tac "null_filter (caps_of_state a) (aa,bb) \ None") - prefer 2 - subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def split: if_splits) + apply assumption + subgoal by (clarsimp simp: cap_master_cap_simps cte_wp_at_def is_derived_def is_cap_simps + split:if_splits dest!:cap_master_cap_eqDs) + apply clarsimp + apply (case_tac srcCTE) + apply (case_tac rv') + apply clarsimp + apply (subgoal_tac "\cap' node'. ctes_of b (cte_map (aa,bb)) = Some (CTE cap' node')") + prefer 2 + apply (clarsimp simp: modify_map_def split: if_split_asm) + apply (case_tac z) + subgoal by clarsimp + apply clarsimp + apply (drule set_cap_caps_of_state_monad)+ + apply (subgoal_tac "null_filter (caps_of_state a) (aa,bb) \ None") + prefer 2 + subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def split: if_splits) - apply clarsimp - apply (subgoal_tac "cte_at (aa,bb) a") - prefer 2 - apply (drule null_filter_caps_of_stateD) - apply (erule cte_wp_at_weakenE, rule TrueI) - apply (subgoal_tac "mdbRevocable node = mdbRevocable node'") - subgoal by clarsimp - apply (subgoal_tac "cte_map (aa,bb) \ cte_map dest") - subgoal by (clarsimp simp: modify_map_def split: if_split_asm) - apply (erule (5) cte_map_inj) + apply clarsimp + apply (subgoal_tac "cte_at (aa,bb) a") + prefer 2 + apply (drule null_filter_caps_of_stateD) + apply (erule cte_wp_at_weakenE, rule TrueI) + apply (subgoal_tac "mdbRevocable node = mdbRevocable node'") + subgoal by clarsimp + apply (subgoal_tac "cte_map (aa,bb) \ cte_map dest") + subgoal by (clarsimp simp: modify_map_def split: if_split_asm) + apply (erule (5) cte_map_inj) (* FIXME *) - - apply (rule setUntypedCapAsFull_corres) - apply simp+ apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap setUntypedCapAsFull_cte_wp_at | clarsimp simp: cte_wp_at_caps_of_state| wps)+ @@ -5672,12 +5666,12 @@ lemma cteInsert_corres: apply simp apply (subst mdb_insert_child.descendants) apply (rule mdb_insert_child.intro) - apply simp + apply simp apply (rule mdb_insert_child_axioms.intro) apply (subst can_be_is [symmetric]) apply simp - apply (rule cap_relation_masked_as_full) - apply (simp+)[3] + apply (rule cap_relation_masked_as_full) + apply (simp+)[3] apply simp apply simp apply (subst (asm) revokable_eq, assumption, assumption) diff --git a/proof/refine/ARM_HYP/CSpace_R.thy b/proof/refine/ARM_HYP/CSpace_R.thy index 0582fc54a..6f1d13280 100644 --- a/proof/refine/ARM_HYP/CSpace_R.thy +++ b/proof/refine/ARM_HYP/CSpace_R.thy @@ -3493,11 +3493,11 @@ lemma lookupSlotForCNodeOp_corres: word_bits_def toInteger_nat fromIntegral_def fromInteger_nat) apply (rule corres_lookup_error) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF rab_corres']) - apply (rule corres_trivial) - apply (clarsimp simp: returnOk_def lookup_failure_map_def - split: list.split) - apply simp+ + apply (rule corres_splitEE) + apply (rule rab_corres'; simp) + apply (rule corres_trivial) + apply (clarsimp simp: returnOk_def lookup_failure_map_def + split: list.split) apply wp+ apply clarsimp apply clarsimp @@ -4795,135 +4795,133 @@ lemma cteInsert_simple_corres: R'="\r. ?P' and cte_wp_at' ((=) rv') (cte_map dest) and cte_wp_at' ((=) (CTE (maskedAsFull (cteCap srcCTE) c') (cteMDBNode srcCTE))) (cte_map src) and (\s. safe_parent_for' (ctes_of s) src' c')" - in corres_split_deprecated[where r'=dc]) - apply (rule corres_stronger_no_failI) - apply (rule no_fail_pre, wp hoare_weak_lift_imp) - apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def) - apply (erule_tac valid_dlistEn[where p = "cte_map src"]) - apply (simp+)[3] - apply (clarsimp simp: corres_underlying_def state_relation_def - in_monad valid_mdb'_def valid_mdb_ctes_def) - apply (drule (1) pspace_relationsD) - apply (drule (18) set_cap_not_quite_corres) - apply (rule refl) - apply (elim conjE exE) - apply (rule bind_execI, assumption) - apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") + in corres_split[where r'=dc]) + apply (rule setUntypedCapAsFull_corres; simp) + apply (rule corres_stronger_no_failI) + apply (rule no_fail_pre, wp hoare_weak_lift_imp) + apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def) + apply (erule_tac valid_dlistEn[where p = "cte_map src"]) + apply (simp+)[3] + apply (clarsimp simp: corres_underlying_def state_relation_def + in_monad valid_mdb'_def valid_mdb_ctes_def) + apply (drule (1) pspace_relationsD) + apply (drule (18) set_cap_not_quite_corres) + apply (rule refl) + apply (elim conjE exE) + apply (rule bind_execI, assumption) + apply (subgoal_tac "mdb_insert_abs (cdt a) src dest") + prefer 2 + apply (clarsimp simp: cte_wp_at_caps_of_state valid_mdb_def2) + apply (rule mdb_insert_abs.intro) + apply clarsimp + apply (erule (1) mdb_cte_at_Null_None) + apply (erule (1) mdb_cte_at_Null_descendants) + apply (subgoal_tac "no_mloop (cdt a)") + prefer 2 + apply (simp add: valid_mdb_def) + apply (clarsimp simp: exec_gets update_cdt_def bind_assoc set_cdt_def + exec_get exec_put set_original_def modify_def + simp del: fun_upd_apply + + | (rule bind_execI[where f="cap_insert_ext x y z x' y'" for x y z x' y'], clarsimp simp: mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def set_cdt_list_def put_def simp del: fun_upd_apply) | rule refl)+ + + apply (clarsimp simp: put_def state_relation_def simp del: fun_upd_apply) + apply (drule updateCap_stuff) + apply clarsimp + apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) + apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) + apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) + apply (clarsimp simp: pspace_relations_def) + apply (thin_tac "gsCNodes t = p" for t p)+ + apply (thin_tac "ksMachineState t = p" for t p)+ + apply (thin_tac "ksCurThread t = p" for t p)+ + apply (thin_tac "ksWorkUnitsCompleted t = p" for t p)+ + apply (thin_tac "ksIdleThread t = p" for t p)+ + apply (thin_tac "ksReadyQueues t = p" for t p)+ + apply (thin_tac "ksSchedulerAction t = p" for t p)+ + apply (thin_tac "cur_thread t = p" for t p)+ + apply (thin_tac "domain_index t = p" for t p)+ + apply (thin_tac "domain_time t = p" for t p)+ + apply (thin_tac "cur_domain t = p" for t p)+ + apply (thin_tac "scheduler_action t = p" for t p)+ + apply (thin_tac "ready_queues t = p" for t p)+ + apply (thin_tac "idle_thread t = p" for t p)+ + apply (thin_tac "machine_state t = p" for t p)+ + apply (thin_tac "work_units_completed t = p" for t p)+ + apply (thin_tac "ksArchState t = p" for t p)+ + apply (thin_tac "gsUserPages t = p" for t p)+ + apply (thin_tac "ksCurDomain t = p" for t p)+ + apply (thin_tac "ksInterruptState t = p" for t p)+ + apply (thin_tac "ksDomScheduleIdx t = p" for t p)+ + apply (thin_tac "ksDomainTime t = p" for t p)+ + apply (thin_tac "ksDomSchedule t = p" for t p)+ + apply (thin_tac "ctes_of t = p" for t p)+ + apply (thin_tac "ekheap_relation t p" for t p)+ + apply (thin_tac "pspace_relation t p" for t p)+ + apply (thin_tac "interrupt_state_relation s t p" for s t p)+ + apply (thin_tac "sched_act_relation t p" for t p)+ + apply (thin_tac "ready_queues_relation t p" for t p)+ + apply (rule conjI) + subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) + apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def prev_update_modify_mdb_relation) + apply (subgoal_tac "cte_map dest \ 0") + prefer 2 + apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def) + apply (subgoal_tac "cte_map src \ 0") + prefer 2 + apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def) + apply (subgoal_tac "should_be_parent_of src_cap (is_original_cap a src) c (revokable src_cap c) = True") + prefer 2 + apply (subst should_be_parent_of_masked_as_full[symmetric]) + apply (subst safe_parent_is_parent) + apply ((simp add: cte_wp_at_caps_of_state)+)[4] + apply (subst conj_assoc[symmetric]) + apply (rule conjI) + defer + apply (clarsimp simp: modify_map_apply) + apply (clarsimp simp: revokable_relation_def simp del: fun_upd_apply) + apply (simp split: if_split) + apply (rule conjI) + apply clarsimp + apply (subgoal_tac "mdbRevocable node = revokable' (cteCap srcCTE) c'") + prefer 2 + apply (case_tac rv') + apply (clarsimp simp add: const_def modify_map_def split: if_split_asm) + apply clarsimp + apply (rule revokable_eq, assumption, assumption) + apply (subst same_region_as_relation [symmetric]) + prefer 3 + apply (rule safe_parent_same_region) + apply (simp add: cte_wp_at_caps_of_state) + apply assumption + apply assumption + apply (clarsimp simp: cte_wp_at_def is_simple_cap_def) + apply clarsimp + apply (case_tac srcCTE) + apply (case_tac rv') + apply clarsimp + apply (subgoal_tac "\cap' node'. ctes_of b (cte_map (aa,bb)) = Some (CTE cap' node')") prefer 2 - apply (clarsimp simp: cte_wp_at_caps_of_state valid_mdb_def2) - apply (rule mdb_insert_abs.intro) - apply clarsimp - apply (erule (1) mdb_cte_at_Null_None) - apply (erule (1) mdb_cte_at_Null_descendants) - apply (subgoal_tac "no_mloop (cdt a)") - prefer 2 - apply (simp add: valid_mdb_def) - apply (clarsimp simp: exec_gets update_cdt_def bind_assoc set_cdt_def - exec_get exec_put set_original_def modify_def - simp del: fun_upd_apply - - | (rule bind_execI[where f="cap_insert_ext x y z x' y'" for x y z x' y'], clarsimp simp: mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def set_cdt_list_def put_def simp del: fun_upd_apply) | rule refl)+ - - apply (clarsimp simp: put_def state_relation_def simp del: fun_upd_apply) - apply (drule updateCap_stuff) - apply clarsimp - apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) - apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) - apply (drule (3) updateMDB_the_lot', simp only: no_0_modify_map, simp only:, elim conjE) - apply (clarsimp simp: pspace_relations_def) - apply (thin_tac "gsCNodes t = p" for t p)+ - apply (thin_tac "ksMachineState t = p" for t p)+ - apply (thin_tac "ksCurThread t = p" for t p)+ - apply (thin_tac "ksWorkUnitsCompleted t = p" for t p)+ - apply (thin_tac "ksIdleThread t = p" for t p)+ - apply (thin_tac "ksReadyQueues t = p" for t p)+ - apply (thin_tac "ksSchedulerAction t = p" for t p)+ - apply (thin_tac "cur_thread t = p" for t p)+ - apply (thin_tac "domain_index t = p" for t p)+ - apply (thin_tac "domain_time t = p" for t p)+ - apply (thin_tac "cur_domain t = p" for t p)+ - apply (thin_tac "scheduler_action t = p" for t p)+ - apply (thin_tac "ready_queues t = p" for t p)+ - apply (thin_tac "idle_thread t = p" for t p)+ - apply (thin_tac "machine_state t = p" for t p)+ - apply (thin_tac "work_units_completed t = p" for t p)+ - apply (thin_tac "ksArchState t = p" for t p)+ - apply (thin_tac "gsUserPages t = p" for t p)+ - apply (thin_tac "ksCurDomain t = p" for t p)+ - apply (thin_tac "ksInterruptState t = p" for t p)+ - apply (thin_tac "ksDomScheduleIdx t = p" for t p)+ - apply (thin_tac "ksDomainTime t = p" for t p)+ - apply (thin_tac "ksDomSchedule t = p" for t p)+ - apply (thin_tac "ctes_of t = p" for t p)+ - apply (thin_tac "ekheap_relation t p" for t p)+ - apply (thin_tac "pspace_relation t p" for t p)+ - apply (thin_tac "interrupt_state_relation s t p" for s t p)+ - apply (thin_tac "sched_act_relation t p" for t p)+ - apply (thin_tac "ready_queues_relation t p" for t p)+ - apply (rule conjI) - subgoal by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) - apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def prev_update_modify_mdb_relation) - apply (subgoal_tac "cte_map dest \ 0") - prefer 2 - apply (clarsimp simp: valid_mdb'_def - valid_mdb_ctes_def no_0_def) - apply (subgoal_tac "cte_map src \ 0") - prefer 2 - apply (clarsimp simp: valid_mdb'_def - valid_mdb_ctes_def no_0_def) - apply (subgoal_tac "should_be_parent_of src_cap (is_original_cap a src) c (revokable src_cap c) = True") - prefer 2 - apply (subst should_be_parent_of_masked_as_full[symmetric]) - apply (subst safe_parent_is_parent) - apply ((simp add: cte_wp_at_caps_of_state)+)[4] - apply (subst conj_assoc[symmetric]) - apply (rule conjI) - defer - apply (clarsimp simp: modify_map_apply) - apply (clarsimp simp: revokable_relation_def simp del: fun_upd_apply) - apply (simp split: if_split) - apply (rule conjI) - apply clarsimp - apply (subgoal_tac "mdbRevocable node = revokable' (cteCap srcCTE) c'") - prefer 2 - apply (case_tac rv') - apply (clarsimp simp add: const_def modify_map_def split: if_split_asm) - apply clarsimp - apply (rule revokable_eq, assumption, assumption) - apply (subst same_region_as_relation [symmetric]) - prefer 3 - apply (rule safe_parent_same_region) - apply (simp add: cte_wp_at_caps_of_state) - apply assumption - apply assumption - apply (clarsimp simp: cte_wp_at_def is_simple_cap_def) - apply clarsimp - apply (case_tac srcCTE) - apply (case_tac rv') - apply clarsimp - apply (subgoal_tac "\cap' node'. ctes_of b (cte_map (aa,bb)) = Some (CTE cap' node')") - prefer 2 - subgoal by (clarsimp simp: modify_map_def split: if_split_asm) - apply clarsimp - apply (drule set_cap_caps_of_state_monad)+ - apply (subgoal_tac "null_filter (caps_of_state a) (aa,bb) \ None") - prefer 2 - subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def split: if_splits) - apply clarsimp - apply (subgoal_tac "cte_at (aa,bb) a") - prefer 2 - apply (drule null_filter_caps_of_stateD) - apply (erule cte_wp_at_weakenE, rule TrueI) - apply (subgoal_tac "mdbRevocable node = mdbRevocable node'") - apply clarsimp - apply (subgoal_tac "cte_map (aa,bb) \ cte_map dest") - subgoal by (clarsimp simp: modify_map_def split: if_split_asm) - apply (erule (5) cte_map_inj) - apply (rule setUntypedCapAsFull_corres) - apply simp+ - apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb set_untyped_cap_as_full_valid_list - set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap - setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for' | clarsimp | wps)+ + subgoal by (clarsimp simp: modify_map_def split: if_split_asm) + apply clarsimp + apply (drule set_cap_caps_of_state_monad)+ + apply (subgoal_tac "null_filter (caps_of_state a) (aa,bb) \ None") + prefer 2 + subgoal by (clarsimp simp: cte_wp_at_caps_of_state null_filter_def split: if_splits) + apply clarsimp + apply (subgoal_tac "cte_at (aa,bb) a") + prefer 2 + apply (drule null_filter_caps_of_stateD) + apply (erule cte_wp_at_weakenE, rule TrueI) + apply (subgoal_tac "mdbRevocable node = mdbRevocable node'") + apply clarsimp + apply (subgoal_tac "cte_map (aa,bb) \ cte_map dest") + subgoal by (clarsimp simp: modify_map_def split: if_split_asm) + apply (erule (5) cte_map_inj) + apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb + set_untyped_cap_as_full_valid_list set_untyped_cap_as_full_cte_wp_at + setUntypedCapAsFull_valid_cap setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for' + | clarsimp | wps)+ apply (clarsimp simp:cte_wp_at_caps_of_state ) apply (case_tac rv',clarsimp simp:cte_wp_at_ctes_of maskedAsFull_def) apply (wp getCTE_wp' get_cap_wp)+ @@ -4939,7 +4937,6 @@ lemma cteInsert_simple_corres: prefer 2 subgoal by (fastforce simp: cte_wp_at_def) apply (erule conjE) - apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node (cte_map dest) NullCap dest_node") prefer 2 diff --git a/proof/refine/ARM_HYP/Detype_R.thy b/proof/refine/ARM_HYP/Detype_R.thy index 3b079116a..644082b53 100644 --- a/proof/refine/ARM_HYP/Detype_R.thy +++ b/proof/refine/ARM_HYP/Detype_R.thy @@ -654,7 +654,7 @@ lemma deleteObjects_corres: valid_pspace' s" in corres_underlying_split) apply (rule corres_bind_return) apply (rule corres_guard_imp[where r=dc]) - apply (rule corres_split_deprecated[OF cNodeNoPartialOverlap]) + apply (rule corres_split[OF _ cNodeNoPartialOverlap]) apply (rule corres_machine_op[OF corres_Id], simp+) apply (rule no_fail_freeMemory, simp+) apply (wp hoare_vcg_ex_lift)+ diff --git a/proof/refine/ARM_HYP/Finalise_R.thy b/proof/refine/ARM_HYP/Finalise_R.thy index d54f8627f..8229aa571 100644 --- a/proof/refine/ARM_HYP/Finalise_R.thy +++ b/proof/refine/ARM_HYP/Finalise_R.thy @@ -3907,8 +3907,8 @@ lemma unbindNotification_corres: apply (rule corres_split[OF getNotification_corres]) apply clarsimp apply (rule corres_split[OF setNotification_corres]) - apply (rule setBoundNotification_corres) - apply (clarsimp simp: ntfn_relation_def split:Structures_A.ntfn.splits) + apply (clarsimp simp: ntfn_relation_def split:Structures_A.ntfn.splits) + apply (rule setBoundNotification_corres) apply (wp gbn_wp' gbn_wp)+ apply (clarsimp elim!: obj_at_valid_objsE dest!: bound_tcb_at_state_refs_ofD invs_valid_objs @@ -3933,8 +3933,8 @@ lemma unbindMaybeNotification_corres: apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) apply (rule corres_return_trivial) apply (rule corres_split[OF setNotification_corres]) - apply (rule setBoundNotification_corres) - apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) + apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) + apply (rule setBoundNotification_corres) apply (wp get_simple_ko_wp getNotification_wp)+ apply (clarsimp elim!: obj_at_valid_objsE dest!: bound_tcb_at_state_refs_ofD invs_valid_objs @@ -3996,10 +3996,10 @@ lemma cap_delete_one_corres: apply (rule corres_split[OF isFinalCapability_corres[where ptr=ptr]]) apply (simp add: split_def bind_assoc [THEN sym]) apply (rule corres_split[OF fast_finaliseCap_corres[where sl=ptr]]) - apply (rule emptySlot_corres) - apply simp+ + apply simp+ + apply (rule emptySlot_corres, simp) apply (wp hoare_drop_imps)+ - apply (wp isFinalCapability_inv | wp (once) isFinal[where x="cte_map ptr"])+ + apply (wp isFinalCapability_inv | wp (once) isFinal[where x="cte_map ptr"])+ apply (rule corres_trivial, simp) apply (wp get_cap_wp getCTE_wp)+ apply (clarsimp simp: cte_wp_at_caps_of_state can_fast_finalise_Null diff --git a/proof/refine/ARM_HYP/InterruptAcc_R.thy b/proof/refine/ARM_HYP/InterruptAcc_R.thy index 6acd71439..3c2a24510 100644 --- a/proof/refine/ARM_HYP/InterruptAcc_R.thy +++ b/proof/refine/ARM_HYP/InterruptAcc_R.thy @@ -31,15 +31,15 @@ lemma setIRQState_corres: apply (subgoal_tac "(state = irq_state.IRQInactive) = (state' = irqstate.IRQInactive)") apply (rule corres_guard_imp) apply (rule corres_split_nor) - apply (rule corres_machine_op) - apply (rule corres_Id | simp)+ - apply (rule no_fail_maskInterrupt) - apply (simp add: getInterruptState_def setInterruptState_def - simpler_gets_def simpler_modify_def bind_def) - apply (simp add: simpler_modify_def[symmetric]) - apply (rule corres_trivial, rule corres_modify) - apply (simp add: state_relation_def swp_def) - apply (clarsimp simp: interrupt_state_relation_def) + apply (simp add: getInterruptState_def setInterruptState_def + simpler_gets_def simpler_modify_def bind_def) + apply (simp add: simpler_modify_def[symmetric]) + apply (rule corres_trivial, rule corres_modify) + apply (simp add: state_relation_def swp_def) + apply (clarsimp simp: interrupt_state_relation_def) + apply (rule corres_machine_op) + apply (rule corres_Id | simp)+ + apply (rule no_fail_maskInterrupt) apply (wp | simp)+ apply (clarsimp simp: irq_state_relation_def split: irq_state.split_asm irqstate.split_asm) diff --git a/proof/refine/ARM_HYP/Interrupt_R.thy b/proof/refine/ARM_HYP/Interrupt_R.thy index 20dfba6fc..25952092e 100644 --- a/proof/refine/ARM_HYP/Interrupt_R.thy +++ b/proof/refine/ARM_HYP/Interrupt_R.thy @@ -220,16 +220,18 @@ lemma arch_decodeIRQControlInvocation_corres: apply (clarsimp simp add: minIRQ_def maxIRQ_def ucast_nat_def) apply (rule corres_split_eqr[OF is_irq_active_corres]) apply (rule whenE_throwError_corres, clarsimp, clarsimp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (rule corres_splitEE[OF ensureEmptySlot_corres]) - apply (rule corres_returnOkTT) - apply (clarsimp simp: arch_irq_control_inv_relation_def ) - apply ((wpsimp wp: isIRQActive_inv arch_check_irq_maxIRQ_valid' checkIRQ_inv - wp_del: arch_check_irq_inv - simp: invs_valid_objs invs_psp_aligned invs_valid_objs' - invs_pspace_aligned' invs_pspace_distinct' - | strengthen invs_valid_objs invs_psp_aligned - | wp (once) hoare_drop_imps arch_check_irq_inv)+) + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (rule corres_splitEE[OF ensureEmptySlot_corres]) + apply simp + apply (rule corres_returnOkTT) + apply (clarsimp simp: arch_irq_control_inv_relation_def ) + apply ((wpsimp wp: isIRQActive_inv arch_check_irq_maxIRQ_valid' checkIRQ_inv + wp_del: arch_check_irq_inv + simp: invs_valid_objs invs_psp_aligned invs_valid_objs' + invs_pspace_aligned' invs_pspace_distinct' + | strengthen invs_valid_objs invs_psp_aligned + | wp (once) hoare_drop_imps arch_check_irq_inv)+) apply (auto split: arch_invocation_label.splits invocation_label.splits) done @@ -272,15 +274,17 @@ lemma decodeIRQControlInvocation_corres: apply (clarsimp simp add: minIRQ_def maxIRQ_def ucast_nat_def) apply (rule corres_split_eqr[OF is_irq_active_corres]) apply (rule whenE_throwError_corres, clarsimp, clarsimp) - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) - apply (rule corres_splitEE[OF ensureEmptySlot_corres]) - apply (rule corres_returnOkTT) - apply (clarsimp simp: arch_irq_control_inv_relation_def ) - apply (wpsimp wp: isIRQActive_inv arch_check_irq_maxIRQ_valid' checkIRQ_inv - simp: invs_valid_objs invs_psp_aligned invs_valid_objs' - invs_pspace_aligned' invs_pspace_distinct' - | strengthen invs_valid_objs invs_psp_aligned - | wp (once) hoare_drop_imps arch_check_irq_inv)+ + apply (rule corres_splitEE) + apply (rule lookupSlotForCNodeOp_corres; simp) + apply (rule corres_splitEE) + apply (rule ensureEmptySlot_corres; simp) + apply (rule corres_returnOkTT) + apply (clarsimp simp: arch_irq_control_inv_relation_def ) + apply (wpsimp wp: isIRQActive_inv arch_check_irq_maxIRQ_valid' checkIRQ_inv + simp: invs_valid_objs invs_psp_aligned invs_valid_objs' + invs_pspace_aligned' invs_pspace_distinct' + | strengthen invs_valid_objs invs_psp_aligned + | wp (once) hoare_drop_imps arch_check_irq_inv)+ apply (auto split: arch_invocation_label.splits invocation_label.splits simp: not_less unat_le_helper) done @@ -479,13 +483,12 @@ lemma arch_performIRQControl_corres: apply (cases x2; simp add: ARM_HYP_H.performIRQControl_def invoke_irq_control.cases IRQ_def) apply (rule corres_guard_imp) apply (rule corres_split_nor) - apply (rule corres_split_nor) - apply (rule cteInsert_simple_corres; simp) + apply (rule setIRQTrigger_corres) + apply (rule corres_split_nor) apply (rule setIRQState_corres) apply (simp add: irq_state_relation_def) - apply (wp | simp add: irq_state_relation_def IRQHandler_valid IRQHandler_valid')+ - apply (rule setIRQTrigger_corres) - apply wp+ + apply (rule cteInsert_simple_corres; simp) + apply (wp | simp add: irq_state_relation_def IRQHandler_valid IRQHandler_valid')+ apply (clarsimp simp: invs_def valid_state_def valid_pspace_def cte_wp_at_caps_of_state is_simple_cap_def is_cap_simps arch_irq_control_inv_valid_def safe_parent_for_def) @@ -506,9 +509,9 @@ lemma performIRQControl_corres: apply (cases i, simp_all add: performIRQControl_def) apply (rule corres_guard_imp) apply (rule corres_split_nor[OF setIRQState_corres]) - apply (rule cteInsert_simple_corres) - apply (wp | simp add: irq_state_relation_def - IRQHandler_valid IRQHandler_valid')+ + apply (simp add: irq_state_relation_def) + apply (rule cteInsert_simple_corres) + apply (wp | simp add: IRQHandler_valid IRQHandler_valid')+ apply (clarsimp simp: invs_def valid_state_def valid_pspace_def cte_wp_at_caps_of_state is_simple_cap_def is_cap_simps safe_parent_for_def) @@ -637,73 +640,73 @@ lemma timerTick_corres: apply (simp add: timerTick_def timer_tick_def) apply (simp add:thread_state_case_if threadState_case_if) apply (rule_tac Q="\ and (cur_tcb and valid_sched)" and Q'="\ and invs'" in corres_guard_imp) - apply (rule corres_guard_imp) - apply (rule corres_split[OF getCurThread_corres]) - apply simp - apply (rule corres_split[OF getThreadState_corres]) - apply (rename_tac state state') - apply (rule corres_split_deprecated[where r' = dc ]) - apply simp - apply (rule corres_when,simp) - apply (rule corres_split[OF decDomainTime_corres]) - apply (rule corres_split[OF getDomainTime_corres]) - apply (rule corres_when,simp) - apply (rule rescheduleRequired_corres) - apply (wp hoare_drop_imp)+ - apply (simp add:dec_domain_time_def) - apply wp+ - apply (simp add:decDomainTime_def) - apply wp - apply (rule corres_if[where Q = \ and Q' = \]) - apply (case_tac state,simp_all)[1] - apply (simp add: Let_def) - apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres]) - apply (rename_tac ts ts') - apply (rule_tac R="1 < ts" in corres_cases) - apply (simp) - apply (unfold thread_set_time_slice_def) - apply (rule ethread_set_corres, simp+) - apply (clarsimp simp: etcb_relation_def) - apply simp - apply (rule corres_split[OF ethread_set_corres]) - apply (rule corres_split[OF tcbSchedAppend_corres]) - apply (rule rescheduleRequired_corres) - apply (wp)[1] - apply (rule hoare_strengthen_post) - apply (rule tcbSchedAppend_invs_but_ct_not_inQ', clarsimp simp: sch_act_wf_weak) - apply (simp add: sch_act_wf_weak etcb_relation_def pred_conj_def)+ + apply (rule corres_guard_imp) + apply (rule corres_split[OF getCurThread_corres]) + apply simp + apply (rule corres_split[OF getThreadState_corres]) + apply (rename_tac state state') + apply (rule corres_split[where r' = dc ]) + apply (rule corres_if[where Q = \ and Q' = \]) + apply (case_tac state,simp_all)[1] + apply (simp add: Let_def) + apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres]) + apply (simp add:etcb_relation_def) + apply (rename_tac ts ts') + apply (rule_tac R="1 < ts" in corres_cases) + apply (simp) + apply (unfold thread_set_time_slice_def) + apply (rule ethread_set_corres, simp+) + apply (clarsimp simp: etcb_relation_def) + apply simp + apply (rule corres_split) + apply (rule ethread_set_corres; simp) + apply (simp add: etcb_relation_def) + apply (rule corres_split[OF tcbSchedAppend_corres]) + apply (rule rescheduleRequired_corres) + apply (wp)[1] + apply (rule hoare_strengthen_post) + apply (rule tcbSchedAppend_invs_but_ct_not_inQ', + clarsimp simp: sch_act_wf_weak) apply (wp threadSet_timeslice_invs threadSet_valid_queues threadSet_valid_queues' threadSet_pred_tcb_at_state)+ - apply (simp add:etcb_relation_def) - apply (wp threadSet_timeslice_invs threadSet_valid_queues - threadSet_valid_queues' threadSet_pred_tcb_at_state) apply simp - apply (wp|wpc|unfold Let_def|simp)+ - apply (wp static_imp_wp threadSet_timeslice_invs threadSet_valid_queues threadSet_valid_queues' - threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf tcbSchedAppend_valid_objs' - rescheduleRequired_weak_sch_act_wf tcbSchedAppend_valid_queues| simp)+ - apply (strengthen sch_act_wf_weak) - apply (clarsimp simp:conj_comms) - apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf) - apply simp - apply (wp threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act - threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'| simp)+ - apply (wp threadGet_wp gts_wp gts_wp')+ - apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def) - prefer 2 - apply clarsimp - apply (clarsimp simp add:cur_tcb_def valid_sched_def - valid_sched_action_def valid_etcbs_def is_tcb_def - is_etcb_at_def st_tcb_at_def obj_at_def - dest!:get_tcb_SomeD) - apply (clarsimp simp: invs'_def valid_state'_def - sch_act_wf_weak - cur_tcb'_def inQ_def - ct_in_state'_def obj_at'_def) - apply (clarsimp simp:st_tcb_at'_def - valid_idle'_def ct_idle_or_in_cur_domain'_def - obj_at'_def projectKO_eq) - apply simp + apply simp + apply (rule corres_when,simp) + apply (rule corres_split[OF decDomainTime_corres]) + apply (rule corres_split[OF getDomainTime_corres]) + apply (rule corres_when,simp) + apply (rule rescheduleRequired_corres) + apply (wp hoare_drop_imp)+ + apply (simp add:dec_domain_time_def) + apply wp+ + apply (simp add:decDomainTime_def) + apply wp + apply (wp|wpc|unfold Let_def|simp)+ + apply (wp static_imp_wp threadSet_timeslice_invs threadSet_valid_queues threadSet_valid_queues' + threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf tcbSchedAppend_valid_objs' + rescheduleRequired_weak_sch_act_wf tcbSchedAppend_valid_queues| simp)+ + apply (strengthen sch_act_wf_weak) + apply (clarsimp simp:conj_comms) + apply (wp tcbSchedAppend_valid_queues tcbSchedAppend_sch_act_wf) + apply simp + apply (wp threadSet_valid_queues threadSet_pred_tcb_at_state threadSet_sch_act + threadSet_tcbDomain_triv threadSet_valid_queues' threadSet_valid_objs'| simp)+ + apply (wp threadGet_wp gts_wp gts_wp')+ + apply (clarsimp simp: cur_tcb_def tcb_at_is_etcb_at valid_sched_def valid_sched_action_def) + prefer 2 + apply clarsimp + apply (clarsimp simp add:cur_tcb_def valid_sched_def + valid_sched_action_def valid_etcbs_def is_tcb_def + is_etcb_at_def st_tcb_at_def obj_at_def + dest!:get_tcb_SomeD) + apply (clarsimp simp: invs'_def valid_state'_def + sch_act_wf_weak + cur_tcb'_def inQ_def + ct_in_state'_def obj_at'_def) + apply (clarsimp simp:st_tcb_at'_def + valid_idle'_def ct_idle_or_in_cur_domain'_def + obj_at'_def projectKO_eq) + apply simp done lemma corres_return_VGICMaintenance [corres]: @@ -823,65 +826,69 @@ proof - apply (rule corres_trivial, simp) apply clarsimp - apply (rule corres_split_eqr[OF corres_machine_op])+ - apply (rename_tac eisr0 eisr1 flags) - apply (rule corres_split[OF corres_gets_numlistregs]) - apply (rule corres_split_deprecated[where r'="\rv rv'. rv' = arch_fault_map rv"]) - apply (rule corres_split_eqr[OF getCurThread_corres]) - apply (rule corres_split[OF getThreadState_corres]) - apply (fold dc_def) - apply (rule corres_when) - apply clarsimp - apply (rename_tac threadState threadState') - apply (case_tac threadState; simp) - apply (rule handleFault_corres) - apply clarsimp - apply clarsimp - apply (wp gts_wp) - apply (wp gts_wp') + apply (rule corres_split_eqr[OF corres_machine_op], + (rule corres_Id; wpsimp simp: get_gic_vcpu_ctrl_misr_def + get_gic_vcpu_ctrl_eisr1_def + get_gic_vcpu_ctrl_eisr0_def))+ + apply (rename_tac eisr0 eisr1 flags) + apply (rule corres_split[OF corres_gets_numlistregs]) + apply (rule corres_split[where r'="\rv rv'. rv' = arch_fault_map rv"]) + apply (rule corres_if[rotated -1]) + apply (rule corres_trivial, simp) + apply clarsimp + apply (rule corres_if, simp) + apply (rule corres_trivial, simp) + supply if_split[split del] + apply (clarsimp simp: bind_assoc cong: if_cong) + apply (rule corres_split_eqr[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) + apply (rule corres_split_dc[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) apply clarsimp - apply (rule_tac - Q="\rv. tcb_at rv and einvs - and (\_. valid_fault (ExceptionTypes_A.fault.ArchFault rva))" - in hoare_post_imp) - apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb runnable_eq pred_conj_def) - apply (strengthen st_tcb_ex_cap'[where P=active], clarsimp) - apply (clarsimp simp: pred_tcb_at_def obj_at_def) - apply wp - apply clarsimp - apply (rule_tac Q="\rv x. tcb_at' rv x - \ invs' x - \ sch_act_not rv x - \ (\d p. rv \ set (ksReadyQueues x (d, p)))" - in hoare_post_imp) + apply (rule corres_split_dc[OF vgicUpdateLR_corres]) + apply (rule corres_trivial, simp) + apply wpsimp+ + apply (rule corres_split_eqr[OF getCurThread_corres]) + apply (rule corres_split[OF getThreadState_corres]) + apply (fold dc_def) + apply (rule corres_when) apply clarsimp - apply (strengthen st_tcb_ex_cap''[where P=active']) - apply (strengthen invs_iflive') - apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb') - apply (clarsimp simp: pred_tcb_at'_def) - apply (rule conjI, erule_tac p=r in obj_at'_weakenE - , fastforce split: thread_state.splits) - apply (erule_tac p=r in obj_at'_weakenE, fastforce split: thread_state.splits) - apply wp - apply (rule corres_if[rotated -1]) - apply (rule corres_trivial, simp) + apply (rename_tac threadState threadState') + apply (case_tac threadState; simp) + apply (rule handleFault_corres) apply clarsimp - apply (rule corres_if, simp) - apply (rule corres_trivial, simp) - supply if_split[split del] - apply (clarsimp simp: bind_assoc cong: if_cong) - apply (rule corres_split_eqr[OF corres_machine_op]) - apply (rule corres_split_dc[OF corres_machine_op]) - apply clarsimp - apply (rule corres_split_dc[OF vgicUpdateLR_corres]) - apply (rule corres_trivial, simp) - supply corres_return[simp del] - apply (wpsimp wp: corres_Id wplr wplr' hoare_vcg_all_lift - hoare_vcg_imp_lift' dmo_gets_wp dmo'_gets_wp - simp: get_gic_vcpu_ctrl_misr_def if_apply_def2 - get_gic_vcpu_ctrl_eisr1_def - get_gic_vcpu_ctrl_eisr0_def - | strengthen tcb_at_invs tcb_at_invs')+ + apply clarsimp + apply (wp gts_wp) + apply (wp gts_wp') + apply (rule_tac + Q="\rv. tcb_at rv and einvs + and (\_. valid_fault (ExceptionTypes_A.fault.ArchFault rva))" + in hoare_post_imp) + apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb runnable_eq pred_conj_def) + apply (strengthen st_tcb_ex_cap'[where P=active], clarsimp) + apply (clarsimp simp: pred_tcb_at_def obj_at_def) + apply wp + apply clarsimp + apply (rule_tac Q="\rv x. tcb_at' rv x + \ invs' x + \ sch_act_not rv x + \ (\d p. rv \ set (ksReadyQueues x (d, p)))" + in hoare_post_imp) + apply clarsimp + apply (strengthen st_tcb_ex_cap''[where P=active']) + apply (strengthen invs_iflive') + apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb') + apply (clarsimp simp: pred_tcb_at'_def) + apply (rule conjI, erule_tac p=r in obj_at'_weakenE + , fastforce split: thread_state.splits) + apply (erule_tac p=r in obj_at'_weakenE, fastforce split: thread_state.splits) + apply wp + apply (wpsimp wp: wplr wplr' hoare_vcg_all_lift + hoare_vcg_imp_lift' dmo_gets_wp dmo'_gets_wp + simp: get_gic_vcpu_ctrl_misr_def if_apply_def2 + get_gic_vcpu_ctrl_eisr1_def + get_gic_vcpu_ctrl_eisr0_def + | strengthen tcb_at_invs tcb_at_invs')+ apply (frule invs_arch_state) apply (clarsimp simp: valid_arch_state_def valid_fault_def tcb_at_invs obj_at_def is_vcpu_def) @@ -911,47 +918,47 @@ lemma vppiEvent_corres: apply clarsimp apply (rule corres_split_dc[OF corres_machine_op]) - apply (rule corres_split_dc[OF vcpuUpdate_corres]) - apply (rule corres_split_eqr[OF getCurThread_corres]) - apply (rule corres_split[OF getThreadState_corres], rename_tac gts gts') - apply (fold dc_def) - apply (rule corres_when) - apply (case_tac gts; fastforce) - apply (rule handleFault_corres, simp) - apply (wp gts_st_tcb_at hoare_vcg_imp_lift') - apply (wp gts_st_tcb_at' hoare_vcg_imp_lift') - (* on both sides, we check that the current thread is runnable, then have to know it - is runnable directly afterwards, which is obvious and should not propagate further; - clean up the postconditions of the thread_get and threadGet *) - apply (rule_tac - Q="\rv. tcb_at rv and einvs - and (\_. valid_fault (ExceptionTypes_A.fault.ArchFault - (ARM_A.VPPIEvent irq)))" - in hoare_post_imp) - apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb runnable_eq pred_conj_def) - apply (strengthen st_tcb_ex_cap'[where P=active], clarsimp) - apply wp - apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def) - apply (rule_tac Q="\rv x. tcb_at' rv x - \ invs' x - \ sch_act_not rv x - \ (\d p. rv \ set (ksReadyQueues x (d, p)))" in hoare_post_imp) - apply (strengthen st_tcb_ex_cap''[where P=active']) - apply (strengthen invs_iflive') - apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb') - apply (clarsimp simp: pred_tcb_at'_def) - apply (rule conjI, erule_tac p=r in obj_at'_weakenE, fastforce split: thread_state.splits) - apply (erule_tac p=r in obj_at'_weakenE, fastforce split: thread_state.splits) - apply wp - + apply (rule corres_Id; wpsimp) + apply (rule corres_split_dc[OF vcpuUpdate_corres]) apply (fastforce simp: vcpu_relation_def irq_vppi_event_index_def irqVPPIEventIndex_def IRQ_def) - apply (wpsimp wp: vcpu_update_tcb_at hoare_vcg_all_lift hoare_vcg_imp_lift' - cong: vcpu.fold_congs)+ - apply (strengthen tcb_at_invs) - apply (wpsimp wp: dmo_maskInterrupt_True maskInterrupt_invs corres_Id - setVCPU_VPPIMasked_invs' simp: vcpuUpdate_def - | wps)+ + apply (rule corres_split_eqr[OF getCurThread_corres]) + apply (rule corres_split[OF getThreadState_corres], rename_tac gts gts') + apply (fold dc_def) + apply (rule corres_when) + apply (case_tac gts; fastforce) + apply (rule handleFault_corres, simp) + apply (wp gts_st_tcb_at hoare_vcg_imp_lift') + apply (wp gts_st_tcb_at' hoare_vcg_imp_lift') + (* on both sides, we check that the current thread is runnable, then have to know it + is runnable directly afterwards, which is obvious and should not propagate further; + clean up the postconditions of the thread_get and threadGet *) + apply (rule_tac + Q="\rv. tcb_at rv and einvs + and (\_. valid_fault (ExceptionTypes_A.fault.ArchFault + (ARM_A.VPPIEvent irq)))" + in hoare_post_imp) + apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb runnable_eq pred_conj_def) + apply (strengthen st_tcb_ex_cap'[where P=active], clarsimp) + apply wp + apply (clarsimp cong: imp_cong conj_cong simp: pred_conj_def) + apply (rule_tac Q="\rv x. tcb_at' rv x + \ invs' x + \ sch_act_not rv x + \ (\d p. rv \ set (ksReadyQueues x (d, p)))" in hoare_post_imp) + apply (strengthen st_tcb_ex_cap''[where P=active']) + apply (strengthen invs_iflive') + apply (clarsimp cong: imp_cong conj_cong simp: not_pred_tcb') + apply (clarsimp simp: pred_tcb_at'_def) + apply (rule conjI, erule_tac p=r in obj_at'_weakenE, fastforce split: thread_state.splits) + apply (erule_tac p=r in obj_at'_weakenE, fastforce split: thread_state.splits) + apply wp + apply (wpsimp wp: vcpu_update_tcb_at hoare_vcg_all_lift hoare_vcg_imp_lift' + cong: vcpu.fold_congs)+ + apply (strengthen tcb_at_invs) + apply (wpsimp wp: dmo_maskInterrupt_True maskInterrupt_invs + setVCPU_VPPIMasked_invs' simp: vcpuUpdate_def + | wps)+ apply (frule invs_arch_state) apply (simp add: valid_arch_state_def valid_fault_def tcb_at_invs) apply (clarsimp simp: obj_at_def is_vcpu_def) @@ -996,7 +1003,7 @@ lemma handleInterrupt_corres: defer apply (wp getIRQState_prop getIRQState_inv do_machine_op_bind doMachineOp_bind | simp add: do_machine_op_bind doMachineOp_bind )+ apply (rule corres_guard_imp) - apply (rule corres_split_deprecated) + apply (rule corres_split) apply (rule corres_machine_op, rule corres_eq_trivial ; (simp add: dc_def no_fail_maskInterrupt no_fail_bind no_fail_ackInterrupt)+)+ apply ((wp | simp)+)[4] apply (rule corres_gen_asm2) @@ -1015,7 +1022,7 @@ lemma handleInterrupt_corres: apply (rule corres_guard_imp, rule sendSignal_corres) apply (clarsimp simp: valid_cap_def valid_cap'_def do_machine_op_bind doMachineOp_bind)+ apply (clarsimp simp: arch_mask_irq_signal_def maskIrqSignal_def) - apply (rule corres_split_deprecated) + apply (rule corres_split) apply (rule corres_machine_op, rule corres_eq_trivial ; (simp add: no_fail_maskInterrupt no_fail_bind no_fail_ackInterrupt)+)+ apply wp+ @@ -1026,13 +1033,12 @@ lemma handleInterrupt_corres: apply clarsimp apply fastforce apply (rule corres_guard_imp) - apply (rule corres_split_deprecated) - apply simp - apply (rule corres_split[OF timerTick_corres corres_machine_op]) - apply (rule corres_eq_trivial, simp+) - apply (rule corres_machine_op) - apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+) - apply wp+ + apply (rule corres_split) + apply (rule corres_split[OF timerTick_corres corres_machine_op]) + apply (rule corres_eq_trivial, wpsimp+) + apply (rule corres_machine_op) + apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+) + apply wp+ apply clarsimp apply clarsimp apply corressimp diff --git a/proof/refine/ARM_HYP/IpcCancel_R.thy b/proof/refine/ARM_HYP/IpcCancel_R.thy index 4be2759eb..7ef00de13 100644 --- a/proof/refine/ARM_HYP/IpcCancel_R.thy +++ b/proof/refine/ARM_HYP/IpcCancel_R.thy @@ -199,9 +199,9 @@ lemma blocked_cancelIPC_corres: apply simp apply (rule corres_guard_imp) apply (rule corres_split[OF setEndpoint_corres]) - apply (rule setThreadState_corres) - apply simp - apply (simp add: ep_relation_def) + apply (simp add: ep_relation_def) + apply (rule setThreadState_corres) + apply simp apply (simp add: valid_tcb_state_def pred_conj_def) apply (wp weak_sch_act_wf_lift)+ apply (clarsimp simp: st_tcb_at_tcb_at) @@ -222,9 +222,9 @@ lemma blocked_cancelIPC_corres: apply clarsimp apply (rule corres_guard_imp) apply (rule corres_split[OF setEndpoint_corres]) - apply (rule setThreadState_corres) - apply simp - apply (simp add: ep_relation_def) + apply (simp add: ep_relation_def) + apply (rule setThreadState_corres) + apply simp apply (wp)+ apply (clarsimp simp: st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) @@ -247,9 +247,9 @@ lemma blocked_cancelIPC_corres: apply simp apply (rule corres_guard_imp) apply (rule corres_split[OF setEndpoint_corres]) - apply (rule setThreadState_corres) - apply simp - apply (simp add: ep_relation_def) + apply (simp add: ep_relation_def) + apply (rule setThreadState_corres) + apply simp apply (simp add: valid_tcb_state_def pred_conj_def) apply (wp weak_sch_act_wf_lift)+ apply (clarsimp simp: st_tcb_at_tcb_at) @@ -270,9 +270,9 @@ lemma blocked_cancelIPC_corres: apply clarsimp apply (rule corres_guard_imp) apply (rule corres_split[OF setEndpoint_corres]) - apply (rule setThreadState_corres) - apply simp - apply (simp add: ep_relation_def) + apply (simp add: ep_relation_def) + apply (rule setThreadState_corres) + apply simp apply (wp)+ apply (clarsimp simp: st_tcb_at_tcb_at) apply (clarsimp simp: st_tcb_at_def obj_at_def) @@ -325,15 +325,15 @@ lemma cancelSignal_corres: apply (rule_tac R="remove1 t list = []" in corres_cases) apply (simp del: dc_simp) apply (rule corres_split[OF setNotification_corres]) - apply (rule setThreadState_corres) - apply simp - apply (simp add: ntfn_relation_def) + apply (simp add: ntfn_relation_def) + apply (rule setThreadState_corres) + apply simp apply (wp)+ apply (simp add: list_case_If del: dc_simp) apply (rule corres_split[OF setNotification_corres]) - apply (rule setThreadState_corres) - apply simp - apply (clarsimp simp add: ntfn_relation_def neq_Nil_conv) + apply (clarsimp simp add: ntfn_relation_def neq_Nil_conv) + apply (rule setThreadState_corres) + apply simp apply (wp)+ apply (simp add: isWaitingNtfn_def ntfn_relation_def) apply (wp getNotification_wp)+ @@ -1253,20 +1253,21 @@ lemma tcbSchedDequeue_corres': apply (simp add: ready_queues_relation_def) apply (simp add: unless_def when_def) apply (rule corres_guard_imp) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (simp split del: if_split) - apply (rule corres_split_eqr[OF ethreadget_corres]) - apply (rule corres_split_eqr[OF getQueue_corres]) - apply (simp split del: if_split) - apply (subst bind_return_unit, rule corres_split_deprecated[where r'=dc]) - apply (rule corres_split_noop_rhs) - apply (simp add: dc_def[symmetric]) - apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1] - apply (clarsimp, rule removeFromBitmap_corres_noop) - apply wp - apply (simp add: tcb_sched_dequeue_def) - apply (rule setQueue_corres) - apply (wp | simp add: etcb_relation_def)+ + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres, simp add: etcb_relation_def) + apply (simp split del: if_split) + apply (rule corres_split_eqr) + apply (rule ethreadget_corres, simp add: etcb_relation_def) + apply (rule corres_split_eqr[OF getQueue_corres]) + apply (simp split del: if_split) + apply (subst bind_return_unit, rule corres_split[where r'=dc]) + apply (simp add: tcb_sched_dequeue_def) + apply (rule setQueue_corres) + apply (rule corres_split_noop_rhs) + apply (clarsimp, rule removeFromBitmap_corres_noop) + apply (simp add: dc_def[symmetric]) + apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1] + apply (wp | simp)+ done lemma setQueue_valid_inQ_queues: @@ -1424,23 +1425,21 @@ lemma (in delete_one) suspend_corres: apply (rule corres_split_nor[OF cancel_ipc_corres]) apply (rule corres_split[OF getThreadState_corres]) apply (rule corres_split_nor) - apply (rule corres_split_nor[OF setThreadState_corres]) - apply (rule tcbSchedDequeue_corres') - apply wpsimp - apply wp - apply wpsimp - apply (rule corres_if) - apply (case_tac state; simp) - apply (simp add: update_restart_pc_def updateRestartPC_def) - apply (rule asUser_corres') - apply (simp add: ARM_HYP.nextInstructionRegister_def ARM_HYP.faultRegister_def - ARM_HYP_H.nextInstructionRegister_def ARM_HYP_H.faultRegister_def) - apply (simp add: ARM_HYP_H.Register_def) - apply (subst unit_dc_is_eq) - apply (rule corres_underlying_trivial) - apply (wpsimp simp: ARM_HYP.setRegister_def ARM_HYP.getRegister_def) - apply (rule corres_return_trivial) - apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+ + apply (rule corres_if) + apply (case_tac state; simp) + apply (simp add: update_restart_pc_def updateRestartPC_def) + apply (rule asUser_corres') + apply (simp add: ARM_HYP.nextInstructionRegister_def ARM_HYP.faultRegister_def + ARM_HYP_H.nextInstructionRegister_def ARM_HYP_H.faultRegister_def) + apply (simp add: ARM_HYP_H.Register_def) + apply (subst unit_dc_is_eq) + apply (rule corres_underlying_trivial) + apply (wpsimp simp: ARM_HYP.setRegister_def ARM_HYP.getRegister_def) + apply (rule corres_return_trivial) + apply (rule corres_split_nor[OF setThreadState_corres]) + apply simp + apply (rule tcbSchedDequeue_corres') + apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+ apply (rule hoare_post_imp[where Q = "\rv s. tcb_at t s \ is_etcb_at t s"]) apply simp apply wp @@ -2082,7 +2081,7 @@ lemma ep_cancel_corres_helper: in corres_mapM_x) apply clarsimp apply (rule corres_guard_imp) - apply (subst bind_return_unit, rule corres_split_deprecated [OF tcbSchedEnqueue_corres]) + apply (subst bind_return_unit, rule corres_split[OF _ tcbSchedEnqueue_corres]) apply simp apply (rule corres_guard_imp [OF setThreadState_corres]) apply simp @@ -2093,10 +2092,10 @@ lemma ep_cancel_corres_helper: apply (fastforce elim: obj_at'_weakenE) apply ((wp hoare_vcg_const_Ball_lift | simp)+)[1] apply (rule hoare_pre) - apply (wp hoare_vcg_const_Ball_lift - weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st - sts_valid_queues tcbSchedEnqueue_not_st - | simp)+ + apply (wp hoare_vcg_const_Ball_lift + weak_sch_act_wf_lift_linear sts_st_tcb' setThreadState_not_st + sts_valid_queues tcbSchedEnqueue_not_st + | simp)+ apply (auto elim: obj_at'_weakenE simp: valid_tcb_state'_def) done @@ -2128,7 +2127,7 @@ proof - apply (rule corres_underlying_split) apply (rule corres_guard_imp [OF setEndpoint_corres]) apply (simp add: ep_relation_def)+ - apply (rule corres_split_deprecated [OF rescheduleRequired_corres]) + apply (rule corres_split[OF _ rescheduleRequired_corres]) apply (rule ep_cancel_corres_helper) apply (rule mapM_x_wp') apply (wp weak_sch_act_wf_lift_linear set_thread_state_runnable_weak_valid_sched_action | simp)+ @@ -2140,11 +2139,11 @@ proof - sts_valid_queues setThreadState_not_st sts_st_tcb' tcbSchedEnqueue_not_st | clarsimp | fastforce elim: obj_at'_weakenE simp: valid_tcb_state'_def)+)[2] - apply (rule hoare_name_pre_state) - apply (wp hoare_vcg_const_Ball_lift set_ep_valid_objs' - | (clarsimp simp: valid_ep'_def) - | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def valid_ep'_def elim!: valid_objs_valid_tcbE))+ - done + apply (rule hoare_name_pre_state) + apply (wp hoare_vcg_const_Ball_lift set_ep_valid_objs' + | (clarsimp simp: valid_ep'_def) + | (drule (1) bspec, clarsimp simp: valid_pspace'_def valid_tcb'_def valid_ep'_def elim!: valid_objs_valid_tcbE))+ + done show ?thesis apply (simp add: cancel_all_ipc_def cancelAllIPC_def) @@ -2168,8 +2167,8 @@ lemma set_ntfn_tcb_obj_at' [wp]: "\obj_at' (P::tcb \ bool) t\ setNotification ntfn v \\_. obj_at' P t\" -apply (clarsimp simp: setNotification_def, wp) -done + apply (clarsimp simp: setNotification_def, wp) + done lemma cancelAllSignals_corres: "corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn) @@ -2181,23 +2180,21 @@ lemma cancelAllSignals_corres: apply (case_tac "ntfn_obj ntfna", simp_all add: ntfn_relation_def) apply (rule corres_guard_imp) apply (rule corres_split[OF setNotification_corres]) - apply (rule corres_split_deprecated [OF rescheduleRequired_corres]) - apply (rule ep_cancel_corres_helper) - apply (wp mapM_x_wp'[where 'b="det_ext state"] - weak_sch_act_wf_lift_linear setThreadState_not_st - set_thread_state_runnable_weak_valid_sched_action - | simp)+ - apply (rename_tac list) - apply (rule_tac R="\_ s. (\x\set list. tcb_at' x s) \ valid_objs' s" - in hoare_post_add) - apply (rule mapM_x_wp') - apply (rule hoare_name_pre_state) - apply (wp hoare_vcg_const_Ball_lift - sts_st_tcb' sts_valid_queues setThreadState_not_st - tcbSchedEnqueue_not_st - | (clarsimp simp: valid_tcb_state'_def) - | fastforce elim: obj_at'_weakenE)+ - apply (simp add: ntfn_relation_def) + apply (simp add: ntfn_relation_def) + apply (rule corres_split[OF _ rescheduleRequired_corres]) + apply (rule ep_cancel_corres_helper) + apply (wp mapM_x_wp'[where 'b="det_ext state"] + weak_sch_act_wf_lift_linear setThreadState_not_st + set_thread_state_runnable_weak_valid_sched_action + | simp)+ + apply (rename_tac list) + apply (rule_tac R="\_ s. (\x\set list. tcb_at' x s) \ valid_objs' s" + in hoare_post_add) + apply (rule mapM_x_wp') + apply (rule hoare_name_pre_state) + apply (wpsimp wp: hoare_vcg_const_Ball_lift + sts_st_tcb' sts_valid_queues setThreadState_not_st + simp: valid_tcb_state'_def) apply (wp hoare_vcg_const_Ball_lift set_ntfn_aligned' set_ntfn_valid_objs' weak_sch_act_wf_lift_linear | simp)+ @@ -2778,18 +2775,15 @@ lemma cancelBadgedSends_corres: (cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)" apply (simp add: cancel_badged_sends_def cancelBadgedSends_def) apply (rule corres_guard_imp) - apply (rule corres_split[OF getEndpoint_corres get_simple_ko_sp get_ep_sp', + apply (rule corres_split[OF getEndpoint_corres _ get_simple_ko_sp get_ep_sp', where Q="invs and valid_sched" and Q'=invs']) apply simp_all apply (case_tac ep, simp_all add: ep_relation_def) apply (simp add: filterM_mapM list_case_return cong: list.case_cong) apply (rule corres_guard_imp) apply (rule corres_split_nor[OF setEndpoint_corres]) - apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\_. valid_objs'"]]) - apply (rule corres_split_deprecated [OF rescheduleRequired_corres]) - apply (rule setEndpoint_corres) - apply (simp split: list.split add: ep_relation_def) - apply (wp weak_sch_act_wf_lift_linear)+ + apply (simp add: ep_relation_def) + apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\_. valid_objs'"]]) apply (rule_tac S="(=)" and Q="\xs s. (\x \ set xs. (epptr, TCBBlockedSend) \ state_refs_of s x) \ distinct xs \ valid_etcbs s" and Q'="\xs s. (\x \ set xs. tcb_at' x s) \ weak_sch_act_wf (ksSchedulerAction s) s \ Invariants_H.valid_queues s \ valid_queues' s \ valid_objs' s" @@ -2802,26 +2796,31 @@ lemma cancelBadgedSends_corres: in corres_gen_asm) apply (clarsimp simp: o_def dc_def[symmetric] liftM_def) apply (rule corres_split[OF setThreadState_corres]) - apply (rule corres_split[OF tcbSchedEnqueue_corres]) - apply (rule corres_trivial) - apply simp - apply wp+ - apply simp - apply (wp sts_valid_queues gts_st_tcb_at)+ + apply simp + apply (rule corres_split[OF tcbSchedEnqueue_corres]) + apply (rule corres_trivial) + apply simp + apply wp+ + apply simp + apply (wp sts_valid_queues gts_st_tcb_at)+ apply (clarsimp simp: valid_tcb_state_def tcb_at_def st_tcb_def2 st_tcb_at_refs_of_rev dest!: state_refs_of_elemD elim!: tcb_at_is_etcb_at[rotated]) apply (simp add: is_tcb_def) apply simp apply (wp hoare_vcg_const_Ball_lift gts_wp | clarsimp)+ - apply (wp gts_st_tcb_at hoare_vcg_const_Ball_lift hoare_vcg_imp_lift - weak_sch_act_wf_lift_linear mapM_wp' - sts_st_tcb' sts_valid_queues setThreadState_valid_objs' - set_thread_state_runnable_weak_valid_sched_action + apply (wp hoare_vcg_imp_lift sts_st_tcb' sts_valid_queues | clarsimp simp: valid_tcb_state'_def)+ - apply (simp add: ep_relation_def) - apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs' - | simp)+ + apply (rule corres_split[OF _ rescheduleRequired_corres]) + apply (rule setEndpoint_corres) + apply (simp split: list.split add: ep_relation_def) + apply (wp weak_sch_act_wf_lift_linear)+ + apply (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp' + sts_st_tcb' sts_valid_queues + set_thread_state_runnable_weak_valid_sched_action + | clarsimp simp: valid_tcb_state'_def)+ + apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs' + | simp)+ apply (clarsimp simp: conj_comms) apply (frule sym_refs_ko_atD, clarsimp+) apply (rule obj_at_valid_objsE, assumption+, clarsimp+) diff --git a/proof/refine/ARM_HYP/Ipc_R.thy b/proof/refine/ARM_HYP/Ipc_R.thy index 882b7bea2..585b19c53 100644 --- a/proof/refine/ARM_HYP/Ipc_R.thy +++ b/proof/refine/ARM_HYP/Ipc_R.thy @@ -150,11 +150,11 @@ lemma getReceiveSlots_corres: apply (simp add: split_def liftE_bindE unlessE_whenE) apply (rule corres_split[OF get_cap_corres]) apply (rule corres_split_norE) - apply (rule corres_trivial, simp add: returnOk_def) - apply (rule corres_whenE) - apply (case_tac cap, auto)[1] - apply (rule corres_trivial, simp) - apply simp + apply (rule corres_whenE) + apply (case_tac cap, auto)[1] + apply (rule corres_trivial, simp) + apply simp + apply (rule corres_trivial, simp add: returnOk_def) apply (wp lookup_cap_valid lookup_cap_valid' lsfco_cte_at | simp)+ done @@ -433,11 +433,11 @@ next apply (rule corres_if2) apply (case_tac "fst x", auto simp add: isCap_simps)[1] apply (rule corres_split[OF corres_set_extra_badge]) - apply (drule conjunct1) - apply simp - apply (rule corres_rel_imp, rule Cons.hyps, simp_all)[1] - apply (case_tac mi, simp) - apply (clarsimp simp: is_cap_simps) + apply (clarsimp simp: is_cap_simps) + apply (drule conjunct1) + apply simp + apply (rule corres_rel_imp, rule Cons.hyps, simp_all)[1] + apply (case_tac mi, simp) apply (simp add: split_def) apply (wp hoare_vcg_const_Ball_lift) apply (subgoal_tac "obj_ref_of (fst x) = capEPPtr (fst y)") @@ -457,38 +457,38 @@ next apply (simp add: remove_rights_def) apply clarsimp apply (rule corres_split_norE) - apply (simp add: liftE_bindE) - apply (rule corres_split_nor) - apply (rule cteInsert_corres, simp_all add: hd_map)[1] - apply (simp add: tl_map) - apply (rule corres_rel_imp, rule Cons.hyps, simp_all)[1] - apply (wp valid_case_option_post_wp hoare_vcg_const_Ball_lift - hoare_vcg_const_Ball_lift cap_insert_weak_cte_wp_at) - apply (wp hoare_vcg_const_Ball_lift | simp add:split_def del: imp_disj1)+ - apply (wp cap_insert_cte_wp_at) + apply (rule corres_whenE) + apply (case_tac cap', auto)[1] + apply (rule corres_trivial, simp) + apply (case_tac mi, simp) + apply simp + apply (simp add: liftE_bindE) + apply (rule corres_split_nor) + apply (rule cteInsert_corres, simp_all add: hd_map)[1] + apply (simp add: tl_map) + apply (rule corres_rel_imp, rule Cons.hyps, simp_all)[1] + apply (wp valid_case_option_post_wp hoare_vcg_const_Ball_lift + hoare_vcg_const_Ball_lift cap_insert_weak_cte_wp_at) + apply (wp hoare_vcg_const_Ball_lift | simp add:split_def del: imp_disj1)+ + apply (wp cap_insert_cte_wp_at) apply (wp valid_case_option_post_wp hoare_vcg_const_Ball_lift cteInsert_valid_pspace | simp add: split_def)+ apply (wp cteInsert_weak_cte_wp_at hoare_valid_ipc_buffer_ptr_typ_at')+ - apply (wp hoare_vcg_const_Ball_lift cteInsert_cte_wp_at valid_case_option_post_wp - | simp add:split_def)+ - apply (rule corres_whenE) - apply (case_tac cap', auto)[1] - apply (rule corres_trivial, simp) - apply (case_tac mi, simp) - apply simp + apply (wpsimp wp: hoare_vcg_const_Ball_lift cteInsert_cte_wp_at valid_case_option_post_wp + simp: split_def) apply (unfold whenE_def) apply wp+ - apply (clarsimp simp: conj_comms ball_conj_distrib split del: if_split) - apply (rule_tac Q' ="\cap' s. (cap'\ cap.NullCap \ - cte_wp_at (is_derived (cdt s) (a, b) cap') (a, b) s - \ QM s cap')" for QM - in hoare_post_imp_R) + apply (clarsimp simp: conj_comms ball_conj_distrib split del: if_split) + apply (rule_tac Q' ="\cap' s. (cap'\ cap.NullCap \ + cte_wp_at (is_derived (cdt s) (a, b) cap') (a, b) s + \ QM s cap')" for QM + in hoare_post_imp_R) prefer 2 - apply clarsimp - apply assumption - apply (subst imp_conjR) - apply (rule hoare_vcg_conj_liftE_R) + apply clarsimp + apply assumption + apply (subst imp_conjR) + apply (rule hoare_vcg_conj_liftE_R) apply (rule derive_cap_is_derived) apply (wp derive_cap_is_derived_foo)+ apply (simp split del: if_split) @@ -496,7 +496,7 @@ next cte_wp_at' (\c. is_derived' (ctes_of s) (cte_map (a, b)) cap' (cteCap c)) (cte_map (a, b)) s \ QM s cap')" for QM in hoare_post_imp_R) - prefer 2 + prefer 2 apply clarsimp apply assumption apply (subst imp_conjR) @@ -510,50 +510,50 @@ next apply (rule conjI, (clarsimp split del: if_split)+) apply (clarsimp simp:conj_comms split del:if_split) apply (intro conjI allI) - apply (clarsimp split:if_splits) - apply (case_tac "cap = fst x",simp+) + apply (clarsimp split:if_splits) + apply (case_tac "cap = fst x",simp+) apply (clarsimp simp:masked_as_full_def is_cap_simps cap_master_cap_simps) - apply (clarsimp split del: if_split) - apply (intro conjI) - apply (clarsimp simp:neq_Nil_conv) + apply (clarsimp split del: if_split) + apply (intro conjI) + apply (clarsimp simp:neq_Nil_conv) apply (drule hd_in_set) apply (drule(1) bspec) apply (clarsimp split:if_split_asm) - apply (fastforce simp:neq_Nil_conv) + apply (fastforce simp:neq_Nil_conv) apply (intro ballI conjI) apply (clarsimp simp:neq_Nil_conv) apply (intro impI) apply (drule(1) bspec[OF _ subsetD[rotated]]) apply (clarsimp simp:neq_Nil_conv) - apply (clarsimp split:if_splits) - apply clarsimp - apply (intro conjI) - apply (drule(1) bspec,clarsimp)+ + apply (clarsimp split:if_splits) + apply clarsimp + apply (intro conjI) + apply (drule(1) bspec,clarsimp)+ subgoal for \ aa _ _ capa - by (case_tac "capa = aa"; clarsimp split:if_splits simp:masked_as_full_def is_cap_simps) - apply (case_tac "isEndpointCap (fst y) \ capEPPtr (fst y) = the ep \ (\y. ep = Some y)") - apply (clarsimp simp:conj_comms split del:if_split) - apply (subst if_not_P) - apply clarsimp - apply (clarsimp simp:valid_pspace'_def cte_wp_at_ctes_of split del:if_split) - apply (intro conjI) - apply (case_tac "cteCap cte = fst y",clarsimp simp: badge_derived'_def) - apply (clarsimp simp: maskCapRights_eq_null maskedAsFull_def badge_derived'_def isCap_simps - split: if_split_asm) - apply (clarsimp split del: if_split) - apply (case_tac "fst y = capability.NullCap") - apply (clarsimp simp: neq_Nil_conv split del: if_split)+ - apply (intro allI impI conjI) - apply (clarsimp split:if_splits) - apply (clarsimp simp:image_def)+ - apply (thin_tac "\x\set ys. Q x" for Q) - apply (drule(1) bspec)+ - apply clarsimp+ - apply (drule(1) bspec) - apply (rule conjI) - apply clarsimp+ - apply (case_tac "cteCap cteb = ab") - by (clarsimp simp: isCap_simps maskedAsFull_def split:if_splits)+ + by (case_tac "capa = aa"; clarsimp split:if_splits simp:masked_as_full_def is_cap_simps) + apply (case_tac "isEndpointCap (fst y) \ capEPPtr (fst y) = the ep \ (\y. ep = Some y)") + apply (clarsimp simp:conj_comms split del:if_split) + apply (subst if_not_P) + apply clarsimp + apply (clarsimp simp:valid_pspace'_def cte_wp_at_ctes_of split del:if_split) + apply (intro conjI) + apply (case_tac "cteCap cte = fst y",clarsimp simp: badge_derived'_def) + apply (clarsimp simp: maskCapRights_eq_null maskedAsFull_def badge_derived'_def isCap_simps + split: if_split_asm) + apply (clarsimp split del: if_split) + apply (case_tac "fst y = capability.NullCap") + apply (clarsimp simp: neq_Nil_conv split del: if_split)+ + apply (intro allI impI conjI) + apply (clarsimp split:if_splits) + apply (clarsimp simp:image_def)+ + apply (thin_tac "\x\set ys. Q x" for Q) + apply (drule(1) bspec)+ + apply clarsimp+ + apply (drule(1) bspec) + apply (rule conjI) + apply clarsimp+ + apply (case_tac "cteCap cteb = ab") + by (clarsimp simp: isCap_simps maskedAsFull_def split:if_splits)+ qed declare constOnFailure_wp [wp] @@ -1342,13 +1342,13 @@ lemma lookupCapAndSlot_corres: apply (rule corres_guard_imp) apply (rule_tac r'="\rv rv'. rv' = cte_map (fst rv)" in corres_splitEE) - apply (rule corres_split[OF getSlotCap_corres]) - apply (rule corres_returnOkTT, simp) + apply (rule corres_rel_imp, rule lookupSlotForThread_corres) + apply (simp add: split_def) + apply (rule corres_split[OF getSlotCap_corres]) apply simp - apply wp+ - apply (rule corres_rel_imp, rule lookupSlotForThread_corres) - apply (simp add: split_def) - apply (wp | simp add: liftE_bindE[symmetric])+ + apply (rule corres_returnOkTT, simp) + apply wp+ + apply (wp | simp add: liftE_bindE[symmetric])+ done lemma lookupExtraCaps_corres: @@ -1442,36 +1442,36 @@ lemma doNormalTransfer_corres: (doNormalTransfer sender send_buf ep badge can_grant receiver recv_buf)" apply (simp add: do_normal_transfer_def doNormalTransfer_def) apply (rule corres_guard_imp) - apply (rule corres_split_mapr[OF getMessageInfo_corres]) apply (rule_tac F="valid_message_info mi" in corres_gen_asm) apply (rule_tac r'="list_all2 (\x y. cap_relation (fst x) (fst y) \ snd y = cte_map (snd x))" in corres_split) apply (rule corres_if[OF refl]) apply (rule corres_split_catch) - apply (rule corres_trivial, simp) - apply (rule lookupExtraCaps_corres, simp+) + apply (rule lookupExtraCaps_corres; simp) + apply (rule corres_trivial, simp) apply wp+ apply (rule corres_trivial, simp) apply simp apply (rule corres_split_eqr[OF copyMRs_corres]) - apply (rule corres_split[OF transferCaps_corres]) - apply (rename_tac mi' mi'') - apply (rule_tac F="mi_label mi' = mi_label mi" - in corres_gen_asm) - apply (rule corres_split_nor[OF setMessageInfo_corres]) - apply (simp add: badge_register_def badgeRegister_def) - apply (fold dc_def) - apply (rule asUser_setRegister_corres) - apply (case_tac mi', clarsimp) - apply wp - apply simp+ - apply ((wp valid_case_option_post_wp hoare_vcg_const_Ball_lift - hoare_case_option_wp - hoare_valid_ipc_buffer_ptr_typ_at' copyMRs_typ_at' - hoare_vcg_const_Ball_lift lookupExtraCaps_length - | simp add: if_apply_def2)+) - apply (wp static_imp_wp | strengthen valid_msg_length_strengthen)+ + apply (rule corres_split) + apply (rule transferCaps_corres; simp) + apply (rename_tac mi' mi'') + apply (rule_tac F="mi_label mi' = mi_label mi" + in corres_gen_asm) + apply (rule corres_split_nor[OF setMessageInfo_corres]) + apply (case_tac mi', clarsimp) + apply (simp add: badge_register_def badgeRegister_def) + apply (fold dc_def) + apply (rule asUser_setRegister_corres) + apply wp + apply simp+ + apply ((wp valid_case_option_post_wp hoare_vcg_const_Ball_lift + hoare_case_option_wp + hoare_valid_ipc_buffer_ptr_typ_at' copyMRs_typ_at' + hoare_vcg_const_Ball_lift lookupExtraCaps_length + | simp add: if_apply_def2)+) + apply (wp static_imp_wp | strengthen valid_msg_length_strengthen)+ apply clarsimp apply auto done @@ -1655,26 +1655,26 @@ lemma doFaultTransfer_corres: apply (clarsimp split: option.splits simp: fault_rel_optionation_def assert_opt_def map_option_case) - defer - defer - apply (clarsimp simp: fault_rel_optionation_def) - apply (wp thread_get_wp) - apply (clarsimp simp: obj_at_def is_tcb) - apply wp + defer + defer + apply (clarsimp simp: fault_rel_optionation_def) + apply (wp thread_get_wp) + apply (clarsimp simp: obj_at_def is_tcb) + apply wp apply (rule corres_guard_imp) - apply (rule corres_split_eqr[OF makeFaultMessage_corres]) - apply (rule corres_split_eqr[OF setMRs_corres [OF refl]]) - apply (rule corres_split_nor[OF setMessageInfo_corres]) - apply (rule asUser_setRegister_corres) + apply (rule corres_split_eqr[OF makeFaultMessage_corres]) + apply (rule corres_split_eqr[OF setMRs_corres [OF refl]]) + apply (rule corres_split_nor[OF setMessageInfo_corres]) apply simp - apply (wp | simp)+ - apply (rule corres_guard_imp) - apply (rule corres_split_eqr[OF makeFaultMessage_corres]) - apply (rule corres_split_eqr[OF setMRs_corres [OF refl]]) - apply (rule corres_split_nor[OF setMessageInfo_corres]) - apply (rule asUser_setRegister_corres) - apply simp - apply (wp | simp)+ + apply (rule asUser_setRegister_corres) + apply (wp | simp)+ + apply (rule corres_guard_imp) + apply (rule corres_split_eqr[OF makeFaultMessage_corres]) + apply (rule corres_split_eqr[OF setMRs_corres [OF refl]]) + apply (rule corres_split_nor[OF setMessageInfo_corres]) + apply simp + apply (rule asUser_setRegister_corres) + apply (wp | simp)+ done lemma doFaultTransfer_invs[wp]: @@ -1890,14 +1890,13 @@ lemma handle_fault_reply_registers_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF arch_getSanitiseRegisterInfo_corres]) - apply (rule corres_split_deprecated) - apply (rule corres_trivial, simp) - apply (rule asUser_corres') - apply(simp add: setRegister_def sanitise_register_def - sanitiseRegister_def syscallMessage_def Let_def cong: register.case_cong) - apply(subst zipWithM_x_modify)+ - apply(rule corres_modify') - apply (simp|wp)+ + apply (rule corres_split) + apply (rule asUser_corres') + apply(simp add: setRegister_def sanitise_register_def + sanitiseRegister_def syscallMessage_def Let_def cong: register.case_cong) + apply(subst zipWithM_x_modify)+ + apply(rule corres_modify') + apply (simp|wp)+ done lemma handleFaultReply_corres: @@ -2205,8 +2204,8 @@ lemma doReplyTransfer_corres: apply (rule corres_split[OF doIPCTransfer_corres]) apply (rule corres_split[OF cap_delete_one_corres]) apply (rule corres_split[OF setThreadState_corres]) - apply (rule possibleSwitchTo_corres) - apply simp + apply simp + apply (rule possibleSwitchTo_corres) apply (wp set_thread_state_runnable_valid_sched set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_st_tcb' sts_valid_queues sts_valid_objs' delete_one_tcbDomain_obj_at' | simp add: valid_tcb_state'_def)+ apply (strengthen cte_wp_at_reply_cap_can_fast_finalise) @@ -2241,31 +2240,34 @@ lemma doReplyTransfer_corres: apply (rule corres_split_eqr[OF getMRs_corres]) apply (simp(no_asm) del: dc_simp) apply (rule corres_split_eqr[OF handleFaultReply_corres]) - apply (rule corres_split[OF threadset_corresT]) - apply (rule_tac Q="valid_sched and cur_tcb and tcb_at receiver" - and Q'="tcb_at' receiver and cur_tcb' - and (\s. weak_sch_act_wf (ksSchedulerAction s) s) - and Invariants_H.valid_queues and valid_queues' and valid_objs'" - in corres_guard_imp) - apply (case_tac rvb, simp_all)[1] - apply (rule corres_guard_imp) - apply (rule corres_split[OF setThreadState_corres]) - apply (fold dc_def, rule possibleSwitchTo_corres) - apply simp - apply (wp static_imp_wp static_imp_conj_wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' - sts_st_tcb' sts_valid_queues | simp | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+ - apply (rule corres_guard_imp) - apply (rule setThreadState_corres) - apply (simp_all)[20] - apply (clarsimp simp add: tcb_relation_def fault_rel_optionation_def - tcb_cap_cases_def tcb_cte_cases_def exst_same_def)+ - apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state - thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues' - threadSet_tcbDomain_triv threadSet_valid_objs' - | simp add: valid_tcb_state'_def)+ + apply simp + apply (rule corres_split) + apply (rule threadset_corresT; + clarsimp simp add: tcb_relation_def fault_rel_optionation_def + tcb_cap_cases_def tcb_cte_cases_def exst_same_def) + apply (rule_tac P="valid_sched and cur_tcb and tcb_at receiver" + and P'="tcb_at' receiver and cur_tcb' + and (\s. weak_sch_act_wf (ksSchedulerAction s) s) + and Invariants_H.valid_queues and valid_queues' and valid_objs'" + in corres_inst) + apply (case_tac rvb, simp_all)[1] + apply (rule corres_guard_imp) + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (fold dc_def, rule possibleSwitchTo_corres) + apply simp + apply (wp static_imp_wp static_imp_conj_wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' + sts_st_tcb' sts_valid_queues | simp | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+ + apply (rule corres_guard_imp) + apply (rule setThreadState_corres) + apply clarsimp+ apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues' - | simp add: runnable_def inQ_def valid_tcb'_def)+ + threadSet_tcbDomain_triv threadSet_valid_objs' + | simp add: valid_tcb_state'_def)+ + apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state + thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues' + | simp add: runnable_def inQ_def valid_tcb'_def)+ apply (rule_tac Q="\_. valid_sched and cur_tcb and tcb_at sender and tcb_at receiver and valid_objs and pspace_aligned" in hoare_strengthen_post [rotated], clarsimp) apply (wp) @@ -2340,34 +2342,34 @@ lemma setupCallerCap_corres: getThreadCallerSlot_def) apply (rule stronger_corres_guard_imp) apply (rule corres_split_nor) - apply (rule corres_symb_exec_r) - apply (rule_tac F="\r. cteCap masterCTE = capability.ReplyCap sender True r - \ mdbNext (cteMDBNode masterCTE) = nullPointer" - in corres_gen_asm2, clarsimp simp add: isCap_simps) - apply (rule corres_symb_exec_r) - apply (rule_tac F="rv = capability.NullCap" - in corres_gen_asm2, simp) - apply (rule cteInsert_corres) - apply (simp split: if_splits) - apply (simp add: cte_map_def tcbReplySlot_def - tcb_cnode_index_def cte_level_bits_def) - apply (simp add: cte_map_def tcbCallerSlot_def + apply (rule setThreadState_corres) + apply (simp split: option.split) + apply (rule corres_symb_exec_r) + apply (rule_tac F="\r. cteCap masterCTE = capability.ReplyCap sender True r + \ mdbNext (cteMDBNode masterCTE) = nullPointer" + in corres_gen_asm2, clarsimp simp add: isCap_simps) + apply (rule corres_symb_exec_r) + apply (rule_tac F="rv = capability.NullCap" + in corres_gen_asm2, simp) + apply (rule cteInsert_corres) + apply (simp split: if_splits) + apply (simp add: cte_map_def tcbReplySlot_def tcb_cnode_index_def cte_level_bits_def) - apply (rule_tac Q="\rv. cte_at' (receiver + 2 ^ cte_level_bits * tcbCallerSlot)" - in valid_prove_more) + apply (simp add: cte_map_def tcbCallerSlot_def + tcb_cnode_index_def cte_level_bits_def) + apply (rule_tac Q="\rv. cte_at' (receiver + 2 ^ cte_level_bits * tcbCallerSlot)" + in valid_prove_more) - apply (wp, (wp getSlotCap_wp)+) - apply blast - apply (rule no_fail_pre, wp) - apply (clarsimp simp: cte_wp_at'_def cte_at'_def) - apply (rule_tac Q="\rv. cte_at' (sender + 2 ^ cte_level_bits * tcbReplySlot)" - in valid_prove_more) - apply (wp, (wp getCTE_wp')+) - apply blast - apply (rule no_fail_pre, wp) - apply (clarsimp simp: cte_wp_at_ctes_of) - apply (rule setThreadState_corres) - apply (simp split: option.split) + apply (wp, (wp getSlotCap_wp)+) + apply blast + apply (rule no_fail_pre, wp) + apply (clarsimp simp: cte_wp_at'_def cte_at'_def) + apply (rule_tac Q="\rv. cte_at' (sender + 2 ^ cte_level_bits * tcbReplySlot)" + in valid_prove_more) + apply (wp, (wp getCTE_wp')+) + apply blast + apply (rule no_fail_pre, wp) + apply (clarsimp simp: cte_wp_at_ctes_of) apply (wp sts_valid_pspace_hangers | simp add: cte_wp_at_ctes_of)+ apply (clarsimp simp: valid_tcb_state_def st_tcb_at_reply_cap_valid @@ -2480,9 +2482,9 @@ proof - apply (simp add: ep_relation_def) apply (rule corres_guard_imp) apply (rule corres_split[OF setThreadState_corres]) - apply (rule setEndpoint_corres) - apply (simp add: ep_relation_def) - apply (simp add: fault_rel_optionation_def) + apply simp + apply (rule setEndpoint_corres) + apply (simp add: ep_relation_def) apply wp+ apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def) apply clarsimp @@ -2490,9 +2492,9 @@ proof - apply (simp add: ep_relation_def) apply (rule corres_guard_imp) apply (rule corres_split[OF setThreadState_corres]) - apply (rule setEndpoint_corres) - apply (simp add: ep_relation_def) - apply (simp add: fault_rel_optionation_def) + apply simp + apply (rule setEndpoint_corres) + apply (simp add: ep_relation_def) apply wp+ apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def) apply clarsimp @@ -2506,44 +2508,44 @@ proof - apply (clarsimp split del: if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF setEndpoint_corres]) - apply (simp add: isReceive_def split del:if_split) - apply (rule corres_split[OF getThreadState_corres]) - apply (rule_tac - F="\data. recv_state = Structures_A.BlockedOnReceive ep data" - in corres_gen_asm) - apply (clarsimp simp: case_bool_If case_option_If if3_fold - simp del: dc_simp split del: if_split cong: if_cong) - apply (rule corres_split[OF doIPCTransfer_corres]) - apply (rule corres_split[OF setThreadState_corres]) - apply (rule corres_split[OF possibleSwitchTo_corres]) - apply (fold when_def)[1] - - apply (rule_tac P="call" and P'="call" - in corres_symmetric_bool_cases, blast) - apply (simp add: when_def dc_def[symmetric] split del: if_split) - apply (rule corres_if2, simp) - apply (rule setupCallerCap_corres) - apply (rule setThreadState_corres, simp) - apply (rule corres_trivial) - apply (simp add: when_def dc_def[symmetric] split del: if_split) - apply (simp split del: if_split add: if_apply_def2) - apply (wp hoare_drop_imps)[1] - apply (simp split del: if_split add: if_apply_def2) - apply (wp hoare_drop_imps)[1] - apply (wp | simp)+ - apply (wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases) - apply (wp setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf - sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases)[1] - apply (simp add: valid_tcb_state_def pred_conj_def) - apply (strengthen reply_cap_doesnt_exist_strg disjI2_strg) - apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps weak_valid_sched_action_lift - | clarsimp simp: is_cap_simps)+)[1] - apply (simp add: pred_conj_def) - apply (strengthen sch_act_wf_weak) - apply (simp add: valid_tcb_state'_def) - apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift hoare_drop_imps)[1] - apply (wp gts_st_tcb_at)+ - apply (simp add: ep_relation_def split: list.split) + apply (simp add: ep_relation_def split: list.split) + apply (simp add: isReceive_def split del:if_split) + apply (rule corres_split[OF getThreadState_corres]) + apply (rule_tac + F="\data. recv_state = Structures_A.BlockedOnReceive ep data" + in corres_gen_asm) + apply (clarsimp simp: case_bool_If case_option_If if3_fold + simp del: dc_simp split del: if_split cong: if_cong) + apply (rule corres_split[OF doIPCTransfer_corres]) + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (rule corres_split[OF possibleSwitchTo_corres]) + apply (fold when_def)[1] + apply (rule_tac P="call" and P'="call" + in corres_symmetric_bool_cases, blast) + apply (simp add: when_def dc_def[symmetric] split del: if_split) + apply (rule corres_if2, simp) + apply (rule setupCallerCap_corres) + apply (rule setThreadState_corres, simp) + apply (rule corres_trivial) + apply (simp add: when_def dc_def[symmetric] split del: if_split) + apply (simp split del: if_split add: if_apply_def2) + apply (wp hoare_drop_imps)[1] + apply (simp split del: if_split add: if_apply_def2) + apply (wp hoare_drop_imps)[1] + apply (wp | simp)+ + apply (wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases) + apply (wp setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf + sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases)[1] + apply (simp add: valid_tcb_state_def pred_conj_def) + apply (strengthen reply_cap_doesnt_exist_strg disjI2_strg) + apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps weak_valid_sched_action_lift + | clarsimp simp: is_cap_simps)+)[1] + apply (simp add: pred_conj_def) + apply (strengthen sch_act_wf_weak) + apply (simp add: valid_tcb_state'_def) + apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift hoare_drop_imps)[1] + apply (wp gts_st_tcb_at)+ apply (simp add: pred_conj_def cong: conj_cong) apply (wp hoare_post_taut) apply (simp) @@ -2587,30 +2589,29 @@ proof - apply (clarsimp split del: if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF setEndpoint_corres]) - apply (rule corres_split[OF getThreadState_corres]) - apply (rule_tac - F="\data. recv_state = Structures_A.BlockedOnReceive ep data" - in corres_gen_asm) - apply (clarsimp simp: isReceive_def case_bool_If - split del: if_split cong: if_cong) - apply (rule corres_split[OF doIPCTransfer_corres]) - apply (rule corres_split[OF setThreadState_corres]) - apply (rule possibleSwitchTo_corres) - apply (simp add: if_apply_def2) - apply (wp hoare_drop_imps) - apply (simp add: if_apply_def2) - apply ((wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases | - simp add: if_apply_def2 split del: if_split)+)[1] - apply (wp setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf - sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases) - apply (simp add: valid_tcb_state_def pred_conj_def) - apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps weak_valid_sched_action_lift - | clarsimp simp:is_cap_simps)+)[1] - apply (simp add: valid_tcb_state'_def pred_conj_def) - apply (strengthen sch_act_wf_weak) - apply (wp weak_sch_act_wf_lift_linear hoare_drop_imps) - apply (wp gts_st_tcb_at)+ - apply (simp add: ep_relation_def split: list.split) + apply (simp add: ep_relation_def split: list.split) + apply (rule corres_split[OF getThreadState_corres]) + apply (rule_tac + F="\data. recv_state = Structures_A.BlockedOnReceive ep data" + in corres_gen_asm) + apply (clarsimp simp: isReceive_def case_bool_If + split del: if_split cong: if_cong) + apply (rule corres_split[OF doIPCTransfer_corres]) + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (rule possibleSwitchTo_corres) + apply (simp add: if_apply_def2) + apply ((wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases | + simp add: if_apply_def2 split del: if_split)+)[1] + apply (wp setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf + sts_cur_tcb' setThreadState_tcb' sts_st_tcb_at'_cases) + apply (simp add: valid_tcb_state_def pred_conj_def) + apply ((wp hoare_drop_imps do_ipc_transfer_tcb_caps weak_valid_sched_action_lift + | clarsimp simp:is_cap_simps)+)[1] + apply (simp add: valid_tcb_state'_def pred_conj_def) + apply (strengthen sch_act_wf_weak) + apply (wp weak_sch_act_wf_lift_linear hoare_drop_imps) + apply (wp gts_st_tcb_at)+ apply (simp add: pred_conj_def cong: conj_cong) apply (wp hoare_post_taut) apply simp @@ -2681,16 +2682,16 @@ lemma sendSignal_corres: Structures_H.thread_state.splits) apply (rule corres_split[OF cancel_ipc_corres]) apply (rule corres_split[OF setThreadState_corres]) - apply (simp add: badgeRegister_def badge_register_def) - apply (rule corres_split[OF asUser_setRegister_corres]) - apply (rule possibleSwitchTo_corres) - apply wp - apply (clarsimp simp: thread_state_relation_def) - apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' - sts_valid_queues sts_st_tcb' hoare_disjI2 - cancel_ipc_cte_wp_at_not_reply_state - | strengthen invs_vobjs_strgs invs_psp_aligned_strg valid_sched_weak_strg - | simp add: valid_tcb_state_def)+ + apply (clarsimp simp: thread_state_relation_def) + apply (simp add: badgeRegister_def badge_register_def) + apply (rule corres_split[OF asUser_setRegister_corres]) + apply (rule possibleSwitchTo_corres) + apply wp + apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' + sts_valid_queues sts_st_tcb' hoare_disjI2 + cancel_ipc_cte_wp_at_not_reply_state + | strengthen invs_vobjs_strgs invs_psp_aligned_strg valid_sched_weak_strg + | simp add: valid_tcb_state_def)+ apply (rule_tac Q="\rv. invs' and tcb_at' a" in hoare_strengthen_post) apply wp apply (clarsimp simp: invs'_def valid_state'_def sch_act_wf_weak @@ -2713,26 +2714,27 @@ lemma sendSignal_corres: apply (rule_tac F="list \ []" in corres_gen_asm) apply (simp add: list_case_helper split del: if_split) apply (rule corres_split[OF setNotification_corres]) - apply (rule corres_split[OF setThreadState_corres]) - apply (simp add: badgeRegister_def badge_register_def) - apply (rule corres_split[OF asUser_setRegister_corres]) - apply (rule possibleSwitchTo_corres) - apply ((wp | simp)+)[1] - apply (rule_tac Q="\_. Invariants_H.valid_queues and valid_queues' and - (\s. sch_act_wf (ksSchedulerAction s) s) and - cur_tcb' and - st_tcb_at' runnable' (hd list) and valid_objs'" - in hoare_post_imp, clarsimp simp: pred_tcb_at' elim!: sch_act_wf_weak) - apply (wp | simp)+ - apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action - | simp)+ - apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues' - setThreadState_st_tcb + apply (simp add: ntfn_relation_def) + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (simp add: badgeRegister_def badge_register_def) + apply (rule corres_split[OF asUser_setRegister_corres]) + apply (rule possibleSwitchTo_corres) + apply ((wp | simp)+)[1] + apply (rule_tac Q="\_. Invariants_H.valid_queues and valid_queues' and + (\s. sch_act_wf (ksSchedulerAction s) s) and + cur_tcb' and + st_tcb_at' runnable' (hd list) and valid_objs'" + in hoare_post_imp, clarsimp simp: pred_tcb_at' elim!: sch_act_wf_weak) + apply (wp | simp)+ + apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action | simp)+ - apply (simp add: ntfn_relation_def) - apply (wp set_simple_ko_valid_objs set_ntfn_aligned' set_ntfn_valid_objs' - hoare_vcg_disj_lift weak_sch_act_wf_lift_linear - | simp add: valid_tcb_state_def valid_tcb_state'_def)+ + apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues' + setThreadState_st_tcb + | simp)+ + apply (wp set_simple_ko_valid_objs set_ntfn_aligned' set_ntfn_valid_objs' + hoare_vcg_disj_lift weak_sch_act_wf_lift_linear + | simp add: valid_tcb_state_def valid_tcb_state'_def)+ apply (clarsimp simp: invs_def valid_state_def valid_ntfn_def valid_pspace_def ntfn_queued_st_tcb_at valid_sched_def valid_sched_action_def) @@ -2744,20 +2746,21 @@ lemma sendSignal_corres: apply (rule_tac F="list \ []" in corres_gen_asm) apply (simp add: list_case_helper) apply (rule corres_split[OF setNotification_corres]) - apply (rule corres_split[OF setThreadState_corres]) - apply (simp add: badgeRegister_def badge_register_def) - apply (rule corres_split[OF asUser_setRegister_corres]) - apply (rule possibleSwitchTo_corres) - apply (wp cur_tcb_lift | simp)+ - apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action - | simp)+ - apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues' - setThreadState_st_tcb + apply (simp add: ntfn_relation_def split:list.splits) + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (simp add: badgeRegister_def badge_register_def) + apply (rule corres_split[OF asUser_setRegister_corres]) + apply (rule possibleSwitchTo_corres) + apply (wp cur_tcb_lift | simp)+ + apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action | simp)+ - apply (simp add: ntfn_relation_def split:list.splits) - apply (wp set_ntfn_aligned' set_simple_ko_valid_objs set_ntfn_valid_objs' - hoare_vcg_disj_lift weak_sch_act_wf_lift_linear - | simp add: valid_tcb_state_def valid_tcb_state'_def)+ + apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues' + setThreadState_st_tcb + | simp)+ + apply (wp set_ntfn_aligned' set_simple_ko_valid_objs set_ntfn_valid_objs' + hoare_vcg_disj_lift weak_sch_act_wf_lift_linear + | simp add: valid_tcb_state_def valid_tcb_state'_def)+ apply (clarsimp simp: invs_def valid_state_def valid_ntfn_def valid_pspace_def neq_Nil_conv ntfn_queued_st_tcb_at valid_sched_def valid_sched_action_def @@ -3177,9 +3180,10 @@ lemma replyFromKernel_corres: apply (rule corres_split_eqr[OF lookupIPCBuffer_corres]) apply (rule corres_split[OF asUser_setRegister_corres]) apply (rule corres_split_eqr[OF setMRs_corres]) - apply (rule setMessageInfo_corres) - apply (wp hoare_case_option_wp hoare_valid_ipc_buffer_ptr_typ_at' - | clarsimp)+ + apply simp + apply (rule setMessageInfo_corres) + apply (wp hoare_case_option_wp hoare_valid_ipc_buffer_ptr_typ_at' + | clarsimp)+ done lemma rfk_invs': @@ -3241,120 +3245,120 @@ lemma receiveIPC_corres: apply (rule corres_split[OF getEndpoint_corres]) apply (rule corres_guard_imp) apply (rule corres_split[OF getBoundNotification_corres]) - apply (rule_tac r'="ntfn_relation" in corres_split_deprecated) - apply (rule corres_if) - apply (clarsimp simp: ntfn_relation_def Ipc_A.isActive_def Endpoint_H.isActive_def - split: Structures_A.ntfn.splits Structures_H.notification.splits) + apply (rule_tac r'="ntfn_relation" in corres_split) + apply (rule corres_option_split[rotated 2]) + apply (rule getNotification_corres) apply clarsimp - apply (rule completeSignal_corres) - apply (rule_tac P="einvs and valid_sched and tcb_at thread and - ep_at word1 and valid_ep ep and - obj_at (\k. k = Endpoint ep) word1 - and cte_wp_at (\c. c = cap.NullCap) (thread, tcb_cnode_index 3) - and ex_nonz_cap_to thread" and - P'="invs' and tcb_at' thread and ep_at' word1 and - valid_ep' epa" - in corres_inst) - apply (case_tac ep) - \ \IdleEP\ - apply (simp add: ep_relation_def) - apply (rule corres_guard_imp) - apply (case_tac isBlocking; simp) - apply (rule corres_split[OF setThreadState_corres]) - apply (rule setEndpoint_corres) - apply (simp add: ep_relation_def) + apply (rule corres_trivial, simp add: ntfn_relation_def default_notification_def + default_ntfn_def) + apply (rule corres_if) + apply (clarsimp simp: ntfn_relation_def Ipc_A.isActive_def Endpoint_H.isActive_def + split: Structures_A.ntfn.splits Structures_H.notification.splits) + apply clarsimp + apply (rule completeSignal_corres) + apply (rule_tac P="einvs and valid_sched and tcb_at thread and + ep_at word1 and valid_ep ep and + obj_at (\k. k = Endpoint ep) word1 + and cte_wp_at (\c. c = cap.NullCap) (thread, tcb_cnode_index 3) + and ex_nonz_cap_to thread" and + P'="invs' and tcb_at' thread and ep_at' word1 and + valid_ep' epa" + in corres_inst) + apply (case_tac ep) + \ \IdleEP\ + apply (simp add: ep_relation_def) + apply (rule corres_guard_imp) + apply (case_tac isBlocking; simp) + apply (rule corres_split[OF setThreadState_corres]) apply simp - apply wp+ - apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp) - apply simp - apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def - valid_tcb_state_def st_tcb_at_tcb_at) - apply auto[1] - \ \SendEP\ - apply (simp add: ep_relation_def) - apply (rename_tac list) - apply (rule_tac F="list \ []" in corres_req) - apply (clarsimp simp: valid_ep_def) - apply (case_tac list, simp_all split del: if_split)[1] - apply (rule corres_guard_imp) - apply (rule corres_split[OF setEndpoint_corres]) - apply (rule corres_split[OF getThreadState_corres]) - apply (rule_tac - F="\data. - sender_state = - Structures_A.thread_state.BlockedOnSend word1 data" - in corres_gen_asm) - apply (clarsimp simp: isSend_def case_bool_If - case_option_If if3_fold - split del: if_split cong: if_cong) - apply (rule corres_split[OF doIPCTransfer_corres]) - apply (simp split del: if_split cong: if_cong) - apply (fold dc_def)[1] - apply (rule_tac P="valid_objs and valid_mdb and valid_list - and valid_sched - and cur_tcb - and valid_reply_caps - and pspace_aligned and pspace_distinct - and st_tcb_at (Not \ awaiting_reply) a - and st_tcb_at (Not \ halted) a - and tcb_at thread and valid_reply_masters - and cte_wp_at (\c. c = cap.NullCap) - (thread, tcb_cnode_index 3)" - and P'="tcb_at' a and tcb_at' thread and cur_tcb' - and Invariants_H.valid_queues - and valid_queues' - and valid_pspace' - and valid_objs' - and (\s. weak_sch_act_wf (ksSchedulerAction s) s)" - in corres_guard_imp [OF corres_if]) - apply (simp add: fault_rel_optionation_def) - apply (rule corres_if2 [OF _ setupCallerCap_corres setThreadState_corres]) - apply simp - apply simp - apply (rule corres_split[OF setThreadState_corres]) - apply (rule possibleSwitchTo_corres) - apply simp - apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action - | simp)+ - apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues' - setThreadState_st_tcb - | simp)+ - apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def - valid_sched_action_def) - apply (clarsimp split: if_split_asm) - apply (clarsimp | wp do_ipc_transfer_tcb_caps)+ - apply (rule_tac Q="\_ s. sch_act_wf (ksSchedulerAction s) s" - in hoare_post_imp, erule sch_act_wf_weak) - apply (wp sts_st_tcb' gts_st_tcb_at | simp)+ - apply (case_tac lista, simp_all add: ep_relation_def)[1] - apply (simp cong: list.case_cong) - apply wp - apply simp - apply (wp weak_sch_act_wf_lift_linear setEndpoint_valid_mdb' set_ep_valid_objs') - apply (clarsimp split: list.split) - apply (clarsimp simp add: invs_def valid_state_def st_tcb_at_tcb_at) - apply (clarsimp simp add: valid_ep_def valid_pspace_def) - apply (drule(1) sym_refs_obj_atD[where P="\ko. ko = Endpoint e" for e]) - apply (fastforce simp: st_tcb_at_refs_of_rev elim: st_tcb_weakenE) - apply (auto simp: valid_ep'_def invs'_def valid_state'_def split: list.split)[1] - \ \RecvEP\ - apply (simp add: ep_relation_def) - apply (rule_tac corres_guard_imp) - apply (case_tac isBlocking; simp) - apply (rule corres_split[OF setThreadState_corres]) apply (rule setEndpoint_corres) apply (simp add: ep_relation_def) - apply simp - apply wp+ - apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp) + apply wp+ + apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp) + apply simp + apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def + valid_tcb_state_def st_tcb_at_tcb_at) + apply auto[1] + \ \SendEP\ + apply (simp add: ep_relation_def) + apply (rename_tac list) + apply (rule_tac F="list \ []" in corres_req) + apply (clarsimp simp: valid_ep_def) + apply (case_tac list, simp_all split del: if_split)[1] + apply (rule corres_guard_imp) + apply (rule corres_split[OF setEndpoint_corres]) + apply (case_tac lista, simp_all add: ep_relation_def)[1] + apply (rule corres_split[OF getThreadState_corres]) + apply (rule_tac + F="\data. + sender_state = + Structures_A.thread_state.BlockedOnSend word1 data" + in corres_gen_asm) + apply (clarsimp simp: isSend_def case_bool_If + case_option_If if3_fold + split del: if_split cong: if_cong) + apply (rule corres_split[OF doIPCTransfer_corres]) + apply (simp split del: if_split cong: if_cong) + apply (fold dc_def)[1] + apply (rule_tac P="valid_objs and valid_mdb and valid_list + and valid_sched + and cur_tcb + and valid_reply_caps + and pspace_aligned and pspace_distinct + and st_tcb_at (Not \ awaiting_reply) a + and st_tcb_at (Not \ halted) a + and tcb_at thread and valid_reply_masters + and cte_wp_at (\c. c = cap.NullCap) + (thread, tcb_cnode_index 3)" + and P'="tcb_at' a and tcb_at' thread and cur_tcb' + and Invariants_H.valid_queues + and valid_queues' + and valid_pspace' + and valid_objs' + and (\s. weak_sch_act_wf (ksSchedulerAction s) s)" + in corres_guard_imp [OF corres_if]) + apply (simp add: fault_rel_optionation_def) + apply (rule corres_if2 [OF _ setupCallerCap_corres setThreadState_corres]) + apply simp + apply simp + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (rule possibleSwitchTo_corres) + apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action + | simp)+ + apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues' + setThreadState_st_tcb + | simp)+ + apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 valid_sched_def + valid_sched_action_def) + apply (clarsimp split: if_split_asm) + apply (clarsimp | wp do_ipc_transfer_tcb_caps)+ + apply (rule_tac Q="\_ s. sch_act_wf (ksSchedulerAction s) s" + in hoare_post_imp, erule sch_act_wf_weak) + apply (wp sts_st_tcb' gts_st_tcb_at | simp)+ + apply (simp cong: list.case_cong) + apply wp apply simp - apply (clarsimp simp: valid_tcb_state_def) - apply (clarsimp simp add: valid_tcb_state'_def) - apply (rule corres_option_split[rotated 2]) - apply (rule getNotification_corres) - apply clarsimp - apply (rule corres_trivial, simp add: ntfn_relation_def default_notification_def - default_ntfn_def) + apply (wp weak_sch_act_wf_lift_linear setEndpoint_valid_mdb' set_ep_valid_objs') + apply (clarsimp split: list.split) + apply (clarsimp simp add: invs_def valid_state_def st_tcb_at_tcb_at) + apply (clarsimp simp add: valid_ep_def valid_pspace_def) + apply (drule(1) sym_refs_obj_atD[where P="\ko. ko = Endpoint e" for e]) + apply (fastforce simp: st_tcb_at_refs_of_rev elim: st_tcb_weakenE) + apply (auto simp: valid_ep'_def invs'_def valid_state'_def split: list.split)[1] + \ \RecvEP\ + apply (simp add: ep_relation_def) + apply (rule_tac corres_guard_imp) + apply (case_tac isBlocking; simp) + apply (rule corres_split[OF setThreadState_corres]) + apply simp + apply (rule setEndpoint_corres) + apply (simp add: ep_relation_def) + apply wp+ + apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp) + apply simp + apply (clarsimp simp: valid_tcb_state_def) + apply (clarsimp simp add: valid_tcb_state'_def) apply (wp get_simple_ko_wp[where f=Notification] getNotification_wp gbn_wp gbn_wp' hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_if_lift | wpc | simp add: ep_at_def2[symmetric, simplified] | clarsimp)+ @@ -3392,9 +3396,9 @@ lemma receiveSignal_corres: apply (rule corres_guard_imp) apply (case_tac isBlocking; simp) apply (rule corres_split[OF setThreadState_corres]) - apply (rule setNotification_corres) - apply (simp add: ntfn_relation_def) - apply simp + apply simp + apply (rule setNotification_corres) + apply (simp add: ntfn_relation_def) apply wp+ apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp+) \ \WaitingNtfn\ @@ -3402,9 +3406,9 @@ lemma receiveSignal_corres: apply (rule corres_guard_imp) apply (case_tac isBlocking; simp) apply (rule corres_split[OF setThreadState_corres]) - apply (rule setNotification_corres) - apply (simp add: ntfn_relation_def) - apply simp + apply simp + apply (rule setNotification_corres) + apply (simp add: ntfn_relation_def) apply wp+ apply (rule corres_guard_imp) apply (rule doNBRecvFailedTransfer_corres, simp+) @@ -3447,42 +3451,41 @@ lemma sendFaultIPC_corres: apply (simp add: send_fault_ipc_def sendFaultIPC_def liftE_bindE Let_def) apply (rule corres_guard_imp) - apply (rule corres_split_deprecated [where r'="\fh fh'. fh = to_bl fh'"]) - apply simp - apply (rule corres_splitEE) - apply (rule corres_cap_fault) - apply (rule lookup_cap_corres, rule refl) - apply (rule_tac P="einvs and st_tcb_at active thread - and valid_cap handler_cap and ex_nonz_cap_to thread" - and P'="invs' and tcb_at' thread and sch_act_not thread - and valid_cap' handlerCap" - in corres_inst) - apply (case_tac handler_cap, - simp_all add: isCap_defs lookup_failure_map_def - case_bool_If If_rearrage - split del: if_split cong: if_cong)[1] - apply (rule corres_guard_imp) - apply (rule corres_if2 [OF refl]) - apply (simp add: dc_def[symmetric]) - apply (rule corres_split[OF threadset_corres sendIPC_corres], simp_all)[1] + apply (rule corres_split [where r'="\fh fh'. fh = to_bl fh'"]) + apply (rule threadGet_corres) + apply (simp add: tcb_relation_def) + apply simp + apply (rule corres_splitEE) + apply (rule corres_cap_fault) + apply (rule lookup_cap_corres, rule refl) + apply (rule_tac P="einvs and st_tcb_at active thread + and valid_cap handler_cap and ex_nonz_cap_to thread" + and P'="invs' and tcb_at' thread and sch_act_not thread + and valid_cap' handlerCap" + in corres_inst) + apply (case_tac handler_cap, + simp_all add: isCap_defs lookup_failure_map_def + case_bool_If If_rearrage + split del: if_split cong: if_cong)[1] + apply (rule corres_guard_imp) + apply (rule corres_if2 [OF refl]) + apply (simp add: dc_def[symmetric]) + apply (rule corres_split[OF threadset_corres sendIPC_corres], simp_all)[1] apply (simp add: tcb_relation_def fault_rel_optionation_def exst_same_def)+ - apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state - thread_set_typ_at ep_at_typ_at ex_nonz_cap_to_pres - thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched - | simp add: tcb_cap_cases_def)+ - apply ((wp threadSet_invs_trivial threadSet_tcb' - | simp add: tcb_cte_cases_def - | wp (once) sch_act_sane_lift)+)[1] - apply (rule corres_trivial, simp add: lookup_failure_map_def) - apply (clarsimp simp: st_tcb_at_tcb_at split: if_split) - apply (simp add: valid_cap_def) - apply (clarsimp simp: valid_cap'_def inQ_def) - apply auto[1] - apply (clarsimp simp: lookup_failure_map_def) - apply wp+ - apply (rule threadGet_corres) - apply (simp add: tcb_relation_def) - apply wp+ + apply (wp thread_set_invs_trivial thread_set_no_change_tcb_state + thread_set_typ_at ep_at_typ_at ex_nonz_cap_to_pres + thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched + | simp add: tcb_cap_cases_def)+ + apply ((wp threadSet_invs_trivial threadSet_tcb' + | simp add: tcb_cte_cases_def + | wp (once) sch_act_sane_lift)+)[1] + apply (rule corres_trivial, simp add: lookup_failure_map_def) + apply (clarsimp simp: st_tcb_at_tcb_at split: if_split) + apply (simp add: valid_cap_def) + apply (clarsimp simp: valid_cap'_def inQ_def) + apply auto[1] + apply (clarsimp simp: lookup_failure_map_def) + apply wp+ apply (fastforce elim: st_tcb_at_tcb_at) apply fastforce done @@ -4298,17 +4301,17 @@ lemma handleFault_corres: apply (simp add: handle_fault_def handleFault_def) apply (rule corres_guard_imp) apply (subst return_bind [symmetric], - rule corres_split_deprecated [where P="tcb_at thread", - OF _ gets_the_noop_corres [where x="()"]]) - apply (rule corres_split_catch) - apply (rule handleDoubleFault_corres) - apply (rule_tac F="valid_fault f" in corres_gen_asm) + rule corres_split[where P="tcb_at thread", + OF gets_the_noop_corres [where x="()"]]) + apply (simp add: tcb_at_def) + apply (rule corres_split_catch) + apply (rule_tac F="valid_fault f" in corres_gen_asm) apply (rule sendFaultIPC_corres, assumption) apply simp - apply wp+ - apply (rule hoare_post_impErr, rule sfi_invs_plus', simp_all)[1] - apply clarsimp - apply (simp add: tcb_at_def) + apply (rule handleDoubleFault_corres) + apply wp+ + apply (rule hoare_post_impErr, rule sfi_invs_plus', simp_all)[1] + apply clarsimp apply wp+ apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def valid_state_def valid_idle_def) diff --git a/proof/refine/ARM_HYP/Refine.thy b/proof/refine/ARM_HYP/Refine.thy index f0e337548..2ec62aecd 100644 --- a/proof/refine/ARM_HYP/Refine.thy +++ b/proof/refine/ARM_HYP/Refine.thy @@ -601,14 +601,14 @@ lemma kernel_corres: apply (rule corres_guard_imp) apply (rule corres_add_noop_lhs2) apply (simp only: bind_assoc[symmetric]) - apply (rule corres_split_deprecated[where r'=dc and + apply (rule corres_split[where r'=dc and R="\_ s. 0 < domain_time s \ valid_domain_list s" and R'="\_. \"]) - apply (rule corres_bind_return2, rule corres_stateAssert_assume_stronger) - apply simp - apply (simp add: kernelExitAssertions_def state_relation_def) - apply (simp only: bind_assoc) - apply (rule kernel_corres') + apply (simp only: bind_assoc) + apply (rule kernel_corres') + apply (rule corres_bind_return2, rule corres_stateAssert_assume_stronger) + apply simp + apply (simp add: kernelExitAssertions_def state_relation_def) apply (wp call_kernel_domain_time_inv_det_ext call_kernel_domain_list_inv_det_ext) apply wp apply clarsimp @@ -695,13 +695,14 @@ lemma do_user_op_corres: apply (rule_tac F = "dom (rvc \ addrFromPPtr) \ dom rvd" in corres_gen_asm) apply simp apply (rule_tac r'="(=)" in corres_split[OF corres_select]) - apply (rule corres_underlying_split[OF corres_machine_op]) - apply simp - apply (rule corres_underlying_trivial) - apply (simp add: user_memory_update_def) - apply (wp | simp)+ - apply (rule corres_underlying_split[OF corres_machine_op,where Q = dc and Q'=dc]) - apply (rule corres_underlying_trivial) + apply simp + apply (rule corres_underlying_split[OF corres_machine_op]) + apply simp + apply (rule corres_underlying_trivial) + apply (simp add: user_memory_update_def) + apply (wp | simp)+ + apply (rule corres_underlying_split[OF corres_machine_op,where Q = dc and Q'=dc]) + apply (rule corres_underlying_trivial) apply (wp | simp add: dc_def device_memory_update_def)+ apply (clarsimp simp: invs_def valid_state_def pspace_respects_device_region_def) apply fastforce diff --git a/proof/refine/ARM_HYP/Retype_R.thy b/proof/refine/ARM_HYP/Retype_R.thy index a40fecd6b..36c2bb8d2 100644 --- a/proof/refine/ARM_HYP/Retype_R.thy +++ b/proof/refine/ARM_HYP/Retype_R.thy @@ -1435,16 +1435,20 @@ lemma objBitsKO_gt_0: "0 < objBitsKO ko" apply (simp_all add:archObjSize_def vcpu_bits_def vspace_bits_defs) done -lemma kheap_ekheap_double_gets: "(\rv erv rv'. pspace_relation rv rv' \ ekheap_relation erv rv' \ corres r (R rv erv) (R' rv') (b rv erv) (d rv')) \ -corres r (\s. R (kheap s) (ekheap s) s) (\s. R' (ksPSpace s) s) (do x \ gets kheap; xa \ gets ekheap; b x xa od) (gets ksPSpace >>= d)" +lemma kheap_ekheap_double_gets: + "(\rv erv rv'. \pspace_relation rv rv'; ekheap_relation erv rv'\ + \ corres r (R rv erv) (R' rv') (b rv erv) (d rv')) \ + corres r (\s. R (kheap s) (ekheap s) s) (\s. R' (ksPSpace s) s) + (do x \ gets kheap; xa \ gets ekheap; b x xa od) (gets ksPSpace >>= d)" apply (rule corres_symb_exec_l) apply (rule corres_guard_imp) - apply (rule_tac r'= "\erv rv'. ekheap_relation erv rv' \ pspace_relation x rv'" in corres_split_deprecated) + apply (rule_tac r'= "\erv rv'. ekheap_relation erv rv' \ pspace_relation x rv'" + in corres_split) + apply (subst corres_gets[where P="\s. x = kheap s" and P'=\]) apply clarsimp - apply assumption - apply (subst corres_gets[where P="\s. x = kheap s" and P'=\]) + apply (simp add: state_relation_def) apply clarsimp - apply (simp add: state_relation_def) + apply assumption apply (wp gets_exs_valid | simp)+ done @@ -1800,19 +1804,19 @@ proof - apply (simp add: not_less modify_modify bind_assoc[symmetric] obj_bits_api[symmetric] shiftl_t2n upto_enum_red' range_cover.unat_of_nat_n[OF cover]) - apply (rule corres_split_nor[OF corres_trivial]) - apply (clarsimp simp: retype_addrs_fold[symmetric] ptr_add_def upto_enum_red' not_zero' - range_cover.unat_of_nat_n[OF cover] word_le_sub1 - simp del: word_of_nat_eq_0_iff) - apply (rule_tac f=g in arg_cong) - apply clarsimp - apply (rename_tac x eps ps) - apply (rule_tac P="\s. x = kheap s \ eps = ekheap (s) \ ?P s" and - P'="\s. ps = ksPSpace s \ ?P' s" in corres_modify) - apply (simp add: set_retype_addrs_fold new_caps_adds_fold) - apply (erule retype_state_relation[OF _ _ _ _ _ _ _ _ _ cover _ _ orr], - simp_all add: ko not_zero obj_bits_api - bound[simplified obj_bits_api ko])[1] + apply (rule corres_split_nor[OF _ corres_trivial]) + apply (rename_tac x eps ps) + apply (rule_tac P="\s. x = kheap s \ eps = ekheap (s) \ ?P s" and + P'="\s. ps = ksPSpace s \ ?P' s" in corres_modify) + apply (simp add: set_retype_addrs_fold new_caps_adds_fold) + apply (erule retype_state_relation[OF _ _ _ _ _ _ _ _ _ cover _ _ orr], + simp_all add: ko not_zero obj_bits_api + bound[simplified obj_bits_api ko])[1] + apply (clarsimp simp: retype_addrs_fold[symmetric] ptr_add_def upto_enum_red' not_zero' + range_cover.unat_of_nat_n[OF cover] word_le_sub1 + simp del: word_of_nat_eq_0_iff) + apply (rule_tac f=g in arg_cong) + apply clarsimp apply wp+ apply (clarsimp split: option.splits) apply (intro conjI impI) @@ -5331,19 +5335,19 @@ lemma corres_retype_region_createNewCaps: split del: if_split)[10] (* not PageDirectoryObject *) apply (rule corres_guard_imp) apply (rule corres_split_eqr) - apply (rule corres_split_nor) - apply (rule corres_trivial, simp) - apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2 - objBits_simps APIType_map2_def) + apply (rule corres_retype[where 'a = tcb], + simp_all add: obj_bits_api_def objBits_simps' pageBits_def + APIType_map2_def makeObjectKO_def + other_objs_default_relation)[1] + apply (fastforce simp: range_cover_def) + apply (rule corres_split_nor) apply (simp add: APIType_map2_def) apply (rule retype_region2_extra_ext_mapM_x_corres) - apply wp + apply (rule corres_trivial, simp) + apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2 + objBits_simps APIType_map2_def) apply wp - apply (rule corres_retype[where 'a = tcb], - simp_all add: obj_bits_api_def objBits_simps' pageBits_def - APIType_map2_def makeObjectKO_def - other_objs_default_relation)[1] - apply (fastforce simp: range_cover_def) + apply wp apply ((wp retype_region2_obj_at | simp add: APIType_map2_def)+)[1] apply ((wp createObjects_tcb_at'[where sz=sz] | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1] apply simp @@ -5479,23 +5483,19 @@ lemma corres_retype_region_createNewCaps: apply simp+ defer \ \PageDirectory\ - apply (rule corres_guard_imp) - apply (rule corres_split_eqr) + apply (rule corres_guard_imp) + apply (rule corres_split_eqr) + apply (rule corres_retype[where ty = "Inr PageDirectoryObject" and 'a = pde + , simplified, folded retype_region2_ext_retype_region_ArchObject_PageDirectoryObj], + simp_all add: APIType_map2_def obj_bits_api_def + default_arch_object_def objBits_simps + archObjSize_def vspace_bits_defs + makeObjectKO_def)[1] + apply (simp add: range_cover_def)+ + apply (rule pagedirectory_relation_retype) apply (simp add: init_arch_objects_def APIType_map2_def bind_assoc) apply (rule corres_split_nor) - apply (simp add: liftM_def[symmetric] o_def list_all2_map1 - list_all2_map2 list_all2_same - arch_default_cap_def mapM_x_mapM) - apply (simp add: dc_def[symmetric]) - apply (rule corres_machine_op) - apply (rule corres_Id) - apply (simp add: shiftl_t2n shiftL_nat - vspace_bits_defs) - apply simp - apply (simp add: mapM_discarded[where g = "return ()",simplified,symmetric]) - apply (rule no_fail_pre) - apply (wp no_fail_mapM|clarsimp)+ apply (simp add: mapM_x_mapM) apply (rule corres_underlying_split[where r' = dc]) apply (rule_tac Q="\xs s. (\x \ set xs. page_directory_at x s) @@ -5510,15 +5510,18 @@ lemma corres_retype_region_createNewCaps: apply (rule corres_return[where P =\ and P'=\,THEN iffD2]) apply simp apply wp+ - apply (rule corres_retype[where ty = "Inr PageDirectoryObject" and 'a = pde - , simplified, folded retype_region2_ext_retype_region_ArchObject_PageDirectoryObj], - simp_all add: APIType_map2_def obj_bits_api_def - default_arch_object_def objBits_simps - archObjSize_def vspace_bits_defs - makeObjectKO_def)[1] - apply (simp add: range_cover_def)+ - apply (rule pagedirectory_relation_retype) - apply (wp | simp)+ + apply (simp add: liftM_def[symmetric] o_def list_all2_map1 + list_all2_map2 list_all2_same + arch_default_cap_def mapM_x_mapM) + apply (simp add: dc_def[symmetric]) + apply (rule corres_machine_op) + apply (rule corres_Id) + apply (simp add: shiftl_t2n shiftL_nat + vspace_bits_defs) + apply simp + apply (simp add: mapM_discarded[where g = "return ()",simplified,symmetric]) + apply (rule no_fail_pre) + apply (wp no_fail_mapM|clarsimp)+ apply (rule hoare_vcg_conj_lift) apply (rule hoare_post_imp) prefer 2 diff --git a/proof/refine/ARM_HYP/Schedule_R.thy b/proof/refine/ARM_HYP/Schedule_R.thy index ae84b36f2..0ff23927a 100644 --- a/proof/refine/ARM_HYP/Schedule_R.thy +++ b/proof/refine/ARM_HYP/Schedule_R.thy @@ -49,15 +49,15 @@ proof - apply (subst P) apply (rule corres_guard_imp) apply (rule corres_split[OF x]) - apply (rule corres_if2) - apply (case_tac ra, clarsimp+)[1] - apply (rule corres_trivial, clarsimp) - apply (case_tac ra, simp_all)[1] - apply (erule(1) meta_mp [OF _ suffix_ConsD]) - apply assumption + apply assumption + apply (rule corres_if2) + apply (case_tac ra, clarsimp+)[1] + apply (rule corres_trivial, clarsimp) + apply (case_tac ra, simp_all)[1] + apply (erule(1) meta_mp [OF _ suffix_ConsD]) apply (rule Q) apply (rule hoare_post_imp [OF _ z]) - apply simp+ + apply simp+ done qed @@ -140,15 +140,14 @@ lemma arch_switchToThread_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF get_tcb_corres]) apply (rule corres_split[OF vcpuSwitch_corres']) - apply (simp add: tcb_relation_def arch_tcb_relation_def) - apply (rule corres_split[OF setVMRoot_corres]) - apply (rule corres_machine_op[OF corres_rel_imp]) - apply (rule corres_underlying_trivial) - apply wpsimp - apply (clarsimp simp: ARM_HYP.clearExMonitor_def)+ - apply wpsimp + apply (clarsimp simp: tcb_relation_def arch_tcb_relation_def) + apply (rule corres_split[OF setVMRoot_corres]) + apply (rule corres_machine_op[OF corres_rel_imp]) + apply (rule corres_underlying_trivial) + apply wpsimp + apply (clarsimp simp: ARM_HYP.clearExMonitor_def)+ apply wpsimp - apply (clarsimp simp: tcb_relation_def arch_tcb_relation_def) + apply wpsimp apply (wpsimp wp: tcb_at_typ_at simp:) apply (wpsimp simp: ARM_HYP.clearExMonitor_def wp: tcb_at_typ_at)+ apply (wp getObject_tcb_hyp_sym_refs) @@ -199,21 +198,30 @@ lemma tcbSchedAppend_corres: apply clarsimp apply (clarsimp simp: unless_def when_def cong: if_cong) apply (rule stronger_corres_guard_imp) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (rule corres_split_deprecated[where r'="(=)"]) - apply (rule corres_split_noop_rhs2) - apply (rule corres_split_noop_rhs2) - apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1] - apply (rule addToBitmap_if_null_noop_corres) - apply wp+ - apply (simp add: tcb_sched_append_def) - apply (intro conjI impI) - apply (rule corres_guard_imp) - apply (rule setQueue_corres) - prefer 3 - apply (rule_tac P=\ and Q="K (t \ set queuea)" in corres_assume_pre) - apply (wp getQueue_corres getObject_tcb_wp | simp add: etcb_relation_def threadGet_def)+ + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres) + apply (simp add: etcb_relation_def) + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres) + apply (simp add: etcb_relation_def) + apply (rule corres_split[where r'="(=)"]) + apply simp + apply (rule getQueue_corres) + apply (rule corres_split_noop_rhs2) + apply (simp add: tcb_sched_append_def) + apply (intro conjI impI) + apply (rule corres_guard_imp) + apply (rule setQueue_corres) + prefer 3 + apply (rule_tac P=\ and Q="K (t \ set queuea)" in corres_assume_pre) + apply simp + apply simp + apply simp + apply (rule corres_split_noop_rhs2) + apply (rule addToBitmap_if_null_noop_corres) + apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1] + apply wp+ + apply (wp getObject_tcb_wp | simp add: threadGet_def)+ apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def projectKO_eq project_inject) done @@ -1821,11 +1829,11 @@ lemma scheduleChooseNewThread_fragment_corres: apply (subst bind_dummy_ret_val) apply (subst bind_dummy_ret_val) apply (rule corres_guard_imp) - apply (rule corres_split[OF corres_when]) - apply simp - apply (rule chooseThread_corres) - apply simp - apply (rule nextDomain_corres) + apply (rule corres_split) + apply (rule corres_when, simp) + apply (rule nextDomain_corres) + apply simp + apply (rule chooseThread_corres) apply (wp nextDomain_invs_no_cicd')+ apply (clarsimp simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def)+ done @@ -1945,69 +1953,72 @@ lemma schedule_corres: apply clarsimp apply (rule corres_split[OF thread_get_isRunnable_corres]) apply (rule corres_split[OF corres_when]) - apply (rule scheduleChooseNewThread_corres, simp) - apply (rule tcbSchedEnqueue_corres, simp) + apply simp + apply (rule tcbSchedEnqueue_corres) + apply (rule scheduleChooseNewThread_corres, simp) apply (wp thread_get_wp' tcbSchedEnqueue_invs' hoare_vcg_conj_lift hoare_drop_imps | clarsimp)+ (* switch to thread *) apply (rule corres_split[OF thread_get_isRunnable_corres], rename_tac was_running wasRunning) apply (rule corres_split[OF corres_when]) - apply (rule corres_split[OF getIdleThread_corres], rename_tac it it') - apply (rule_tac F="was_running \ ct \ it" in corres_gen_asm) - apply (rule corres_split[OF ethreadget_corres[where r="(=)"]], - rename_tac tp tp') - apply (rule corres_split[OF ethread_get_when_corres[where r="(=)"]], - rename_tac cp cp') - apply (rule corres_split[OF scheduleSwitchThreadFastfail_corres]) - apply (rule corres_split[OF curDomain_corres]) - apply (rule corres_split[OF isHighestPrio_corres]; simp only:) - apply (rule corres_if, simp) - apply (rule corres_split[OF tcbSchedEnqueue_corres]) - apply (simp, fold dc_def) - apply (rule corres_split[OF setSchedulerAction_corres]) - apply (rule scheduleChooseNewThread_corres, simp) + apply simp + apply (rule tcbSchedEnqueue_corres) + apply (rule corres_split[OF getIdleThread_corres], rename_tac it it') + apply (rule_tac F="was_running \ ct \ it" in corres_gen_asm) + apply (rule corres_split[OF ethreadget_corres[where r="(=)"]]) + apply (simp add: etcb_relation_def) + apply (rename_tac tp tp') + apply (rule corres_split[OF ethread_get_when_corres[where r="(=)"]]) + apply (simp add: etcb_relation_def) + apply (rename_tac cp cp') + apply (rule corres_split) + apply (rule scheduleSwitchThreadFastfail_corres; simp) + apply (rule corres_split[OF curDomain_corres]) + apply (rule corres_split[OF isHighestPrio_corres]; simp only:) + apply (rule corres_if, simp) + apply (rule corres_split[OF tcbSchedEnqueue_corres]) + apply (simp, fold dc_def) + apply (rule corres_split[OF setSchedulerAction_corres]) + apply simp + apply (rule scheduleChooseNewThread_corres) + apply (wp | simp)+ + apply (simp add: valid_sched_def) + apply wp + apply (rule hoare_vcg_conj_lift) + apply (rule_tac t=t in set_scheduler_action_cnt_valid_blocked') + apply (wpsimp wp: setSchedulerAction_invs')+ + apply (wp tcb_sched_action_enqueue_valid_blocked hoare_vcg_all_lift enqueue_thread_queued) + apply (wp tcbSchedEnqueue_invs'_not_ResumeCurrentThread) - apply (wp | simp)+ - apply (simp add: valid_sched_def) - apply wp - apply (rule hoare_vcg_conj_lift) - apply (rule_tac t=t in set_scheduler_action_cnt_valid_blocked') - apply (wpsimp wp: setSchedulerAction_invs')+ - apply (wp tcb_sched_action_enqueue_valid_blocked hoare_vcg_all_lift enqueue_thread_queued) - apply (wp tcbSchedEnqueue_invs'_not_ResumeCurrentThread) + apply (rule corres_if, fastforce) - apply (rule corres_if, fastforce) + apply (rule corres_split[OF tcbSchedAppend_corres]) + apply (simp, fold dc_def) + apply (rule corres_split[OF setSchedulerAction_corres]) + apply simp + apply (rule scheduleChooseNewThread_corres) - apply (rule corres_split[OF tcbSchedAppend_corres]) - apply (simp, fold dc_def) - apply (rule corres_split[OF setSchedulerAction_corres]) - apply (rule scheduleChooseNewThread_corres, simp) + apply (wp | simp)+ + apply (simp add: valid_sched_def) + apply wp + apply (rule hoare_vcg_conj_lift) + apply (rule_tac t=t in set_scheduler_action_cnt_valid_blocked') + apply (wpsimp wp: setSchedulerAction_invs')+ + apply (wp tcb_sched_action_append_valid_blocked hoare_vcg_all_lift append_thread_queued) + apply (wp tcbSchedAppend_invs'_not_ResumeCurrentThread) - apply (wp | simp)+ - apply (simp add: valid_sched_def) - apply wp - apply (rule hoare_vcg_conj_lift) - apply (rule_tac t=t in set_scheduler_action_cnt_valid_blocked') - apply (wpsimp wp: setSchedulerAction_invs')+ - apply (wp tcb_sched_action_append_valid_blocked hoare_vcg_all_lift append_thread_queued) - apply (wp tcbSchedAppend_invs'_not_ResumeCurrentThread) + apply (rule corres_split[OF guarded_switch_to_corres], simp) + apply (rule setSchedulerAction_corres[simplified dc_def]) + apply (wp | simp)+ - apply (rule corres_split[OF guarded_switch_to_corres], simp) - apply (rule setSchedulerAction_corres[simplified dc_def]) - apply (wp | simp)+ - - (* isHighestPrio *) - apply (clarsimp simp: if_apply_def2) - apply ((wp (once) hoare_drop_imp)+)[1] - - apply (simp add: if_apply_def2) - apply ((wp (once) hoare_drop_imp)+)[1] - apply wpsimp+ - apply (wpsimp simp: etcb_relation_def)+ - apply (rule tcbSchedEnqueue_corres) - apply wpsimp+ + (* isHighestPrio *) + apply (clarsimp simp: if_apply_def2) + apply ((wp (once) hoare_drop_imp)+)[1] + apply (simp add: if_apply_def2) + apply ((wp (once) hoare_drop_imp)+)[1] + apply wpsimp+ apply (clarsimp simp: conj_ac cong: conj_cong) apply wp apply (rule_tac Q="\_ s. valid_blocked_except t s \ scheduler_action s = switch_thread t" @@ -2395,18 +2406,20 @@ lemma possibleSwitchTo_corres: apply (simp add: possible_switch_to_def possibleSwitchTo_def cong: if_cong) apply (rule corres_guard_imp) apply (rule corres_split[OF curDomain_corres], simp) - apply (rule corres_split[OF ethreadget_corres[where r="(=)"]]) - apply (rule corres_split[OF getSchedulerAction_corres]) - apply (rule corres_if, simp) - apply (rule tcbSchedEnqueue_corres) - apply (rule corres_if, simp) - apply (case_tac action; simp) - apply (rule corres_split[OF rescheduleRequired_corres]) - apply (rule tcbSchedEnqueue_corres) - apply (wp rescheduleRequired_valid_queues'_weak)+ - apply (rule setSchedulerAction_corres, simp) - apply (wpsimp simp: etcb_relation_def if_apply_def2 - wp: hoare_drop_imp[where f="ethread_get a b" for a b])+ + apply (rule corres_split) + apply (rule ethreadget_corres[where r="(=)"]) + apply (clarsimp simp: etcb_relation_def) + apply (rule corres_split[OF getSchedulerAction_corres]) + apply (rule corres_if, simp) + apply (rule tcbSchedEnqueue_corres) + apply (rule corres_if, simp) + apply (case_tac action; simp) + apply (rule corres_split[OF rescheduleRequired_corres]) + apply (rule tcbSchedEnqueue_corres) + apply (wp rescheduleRequired_valid_queues'_weak)+ + apply (rule setSchedulerAction_corres, simp) + apply (wpsimp simp: if_apply_def2 + wp: hoare_drop_imp[where f="ethread_get a b" for a b])+ apply (wp hoare_drop_imps)[1] apply wp+ apply (fastforce simp: valid_sched_def invs_def valid_state_def cur_tcb_def diff --git a/proof/refine/ARM_HYP/Syscall_R.thy b/proof/refine/ARM_HYP/Syscall_R.thy index 9becc9fd6..9139b3ae9 100644 --- a/proof/refine/ARM_HYP/Syscall_R.thy +++ b/proof/refine/ARM_HYP/Syscall_R.thy @@ -139,24 +139,25 @@ lemma decodeDomainInvocation_corres: apply (simp+)[2] apply (case_tac "args", simp_all) apply (rule corres_guard_imp) - apply (rule_tac r'="\domain domain'. domain = domain'" and R="\_. \" and R'="\_. \" in corres_splitEE) - apply (rule whenE_throwError_corres_initial) - apply simp - apply (case_tac "cs") - apply ((case_tac "cs'", ((simp add: null_def)+)[2])+)[2] - apply (subgoal_tac "cap_relation (fst (hd cs)) (fst (hd cs'))") - apply (case_tac "fst (hd cs)") - apply (case_tac "fst (hd cs')", simp+, rule corres_returnOkTT) - apply (simp add: inv_relation_def o_def uncurry_def) - apply (case_tac "fst (hd cs')", fastforce+) - apply (case_tac "cs") - apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2]) - apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2]) - apply (rule whenE_throwError_corres) - apply (simp+)[2] - apply (rule corres_returnOkTT) + apply (rule_tac r'="\domain domain'. domain = domain'" and R="\_. \" and R'="\_. \" + in corres_splitEE) apply (rule whenE_throwError_corres) + apply (simp+)[2] + apply (rule corres_returnOkTT) + apply simp + apply (rule whenE_throwError_corres_initial) + apply simp + apply (case_tac "cs") + apply ((case_tac "cs'", ((simp add: null_def)+)[2])+)[2] + apply (subgoal_tac "cap_relation (fst (hd cs)) (fst (hd cs'))") + apply (case_tac "fst (hd cs)") + apply (case_tac "fst (hd cs')", simp+, rule corres_returnOkTT) + apply (simp add: inv_relation_def o_def uncurry_def) + apply (case_tac "fst (hd cs')", fastforce+) + apply (case_tac "cs") + apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2]) + apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2]) apply (wp | simp)+ -done + done lemma decodeInvocation_corres: "\cptr = to_bl cptr'; mi' = message_info_map mi; @@ -266,10 +267,10 @@ lemma hinv_corres_assist: \ \switched over to argument of corres_cap_fault\ apply (rule lookupCapAndSlot_corres, simp) apply (rule corres_split[OF lookupIPCBuffer_corres]) - apply (rule corres_splitEE[OF lookupExtraCaps_corres]) - apply (rule corres_returnOkTT) - apply simp+ - apply (wp | simp)+ + apply (rule corres_splitEE) + apply (rule lookupExtraCaps_corres; simp) + apply (rule corres_returnOkTT) + apply (wp | simp)+ apply auto done @@ -360,17 +361,18 @@ lemma setDomain_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF getCurThread_corres]) apply (rule corres_split[OF tcbSchedDequeue_corres]) - apply (rule corres_split[OF ethread_set_corres]) - apply (rule corres_split[OF isRunnable_corres]) - apply simp - apply (rule corres_split_deprecated[OF corres_when[OF refl]]) - apply (rule rescheduleRequired_corres) - apply clarsimp - apply (rule corres_when[OF refl]) - apply (rule tcbSchedEnqueue_corres) - apply (wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+ - apply (clarsimp simp: etcb_relation_def) - apply ((wp hoare_vcg_conj_lift hoare_vcg_disj_lift | clarsimp)+)[1] + apply (rule corres_split) + apply (rule ethread_set_corres; simp) + apply (clarsimp simp: etcb_relation_def) + apply (rule corres_split[OF isRunnable_corres]) + apply simp + apply (rule corres_split) + apply clarsimp + apply (rule corres_when[OF refl]) + apply (rule tcbSchedEnqueue_corres) + apply (rule corres_when[OF refl]) + apply (rule rescheduleRequired_corres) + apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5] apply clarsimp apply (rule_tac Q="\_. valid_objs' and valid_queues' and valid_queues and (\s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr" @@ -407,60 +409,61 @@ lemma performInvocation_corres: apply (case_tac i) apply (clarsimp simp: o_def liftE_bindE) apply (rule corres_guard_imp) - apply (rule corres_split_norE[OF corres_returnOkTT]) - apply simp - apply (rule corres_rel_imp, rule inv_untyped_corres) - apply simp - apply (case_tac x, simp_all)[1] + apply (rule corres_split_norE) + apply (rule corres_rel_imp, rule inv_untyped_corres) + apply simp + apply (case_tac x, simp_all)[1] + apply (rule corres_returnOkTT) + apply simp apply wp+ apply simp+ apply (rule corres_guard_imp) - apply (rule corres_split[OF getCurThread_corres]) - apply simp - apply (rule corres_split[OF sendIPC_corres]) + apply (rule corres_split[OF getCurThread_corres]) + apply simp + apply (rule corres_split[OF sendIPC_corres]) + apply simp apply (rule corres_trivial) apply simp - apply simp - apply wp+ - apply (clarsimp simp: ct_in_state_def) - apply (fastforce elim: st_tcb_ex_cap) - apply (clarsimp simp: pred_conj_def invs'_def cur_tcb'_def simple_sane_strg - sch_act_simple_def) - apply (rule corres_guard_imp) - apply (simp add: liftE_bindE) - apply (rule corres_split[OF sendSignal_corres]) - apply (rule corres_trivial) - apply (simp add: returnOk_def) - apply wp+ - apply (simp+)[2] - apply simp - apply (rule corres_guard_imp) - apply (rule corres_split_eqr[OF getCurThread_corres]) - apply (rule corres_split_nor[OF doReplyTransfer_corres']) - apply (rule corres_trivial, simp) + apply wp+ + apply (clarsimp simp: ct_in_state_def) + apply (fastforce elim: st_tcb_ex_cap) + apply (clarsimp simp: pred_conj_def invs'_def cur_tcb'_def simple_sane_strg + sch_act_simple_def) + apply (rule corres_guard_imp) + apply (simp add: liftE_bindE) + apply (rule corres_split[OF sendSignal_corres]) + apply (rule corres_trivial) + apply (simp add: returnOk_def) apply wp+ - apply (clarsimp simp: tcb_at_invs) - apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) + apply (simp+)[2] + apply simp + apply (rule corres_guard_imp) + apply (rule corres_split_eqr[OF getCurThread_corres]) + apply (rule corres_split_nor[OF doReplyTransfer_corres']) + apply (rule corres_trivial, simp) + apply wp+ + apply (clarsimp simp: tcb_at_invs) + apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) apply (erule cte_wp_at_weakenE, fastforce simp: is_reply_cap_to_def) - apply (clarsimp simp: tcb_at_invs') - apply (fastforce elim!: cte_wp_at_weakenE') - apply (clarsimp simp: liftME_def) - apply (rule corres_guard_imp) - apply (erule invokeTCB_corres) - apply (simp)+ - \ \domain cap\ + apply (clarsimp simp: tcb_at_invs') + apply (fastforce elim!: cte_wp_at_weakenE') + apply (clarsimp simp: liftME_def) + apply (rule corres_guard_imp) + apply (erule invokeTCB_corres) + apply (simp)+ + \ \domain cap\ apply (clarsimp simp: invoke_domain_def) apply (rule corres_guard_imp) - apply (rule corres_split[OF setDomain_corres]) - apply (rule corres_trivial, simp) - apply (wp)+ + apply (rule corres_split[OF setDomain_corres]) + apply (rule corres_trivial, simp) + apply (wp)+ apply (clarsimp+)[2] \ \CNodes\ apply clarsimp apply (rule corres_guard_imp) apply (rule corres_splitEE[OF invokeCNode_corres]) - apply (rule corres_trivial, simp add: returnOk_def) - apply assumption + apply assumption + apply (rule corres_trivial, simp add: returnOk_def) apply wp+ apply (clarsimp+)[2] apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric]) @@ -1248,24 +1251,26 @@ lemma handleInvocation_corres: apply (clarsimp simp: when_def) apply (rule replyFromKernel_corres) apply (rule corres_split[OF setThreadState_corres]) - apply (rule corres_splitEE[OF performInvocation_corres]) - apply simp - apply (rule corres_split[OF getThreadState_corres]) - apply (rename_tac state state') - apply (case_tac state, simp_all)[1] - apply (fold dc_def)[1] - apply (rule corres_split_deprecated [OF setThreadState_corres]) - apply simp - apply (rule corres_when [OF refl replyFromKernel_corres]) - apply (simp add: when_def) - apply (rule conjI, rule impI) - apply (rule reply_from_kernel_tcb_at) - apply (rule impI, wp+) - apply (simp)+ - apply (wp hoare_drop_imps)+ - apply (simp) - apply (wp) - apply (simp) + apply simp + apply (rule corres_splitEE) + apply (rule performInvocation_corres; simp) + apply simp + apply (rule corres_split[OF getThreadState_corres]) + apply (rename_tac state state') + apply (case_tac state, simp_all)[1] + apply (fold dc_def)[1] + apply (rule corres_split) + apply (rule corres_when [OF refl replyFromKernel_corres]) + apply (rule setThreadState_corres) + apply simp + apply (simp add: when_def) + apply (rule conjI, rule impI) + apply (rule reply_from_kernel_tcb_at) + apply (rule impI, wp+) + apply simp+ + apply (wp hoare_drop_imps)+ + apply simp + apply wp apply simp apply (rule_tac Q="\rv. einvs and simple_sched_action and valid_invocation rve and (\s. thread = cur_thread s) @@ -1518,17 +1523,16 @@ lemma handleRecv_isBlocking_corres': apply (rule corres_split_eqr[OF getCurThread_corres]) apply (rule corres_split_eqr[OF asUser_getRegister_corres]) apply (rule corres_split_catch) - apply (erule handleFault_corres) - apply (rule corres_cap_fault) - apply (rule corres_splitEE[OF lookupCap_corres]) - apply (rule_tac P="?pre1 and tcb_at thread - and (\s. (cur_thread s) = thread ) - and valid_cap rv" - and P'="?pre2 and tcb_at' thread and valid_cap' rv'" in corres_inst) - apply (clarsimp split: cap_relation_split_asm arch_cap.split_asm split del: if_split - simp: lookup_failure_map_def whenE_def) - apply (rule corres_guard_imp) - apply (rename_tac rights) + apply (rule corres_cap_fault) + apply (rule corres_splitEE[OF lookupCap_corres]) + apply (rule_tac P="?pre1 and tcb_at thread + and (\s. (cur_thread s) = thread ) + and valid_cap rv" + and P'="?pre2 and tcb_at' thread and valid_cap' rv'" in corres_inst) + apply (clarsimp split: cap_relation_split_asm arch_cap.split_asm split del: if_split + simp: lookup_failure_map_def whenE_def) + apply (rule corres_guard_imp) + apply (rename_tac rights) apply (case_tac "AllowRead \ rights"; simp) apply (rule corres_split_nor[OF deleteCallerCap_corres]) apply (rule receiveIPC_corres) @@ -1536,31 +1540,35 @@ lemma handleRecv_isBlocking_corres': apply (wp delete_caller_cap_nonz_cap delete_caller_cap_valid_ep_cap)+ apply (clarsimp)+ apply (clarsimp simp: lookup_failure_map_def)+ - apply (clarsimp simp: valid_cap'_def capAligned_def) - apply (rule corres_guard_imp) - apply (rename_tac rights) - apply (case_tac "AllowRead \ rights"; simp) - apply (rule_tac r'=ntfn_relation in corres_splitEE) + apply (clarsimp simp: valid_cap'_def capAligned_def) + apply (rule corres_guard_imp) + apply (rename_tac rights) + apply (case_tac "AllowRead \ rights"; simp) + apply (rule_tac r'=ntfn_relation in corres_splitEE) + apply clarsimp + apply (rule getNotification_corres) apply (rule corres_if) apply (clarsimp simp: ntfn_relation_def) apply (clarsimp, rule receiveSignal_corres) prefer 3 apply (rule corres_trivial) apply (clarsimp simp: lookup_failure_map_def)+ - apply (rule getNotification_corres) - apply (wp get_simple_ko_wp getNotification_wp | wpcw | simp)+ - apply (clarsimp simp: lookup_failure_map_def) - apply (clarsimp simp: valid_cap_def ct_in_state_def) - apply (clarsimp simp: valid_cap'_def capAligned_def) - apply (wp get_simple_ko_wp | wpcw | simp)+ + apply (wp get_simple_ko_wp getNotification_wp | wpcw | simp)+ + apply (clarsimp simp: lookup_failure_map_def) + apply (clarsimp simp: valid_cap_def ct_in_state_def) + apply (clarsimp simp: valid_cap'_def capAligned_def) + apply wp+ + apply (rule handleFault_corres) + apply simp + apply (wp get_simple_ko_wp | wpcw | simp)+ apply (rule hoare_vcg_E_elim) apply (simp add: lookup_cap_def lookup_slot_for_thread_def) apply wp apply (simp add: split_def) apply (wp resolve_address_bits_valid_fault2)+ apply (wp getNotification_wp | wpcw | simp add: valid_fault_def whenE_def split del: if_split)+ - apply (clarsimp simp add: ct_in_state_def ct_in_state'_def conj_comms invs_valid_tcb_ctable - invs_valid_objs tcb_at_invs invs_psp_aligned invs_cur) + apply (clarsimp simp add: ct_in_state_def ct_in_state'_def conj_comms invs_valid_tcb_ctable + invs_valid_objs tcb_at_invs invs_psp_aligned invs_cur) apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def ct_in_state'_def sch_act_sane_not) done @@ -2066,14 +2074,14 @@ proof - apply (rule corres_split_eqr[where R="\rv. einvs" and R'="\rv s. \x. rv = Some x \ R'' x s" for R'']) - apply (case_tac rv, simp_all add: doMachineOp_return)[1] - apply (rule handleInterrupt_corres) - apply (rule corres_machine_op) - apply (rule corres_Id, simp+) - apply (wp hoare_vcg_all_lift - doMachineOp_getActiveIRQ_IRQ_active' - | simp - | simp add: imp_conjR | wp (once) hoare_drop_imps)+ + apply (rule corres_machine_op) + apply (rule corres_Id; wpsimp) + apply (case_tac rv, simp_all add: doMachineOp_return)[1] + apply (rule handleInterrupt_corres) + apply (wp hoare_vcg_all_lift + doMachineOp_getActiveIRQ_IRQ_active' + | simp + | simp add: imp_conjR | wp (once) hoare_drop_imps)+ apply force apply simp apply (clarsimp simp: invs'_def valid_state'_def ct_not_inQ_def valid_queues_def @@ -2084,8 +2092,8 @@ proof - apply (rule_tac corres_underlying_split) apply (rule corres_guard_imp, rule getCurThread_corres, simp+) apply (rule corres_split_catch) - apply (erule handleFault_corres) - apply (rule handleVMFault_corres) + apply (rule handleVMFault_corres) + apply (erule handleFault_corres) apply (wp handle_vm_fault_valid_fault) apply (wp hvmf_invs_etc) apply wp diff --git a/proof/refine/ARM_HYP/TcbAcc_R.thy b/proof/refine/ARM_HYP/TcbAcc_R.thy index 98f8d09fa..0ff5098fe 100644 --- a/proof/refine/ARM_HYP/TcbAcc_R.thy +++ b/proof/refine/ARM_HYP/TcbAcc_R.thy @@ -423,10 +423,10 @@ lemma threadSet_corres_noop_splitT: apply (rule corres_guard_imp) apply (subst return_bind[symmetric]) apply (rule corres_split_nor[OF threadSet_corres_noopT]) - apply (rule z) - apply (simp add: x) - apply (rule y) - apply (rule e) + apply (simp add: x) + apply (rule y) + apply (rule e) + apply (rule z) apply (wp w)+ apply simp apply simp @@ -1381,22 +1381,22 @@ lemma asUser_corres': show ?thesis apply (simp add: as_user_def asUser_def) apply (rule corres_guard_imp) - apply (rule_tac r'="\tcb con. (arch_tcb_context_get o tcb_arch) tcb = con" in corres_split_deprecated) - apply (rule corres_split[OF L4]) - apply clarsimp - apply (rule corres_split_nor) - apply (rule corres_trivial, simp) - apply (simp add: threadSet_def) - apply (rule corres_symb_exec_r) - prefer 4 - apply (rule no_fail_pre_and, wp) - apply (rule L3[simplified]) - apply simp - apply simp - apply (wp select_f_inv | simp)+ - apply (rule L1[simplified]) - apply wp+ - apply auto + apply (rule_tac r'="\tcb con. (arch_tcb_context_get o tcb_arch) tcb = con" + in corres_split) + apply simp + apply (rule L1[simplified]) + apply (rule corres_split) + apply (rule L4; simp) + apply clarsimp + apply (rule corres_split_nor) + apply (simp add: threadSet_def) + apply (rule corres_symb_exec_r) + prefer 4 + apply (rule no_fail_pre_and, wp) + apply (rule L3[simplified]) + apply simp + apply simp + apply (wp select_f_inv | simp)+ done qed @@ -1874,21 +1874,27 @@ proof - apply (rule ready_queues_helper; auto) apply (clarsimp simp: when_def) apply (rule stronger_corres_guard_imp) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (rule corres_split_deprecated[where r'="(=)"]) - apply (rule corres_split_noop_rhs2) - apply (rule corres_split_noop_rhs2) - apply (fastforce intro: threadSet_corres_noop simp: tcb_relation_def exst_same_def) - apply (fastforce intro: addToBitmap_noop_corres) - apply wp+ - apply (simp add: tcb_sched_enqueue_def split del: if_split) - apply (rule_tac P=\ and Q="K (t \ set queuea)" in corres_assume_pre) - apply (wp setQueue_corres[unfolded dc_def] | simp)+ - apply (wp getQueue_corres getObject_tcb_wp | simp add: etcb_relation_def threadGet_def)+ - apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def - projectKO_eq project_inject) - done + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres) + apply (simp add: etcb_relation_def) + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres) + apply (simp add: etcb_relation_def) + apply (rule corres_split[where r'="(=)"]) + apply simp + apply (rule getQueue_corres) + apply (rule corres_split_noop_rhs2) + apply (simp add: tcb_sched_enqueue_def split del: if_split) + apply (rule_tac P=\ and Q="K (t \ set queuea)" in corres_assume_pre) + apply simp + apply (rule setQueue_corres[unfolded dc_def]) + apply (rule corres_split_noop_rhs2) + apply (fastforce intro: addToBitmap_noop_corres) + apply (fastforce intro: threadSet_corres_noop simp: tcb_relation_def exst_same_def) + apply (wp getObject_tcb_wp | simp add: threadGet_def)+ + apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def + projectKO_eq project_inject) + done qed definition @@ -1922,13 +1928,14 @@ lemma rescheduleRequired_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF getSchedulerAction_corres]) apply (rule_tac P="case action of switch_thread t \ P t | _ \ \" - and P'="case actiona of SwitchToThread t \ P' t | _ \ \" for P P' in corres_split_deprecated[where r'=dc]) - apply (rule setSchedulerAction_corres) - apply simp - apply (case_tac action) + and P'="case actiona of SwitchToThread t \ P' t | _ \ \" for P P' + in corres_split[where r'=dc]) + apply (case_tac action) + apply simp apply simp + apply (rule tcbSchedEnqueue_corres) apply simp - apply (rule tcbSchedEnqueue_corres) + apply (rule setSchedulerAction_corres) apply simp apply (wp | wpc | simp)+ apply (force dest: st_tcb_weakenE simp: in_monad weak_valid_sched_action_def valid_etcbs_def @@ -2075,15 +2082,19 @@ lemma tcbSchedDequeue_corres: apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def) apply (simp add: when_def) apply (rule corres_guard_imp) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres]) - apply (rule corres_split_deprecated[where r'="(=)"]) - apply (rule corres_split_noop_rhs2) - apply (rule corres_split_noop_rhs) - apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def) - apply (clarsimp, rule removeFromBitmap_corres_noop) - apply (rule setQueue_corres | rule getQueue_corres | - wp | simp add: tcb_sched_dequeue_def etcb_relation_def)+ + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres, simp add: etcb_relation_def) + apply (rule corres_split[where r'="(=)"]) + apply (rule ethreadget_corres, simp add: etcb_relation_def) + apply (rule corres_split[where r'="(=)"]) + apply (simp, rule getQueue_corres) + apply (rule corres_split_noop_rhs2) + apply (simp add: tcb_sched_dequeue_def) + apply (rule setQueue_corres) + apply (rule corres_split_noop_rhs) + apply (clarsimp, rule removeFromBitmap_corres_noop) + apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def) + apply (wp | simp)+ done lemma thread_get_test: "do cur_ts \ get_thread_state cur; g (test cur_ts) od = @@ -2113,21 +2124,20 @@ lemma setThreadState_corres: apply (simp add: set_thread_state_ext_def[abs_def]) apply (subst bind_assoc[symmetric], subst thread_set_def[simplified, symmetric]) apply (rule corres_guard_imp) - apply (rule corres_split_deprecated[where r'=dc]) - apply simp - apply (subst thread_get_test[where test="runnable"]) - apply (rule corres_split[OF thread_get_isRunnable_corres]) - apply (rule corres_split[OF getCurThread_corres]) - apply (rule corres_split[OF getSchedulerAction_corres]) - apply (simp only: when_def) - apply (rule corres_if[where Q=\ and Q'=\]) - apply (rule iffI) - apply clarsimp+ - apply (case_tac rva,simp_all)[1] - apply (wp rescheduleRequired_corres_simple corres_return_trivial | simp)+ - apply (rule threadset_corres, (simp add: tcb_relation_def exst_same_def)+) - apply (wp hoare_vcg_conj_lift[where Q'="\\"] | simp add: sch_act_simple_def)+ - done + apply (rule corres_split[where r'=dc]) + apply (rule threadset_corres, (simp add: tcb_relation_def exst_same_def)+) + apply (subst thread_get_test[where test="runnable"]) + apply (rule corres_split[OF thread_get_isRunnable_corres]) + apply (rule corres_split[OF getCurThread_corres]) + apply (rule corres_split[OF getSchedulerAction_corres]) + apply (simp only: when_def) + apply (rule corres_if[where Q=\ and Q'=\]) + apply (rule iffI) + apply clarsimp+ + apply (case_tac rva,simp_all)[1] + apply (wp rescheduleRequired_corres_simple corres_return_trivial | simp)+ + apply (wp hoare_vcg_conj_lift[where Q'="\\"] | simp add: sch_act_simple_def)+ + done lemma setBoundNotification_corres: "corres dc @@ -3241,21 +3251,22 @@ lemma storeWordUser_corres: apply (rule corres_guard2_imp) apply (rule_tac F = "is_aligned a msg_align_bits" in corres_gen_asm2) apply (rule corres_guard1_imp) - apply (rule_tac r'=dc in corres_split_deprecated) - apply (rule corres_machine_op) - apply (rule corres_Id [OF refl]) - apply simp - apply (rule no_fail_pre) - apply (wp no_fail_storeWord) - apply (erule_tac n=msg_align_bits in aligned_add_aligned) - apply (rule is_aligned_mult_triv2 [where n = 2, simplified]) - apply (simp add: word_bits_conv msg_align_bits)+ - apply (simp add: stateAssert_def) - apply (rule_tac r'=dc in corres_split_deprecated) + apply (rule_tac r'=dc in corres_split) + apply (simp add: stateAssert_def) + apply (rule_tac r'=dc in corres_split) + apply (rule corres_trivial) + apply simp apply (rule corres_assert) - apply (rule corres_trivial) - apply simp - apply wp+ + apply wp+ + apply (rule corres_machine_op) + apply (rule corres_Id [OF refl]) + apply simp + apply (rule no_fail_pre) + apply (wp no_fail_storeWord) + apply (erule_tac n=msg_align_bits in aligned_add_aligned) + apply (rule is_aligned_mult_triv2 [where n = 2, simplified]) + apply (simp add: word_bits_conv msg_align_bits)+ + apply wp+ apply (simp add: in_user_frame_eq[OF y]) apply simp apply (rule conjI) @@ -3310,7 +3321,7 @@ lemma getMRs_corres: apply (case_tac mi, simp add: get_mrs_def getMRs_def split del: if_split) apply (case_tac buf) apply (rule corres_guard_imp) - apply (rule corres_split_deprecated [where R = "\_. \" and R' = "\_. \", OF _ T]) + apply (rule corres_split [where R = "\_. \" and R' = "\_. \", OF T]) apply simp apply wp+ apply simp @@ -3320,21 +3331,21 @@ lemma getMRs_corres: apply (simp only: option.simps return_bind fun_app_def load_word_offs_def doMachineOp_mapM ef_loadWord) apply (rule corres_split_eqr) - apply (rule corres_trivial, simp) - apply (simp only: mapM_map_simp msgMaxLength_def msgLengthBits_def - msg_max_length_def o_def upto_enum_word) - apply (rule corres_mapM [where r'="(=)" and S="{a. fst a = snd a \ fst a < unat max_ipc_words}"]) + apply (simp only: mapM_map_simp msgMaxLength_def msgLengthBits_def + msg_max_length_def o_def upto_enum_word) + apply (rule corres_mapM [where r'="(=)" and S="{a. fst a = snd a \ fst a < unat max_ipc_words}"]) + apply simp apply simp + apply (simp add: word_size wordSize_def wordBits_def) + apply (rule loadWordUser_corres) apply simp - apply (simp add: word_size wordSize_def wordBits_def) - apply (rule loadWordUser_corres) - apply simp - apply wp+ - apply simp - apply (unfold msgRegisters_unfold)[1] - apply simp - apply (clarsimp simp: set_zip) - apply (simp add: msgRegisters_unfold max_ipc_words nth_append) + apply wp+ + apply simp + apply (unfold msgRegisters_unfold)[1] + apply simp + apply (clarsimp simp: set_zip) + apply (simp add: msgRegisters_unfold max_ipc_words nth_append) + apply (rule corres_trivial, simp) apply (wp hoare_vcg_all_lift | simp add: valid_ipc_buffer_ptr'_def)+ done qed @@ -3410,11 +3421,11 @@ proof - apply (clarsimp simp: msgRegisters_unfold setRegister_def2 zipWithM_x_Nil zipWithM_x_modify take_min_len zip_take_triv2 min.commute) apply (rule corres_guard_imp) - apply (rule corres_split_nor[OF asUser_corres'], rule corres_trivial, simp) - apply (rule corres_modify') - apply (fastforce simp: fold_fun_upd[symmetric] msgRegisters_unfold - cong: if_cong simp del: the_index.simps) - apply ((wp |simp)+)[5] + apply (rule corres_split_nor[OF asUser_corres']) + apply (rule corres_modify') + apply (fastforce simp: fold_fun_upd[symmetric] msgRegisters_unfold + cong: if_cong simp del: the_index.simps) + apply ((wp |simp)+)[6] \ \buf = Some a\ using if_split[split del] apply (clarsimp simp: msgRegisters_unfold setRegister_def2 zipWithM_x_Nil zipWithM_x_modify @@ -3423,21 +3434,23 @@ proof - apply (simp add: msg_max_length_def) apply (rule corres_guard_imp) apply (rule corres_split_nor[OF asUser_corres']) - apply (rule corres_split_nor, rule corres_trivial, clarsimp simp: min.commute) - apply (rule_tac S="{((x, y), (x', y')). y = y' \ x' = (a + (of_nat x * 4)) \ x < unat max_ipc_words}" - in zipWithM_x_corres) - apply (fastforce intro: storeWordUser_corres) - apply wp+ - apply (clarsimp simp add: S msgMaxLength_def msg_max_length_def set_zip) - apply (simp add: wordSize_def wordBits_def word_size max_ipc_words - upt_Suc_append[symmetric] upto_enum_word) - apply simp - apply wp+ apply (rule corres_modify') apply (simp only: msgRegisters_unfold cong: if_cong) apply (fastforce simp: fold_fun_upd[symmetric]) - apply (wp | clarsimp simp: valid_ipc_buffer_ptr'_def)+ - done + apply clarsimp + apply (rule corres_split_nor) + apply (rule_tac S="{((x, y), (x', y')). y = y' \ x' = (a + (of_nat x * 4)) \ x < unat max_ipc_words}" + in zipWithM_x_corres) + apply (fastforce intro: storeWordUser_corres) + apply wp+ + apply (clarsimp simp add: S msgMaxLength_def msg_max_length_def set_zip) + apply (simp add: wordSize_def wordBits_def word_size max_ipc_words + upt_Suc_append[symmetric] upto_enum_word) + apply simp + apply (rule corres_trivial, clarsimp simp: min.commute) + apply wp+ + apply (wp | clarsimp simp: valid_ipc_buffer_ptr'_def)+ + done qed lemma copyMRs_corres: @@ -3503,23 +3516,24 @@ proof - apply (rename_tac sb_ptr rb_ptr) apply (rule corres_split_nor[OF as_user_bit]) apply (rule corres_split_eqr) - apply (rule corres_trivial, simp) - apply (rule_tac S="{(x, y). y = of_nat x \ x < unat max_ipc_words}" in corres_mapM, simp+) - apply (rule corres_split_eqr) - apply (rule storeWordUser_corres) - apply simp - apply (rule loadWordUser_corres) - apply simp - apply (wp hoare_vcg_all_lift | simp)+ - apply (clarsimp simp: upto_enum_def) - apply arith - apply (subst set_zip) - apply (simp add: upto_enum_def U del: upt.simps) - apply (clarsimp simp del: upt.simps) - apply (clarsimp simp: msg_max_length_def word_le_nat_alt nth_append - max_ipc_words) - apply (erule order_less_trans) - apply simp + apply (rule_tac S="{(x, y). y = of_nat x \ x < unat max_ipc_words}" + in corres_mapM, simp+) + apply (rule corres_split_eqr) + apply (rule loadWordUser_corres) + apply simp + apply (rule storeWordUser_corres) + apply simp + apply (wp hoare_vcg_all_lift | simp)+ + apply (clarsimp simp: upto_enum_def) + apply arith + apply (subst set_zip) + apply (simp add: upto_enum_def U del: upt.simps) + apply (clarsimp simp del: upt.simps) + apply (clarsimp simp: msg_max_length_def word_le_nat_alt nth_append + max_ipc_words) + apply (erule order_less_trans) + apply simp + apply (rule corres_trivial, simp) apply (wp hoare_vcg_all_lift mapM_wp' | simp add: valid_ipc_buffer_ptr'_def)+ done @@ -3606,39 +3620,39 @@ lemma lookupIPCBuffer_corres': apply (simp add: lookup_ipc_buffer_def ARM_HYP_H.lookupIPCBuffer_def) apply (rule corres_guard_imp) apply (rule corres_split_eqr[OF threadGet_corres]) - apply (simp add: getThreadBufferSlot_def locateSlot_conv) - apply (rule corres_split[OF getSlotCap_corres]) - apply (rule_tac F="valid_ipc_buffer_cap rv buffer_ptr" - in corres_gen_asm) - apply (rule_tac P="valid_cap rv" and Q="no_0_obj'" - in corres_assume_pre) - apply (simp add: Let_def split: cap.split arch_cap.split - split del: if_split cong: if_cong) - apply (safe, simp_all add: isCap_simps valid_ipc_buffer_cap_simps split:bool.split_asm)[1] - apply (rename_tac word rights vmpage_size option) - apply (subgoal_tac "word + (buffer_ptr && - mask (pageBitsForSize vmpage_size)) \ 0") - apply (simp add: cap_aligned_def - valid_ipc_buffer_cap_def - vmrights_map_def vm_read_only_def vm_read_write_def) - apply auto[1] - apply (subgoal_tac "word \ 0") - apply (subgoal_tac "word \ word + (buffer_ptr && - mask (pageBitsForSize vmpage_size))") - apply fastforce - apply (rule_tac b="2 ^ (pageBitsForSize vmpage_size) - 1" - in word_plus_mono_right2) - apply (clarsimp simp: valid_cap_def cap_aligned_def - intro!: is_aligned_no_overflow') - apply (clarsimp simp: word_bits_def - intro!: word_less_sub_1 and_mask_less') - apply (case_tac vmpage_size, simp_all)[1] - apply (drule state_relation_pspace_relation) - apply (clarsimp simp: valid_cap_def obj_at_def no_0_obj_kheap - obj_relation_cuts_def3 no_0_obj'_def split:if_split_asm) + apply (simp add: tcb_relation_def) + apply (simp add: getThreadBufferSlot_def locateSlot_conv) + apply (rule corres_split[OF getSlotCap_corres]) apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def tcbIPCBufferSlot_def) - apply (wp get_cap_valid_ipc get_cap_aligned)+ - apply (simp add: tcb_relation_def) + apply (rule_tac F="valid_ipc_buffer_cap rv buffer_ptr" + in corres_gen_asm) + apply (rule_tac P="valid_cap rv" and Q="no_0_obj'" + in corres_assume_pre) + apply (simp add: Let_def split: cap.split arch_cap.split + split del: if_split cong: if_cong) + apply (safe, simp_all add: isCap_simps valid_ipc_buffer_cap_simps split:bool.split_asm)[1] + apply (rename_tac word rights vmpage_size option) + apply (subgoal_tac "word + (buffer_ptr && + mask (pageBitsForSize vmpage_size)) \ 0") + apply (simp add: cap_aligned_def + valid_ipc_buffer_cap_def + vmrights_map_def vm_read_only_def vm_read_write_def) + apply auto[1] + apply (subgoal_tac "word \ 0") + apply (subgoal_tac "word \ word + (buffer_ptr && + mask (pageBitsForSize vmpage_size))") + apply fastforce + apply (rule_tac b="2 ^ (pageBitsForSize vmpage_size) - 1" + in word_plus_mono_right2) + apply (clarsimp simp: valid_cap_def cap_aligned_def + intro!: is_aligned_no_overflow') + apply (clarsimp simp: word_bits_def + intro!: word_less_sub_1 and_mask_less') + apply (case_tac vmpage_size, simp_all)[1] + apply (drule state_relation_pspace_relation) + apply (clarsimp simp: valid_cap_def obj_at_def no_0_obj_kheap + obj_relation_cuts_def3 no_0_obj'_def split:if_split_asm) + apply (wp get_cap_valid_ipc get_cap_aligned)+ apply (wp thread_get_obj_at_eq)+ apply (clarsimp elim!: tcb_at_cte_at) apply clarsimp @@ -4536,11 +4550,10 @@ lemma get_cap_corres_all_rights_P: apply (subst bind_return [symmetric]) apply (rule corres_guard_imp) apply (rule corres_split[OF get_cap_corres_P [where P=P]]) - defer - apply (wp getCTE_wp')+ - apply simp - apply fastforce - apply (insert cap_relation_masks, simp) + apply (insert cap_relation_masks, simp) + apply (wp getCTE_wp')+ + apply simp + apply fastforce done lemma asUser_irq_handlers': diff --git a/proof/refine/ARM_HYP/Tcb_R.thy b/proof/refine/ARM_HYP/Tcb_R.thy index b59edf46f..51f89b22b 100644 --- a/proof/refine/ARM_HYP/Tcb_R.thy +++ b/proof/refine/ARM_HYP/Tcb_R.thy @@ -68,8 +68,8 @@ lemma bindNotification_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF getNotification_corres]) apply (rule corres_split[OF setNotification_corres]) - apply (rule setBoundNotification_corres) - apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) + apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits) + apply (rule setBoundNotification_corres) apply (wp)+ apply auto done @@ -213,8 +213,10 @@ lemma restart_corres: apply (rule corres_split_nor[OF cancel_ipc_corres]) apply (rule corres_split_nor[OF setupReplyMaster_corres]) apply (rule corres_split_nor[OF setThreadState_corres]) - apply (rule corres_split[OF tcbSchedEnqueue_corres possibleSwitchTo_corres]) - apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_valid_queues sts_st_tcb' | clarsimp simp: valid_tcb_state'_def)+ + apply clarsimp + apply (rule corres_split[OF tcbSchedEnqueue_corres possibleSwitchTo_corres]) + apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_valid_queues sts_st_tcb' + | clarsimp simp: valid_tcb_state'_def)+ apply (rule_tac Q="\rv. valid_sched and cur_tcb" in hoare_strengthen_post) apply wp apply (simp add: valid_sched_def valid_sched_action_def) @@ -226,7 +228,6 @@ lemma restart_corres: apply (clarsimp simp add: invs'_def valid_state'_def sch_act_wf_weak) done - lemma restart_invs': "\invs' and ex_nonz_cap_to' t and (\s. t \ ksIdleThread s)\ ThreadDecls_H.restart t \\rv. invs'\" @@ -282,18 +283,17 @@ lemma invokeTCB_ReadRegisters_corres: frameRegisters_def gpRegisters_def) apply (rule corres_guard_imp) apply (rule corres_split_nor) - apply (rule corres_split[OF getCurThread_corres]) - apply (simp add: liftM_def[symmetric]) - apply (rule asUser_corres) - apply (rule corres_Id) - apply simp + apply (rule corres_when[OF refl]) + apply (rule suspend_corres) + apply (rule corres_split[OF getCurThread_corres]) + apply (simp add: liftM_def[symmetric]) + apply (rule asUser_corres) + apply (rule corres_Id) apply simp - apply (rule no_fail_mapM) - apply (simp add: no_fail_getRegister) - apply wp+ - apply (rule corres_when [OF refl]) - apply (rule suspend_corres) - apply wp+ + apply simp + apply (rule no_fail_mapM) + apply (simp add: no_fail_getRegister) + apply wp+ apply (clarsimp simp: invs_def valid_state_def valid_pspace_def dest!: idle_no_ex_cap) apply (clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap) @@ -403,12 +403,12 @@ proof - apply clarsimp apply (rule corres_guard_imp) apply (rule corres_split_eqr) + apply (rule asUser_getRegister_corres) apply (simp add: setRegister_def) apply (rule asUser_corres) apply (rule corres_modify') apply simp apply simp - apply (rule asUser_getRegister_corres) apply (simp | wp)+ done have R: "\src src' des des' xs ys. \ src = src'; des = des'; xs = ys \ \ @@ -439,36 +439,36 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split[OF corres_when [OF refl suspend_corres]], simp) apply (rule corres_split[OF corres_when [OF refl restart_corres]], simp) + apply (rule corres_split_nor) + apply (rule corres_when[OF refl]) apply (rule corres_split_nor) - apply (rule corres_split_nor) - apply (rule corres_split_eqr[OF getCurThread_corres]) - apply (rule corres_split_nor[OF asUser_postModifyRegisters_corres[simplified]]) - apply (rule corres_split[OF corres_when[OF refl rescheduleRequired_corres]]) - apply (rule_tac P=\ and P'=\ in corres_inst) - apply simp - apply (wp static_imp_wp)+ + apply (rule R[OF refl refl]) + apply (simp add: frame_registers_def frameRegisters_def) + apply (simp add: getRestartPC_def setNextPC_def dc_def[symmetric]) + apply (rule Q[OF refl refl]) + apply (wp mapM_x_wp' static_imp_wp | simp)+ + apply (rule corres_split_nor) apply (rule corres_when[OF refl]) apply (rule R[OF refl refl]) apply (simp add: gpRegisters_def) - apply (rule_tac Q="\_. einvs and tcb_at dest" in hoare_strengthen_post[rotated]) - apply (clarsimp simp: invs_def valid_sched_weak_strg valid_sched_def) - prefer 2 - apply (rule_tac Q="\_. invs' and tcb_at' dest" in hoare_strengthen_post[rotated]) - apply (clarsimp simp: invs'_def valid_state'_def invs_weak_sch_act_wf) - apply (wp mapM_x_wp' | simp)+ - apply (rule corres_when[OF refl]) - apply (rule corres_split_nor) - apply (simp add: getRestartPC_def setNextPC_def dc_def[symmetric]) - apply (rule Q[OF refl refl]) - apply (rule R[OF refl refl]) - apply (simp add: frame_registers_def frameRegisters_def) + apply (rule corres_split_eqr[OF getCurThread_corres]) + apply (rule corres_split_nor[OF asUser_postModifyRegisters_corres[simplified]]) + apply (rule corres_split[OF corres_when[OF refl rescheduleRequired_corres]]) + apply (rule_tac P=\ and P'=\ in corres_inst) + apply simp + apply (solves \wp static_imp_wp\)+ + apply (rule_tac Q="\_. einvs and tcb_at dest" in hoare_strengthen_post[rotated]) + apply (clarsimp simp: invs_def valid_sched_weak_strg valid_sched_def) + prefer 2 + apply (rule_tac Q="\_. invs' and tcb_at' dest" in hoare_strengthen_post[rotated]) + apply (clarsimp simp: invs'_def valid_state'_def invs_weak_sch_act_wf) apply ((wp mapM_x_wp' static_imp_wp | simp)+)[4] apply ((wp static_imp_wp restart_invs' | wpc | clarsimp simp add: if_apply_def2)+)[2] apply (wp suspend_nonz_cap_to_tcb static_imp_wp | simp add: if_apply_def2)+ - apply (fastforce simp: invs_def valid_state_def valid_pspace_def - dest!: idle_no_ex_cap) - apply (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap) - done + apply (fastforce simp: invs_def valid_state_def valid_pspace_def + dest!: idle_no_ex_cap) + apply (fastforce simp: invs'_def valid_state'_def dest!: global'_no_ex_cap) + done qed lemma readreg_invs': @@ -626,19 +626,19 @@ lemma sp_corres2: apply (rule stronger_corres_guard_imp) apply (rule corres_split[OF tcbSchedDequeue_corres]) apply (rule corres_split[OF ethread_set_corres], simp_all)[1] - apply (rule corres_split[OF isRunnable_corres]) - apply (erule corres_when) - apply(rule corres_split[OF getCurThread_corres]) - apply (wp corres_if; clarsimp) - apply (rule rescheduleRequired_corres) - apply (rule possibleSwitchTo_corres) - apply wp + apply (simp add: etcb_relation_def) + apply (rule corres_split[OF isRunnable_corres]) + apply (erule corres_when) + apply(rule corres_split[OF getCurThread_corres]) + apply (wp corres_if; clarsimp) + apply (rule rescheduleRequired_corres) + apply (rule possibleSwitchTo_corres) apply wp - apply clarsimp - apply (wp static_imp_wp hoare_vcg_if_lift hoare_wp_combs gts_wp) + apply wp apply clarsimp - apply (wp hoare_vcg_if_lift static_imp_wp hoare_wp_combs isRunnable_wp) - apply (simp add: etcb_relation_def) + apply (wp static_imp_wp hoare_vcg_if_lift hoare_wp_combs gts_wp) + apply clarsimp + apply (wp hoare_vcg_if_lift static_imp_wp hoare_wp_combs isRunnable_wp) apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift) apply clarsimp apply (wp hoare_drop_imps) @@ -1428,19 +1428,18 @@ proof - apply (case_tac b, simp_all add: newroot_rel_def) apply (rule corres_guard_imp) apply (rule corres_split_norE) - apply (rule_tac F="is_aligned aa msg_align_bits" in corres_gen_asm2) - apply (rule corres_split_nor) - apply (rule corres_split[OF getCurThread_corres], clarsimp) - apply (rule corres_when[OF refl rescheduleRequired_corres]) - apply (wpsimp wp: gct_wp)+ + apply (rule cteDelete_corres) + apply (rule_tac F="is_aligned aa msg_align_bits" in corres_gen_asm2) + apply (rule corres_split_nor) apply (rule threadset_corres, (simp add: tcb_relation_def), (simp add: exst_same_def)+)[1] - apply (wp hoare_drop_imp) - apply (rule threadcontrol_corres_helper1[unfolded pred_conj_def]) + apply (rule corres_split[OF getCurThread_corres], clarsimp) + apply (rule corres_when[OF refl rescheduleRequired_corres]) + apply (wpsimp wp: gct_wp)+ apply (wp hoare_drop_imp) - apply (wp threadcontrol_corres_helper2 | wpc | simp)+ - apply (rule cteDelete_corres) - apply wp + apply (rule threadcontrol_corres_helper1[unfolded pred_conj_def]) + apply (wp hoare_drop_imp) + apply (wp threadcontrol_corres_helper2 | wpc | simp)+ apply (wpsimp wp: cteDelete_invs' hoare_vcg_conj_lift) apply (fastforce simp: emptyable_def) apply fastforce @@ -1450,15 +1449,15 @@ proof - apply (rule_tac F="is_aligned aa msg_align_bits" in corres_gen_asm) apply (rule_tac F="isArchObjectCap ac" in corres_gen_asm2) apply (rule corres_split_nor) - apply (rule corres_split_nor) - apply (rule corres_split[OF getCurThread_corres], clarsimp) - apply (rule corres_when[OF refl rescheduleRequired_corres]) - apply (wp gct_wp)+ + apply (rule threadset_corres, + simp add: tcb_relation_def, (simp add: exst_same_def)+) + apply (rule corres_split_nor) apply (erule checkCapAt_cteInsert_corres) - apply (wp hoare_drop_imp threadcontrol_corres_helper3)[1] - apply (wp hoare_drop_imp threadcontrol_corres_helper4)[1] - apply (rule threadset_corres, - simp add: tcb_relation_def, (simp add: exst_same_def)+) + apply (rule corres_split[OF getCurThread_corres], clarsimp) + apply (rule corres_when[OF refl rescheduleRequired_corres]) + apply (wp gct_wp)+ + apply (wp hoare_drop_imp threadcontrol_corres_helper3)[1] + apply (wp hoare_drop_imp threadcontrol_corres_helper4)[1] apply (wp thread_set_tcb_ipc_buffer_cap_cleared_invs thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched | simp add: ran_tcb_cap_cases)+ @@ -1533,11 +1532,11 @@ proof - apply (rule corres_split_norE[OF T [OF x U], simplified]) apply (rule corres_split_norE[OF T [OF y V], simplified]) apply (rule corres_split_norE) - apply (rule corres_split_nor[OF S, simplified]) - apply (rule corres_returnOkTT, simp) - apply wp + apply (rule T2[simplified]) + apply (rule corres_split_nor[OF S, simplified]) + apply (rule corres_returnOkTT, simp) apply wp - apply (rule T2[simplified]) + apply wp apply (wpsimp wp: hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift hoare_vcg_all_lift_R hoare_vcg_all_lift as_user_invs cap_delete_deletes thread_set_ipc_tcb_cap_valid thread_set_tcb_ipc_buffer_cap_cleared_invs @@ -1842,9 +1841,9 @@ lemma invokeTCB_corres: apply (rule corres_split[OF TcbAcc_R.asUser_setRegister_corres]) apply (rule corres_split[OF Bits_R.getCurThread_corres]) apply (rule corres_split[OF Corres_UL.corres_when]) - apply (rule corres_trivial, simp) - apply simp - apply (rule TcbAcc_R.rescheduleRequired_corres) + apply simp + apply (rule TcbAcc_R.rescheduleRequired_corres) + apply (rule corres_trivial, simp) apply (wpsimp wp: hoare_drop_imp)+ apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs) apply (clarsimp simp: Tcb_R.invs_valid_queues' Invariants_H.invs_queues) @@ -2050,16 +2049,16 @@ lemma checkPrio_corres: apply (simp add: check_prio_def checkPrio_def) apply (rule corres_guard_imp) apply (simp add: liftE_bindE) - apply (rule corres_split[OF threadGet_corres]) - apply (rule_tac rvr = dc and - R = \ and - R' = \ in - whenE_throwError_corres'[where m="returnOk ()" and m'="returnOk ()", simplified]) - apply (simp add: minPriority_def) - apply (clarsimp simp: minPriority_def) - apply (rule corres_returnOkTT) - apply (simp add: minPriority_def) - apply (simp add: tcb_relation_def) + apply (rule corres_split[OF threadGet_corres[where r="(=)"]]) + apply (clarsimp simp: tcb_relation_def) + apply (rule_tac rvr = dc and + R = \ and + R' = \ in + whenE_throwError_corres'[where m="returnOk ()" and m'="returnOk ()", simplified]) + apply (simp add: minPriority_def) + apply (clarsimp simp: minPriority_def) + apply (rule corres_returnOkTT) + apply (simp add: minPriority_def) apply (wp gct_wp)+ apply (simp add: cur_tcb_def cur_tcb'_def)+ done @@ -2076,11 +2075,11 @@ lemma decodeSetPriority_corres: clarsimp simp: decode_set_priority_def decodeSetPriority_def) apply (rename_tac auth_cap auth_slot auth_path rest auth_cap' rest') apply (rule corres_split_eqrE) - apply (rule corres_splitEE[OF checkPrio_corres]) - apply (rule corres_returnOkTT) - apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2)) - apply wpsimp+ - apply (corressimp simp: valid_cap_def valid_cap'_def)+ + apply corressimp + apply (rule corres_splitEE[OF checkPrio_corres]) + apply (rule corres_returnOkTT) + apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2)) + apply (wpsimp simp: valid_cap_def valid_cap'_def)+ done lemma decodeSetMCPriority_corres: @@ -2095,11 +2094,11 @@ lemma decodeSetMCPriority_corres: clarsimp simp: decode_set_mcpriority_def decodeSetMCPriority_def) apply (rename_tac auth_cap auth_slot auth_path rest auth_cap' rest') apply (rule corres_split_eqrE) - apply (rule corres_splitEE[OF checkPrio_corres]) - apply (rule corres_returnOkTT) - apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2)) - apply wpsimp+ - apply (corressimp simp: valid_cap_def valid_cap'_def)+ + apply corressimp + apply (rule corres_splitEE[OF checkPrio_corres]) + apply (rule corres_returnOkTT) + apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2)) + apply (wpsimp simp: valid_cap_def valid_cap'_def)+ done lemma valid_objs'_maxPriority': @@ -2212,12 +2211,13 @@ lemma decodeSetSchedParams_corres: apply (clarsimp split: list.split simp: list_all2_Cons2) apply (clarsimp simp: list_all2_Cons1 neq_Nil_conv val_le_length_Cons linorder_not_less) apply (rule corres_split_eqrE) - apply (rule corres_split_norE[OF checkPrio_corres]) - apply (rule corres_splitEE[OF checkPrio_corres]) - apply (rule corres_returnOkTT) - apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2)) - apply (wpsimp wp: check_prio_inv checkPrio_inv)+ - apply (corressimp simp: valid_cap_def valid_cap'_def)+ + apply corressimp + apply (rule corres_split_norE[OF checkPrio_corres]) + apply (rule corres_splitEE[OF checkPrio_corres]) + apply (rule corres_returnOkTT) + apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2)) + apply (wpsimp wp: check_prio_inv checkPrio_inv + simp: valid_cap_def valid_cap'_def)+ done lemma checkValidIPCBuffer_corres: @@ -2273,7 +2273,8 @@ lemma decodeSetIPCBuffer_corres: split del: if_split) apply (clarsimp simp add: returnOk_def newroot_rel_def) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF deriveCap_corres]) + apply (rule corres_splitEE) + apply (rule deriveCap_corres; simp) apply (simp add: o_def newroot_rel_def split_def dc_def[symmetric]) apply (erule checkValidIPCBuffer_corres) apply (wp hoareE_TrueI | simp)+ @@ -2372,55 +2373,56 @@ lemma decodeSetSpace_corres: apply (cases "3 \ length args \ 2 \ length extras'") apply (clarsimp simp: val_le_length_Cons list_all2_Cons2 split del: if_split) - apply (simp add: liftE_bindE liftM_def + apply (simp add: liftE_bindE liftM_def unlessE_whenE getThreadCSpaceRoot getThreadVSpaceRoot split del: if_split) apply (rule corres_guard_imp) apply (rule corres_split[OF slotCapLongRunningDelete_corres]) - apply (rule corres_split[OF slotCapLongRunningDelete_corres]) - apply (rule corres_split_norE) - apply (simp(no_asm) add: split_def unlessE_throwError_returnOk - bindE_assoc cap_CNode_case_throw - split del: if_split) - apply (rule corres_splitEE[OF deriveCap_corres]) - apply (rule corres_split_norE) - apply (rule corres_splitEE[OF deriveCap_corres]) - apply (rule corres_split_norE) - apply (rule corres_trivial) - apply (clarsimp simp: returnOk_def newroot_rel_def is_cap_simps - list_all2_conv_all_nth split_def) - apply (unfold unlessE_whenE) - apply (rule corres_whenE) - apply (case_tac vroot_cap', simp_all add: - is_valid_vtable_root_def isValidVTableRoot_def - ARM_HYP_H.isValidVTableRoot_def)[1] - apply (rename_tac arch_cap) - apply (clarsimp, case_tac arch_cap, simp_all)[1] - apply (simp split: option.split) - apply (rule corres_trivial, simp) - apply simp - apply wp+ - apply (clarsimp simp: cap_map_update_data) - apply simp - apply ((simp only: simp_thms pred_conj_def | wp)+)[2] + apply (clarsimp simp: is_cap_simps get_tcb_ctable_ptr_def cte_map_tcb_0) + apply (rule corres_split[OF slotCapLongRunningDelete_corres]) + apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified] objBits_defs) + apply (rule corres_split_norE) + apply (rule corres_whenE) + apply simp + apply (rule corres_trivial, simp) + apply simp + apply (simp(no_asm) add: split_def unlessE_throwError_returnOk + bindE_assoc cap_CNode_case_throw unlessE_whenE + split del: if_split) + apply (rule corres_splitEE) + apply (rule deriveCap_corres) + apply (clarsimp simp: cap_map_update_data) + apply simp + apply (rule corres_split_norE) + apply (rule corres_whenE) + apply simp + apply (rule corres_trivial, simp) + apply simp + apply (rule corres_splitEE) + apply (rule deriveCap_corres) + apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data) + apply simp + apply (rule corres_split_norE) + apply (unfold unlessE_whenE) apply (rule corres_whenE) - apply simp + apply (case_tac vroot_cap', simp_all add: + is_valid_vtable_root_def isValidVTableRoot_def + ARM_HYP_H.isValidVTableRoot_def)[1] + apply (rename_tac arch_cap) + apply (clarsimp, case_tac arch_cap, simp_all)[1] + apply (simp split: option.split) apply (rule corres_trivial, simp) apply simp - apply (unfold whenE_def, wp+)[2] - apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data) - apply (fastforce dest: list_all2_nthD2[where p=0]) - apply ((simp split del: if_split | wp | rule hoare_drop_imps)+)[2] - apply (rule corres_whenE) - apply simp - apply (rule corres_trivial, simp) - apply simp - apply (unfold whenE_def, wp+)[2] - apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified] objBits_defs) - apply simp - apply (wp hoare_drop_imps)+ - apply (clarsimp simp: is_cap_simps get_tcb_ctable_ptr_def cte_map_tcb_0) - apply wp+ + apply (rule corres_trivial) + apply (clarsimp simp: returnOk_def newroot_rel_def is_cap_simps + list_all2_conv_all_nth split_def) + apply wp+ + apply ((simp only: simp_thms pred_conj_def | wp)+)[2] + apply (unfold whenE_def, wp+)[2] + apply ((simp split del: if_split | wp | rule hoare_drop_imps)+)[2] + apply (unfold whenE_def, wp+)[2] + apply simp + apply (wp hoare_drop_imps)+ apply (clarsimp simp: get_tcb_ctable_ptr_def get_tcb_vtable_ptr_def is_cap_simps valid_cap_def tcb_at_cte_at_0 tcb_at_cte_at_1[simplified]) @@ -2511,14 +2513,16 @@ lemma decodeTCBConfigure_corres: apply (clarsimp simp: linorder_not_less val_le_length_Cons list_all2_Cons1 priorityBits_def) apply (rule corres_guard_imp) - apply (rule corres_splitEE[OF decodeSetIPCBuffer_corres]) - apply (rule corres_splitEE[OF decodeSetSpace_corres]) - apply (rule_tac F="is_thread_control set_params" in corres_gen_asm) - apply (rule_tac F="is_thread_control set_space" in corres_gen_asm) - apply (rule_tac F="tcThreadCapSlot setSpace = cte_map slot" in corres_gen_asm2) - apply (rule corres_trivial) - apply (clarsimp simp: returnOk_def is_thread_control_def2 is_cap_simps) - apply (wp | simp add: invs_def valid_sched_def)+ + apply (rule corres_splitEE) + apply (rule decodeSetIPCBuffer_corres; simp) + apply (rule corres_splitEE) + apply (rule decodeSetSpace_corres; simp) + apply (rule_tac F="is_thread_control set_params" in corres_gen_asm) + apply (rule_tac F="is_thread_control set_space" in corres_gen_asm) + apply (rule_tac F="tcThreadCapSlot setSpace = cte_map slot" in corres_gen_asm2) + apply (rule corres_trivial) + apply (clarsimp simp: returnOk_def is_thread_control_def2 is_cap_simps) + apply (wp | simp add: invs_def valid_sched_def)+ done lemma isThreadControl_def2: @@ -2568,15 +2572,14 @@ lemma tcb_real_cte_16: by (clarsimp simp: obj_at'_def projectKOs objBitsKO_def ps_clear_16) lemma corres_splitEE': + assumes x: "corres_underlying sr nf nf' (f \ r') P P' a c" assumes y: "\x y x' y'. r' (x, y) (x', y') \ corres_underlying sr nf nf' (f \ r) (R x y) (R' x' y') (b x y) (d x' y')" - assumes "corres_underlying sr nf nf' (f \ r') P P' a c" - assumes x: "\Q\ a \%(x, y). R x y \,\\\\" "\Q'\ c \%(x, y). R' x y\,\\\\" + assumes z: "\Q\ a \%(x, y). R x y \,\\\\" "\Q'\ c \%(x, y). R' x y\,\\\\" shows "corres_underlying sr nf nf' (f \ r) (P and Q) (P' and Q') (a >>=E (\(x, y). b x y)) (c >>=E (\(x, y). d x y))" using assms apply (unfold bindE_def validE_def split_def) - apply (rule corres_split_deprecated) - defer + apply (rule corres_split[rotated 2]) apply assumption+ apply (case_tac rv) apply (clarsimp simp: lift_def y)+ @@ -2594,33 +2597,32 @@ notes if_cong[cong] shows apply (simp add: null_def returnOk_def) apply (rule corres_guard_imp) apply (rule corres_split_norE) - apply (rule_tac F="extras \ []" in corres_gen_asm) - apply (rule corres_split_eqrE) - apply (rule corres_split_norE) - apply (rule corres_splitEE'[where r'="\rv rv'. ((fst rv) = (fst rv')) \ ((snd rv') = (AllowRead \ (snd rv)))"]) - apply (rule corres_split_norE) - apply (clarsimp split del: if_split) - apply (rule corres_splitEE[where r'=ntfn_relation]) - apply (rule corres_trivial, simp split del: if_split) - apply (simp add: ntfn_relation_def - split: Structures_A.ntfn.splits Structures_H.ntfn.splits - option.splits) - apply simp - apply (rule getNotification_corres) - apply wp+ - apply (rule corres_trivial, clarsimp simp: whenE_def returnOk_def) - apply (wp | simp add: whenE_def split del: if_split)+ - apply (rule corres_trivial, simp) - apply (case_tac extras, simp, clarsimp simp: list_all2_Cons1) - apply (fastforce split: cap.splits capability.splits simp: returnOk_def) - apply (wp | wpc | simp)+ - apply (rule corres_trivial, simp split: option.splits add: returnOk_def) - apply (wp | wpc | simp)+ + apply (rule corres_trivial) + apply (auto simp: returnOk_def whenE_def)[1] + apply (rule_tac F="extras \ []" in corres_gen_asm) + apply (rule corres_split_eqrE) + apply simp apply (rule getBoundNotification_corres) - apply (simp | wp gbn_wp gbn_wp')+ - apply (rule corres_trivial) - apply (auto simp: returnOk_def whenE_def)[1] - apply (simp add: whenE_def split del: if_split | wp)+ + apply (rule corres_split_norE) + apply (rule corres_trivial, simp split: option.splits add: returnOk_def) + apply (rule corres_splitEE'[where r'="\rv rv'. ((fst rv) = (fst rv')) \ ((snd rv') = (AllowRead \ (snd rv)))"]) + apply (rule corres_trivial, simp) + apply (case_tac extras, simp, clarsimp simp: list_all2_Cons1) + apply (fastforce split: cap.splits capability.splits simp: returnOk_def) + apply (rule corres_split_norE) + apply (rule corres_trivial, clarsimp simp: whenE_def returnOk_def) + apply (clarsimp split del: if_split) + apply (rule corres_splitEE[where r'=ntfn_relation]) + apply simp + apply (rule getNotification_corres) + apply (rule corres_trivial, simp split del: if_split) + apply (simp add: ntfn_relation_def + split: Structures_A.ntfn.splits Structures_H.ntfn.splits + option.splits) + apply wp+ + apply (wp | simp add: whenE_def split del: if_split)+ + apply (wp | wpc | simp)+ + apply (simp | wp gbn_wp gbn_wp')+ apply (fastforce simp: valid_cap_def valid_cap'_def dest: hd_in_set)+ done @@ -2633,11 +2635,11 @@ lemma decodeUnbindNotification_corres: apply (simp add: decode_unbind_notification_def decodeUnbindNotification_def) apply (rule corres_guard_imp) apply (rule corres_split_eqrE) - apply (rule corres_trivial) - apply (simp split: option.splits) - apply (simp add: returnOk_def) - apply simp - apply (rule getBoundNotification_corres) + apply simp + apply (rule getBoundNotification_corres) + apply (rule corres_trivial) + apply (simp split: option.splits) + apply (simp add: returnOk_def) apply wp+ apply auto done diff --git a/proof/refine/ARM_HYP/Untyped_R.thy b/proof/refine/ARM_HYP/Untyped_R.thy index a12ccbad2..227aff292 100644 --- a/proof/refine/ARM_HYP/Untyped_R.thy +++ b/proof/refine/ARM_HYP/Untyped_R.thy @@ -87,14 +87,13 @@ lemma corres_check_no_children: apply (clarsimp simp:const_on_failure_def constOnFailure_def) apply (rule corres_guard_imp) apply (rule corres_split_catch[where E = dc and E'=dc]) - apply simp - apply (rule corres_guard_imp[OF corres_splitEE]) - apply (rule corres_returnOkTT) - apply simp - apply (rule ensureNoChildren_corres) - apply simp - apply wp+ - apply simp+ + apply (rule corres_guard_imp[OF corres_splitEE]) + apply (rule ensureNoChildren_corres) + apply simp + apply (rule corres_returnOkTT) + apply simp + apply wp+ + apply simp+ apply (clarsimp simp:dc_def,wp)+ apply simp apply simp @@ -297,108 +296,108 @@ next apply (rule whenE_throwError_corres, simp) apply (clarsimp simp: fromAPIType_def ARM_HYP_H.fromAPIType_def) apply (rule_tac r' = "\cap cap'. cap_relation cap cap'" in corres_splitEE[OF corres_if]) - apply (rule_tac corres_split_norE) - apply (rule corres_if) - apply simp - apply (rule corres_returnOk,clarsimp) - apply (rule corres_trivial) - apply (clarsimp simp: fromAPIType_def lookup_failure_map_def) - apply (rule_tac F="is_cnode_cap rva \ cap_aligned rva" in corres_gen_asm) - apply (subgoal_tac "is_aligned (obj_ref_of rva) (bits_of rva) \ bits_of rva < 32") - prefer 2 - apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def word_bits_def - is_aligned_weaken) - apply (rule whenE_throwError_corres) - apply (clarsimp simp:Kernel_Config.retypeFanOutLimit_def is_cap_simps bits_of_def)+ - apply (simp add: unat_arith_simps(2) unat_2p_sub_1 word_bits_def) - apply (rule whenE_throwError_corres) - apply (clarsimp simp:Kernel_Config.retypeFanOutLimit_def is_cap_simps bits_of_def)+ - apply (simp add: unat_eq_0 word_less_nat_alt) - apply (rule whenE_throwError_corres) - apply (clarsimp simp:Kernel_Config.retypeFanOutLimit_def is_cap_simps bits_of_def)+ - apply (clarsimp simp:toInteger_word unat_arith_simps(2) cap_aligned_def) - apply (subst unat_sub) - apply (simp add: linorder_not_less word_le_nat_alt) - apply (fold neq0_conv) - apply (simp add: unat_eq_0 cap_aligned_def) - apply (clarsimp simp:fromAPIType_def) - apply (clarsimp simp:liftE_bindE mapM_locate_eq) - apply (subgoal_tac "unat (arg4 + arg5) = unat arg4 + unat arg5") - prefer 2 - apply (clarsimp simp:not_less) - apply (subst unat_word_ariths(1)) - apply (rule mod_less) - apply (unfold word_bits_len_of)[1] - apply (subgoal_tac "2 ^ bits_of rva < (2 :: nat) ^ word_bits") - apply arith - apply (rule power_strict_increasing, simp add: word_bits_conv) - apply simp - apply (rule_tac P'="valid_cap rva" in corres_stateAssert_implied) - apply (frule_tac bits2 = "bits_of rva" in YUCK) - apply (simp) - apply (simp add: word_bits_conv) - apply (simp add: word_le_nat_alt) - apply (simp add: word_le_nat_alt) - apply (simp add:liftE_bindE[symmetric] free_index_of_def) - apply (rule corres_split_norE) - apply (subst liftE_bindE)+ - apply (rule corres_split_eqr[OF corres_check_no_children]) - apply (simp only: free_index_of_def cap.simps if_res_def[symmetric]) - apply (rule_tac F="if_res reset \ 2 ^ n" in corres_gen_asm) - apply (rule whenE_throwError_corres) - apply (clarsimp simp:shiftL_nat word_less_nat_alt shiftr_div_2n' - split del: if_split)+ - apply (simp add: word_of_nat_le another) - apply (drule_tac x = "if_res reset" in unat_of_nat32[OF le_less_trans]) - apply (simp add:ty_size shiftR_nat)+ - apply (simp add:unat_of_nat32 le_less_trans[OF div_le_dividend] - le_less_trans[OF diff_le_self]) - apply (rule whenE_throwError_corres) - apply (clarsimp) - apply (clarsimp simp: fromAPIType_def) - apply (rule corres_returnOkTT) - apply (clarsimp simp:ty_size getFreeRef_def get_free_ref_def is_cap_simps) - apply simp - apply (strengthen if_res_2n, wp) - apply simp - apply wp - apply (clarsimp simp:is_cap_simps simp del:ser_def) - apply (simp add: mapME_x_map_simp del: ser_def) - apply (rule_tac P = "valid_cap (cap.CNodeCap r bits g) and invs" in corres_guard_imp [where P' = invs']) - apply (rule mapME_x_corres_inv [OF _ _ _ refl]) - apply (simp del: ser_def) - apply (rule ensureEmptySlot_corres) - apply (clarsimp simp: is_cap_simps) - apply (simp, wp) - apply (simp, wp) - apply clarsimp - apply (clarsimp simp add: xs is_cap_simps bits_of_def valid_cap_def) - apply (erule cap_table_at_cte_at) - apply (simp add: nat_to_cref_def word_bits_conv) - apply simp - apply (wp mapME_x_inv_wp - validE_R_validE[OF valid_validE_R[OF ensure_empty_inv]] - validE_R_validE[OF valid_validE_R[OF ensureEmpty_inv]])+ - apply (clarsimp simp: is_cap_simps valid_cap_simps - cap_table_at_gsCNodes bits_of_def - linorder_not_less) - apply (erule order_le_less_trans) - apply (rule word_leq_le_minus_one) - apply (simp add: word_le_nat_alt) - apply (simp add: unat_arith_simps) - apply wp+ - apply simp - apply (rule corres_returnOkTT) - apply (rule crel) - apply simp - apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) + apply simp + apply (rule corres_returnOkTT) + apply (rule crel) + apply simp + apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres]) + apply (rule crel) apply simp - apply (rule getSlotCap_corres,simp) - apply (rule crel) - apply simp - apply (wp lookup_slot_for_cnode_op_inv - hoare_drop_impE_R hoare_vcg_all_lift_R - | clarsimp)+ + apply simp + apply (rule getSlotCap_corres,simp) + apply (wp lookup_slot_for_cnode_op_inv)+ + apply (rule_tac corres_split_norE) + apply (rule corres_if) + apply simp + apply (rule corres_returnOk,clarsimp) + apply (rule corres_trivial) + apply (clarsimp simp: fromAPIType_def lookup_failure_map_def) + apply (rule_tac F="is_cnode_cap rva \ cap_aligned rva" in corres_gen_asm) + apply (subgoal_tac "is_aligned (obj_ref_of rva) (bits_of rva) \ bits_of rva < 32") + prefer 2 + apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def word_bits_def + is_aligned_weaken) + apply (rule whenE_throwError_corres) + apply (clarsimp simp:Kernel_Config.retypeFanOutLimit_def is_cap_simps bits_of_def)+ + apply (simp add: unat_arith_simps(2) unat_2p_sub_1 word_bits_def) + apply (rule whenE_throwError_corres) + apply (clarsimp simp:Kernel_Config.retypeFanOutLimit_def is_cap_simps bits_of_def)+ + apply (simp add: unat_eq_0 word_less_nat_alt) + apply (rule whenE_throwError_corres) + apply (clarsimp simp:Kernel_Config.retypeFanOutLimit_def is_cap_simps bits_of_def)+ + apply (clarsimp simp:toInteger_word unat_arith_simps(2) cap_aligned_def) + apply (subst unat_sub) + apply (simp add: linorder_not_less word_le_nat_alt) + apply (fold neq0_conv) + apply (simp add: unat_eq_0 cap_aligned_def) + apply (clarsimp simp:fromAPIType_def) + apply (clarsimp simp:liftE_bindE mapM_locate_eq) + apply (subgoal_tac "unat (arg4 + arg5) = unat arg4 + unat arg5") + prefer 2 + apply (clarsimp simp:not_less) + apply (subst unat_word_ariths(1)) + apply (rule mod_less) + apply (unfold word_bits_len_of)[1] + apply (subgoal_tac "2 ^ bits_of rva < (2 :: nat) ^ word_bits") + apply arith + apply (rule power_strict_increasing, simp add: word_bits_conv) + apply simp + apply (rule_tac P'="valid_cap rva" in corres_stateAssert_implied) + apply (frule_tac bits2 = "bits_of rva" in YUCK) + apply (simp) + apply (simp add: word_bits_conv) + apply (simp add: word_le_nat_alt) + apply (simp add: word_le_nat_alt) + apply (simp add:liftE_bindE[symmetric] free_index_of_def) + apply (rule corres_split_norE) + apply (clarsimp simp:is_cap_simps simp del:ser_def) + apply (simp add: mapME_x_map_simp del: ser_def) + apply (rule_tac P = "valid_cap (cap.CNodeCap r bits g) and invs" in corres_guard_imp [where P' = invs']) + apply (rule mapME_x_corres_inv [OF _ _ _ refl]) + apply (simp del: ser_def) + apply (rule ensureEmptySlot_corres) + apply (clarsimp simp: is_cap_simps) + apply (simp, wp) + apply (simp, wp) + apply clarsimp + apply (clarsimp simp add: xs is_cap_simps bits_of_def valid_cap_def) + apply (erule cap_table_at_cte_at) + apply (simp add: nat_to_cref_def word_bits_conv) + apply simp + apply (subst liftE_bindE)+ + apply (rule corres_split_eqr[OF corres_check_no_children]) + apply (simp only: free_index_of_def cap.simps if_res_def[symmetric]) + apply (rule_tac F="if_res reset \ 2 ^ n" in corres_gen_asm) + apply (rule whenE_throwError_corres) + apply (clarsimp simp:shiftL_nat word_less_nat_alt shiftr_div_2n' + split del: if_split)+ + apply (simp add: word_of_nat_le another) + apply (drule_tac x = "if_res reset" in unat_of_nat32[OF le_less_trans]) + apply (simp add:ty_size shiftR_nat)+ + apply (simp add:unat_of_nat32 le_less_trans[OF div_le_dividend] + le_less_trans[OF diff_le_self]) + apply (rule whenE_throwError_corres) + apply (clarsimp) + apply (clarsimp simp: fromAPIType_def) + apply (rule corres_returnOkTT) + apply (clarsimp simp:ty_size getFreeRef_def get_free_ref_def is_cap_simps) + apply simp + apply (strengthen if_res_2n, wp) + apply simp + apply wp + apply (wp mapME_x_inv_wp + validE_R_validE[OF valid_validE_R[OF ensure_empty_inv]] + validE_R_validE[OF valid_validE_R[OF ensureEmpty_inv]])+ + apply (clarsimp simp: is_cap_simps valid_cap_simps + cap_table_at_gsCNodes bits_of_def + linorder_not_less) + apply (erule order_le_less_trans) + apply (rule word_leq_le_minus_one) + apply (simp add: word_le_nat_alt) + apply (simp add: unat_arith_simps) + apply wp+ + apply (wp hoare_drop_impE_R hoare_vcg_all_lift_R + | clarsimp)+ apply (rule hoare_strengthen_post [where Q = "\r. invs and valid_cap r and cte_at slot"]) apply wp+ apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def @@ -411,17 +410,17 @@ next apply wp+ apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct') apply auto[1] - apply (wp whenE_throwError_wp | wp (once) hoare_drop_imps)+ - apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct' - cte_wp_at_caps_of_state cte_wp_at_ctes_of ) - apply (clarsimp simp: invs_valid_objs invs_psp_aligned) - apply (frule caps_of_state_valid_cap, clarsimp+) - apply (strengthen refl[where t=True] refl exI[mk_strg I E] exI[where x=d])+ - apply (clarsimp simp: is_cap_simps valid_cap_def bits_of_def cap_aligned_def - cte_level_bits_def word_bits_conv) - apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct' - cte_wp_at_caps_of_state cte_wp_at_ctes_of ) - done + apply (wp whenE_throwError_wp | wp (once) hoare_drop_imps)+ + apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct' + cte_wp_at_caps_of_state cte_wp_at_ctes_of ) + apply (clarsimp simp: invs_valid_objs invs_psp_aligned) + apply (frule caps_of_state_valid_cap, clarsimp+) + apply (strengthen refl[where t=True] refl exI[mk_strg I E] exI[where x=d])+ + apply (clarsimp simp: is_cap_simps valid_cap_def bits_of_def cap_aligned_def + cte_level_bits_def word_bits_conv) + apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct' + cte_wp_at_caps_of_state cte_wp_at_ctes_of ) + done qed lemma decodeUntyped_inv[wp]: @@ -932,11 +931,11 @@ lemma corres_list_all2_mapM_': apply (clarsimp simp add: mapM_x_def sequence_x_def) apply (rule corres_guard_imp) apply (rule corres_split[OF y]) - apply (clarsimp dest!: suffix_ConsD) - apply (erule meta_allE, (drule(1) meta_mp)+) apply assumption apply assumption apply assumption + apply (clarsimp dest!: suffix_ConsD) + apply (erule meta_allE, (drule(1) meta_mp)+) apply assumption apply (erule(1) z)+ apply simp+ @@ -1533,16 +1532,17 @@ shows apply (rule corres_underlying_symb_exec_l [OF set_original_symb_exec_l]) apply (rule corres_cong[OF refl refl _ refl refl, THEN iffD1]) apply (rule bind_return[THEN fun_cong]) - apply (rule corres_split[OF setCTE_corres]) - apply (subst bind_return[symmetric], - rule corres_split) - apply (simp add: dc_def[symmetric]) - apply (rule updateMDB_symb_exec_r) + apply (rule corres_split) + apply (rule setCTE_corres; simp) + apply (subst bind_return[symmetric], + rule corres_split) apply (simp add: dc_def[symmetric]) - apply (rule corres_split_noop_rhs[OF updateMDB_symb_exec_r]) - apply (rule updateNewFreeIndex_noop_psp_corres) - apply (wp getCTE_wp set_cdt_valid_objs set_cdt_cte_at - hoare_weak_lift_imp | simp add: o_def)+ + apply (rule updateMDB_symb_exec_r) + apply (simp add: dc_def[symmetric]) + apply (rule corres_split_noop_rhs[OF updateMDB_symb_exec_r]) + apply (rule updateNewFreeIndex_noop_psp_corres) + apply (wp getCTE_wp set_cdt_valid_objs set_cdt_cte_at + hoare_weak_lift_imp | simp add: o_def)+ apply (clarsimp simp: cte_wp_at_cte_at) apply (clarsimp simp: cte_wp_at_ctes_of no_0_def valid_mdb'_def valid_mdb_ctes_def) @@ -4233,128 +4233,131 @@ lemma resetUntypedCap_corres: liftE_bindE) apply (rule corres_guard_imp) apply (rule corres_split[OF getSlotCap_corres]) - apply (rule_tac F="cap = cap.UntypedCap dev ptr sz idx - \ (\s. s \ cap)" in corres_gen_asm) - apply (clarsimp simp: bits_of_def free_index_of_def unlessE_def - split del: if_split) - apply (rule corres_if[OF refl]) - apply (rule corres_returnOk[where P=\ and P'=\], simp) - apply (simp add: liftE_bindE bits_of_def split del: if_split) - apply (rule corres_split[OF deleteObjects_corres]) - apply (rule corres_if) - apply simp - apply (simp add: bits_of_def shiftL_nat) - apply (rule corres_split_nor) - apply (rule updateFreeIndex_corres, simp) - apply (simp add: free_index_of_def) - apply (simp add: unless_def) - apply (rule corres_when, simp) - apply (rule corres_machine_op) - apply (rule corres_Id, simp, simp, wp) - apply (wp | simp only: unless_def)+ - apply (rule_tac F="sz < word_bits \ idx \ 2 ^ sz - \ ptr \ 0 \ is_aligned ptr sz - \ resetChunkBits \ sz" in corres_gen_asm) - apply (simp add: bits_of_def free_index_of_def mapME_x_map_simp liftE_bindE - reset_addrs_same[where ptr=ptr and idx=idx and sz=sz] - o_def rev_map - del: capFreeIndex_update.simps) - apply (rule_tac P="\x. valid_objs and pspace_aligned and pspace_distinct - and pspace_no_overlap {ptr .. ptr + 2 ^ sz - 1} - and cte_wp_at (\a. is_untyped_cap a \ obj_ref_of a = ptr \ cap_bits a = sz - \ cap_is_device a = dev) slot" - and P'="\_. valid_pspace' and (\s. descendants_of' (cte_map slot) (ctes_of s) = {}) - and pspace_no_overlap' ptr sz - and cte_wp_at' (\cte. \idx. cteCap cte = UntypedCap dev ptr sz idx) (cte_map slot)" - in mapME_x_corres_same_xs) - apply (rule corres_guard_imp) - apply (rule corres_split_nor) - apply (rule corres_split_nor[OF updateFreeIndex_corres]) - apply (rule preemptionPoint_corres) - apply simp - apply (simp add: getFreeRef_def getFreeIndex_def free_index_of_def) - apply clarify - apply (subst unat_mult_simple) - apply (subst unat_of_nat_eq) - apply (rule order_less_trans[rotated], - rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) - apply (erule order_less_le_trans; simp) - apply (subst unat_p2) - apply (simp add: Kernel_Config.resetChunkBits_def) - apply (rule order_less_trans[rotated], - rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) - apply (subst unat_of_nat_eq) - apply (rule order_less_trans[rotated], - rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) - apply (erule order_less_le_trans; simp) - apply simp - apply wp+ - apply (rule corres_machine_op) - apply (rule corres_Id) - apply (simp add: shiftL_nat getFreeRef_def shiftl_t2n mult.commute) + apply simp + apply (rule_tac F="cap = cap.UntypedCap dev ptr sz idx + \ (\s. s \ cap)" in corres_gen_asm) + apply (clarsimp simp: bits_of_def free_index_of_def unlessE_def + split del: if_split) + apply (rule corres_if[OF refl]) + apply (rule corres_returnOk[where P=\ and P'=\], simp) + apply (simp add: liftE_bindE bits_of_def split del: if_split) + apply (rule corres_split) + apply (rule deleteObjects_corres) + apply (clarsimp simp: valid_cap_def cap_aligned_def) + apply (clarsimp simp: valid_cap_def cap_aligned_def untyped_min_bits_def) + apply (rule corres_if) + apply simp + apply (simp add: bits_of_def shiftL_nat) + apply (rule corres_split_nor) + apply (simp add: unless_def) + apply (rule corres_when, simp) + apply (rule corres_machine_op) + apply (rule corres_Id, simp, simp, wp) + apply (rule updateFreeIndex_corres, simp) + apply (simp add: free_index_of_def) + apply (wp | simp only: unless_def)+ + apply (rule_tac F="sz < word_bits \ idx \ 2 ^ sz + \ ptr \ 0 \ is_aligned ptr sz + \ resetChunkBits \ sz" in corres_gen_asm) + apply (simp add: bits_of_def free_index_of_def mapME_x_map_simp liftE_bindE + reset_addrs_same[where ptr=ptr and idx=idx and sz=sz] + o_def rev_map + del: capFreeIndex_update.simps) + apply (rule_tac P="\x. valid_objs and pspace_aligned and pspace_distinct + and pspace_no_overlap {ptr .. ptr + 2 ^ sz - 1} + and cte_wp_at (\a. is_untyped_cap a \ obj_ref_of a = ptr \ cap_bits a = sz + \ cap_is_device a = dev) slot" + and P'="\_. valid_pspace' and (\s. descendants_of' (cte_map slot) (ctes_of s) = {}) + and pspace_no_overlap' ptr sz + and cte_wp_at' (\cte. \idx. cteCap cte = UntypedCap dev ptr sz idx) (cte_map slot)" + in mapME_x_corres_same_xs) + apply (rule corres_guard_imp) + apply (rule corres_split_nor) + apply (rule corres_machine_op) + apply (rule corres_Id) + apply (simp add: shiftL_nat getFreeRef_def shiftl_t2n mult.commute) + apply simp + apply wp + apply (rule corres_split_nor) + apply (rule updateFreeIndex_corres) apply simp - apply wp+ - apply (clarsimp simp: cte_wp_at_caps_of_state) - apply (clarsimp simp: getFreeRef_def valid_pspace'_def cte_wp_at_ctes_of - valid_cap_def cap_aligned_def) - apply (erule aligned_add_aligned) - apply (rule is_aligned_weaken) - apply (rule is_aligned_mult_triv2) - apply (simp add: Kernel_Config.resetChunkBits_def) - apply (simp add: untyped_min_bits_def) - apply (rule hoare_pre) - apply simp - apply (strengthen imp_consequent) - apply (wp preemption_point_inv set_cap_cte_wp_at - update_untyped_cap_valid_objs - set_cap_no_overlap | simp)+ - apply (clarsimp simp: exI cte_wp_at_caps_of_state) - apply (drule caps_of_state_valid_cap, simp+) - apply (clarsimp simp: is_cap_simps valid_cap_simps - cap_aligned_def - valid_untyped_pspace_no_overlap) - apply (rule hoare_pre) - apply (simp del: capFreeIndex_update.simps) - apply (strengthen imp_consequent) - apply (wp updateFreeIndex_valid_pspace_no_overlap' - updateFreeIndex_descendants_of2 - doMachineOp_psp_no_overlap - updateFreeIndex_cte_wp_at - pspace_no_overlap'_lift - preemptionPoint_inv - hoare_vcg_ex_lift - | simp)+ - apply (clarsimp simp add: cte_wp_at_ctes_of exI isCap_simps valid_pspace'_def) - apply (clarsimp simp: getFreeIndex_def getFreeRef_def) - apply (subst is_aligned_weaken[OF is_aligned_mult_triv2]) - apply (simp add: Kernel_Config.resetChunkBits_def minUntypedSizeBits_def) - apply (subst unat_mult_simple) - apply (subst unat_of_nat_eq) - apply (rule order_less_trans[rotated], - rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) - apply (erule order_less_le_trans; simp) - apply (subst unat_p2) - apply (simp add: Kernel_Config.resetChunkBits_def) - apply (rule order_less_trans[rotated], - rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) - apply (subst unat_of_nat_eq) - apply (rule order_less_trans[rotated], - rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) - apply (erule order_less_le_trans; simp) - apply simp + apply (simp add: getFreeRef_def getFreeIndex_def free_index_of_def) + apply clarify + apply (subst unat_mult_simple) + apply (subst unat_of_nat_eq) + apply (rule order_less_trans[rotated], + rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) + apply (erule order_less_le_trans; simp) + apply (subst unat_p2) + apply (simp add: Kernel_Config.resetChunkBits_def) + apply (rule order_less_trans[rotated], + rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) + apply (subst unat_of_nat_eq) + apply (rule order_less_trans[rotated], + rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) + apply (erule order_less_le_trans; simp) + apply simp + apply (rule preemptionPoint_corres) + apply wp+ + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (clarsimp simp: getFreeRef_def valid_pspace'_def cte_wp_at_ctes_of + valid_cap_def cap_aligned_def) + apply (erule aligned_add_aligned) + apply (rule is_aligned_weaken) + apply (rule is_aligned_mult_triv2) + apply (simp add: Kernel_Config.resetChunkBits_def) + apply (simp add: untyped_min_bits_def) + apply (rule hoare_pre) apply simp - apply (clarsimp simp add: valid_cap_def cap_aligned_def) - apply (clarsimp simp add: valid_cap_def cap_aligned_def untyped_min_bits_def) - apply (simp add: if_apply_def2) - apply (strengthen invs_valid_objs invs_psp_aligned invs_distinct) - apply (wp hoare_vcg_const_imp_lift) + apply (strengthen imp_consequent) + apply (wp preemption_point_inv set_cap_cte_wp_at + update_untyped_cap_valid_objs + set_cap_no_overlap | simp)+ + apply (clarsimp simp: exI cte_wp_at_caps_of_state) + apply (drule caps_of_state_valid_cap, simp+) + apply (clarsimp simp: is_cap_simps valid_cap_simps + cap_aligned_def + valid_untyped_pspace_no_overlap) + apply (rule hoare_pre) + apply (simp del: capFreeIndex_update.simps) + apply (strengthen imp_consequent) + apply (wp updateFreeIndex_valid_pspace_no_overlap' + updateFreeIndex_descendants_of2 + doMachineOp_psp_no_overlap + updateFreeIndex_cte_wp_at + pspace_no_overlap'_lift + preemptionPoint_inv + hoare_vcg_ex_lift + | simp)+ + apply (clarsimp simp add: cte_wp_at_ctes_of exI isCap_simps valid_pspace'_def) + apply (clarsimp simp: getFreeIndex_def getFreeRef_def) + apply (subst is_aligned_weaken[OF is_aligned_mult_triv2]) + apply (simp add: Kernel_Config.resetChunkBits_def minUntypedSizeBits_def) + apply (subst unat_mult_simple) + apply (subst unat_of_nat_eq) + apply (rule order_less_trans[rotated], + rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) + apply (erule order_less_le_trans; simp) + apply (subst unat_p2) + apply (simp add: Kernel_Config.resetChunkBits_def) + apply (rule order_less_trans[rotated], + rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) + apply (subst unat_of_nat_eq) + apply (rule order_less_trans[rotated], + rule_tac n=sz in power_strict_increasing; simp add: word_bits_def) + apply (erule order_less_le_trans; simp) + apply simp + apply simp apply (simp add: if_apply_def2) - apply (strengthen invs_pspace_aligned' invs_pspace_distinct' - invs_valid_pspace') - apply (wp hoare_vcg_const_imp_lift deleteObjects_cte_wp_at'[where p="cte_map slot"] - deleteObjects_invs'[where p="cte_map slot"] - deleteObjects_descendants[where p="cte_map slot"] - | simp)+ + apply (strengthen invs_valid_objs invs_psp_aligned invs_distinct) + apply (wp hoare_vcg_const_imp_lift) + apply (simp add: if_apply_def2) + apply (strengthen invs_pspace_aligned' invs_pspace_distinct' + invs_valid_pspace') + apply (wp hoare_vcg_const_imp_lift deleteObjects_cte_wp_at'[where p="cte_map slot"] + deleteObjects_invs'[where p="cte_map slot"] + deleteObjects_descendants[where p="cte_map slot"] + | simp)+ apply (wp get_cap_wp getCTE_wp' | simp add: getSlotCap_def)+ apply (clarsimp simp: cte_wp_at_caps_of_state descendants_range_def2) apply (cases slot) @@ -4892,14 +4895,13 @@ lemma inv_untyped_corres': sz (if reset then 0 else idx)" in corres_gen_asm) apply (rule corres_add_noop_lhs) apply (rule corres_split_nor[OF cNodeNoOverlap _ return_wp stateAssert_wp]) - apply (rule corres_split[OF updateFreeIndex_corres,rotated]) + apply (rule corres_split[OF updateFreeIndex_corres]) apply (simp add:isCap_simps)+ apply (clarsimp simp:getFreeIndex_def bits_of_def shiftL_nat shiftl_t2n free_index_of_def) - prefer 3 apply (insert range_cover.range_cover_n_less[OF cover] vslot) apply (rule createNewObjects_corres_helper) - apply simp+ + apply simp+ apply (simp add: insertNewCaps_def) apply (rule corres_split_retype_createNewCaps[where sz = sz,OF corres_rel_imp]) apply (rule inv_untyped_corres_helper1) diff --git a/proof/refine/ARM_HYP/VSpace_R.thy b/proof/refine/ARM_HYP/VSpace_R.thy index c4caccf04..c677628bc 100644 --- a/proof/refine/ARM_HYP/VSpace_R.thy +++ b/proof/refine/ARM_HYP/VSpace_R.thy @@ -198,60 +198,60 @@ lemma findPDForASIDAssert_corres: findPDForASIDAssert_def liftM_def) apply (rule corres_guard_imp) apply (rule corres_split_eqr) - apply (rule_tac F="is_aligned pda pdBits - \ pda = pd" in corres_gen_asm) - apply (clarsimp simp add: is_aligned_mask[symmetric]) - apply (rule_tac P="pde_at pd and pd_at_uniq asid pd - and pspace_aligned and pspace_distinct - and vspace_at_asid asid pd and valid_asid_map" - and P'="pspace_aligned' and pspace_distinct'" - in stronger_corres_guard_imp) + apply (rule corres_split_catch[OF find_pd_for_asid_corres'[where pd=pd]]) + apply (rule_tac P="\" and P'="\" in corres_inst) + apply (simp add: corres_fail) + apply (wp find_pd_for_asid_valids[where pd=pd])+ + apply (rule_tac F="is_aligned pda pdBits + \ pda = pd" in corres_gen_asm) + apply (clarsimp simp add: is_aligned_mask[symmetric]) + apply (rule_tac P="pde_at pd and pd_at_uniq asid pd + and pspace_aligned and pspace_distinct + and vspace_at_asid asid pd and valid_asid_map" + and P'="pspace_aligned' and pspace_distinct'" + in stronger_corres_guard_imp) apply (rule corres_symb_exec_l[where P="pde_at pd and pd_at_uniq asid pd and valid_asid_map and vspace_at_asid asid pd"]) - apply (rule corres_symb_exec_r[where P'="page_directory_at' pd"]) - apply (simp add: checkPDUniqueToASID_def ran_option_map - checkPDASIDMapMembership_def) - apply (rule_tac P'="pd_at_uniq asid pd" in corres_stateAssert_implied) - apply (simp add: gets_def bind_assoc[symmetric] - stateAssert_def[symmetric, where L="[]"]) - apply (rule_tac P'="valid_asid_map and vspace_at_asid asid pd" - in corres_stateAssert_implied) - apply (rule corres_trivial, simp) - apply (clarsimp simp: state_relation_def arch_state_relation_def - valid_asid_map_def - split: option.split) - apply (drule bspec, erule graph_ofI) - apply clarsimp - apply (drule(1) pd_at_asid_unique2) - apply simp + apply (rule corres_symb_exec_r[where P'="page_directory_at' pd"]) + apply (simp add: checkPDUniqueToASID_def ran_option_map + checkPDASIDMapMembership_def) + apply (rule_tac P'="pd_at_uniq asid pd" in corres_stateAssert_implied) + apply (simp add: gets_def bind_assoc[symmetric] + stateAssert_def[symmetric, where L="[]"]) + apply (rule_tac P'="valid_asid_map and vspace_at_asid asid pd" + in corres_stateAssert_implied) + apply (rule corres_trivial, simp) apply (clarsimp simp: state_relation_def arch_state_relation_def - pd_at_uniq_def ran_option_map) - apply wp+ - apply (simp add: checkPDAt_def stateAssert_def) - apply (rule no_fail_pre, wp) - apply simp - apply (clarsimp simp: pde_at_def obj_at_def a_type_def) - apply (clarsimp split: Structures_A.kernel_object.splits - arch_kernel_obj.splits if_split_asm) - apply (simp add: get_pde_def exs_valid_def bind_def return_def - get_pd_def get_object_def simpler_gets_def) - apply wp - apply simp - apply (simp add: get_pde_def get_pd_def) - apply (rule no_fail_pre) - apply (wp get_object_wp | wpc)+ - apply (clarsimp simp: pde_at_def obj_at_def a_type_def) - apply (clarsimp split: Structures_A.kernel_object.splits - arch_kernel_obj.splits if_split_asm) - apply simp - apply (clarsimp simp: state_relation_def) - apply (erule(3) pspace_relation_pd) - apply (simp add: pde_at_def pd_bits_def pdBits_def - is_aligned_neg_mask_eq) - apply (rule corres_split_catch[OF find_pd_for_asid_corres'[where pd=pd]]) - apply (rule_tac P="\" and P'="\" in corres_inst) - apply (simp add: corres_fail) - apply (wp find_pd_for_asid_valids[where pd=pd])+ + valid_asid_map_def + split: option.split) + apply (drule bspec, erule graph_ofI) + apply clarsimp + apply (drule(1) pd_at_asid_unique2) + apply simp + apply (clarsimp simp: state_relation_def arch_state_relation_def + pd_at_uniq_def ran_option_map) + apply wp+ + apply (simp add: checkPDAt_def stateAssert_def) + apply (rule no_fail_pre, wp) + apply simp + apply (clarsimp simp: pde_at_def obj_at_def a_type_def) + apply (clarsimp split: Structures_A.kernel_object.splits + arch_kernel_obj.splits if_split_asm) + apply (simp add: get_pde_def exs_valid_def bind_def return_def + get_pd_def get_object_def simpler_gets_def) + apply wp + apply simp + apply (simp add: get_pde_def get_pd_def) + apply (rule no_fail_pre) + apply (wp get_object_wp | wpc)+ + apply (clarsimp simp: pde_at_def obj_at_def a_type_def) + apply (clarsimp split: Structures_A.kernel_object.splits + arch_kernel_obj.splits if_split_asm) + apply simp + apply (clarsimp simp: state_relation_def) + apply (erule(3) pspace_relation_pd) + apply (simp add: pde_at_def pd_bits_def pdBits_def) + apply (wp find_pd_for_asid_valids[where pd=pd])+ apply (clarsimp simp: word_neq_0_conv) apply simp done @@ -322,23 +322,22 @@ lemma storeHWASID_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF findPDForASIDAssert_corres[where pd=pd]]) apply (rule corres_split_eqr) - apply (rule corres_split) - apply (rule corres_trivial, rule corres_modify) - apply (clarsimp simp: state_relation_def) - apply (simp add: arch_state_relation_def) - apply (rule ext) - apply simp - apply (rule corres_split_eqr) - apply (rule corres_trivial, rule corres_modify) - apply (clarsimp simp: state_relation_def arch_state_relation_def) - apply (rule ext) - apply simp + apply (rule corres_trivial) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (rule corres_split) + apply (rule corres_trivial, rule corres_modify) + apply (clarsimp simp: state_relation_def) + apply (simp add: arch_state_relation_def) + apply (rule ext) + apply simp + apply (rule corres_split_eqr) apply (rule corres_trivial) apply (clarsimp simp: state_relation_def arch_state_relation_def) - apply ((wp | simp)+)[4] - apply (rule corres_trivial) - apply (clarsimp simp: state_relation_def arch_state_relation_def) - apply (wp | simp)+ + apply (rule corres_trivial, rule corres_modify) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (rule ext) + apply simp + apply (wp | simp)+ done lemma invalidateASID_corres: @@ -381,12 +380,12 @@ lemma invalidateHWASIDEntry_corres: apply (simp add: invalidate_hw_asid_entry_def invalidateHWASIDEntry_def) apply (rule corres_guard_imp) apply (rule corres_split_eqr) - apply (rule corres_trivial, rule corres_modify) - defer - apply (rule corres_trivial) - apply (wp | clarsimp simp: state_relation_def arch_state_relation_def)+ - apply (rule ext) - apply simp + apply (rule corres_trivial) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (rule corres_trivial, rule corres_modify) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (rule ext) + apply (wp | clarsimp)+ done lemma findFreeHWASID_corres: @@ -401,38 +400,40 @@ lemma findFreeHWASID_corres: apply (simp add: find_free_hw_asid_def findFreeHWASID_def) apply (rule corres_guard_imp) apply (rule corres_split_eqr[OF corres_trivial]) - apply (rule corres_split_eqr[OF corres_trivial]) - apply (subgoal_tac "take (length [minBound .e. maxBound :: hardware_asid]) - ([next_asid .e. maxBound] @ [minBound .e. next_asid]) - = [next_asid .e. maxBound] @ init [minBound .e. next_asid]") - apply (cut_tac option="find (\a. hw_asid_table a = None) - ([next_asid .e. maxBound] @ init [minBound .e. next_asid])" - in option.nchotomy[rule_format]) - apply (erule corres_disj_division) - apply (clarsimp split del: if_split) - apply (rule corres_split[OF invalidate_asid_ext_corres]) - apply (rule corres_underlying_split [where r'=dc]) - apply (rule corres_trivial, rule corres_machine_op) - apply (rule corres_no_failI) - apply (rule no_fail_invalidateLocalTLB_ASID) - apply fastforce + apply (clarsimp simp: arch_state_relation_def state_relation_def) + apply (rule corres_split_eqr[OF corres_trivial]) + apply (clarsimp simp: arch_state_relation_def state_relation_def) + apply (subgoal_tac "take (length [minBound .e. maxBound :: hardware_asid]) + ([next_asid .e. maxBound] @ [minBound .e. next_asid]) + = [next_asid .e. maxBound] @ init [minBound .e. next_asid]") + apply (cut_tac option="find (\a. hw_asid_table a = None) + ([next_asid .e. maxBound] @ init [minBound .e. next_asid])" + in option.nchotomy[rule_format]) + apply (erule corres_disj_division) + apply (clarsimp split del: if_split) + apply (rule corres_split[OF invalidate_asid_ext_corres]) + apply (rule corres_underlying_split [where r'=dc]) + apply (rule corres_trivial, rule corres_machine_op) + apply (rule corres_no_failI) + apply (rule no_fail_invalidateLocalTLB_ASID) + apply fastforce + apply (rule corres_split) + apply (rule invalidateHWASIDEntry_corres) apply (rule corres_split) - apply (rule invalidateHWASIDEntry_corres) - apply (rule corres_split_deprecated) - apply (rule corres_trivial) - apply simp - apply (rule corres_trivial) - apply (rule corres_modify) - apply (simp add: minBound_word maxBound_word - state_relation_def arch_state_relation_def) - apply (wp | simp split del: if_split)+ - apply (rule corres_trivial, clarsimp) - apply (cut_tac x=next_asid in leq_maxBound) - apply (simp only: word_le_nat_alt) - apply (simp add: init_def upto_enum_word - minBound_word - del: upt.simps) - apply (wp | clarsimp simp: arch_state_relation_def state_relation_def)+ + apply (rule corres_trivial) + apply (rule corres_modify) + apply (simp add: minBound_word maxBound_word + state_relation_def arch_state_relation_def) + apply (rule corres_trivial) + apply simp + apply (wp | simp split del: if_split)+ + apply (rule corres_trivial, clarsimp) + apply (cut_tac x=next_asid in leq_maxBound) + apply (simp only: word_le_nat_alt) + apply (simp add: init_def upto_enum_word + minBound_word + del: upt.simps) + apply wp+ apply (clarsimp dest!: findNoneD) apply (drule bspec, rule UnI1, simp, rule order_refl) apply (clarsimp simp: valid_arch_state_def) @@ -634,19 +635,19 @@ lemma handleVMFault_corres: apply (cases fault) apply simp apply (rule corres_guard_imp) - apply (rule corres_splitEE, prefer_next,simp, + apply (rule corres_splitEE, simp, rule corres_machine_op [where r="(=)"], rule corres_Id refl, rule refl, simp, simp)+ - apply (rule corres_trivial) - apply (simp add: arch_fault_map_def) - apply wpsimp+ + apply (rule corres_trivial) + apply (simp add: arch_fault_map_def) + apply wpsimp+ apply (rule corres_guard_imp) - apply (rule corres_splitEE,prefer_next,simp) + apply (rule corres_splitEE,simp) apply (rule asUser_corres') apply (rule corres_no_failI [where R="(=)"]) apply (rule no_fail_getRestartPC) apply fastforce - apply (rule corres_splitEE, prefer_next,simp, + apply (rule corres_splitEE,simp, rule corres_machine_op [where r="(=)"], rule corres_Id refl, rule refl, simp, simp)+ apply (rule corres_trivial, simp add: arch_fault_map_def) @@ -843,8 +844,9 @@ lemma vcpuSaveReg_corres[corres]: apply (rule corres_guard_imp) apply (rule corres_assert_gen_asm2) apply (rule corres_split[OF corres_machine_op[where r="(=)"]]) - apply (rule vcpuUpdate_corres, fastforce simp: vcpu_relation_def vgic_map_def) - apply (wpsimp wp: corres_Id)+ + apply (rule corres_Id; simp) + apply (rule vcpuUpdate_corres, fastforce simp: vcpu_relation_def vgic_map_def) + apply wpsimp+ done lemma vcpuSaveRegRange_corres[corres]: @@ -882,14 +884,15 @@ lemma saveVirtTimer_corres[corres]: unfolding save_virt_timer_def saveVirtTimer_def apply (rule corres_guard_imp) apply (rule corres_split_dc[OF vcpuSaveReg_corres], simp) - apply (rule corres_split_dc[OF corres_machine_op]) - apply (rule corres_split_eqr[OF corres_machine_op])+ - apply (rule corres_split_dc[OF vcpuWriteReg_corres], simp)+ - apply (rule corres_split_eqr[OF corres_machine_op]) - apply (fold dc_def) - apply (rule vcpuUpdate_corres) - apply (simp add: vcpu_relation_def) - apply (wpsimp simp: if_apply_def2 corres_Id)+ + apply (rule corres_split_dc[OF corres_machine_op], (rule corres_Id; simp)) + apply (rule corres_split_eqr[OF corres_machine_op], (rule corres_Id; simp))+ + apply (rule corres_split_dc[OF vcpuWriteReg_corres], simp)+ + apply (rule corres_split_eqr[OF corres_machine_op]) + apply (rule corres_Id; simp) + apply (fold dc_def) + apply (rule vcpuUpdate_corres) + apply (simp add: vcpu_relation_def) + apply wpsimp+ done lemma isIRQActive_corres: @@ -909,21 +912,21 @@ lemma restoreVirtTimer_corres[corres]: apply (rule corres_guard_imp) apply (rule corres_split_eqr[OF vcpuReadReg_corres], simp) apply (rule corres_split_eqr[OF vcpuReadReg_corres]) - apply (rule corres_split_eqr[OF corres_machine_op], simp)+ - apply (rule corres_split[OF getObject_vcpu_corres]) + apply (rule corres_split_eqr[OF corres_machine_op], (rule corres_Id; simp))+ + apply (rule corres_split[OF getObject_vcpu_corres]) + apply (rule corres_split_eqr[OF vcpuReadReg_corres]) apply (rule corres_split_eqr[OF vcpuReadReg_corres]) - apply (rule corres_split_eqr[OF vcpuReadReg_corres]) - apply (clarsimp simp: vcpu_relation_def) - apply (rule corres_split_dc[OF vcpuWriteReg_corres])+ - apply (rule corres_split_dc[OF corres_machine_op], simp) - apply (rule corres_split_eqr[OF isIRQActive_corres]) - apply (rule corres_split_dc[OF corres_when], simp) - apply (fold dc_def) - apply (rule vcpuRestoreReg_corres, simp) - apply (simp add: irq_vppi_event_index_def irqVPPIEventIndex_def IRQ_def) - apply (rule corres_machine_op, simp) - apply (rule corres_Id) - apply (wpsimp simp: if_apply_def2 corres_Id isIRQActive_def)+ + apply (clarsimp simp: vcpu_relation_def) + apply (rule corres_split_dc[OF vcpuWriteReg_corres])+ + apply (rule corres_split_dc[OF corres_machine_op]) + apply (rule corres_Id; simp) + apply (rule corres_split_eqr[OF isIRQActive_corres]) + apply (rule corres_split_dc[OF corres_when], simp) + apply (simp add: irq_vppi_event_index_def irqVPPIEventIndex_def IRQ_def) + apply (rule corres_machine_op, simp) + apply (rule corres_Id; wpsimp) + apply (rule vcpuRestoreReg_corres) + apply (wpsimp simp: if_apply_def2 isIRQActive_def)+ done lemma vcpuSave_corres: @@ -934,31 +937,39 @@ lemma vcpuSave_corres: apply (cases cvcpu, clarsimp, rename_tac v active) apply (rule corres_guard_imp) apply (rule corres_split_dc[OF corres_machine_op]) - apply (rule corres_split_deprecated[where r'=dc]) - apply (rule corres_split_eqr[OF corres_machine_op], simp) - apply (rule corres_split[OF vgicUpdate_corres]) - apply (rule corres_split_eqr[OF corres_machine_op], simp) - apply (rule corres_split[OF vgicUpdate_corres]) - apply (rule corres_split_eqr, simp) - apply (simp add: mapM_discarded) - apply (rule corres_split[OF corres_mapM_x[OF _ _ _ _ subset_refl]]) - apply (rule corres_split[OF vcpuSaveRegRange_corres]) - apply (rule corres_machine_op) - apply (wpsimp wp: corres_Id simp: vcpu_relation_def vgic_map_def)+ - apply (rule corres_split_eqr[OF corres_machine_op] - , simp, fold dc_def) - apply (rule vgicUpdateLR_corres) - apply (wpsimp wp: corres_Id simp: vcpu_relation_def vgic_map_def)+ - apply (wpsimp wp: corres_gets_trivial mapM_x_wp_inv)+ - apply (fastforce simp add: state_relation_def arch_state_relation_def) - apply (wpsimp wp: corres_Id no_fail_isb simp: vcpu_relation_def vgic_map_def)+ + apply (rule corres_Id; wpsimp) + apply (rule corres_split[where r'=dc]) apply (rule corres_when, simp) apply (rule corres_split[OF vcpuSaveReg_corres]) - apply (rule corres_split_eqr[OF corres_machine_op], simp, fold dc_def) + apply (rule corres_split_eqr[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) + apply (rule corres_split[OF vgicUpdate_corres]) + apply (clarsimp simp: vgic_map_def) + apply (rule saveVirtTimer_corres) + apply wpsimp+ + apply (rule corres_split_eqr[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) + apply (rule corres_split[OF vgicUpdate_corres]) + apply (clarsimp simp: vgic_map_def) + apply (rule corres_split_eqr[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) apply (rule corres_split[OF vgicUpdate_corres]) - apply (rule saveVirtTimer_corres) - apply (wpsimp wp: corres_Id no_fail_isb hoare_vcg_imp_lift' no_fail_dsb - simp: vcpu_relation_def vgic_map_def if_apply_def2)+ + apply (clarsimp simp: vgic_map_def) + apply (rule corres_split_eqr) + apply (rule corres_trivial) + apply (fastforce simp add: state_relation_def arch_state_relation_def) + apply (simp add: mapM_discarded) + apply (rule corres_split[OF corres_mapM_x[OF _ _ _ _ subset_refl]]) + apply (rule corres_split_eqr[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) + apply (clarsimp, fold dc_def) + apply (rule vgicUpdateLR_corres) + apply wpsimp+ + apply (rule corres_split[OF vcpuSaveRegRange_corres]) + apply (rule corres_machine_op) + apply (rule corres_Id; wpsimp) + apply (wpsimp wp: mapM_x_wp_inv hoare_vcg_imp_lift' + simp: if_apply_def2)+ done lemma vcpuDisable_corres: @@ -982,13 +993,16 @@ lemma vcpuDisable_corres: apply (clarsimp simp: doMachineOp_bind do_machine_op_bind bind_assoc IRQ_def) apply (rule corres_guard_imp) apply (rule corres_split_dc[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) apply (rule corres_split_eqr[OF corres_machine_op]) - apply (rule corres_split_dc[OF vgicUpdate_corres]) - apply (rule corres_split_dc[OF vcpuSaveReg_corres]) - apply (rule corres_split_dc[OF corres_machine_op] - corres_split_dc[OF saveVirtTimer_corres] - | rule corres_machine_op corres_Id - | wpsimp simp: vgic_map_def)+ + apply (rule corres_Id; wpsimp) + apply (rule corres_split_dc[OF vgicUpdate_corres]) + apply (clarsimp simp: vgic_map_def) + apply (rule corres_split_dc[OF vcpuSaveReg_corres]) + apply (rule corres_split_dc[OF corres_machine_op] + corres_split_dc[OF saveVirtTimer_corres] + | rule corres_machine_op corres_Id + | wpsimp)+ done lemma vcpuEnable_corres: @@ -1016,18 +1030,22 @@ lemma vcpuRestore_corres: apply (simp add: vcpu_restore_def vcpuRestore_def gicVCPUMaxNumLR_def) apply (rule corres_guard_imp) apply (rule corres_split_dc[OF corres_machine_op] - | rule corres_machine_op corres_Id)+ - apply (rule corres_split[OF getObject_vcpu_corres], rename_tac vcpu') - apply (rule corres_split[OF corres_gets_gicvcpu_numlistregs]) - apply (case_tac vcpu' - , clarsimp simp: comp_def vcpu_relation_def vgic_map_def mapM_x_mapM - uncurry_def split_def mapM_map_simp) - apply (simp add: doMachineOp_bind do_machine_op_bind bind_assoc) + | (rule corres_machine_op corres_Id; wpsimp))+ + apply (rule corres_split[OF getObject_vcpu_corres], rename_tac vcpu') + apply (rule corres_split[OF corres_gets_gicvcpu_numlistregs]) + apply (case_tac vcpu' + , clarsimp simp: comp_def vcpu_relation_def vgic_map_def mapM_x_mapM + uncurry_def split_def mapM_map_simp) + apply (simp add: doMachineOp_bind do_machine_op_bind bind_assoc) + apply (rule corres_split_dc[OF corres_machine_op]) + apply (rule corres_Id; wpsimp) apply (rule corres_split_dc[OF corres_machine_op]) - apply (rule corres_split_dc[OF corres_machine_op]) - apply (rule corres_split_deprecated) - apply (rule corres_split_dc[OF vcpuRestoreRegRange_corres]) - apply (wpsimp wp: vcpuEnable_corres corres_machine_op corres_Id no_fail_mapM)+ + apply (rule corres_Id; wpsimp) + apply (rule corres_split) + apply (rule corres_machine_op, rule corres_Id; wpsimp wp: no_fail_mapM) + apply (rule corres_split_dc[OF vcpuRestoreRegRange_corres]) + apply (rule vcpuEnable_corres) + apply wpsimp+ done crunches @@ -1168,12 +1186,12 @@ proof - od))" apply (rule corres_guard_imp) apply (rule corres_split_catch [where f=lfr]) - apply (rule corres_underlying_split [where P=\ and P'=\ and r'="(=)"]) - apply (clarsimp simp: state_relation_def arch_state_relation_def) - apply (simp, rule setCurrentPD_corres, rule refl) - apply wp+ - apply (subst corres_throwError, simp add: lookup_failure_map_def) - apply (wp | simp)+ + apply (rule corres_trivial) + apply (subst corres_throwError, simp add: lookup_failure_map_def) + apply (rule corres_underlying_split [where P=\ and P'=\ and r'="(=)"]) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (simp, rule setCurrentPD_corres, rule refl) + apply wpsimp+ done have valid_tcb_vcpu: "\s t p v.\ valid_tcb p t s; tcb_vcpu (tcb_arch t) = Some v \ \ vcpu_at v s" @@ -1198,53 +1216,56 @@ proof - cte_wp_at ((=) thread_root) thread_root_slot" and R'="\thread_root. pspace_aligned' and pspace_distinct' and no_0_obj' and tcb_at' t" in corres_split[OF getSlotCap_corres]) - apply (case_tac rv, simp_all add: isCap_simps Q[simplified])[1] - apply (rename_tac arch_cap) - apply (case_tac arch_cap, simp_all add: isCap_simps Q[simplified])[1] - apply (rename_tac word option) - apply (case_tac option, simp_all add: Q[simplified])[1] - apply (clarsimp simp: cap_asid_def) - apply (rule corres_guard_imp) - apply (rule corres_split_catch [where f=lfr]) - apply (simp add: checkPDNotInASIDMap_def - checkPDASIDMapMembership_def) - apply (rule_tac P'="(Not \ vspace_at_asid aa word) and K (aa \ mask asid_bits) - and pd_at_uniq aa word - and valid_asid_map and valid_vs_lookup - and (unique_table_refs o caps_of_state) - and valid_vspace_objs - and valid_arch_state" - in corres_stateAssert_implied) - apply (rule corres_underlying_split [where P=\ and P'=\ and r'="(=)"]) - apply (clarsimp simp: state_relation_def arch_state_relation_def) - apply (rule setCurrentPD_corres, simp) - apply wp+ - apply (clarsimp simp: restrict_map_def state_relation_asid_map - elim!: ranE) - apply (frule(1) valid_asid_mapD) - apply (case_tac "x = aa") - apply clarsimp - apply (clarsimp simp: pd_at_uniq_def restrict_map_def) - apply (erule notE, rule_tac a=x in ranI) - apply simp + apply simp + apply (case_tac rv, simp_all add: isCap_simps Q[simplified])[1] + apply (rename_tac arch_cap) + apply (case_tac arch_cap, simp_all add: isCap_simps Q[simplified])[1] + apply (rename_tac word option) + apply (case_tac option, simp_all add: Q[simplified])[1] + apply (clarsimp simp: cap_asid_def) + apply (rule corres_guard_imp) + apply (rule corres_split_catch [where f=lfr]) apply (rule corres_split_eqrE[OF find_pd_for_asid_corres]) - apply (rule whenE_throwError_corres) - apply (simp add: lookup_failure_map_def) - apply simp apply simp - apply (rule armv_contextSwitch_corres) + apply (rule whenE_throwError_corres) + apply (simp add: lookup_failure_map_def) + apply simp apply simp + apply (rule armv_contextSwitch_corres) apply simp - apply (wpsimp simp: armv_contextSwitch_def if_apply_def2 wp: assert_get_tcb_ko')+ - apply ((wp find_pd_for_asid_pd_at_asid_again - | simp add: if_apply_def2 | wp (once) hoare_drop_imps)+) - apply clarsimp - apply (frule page_directory_cap_pd_at_uniq, simp+) - apply (frule(1) cte_wp_at_valid_objs_valid_cap) - apply (clarsimp simp: valid_cap_def mask_def - word_neq_0_conv) - apply (drule(1) pd_at_asid_unique2, simp) - apply simp+ + apply (wpsimp wp: assert_get_tcb_ko' find_pd_for_asid_pd_at_asid_again + simp: armv_contextSwitch_def if_apply_def2 + | wp (once) hoare_drop_imps)+ + apply (simp add: checkPDNotInASIDMap_def + checkPDASIDMapMembership_def) + apply (rule_tac P'="(Not \ vspace_at_asid aa word) and K (aa \ mask asid_bits) + and pd_at_uniq aa word + and valid_asid_map and valid_vs_lookup + and (unique_table_refs o caps_of_state) + and valid_vspace_objs + and valid_arch_state" + in corres_stateAssert_implied) + apply (rule corres_underlying_split [where P=\ and P'=\ and r'="(=)"]) + apply (clarsimp simp: state_relation_def arch_state_relation_def) + apply (rule setCurrentPD_corres, simp) + apply wp+ + apply (clarsimp simp: restrict_map_def state_relation_asid_map + elim!: ranE) + apply (frule(1) valid_asid_mapD) + apply (case_tac "x = aa") + apply clarsimp + apply (clarsimp simp: pd_at_uniq_def restrict_map_def) + apply (erule notE, rule_tac a=x in ranI) + apply simp + apply ((wp find_pd_for_asid_pd_at_asid_again + | simp add: if_apply_def2 | wp (once) hoare_drop_imps)+) + apply clarsimp + apply (frule page_directory_cap_pd_at_uniq, simp+) + apply (frule(1) cte_wp_at_valid_objs_valid_cap) + apply (clarsimp simp: valid_cap_def mask_def + word_neq_0_conv) + apply (drule(1) pd_at_asid_unique2, simp) + apply simp+ apply (wp get_cap_wp | simp)+ apply (clarsimp simp: tcb_at_cte_at_1 [simplified]) apply simp @@ -1296,14 +1317,14 @@ lemma invalidateASIDEntry_corres: (invalidate_asid_entry asid) (invalidateASIDEntry asid)" apply (simp add: invalidate_asid_entry_def invalidateASIDEntry_def) apply (rule corres_guard_imp) - apply (rule corres_split[OF loadHWASID_corres[where pd=pd]]) - apply (rule corres_split[OF corres_when]) - apply (rule invalidateASID_corres[where pd=pd]) - apply simp - apply simp - apply (rule invalidateHWASIDEntry_corres) - apply (wp load_hw_asid_wp - | clarsimp cong: if_cong)+ + apply (rule corres_split[OF loadHWASID_corres[where pd=pd]]) + apply (rule corres_split[OF corres_when]) + apply simp + apply simp + apply (rule invalidateHWASIDEntry_corres) + apply (rule invalidateASID_corres[where pd=pd]) + apply (wp load_hw_asid_wp + | clarsimp cong: if_cong)+ apply (simp add: pd_at_asid_uniq) apply simp done @@ -1600,26 +1621,26 @@ proof - apply (simp add: set_vm_root_for_flush_def setVMRootForFlush_def getThreadVSpaceRoot_def locateSlot_conv) apply (rule corres_guard_imp) apply (rule corres_split[OF getCurThread_corres]) - apply (rule corres_split_deprecated [where R="\_. vspace_at_asid asid pd and K (asid \ 0 \ asid \ mask asid_bits) + apply (rule corres_split [where R="\_. vspace_at_asid asid pd and K (asid \ 0 \ asid \ mask asid_bits) and valid_asid_map and valid_vs_lookup and valid_vspace_objs and unique_table_refs o caps_of_state and valid_arch_state and pspace_aligned and pspace_distinct" and R'="\_. pspace_aligned' and pspace_distinct' and no_0_obj'", - OF _ getSlotCap_corres]) - apply (case_tac "isArchObjectCap rv' \ - isPageDirectoryCap (capCap rv') \ - capPDMappedASID (capCap rv') \ None \ - capPDBasePtr (capCap rv') = pd") - apply (case_tac rv, simp_all add: isCap_simps)[1] - apply (rename_tac arch_cap) - apply (case_tac arch_cap, auto)[1] - apply (case_tac rv, simp_all add: isCap_simps[simplified] X[simplified])[1] + OF getSlotCap_corres]) + apply (simp add: cte_map_def objBits_simps tcb_cnode_index_def + tcbVTableSlot_def to_bl_1 cte_level_bits_def) + apply (case_tac "isArchObjectCap rv' \ + isPageDirectoryCap (capCap rv') \ + capPDMappedASID (capCap rv') \ None \ + capPDBasePtr (capCap rv') = pd") + apply (case_tac rv, simp_all add: isCap_simps)[1] apply (rename_tac arch_cap) - apply (case_tac arch_cap, auto simp: X[simplified] split: option.splits)[1] - apply (simp add: cte_map_def objBits_simps tcb_cnode_index_def - tcbVTableSlot_def to_bl_1 cte_level_bits_def) + apply (case_tac arch_cap, auto)[1] + apply (case_tac rv, simp_all add: isCap_simps[simplified] X[simplified])[1] + apply (rename_tac arch_cap) + apply (case_tac arch_cap, auto simp: X[simplified] split: option.splits)[1] apply wp+ apply (clarsimp simp: cur_tcb_def) apply (erule tcb_at_cte_at) @@ -1816,16 +1837,16 @@ lemma flushTable_corres: apply (rule corres_split[OF load_hw_asid_corres2[where pd=pd]]) apply (clarsimp cong: corres_weak_cong) apply (rule corres_when, rule refl) - apply (rule corres_split_deprecated[where r' = dc, OF corres_when corres_machine_op]) - apply simp - apply (rule corres_split[OF getCurThread_corres]) - apply (simp, rule setVMRoot_corres) - apply ((wp mapM_wp' hoare_vcg_const_imp_lift get_pte_wp getPTE_wp| - wpc|simp|fold cur_tcb_def cur_tcb'_def)+)[4] - apply (rule corres_Id[OF refl]) + apply (rule corres_split[where r' = dc, OF corres_machine_op corres_when]) + apply (rule corres_Id[OF refl]) + apply simp + apply (rule no_fail_invalidateLocalTLB_ASID) apply simp - apply (rule no_fail_invalidateLocalTLB_ASID) - apply (wpsimp wp: hoare_drop_imps | fold cur_tcb_def cur_tcb'_def)+ + apply (rule corres_split[OF getCurThread_corres]) + apply (simp, rule setVMRoot_corres) + apply ((wp mapM_wp' hoare_vcg_const_imp_lift get_pte_wp getPTE_wp| + wpc|simp|fold cur_tcb_def cur_tcb'_def)+)[4] + apply (wpsimp wp: hoare_drop_imps | fold cur_tcb_def cur_tcb'_def)+ apply (wpsimp wp: hoare_post_taut load_hw_asid_wp simp: valid_global_objs_def | rule hoare_drop_imps)+ done @@ -1852,14 +1873,14 @@ lemma flushPage_corres: apply (clarsimp cong: corres_weak_cong) apply (rule corres_when, rule refl) apply (rule corres_split[OF corres_machine_op [where r=dc]]) - apply (rule corres_when, rule refl) - apply (rule corres_split[OF getCurThread_corres]) - apply simp - apply (rule setVMRoot_corres) - apply wp+ - apply (rule corres_Id, rule refl, simp) - apply (rule no_fail_pre, wp no_fail_invalidateLocalTLB_VAASID) - apply simp + apply (rule corres_Id, rule refl, simp) + apply (rule no_fail_pre, wp no_fail_invalidateLocalTLB_VAASID) + apply simp + apply (rule corres_when, rule refl) + apply (rule corres_split[OF getCurThread_corres]) + apply simp + apply (rule setVMRoot_corres) + apply wp+ apply (simp add: cur_tcb_def [symmetric] cur_tcb'_def [symmetric]) apply (wpsimp wp: hoare_post_taut load_hw_asid_wp simp: valid_global_objs_def | rule hoare_drop_imps @@ -1906,16 +1927,16 @@ lemma pageTableMapped_corres: (pageTableMapped asid vaddr pt)" apply (simp add: page_table_mapped_def pageTableMapped_def) apply (rule corres_guard_imp) - apply (rule corres_split_catch) - apply (rule corres_trivial, simp) - apply (rule corres_split_eqrE[OF find_pd_for_asid_corres]) - apply (simp add: liftE_bindE) - apply (rule corres_split[OF getObject_PDE_corres']) - apply (rule corres_trivial) - apply (case_tac rv, - simp_all add: returnOk_def pde_relation_aligned_def - split:if_splits ARM_HYP_H.pde.splits)[1] - apply (wp | simp add: lookup_pd_slot_def Let_def)+ + apply (rule corres_split_catch) + apply (rule corres_split_eqrE[OF find_pd_for_asid_corres]) + apply simp + apply (simp add: liftE_bindE) + apply (rule corres_split[OF getObject_PDE_corres']) + apply (rule corres_trivial) + apply (case_tac rv, + simp_all add: returnOk_def pde_relation_aligned_def + split:if_splits ARM_HYP_H.pde.splits)[1] + apply (wp | simp add: lookup_pd_slot_def Let_def)+ apply (simp add: word_neq_0_conv) apply simp done @@ -1974,14 +1995,14 @@ lemma unmapPageTable_corres: apply (rule corres_split_eqr[OF pageTableMapped_corres]) apply (simp add: case_option_If2 split del: if_split) apply (rule corres_if2[OF refl]) - apply (rule corres_split[OF storePDE_corres']) - apply (rule corres_split[OF corres_machine_op]) - apply (rule flushTable_corres) + apply (rule corres_split) + apply (rule storePDE_corres') + apply (simp add:pde_relation_aligned_def) + apply (rule corres_split[OF corres_machine_op]) apply (rule corres_Id, rule refl, simp) - apply (wp no_fail_cleanByVA_PoU)+ - apply (simp, wp+) - apply (simp add:pde_relation_aligned_def)+ - apply (wp store_pde_pd_at_asid store_pde_vspace_objs_invalid) + apply (wp no_fail_cleanByVA_PoU) + apply (rule flushTable_corres) + apply (wpsimp wp: store_pde_pd_at_asid store_pde_vspace_objs_invalid)+ apply (rule hoare_vcg_conj_lift) apply (simp add: store_pde_def) apply (wp set_pd_vs_lookup_unmap)+ @@ -2050,9 +2071,9 @@ lemma corres_split_strengthen_ftE: \Q\ f \R\,-; \Q'\ j \R'\,- \ \ corres (dc \ r) (P and Q) (P' and Q') (f >>=E (\rv. g rv)) (j >>=E (\rv'. k rv'))" apply (rule_tac r'=r' in corres_splitEE) - apply (rule corres_rel_imp, assumption) + apply (erule corres_rel_imp) apply (case_tac x, auto)[1] - apply (erule corres_rel_imp) + apply (rule corres_rel_imp, assumption) apply (case_tac x, auto)[1] apply (simp add: validE_R_def)+ done @@ -2119,137 +2140,140 @@ lemma unmapPage_corres: (unmapPage sz asid vptr pptr)" apply (clarsimp simp: unmap_page_def unmapPage_def ignoreFailure_def const_def) apply (rule corres_guard_imp) - apply (rule corres_split_catch [where E="\_. \" and E'="\_. \"], simp) - apply (rule corres_split_strengthen_ftE[where ftr'=dc], - rule find_pd_for_asid_corres[OF refl]) - apply (rule corres_splitEE) + apply (rule corres_split_catch [where E="\_. \" and E'="\_. \"]) + apply (rule corres_split_strengthen_ftE[where ftr'=dc], + rule find_pd_for_asid_corres[OF refl]) + apply (rule corres_splitEE) + apply (rule_tac F = "vptr < kernel_base" in corres_gen_asm) + apply (rule_tac P="\\ pd and page_directory_at pd and vspace_at_asid asid pd + and (\\ (lookup_pd_slot pd vptr && ~~ mask pd_bits)) + and valid_arch_state and valid_vspace_objs + and equal_kernel_mappings + and pspace_aligned and valid_etcbs and + K (valid_unmap sz (asid,vptr) )" and + P'="pspace_aligned' and pspace_distinct'" in corres_inst) + apply clarsimp + apply (rename_tac pd) + apply (cases sz, simp_all)[1] + apply (rule corres_guard_imp) + apply (rule_tac F = "vptr < kernel_base" in corres_gen_asm) + apply (rule corres_split_strengthen_ftE[OF lookupPTSlot_corres]) + apply simp + apply (rule corres_splitEE[OF checkMappingPPtr_corres]) + apply simp + apply (rule corres_split[OF storePTE_corres']) + apply (clarsimp simp: pte_relation_aligned_def) + apply (rule corres_machine_op) + apply (rule corres_Id, rule refl, simp) + apply (rule no_fail_cleanByVA_PoU) + apply (wp hoare_drop_imps lookup_pt_slot_inv + lookupPTSlot_inv lookup_pt_slot_is_aligned + | simp add: valid_global_objs_def)+ + apply (clarsimp simp: page_directory_pde_at_lookupI + page_directory_at_aligned_pd_bits vmsz_aligned_def) + apply (simp add:valid_unmap_def pageBits_def)+ + apply (rule corres_guard_imp) + apply (rule corres_split_strengthen_ftE[OF lookupPTSlot_corres]) + apply (rule_tac F="is_aligned p 7" in corres_gen_asm) + apply (simp add: is_aligned_mask[symmetric]) + apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres]) + apply simp + apply (rule corres_split[OF corres_mapM]) + prefer 8 + apply (rule corres_machine_op) + apply (clarsimp simp: last_byte_pte_def objBits_simps archObjSize_def) + apply (rule corres_Id, rule refl, simp) + apply (rule no_fail_cleanCacheRange_PoU) + prefer 7 + apply (rule order_refl) + apply simp + apply simp + apply clarsimp + apply (rule_tac P="(\s. \x\set largePagePTEOffsets. pte_at (x + pa) s) and pspace_aligned and valid_etcbs" + and P'="pspace_aligned' and pspace_distinct'" + in corres_guard_imp) + apply (rule storePTE_corres', simp add:pte_relation_aligned_def) + apply clarsimp + apply clarsimp + apply (wp store_pte_typ_at hoare_vcg_const_Ball_lift | clarsimp | wp (once) hoare_drop_imps)+ + (* this is dumb... *) + apply (subst mult_is_add.mult_commute) + apply (wpsimp wp: lookup_pt_slot_ptes lookup_pt_slot_inv lookupPTSlot_inv + lookup_pt_slot_is_aligned lookup_pt_slot_is_aligned_6 + simp: largePagePTEOffsets_def pte_bits_def)+ + apply (clarsimp simp: page_directory_pde_at_lookupI vmsz_aligned_def pd_aligned + pd_bits_def pageBits_def valid_unmap_def valid_global_objs_def + page_directory_at_aligned_pd_bits pde_bits_def) + apply (simp add:pd_bits_def pageBits_def) + apply (rule corres_guard_imp) + apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres]) + apply simp + apply (rule corres_split[OF storePDE_corres']) + apply (simp add: pde_relation_aligned_def) + apply (rule corres_machine_op) + apply (rule corres_Id, rule refl, simp) + apply (rule no_fail_cleanByVA_PoU) + apply (rule wp_post_taut)+ + apply (wp | simp add:pde_relation_aligned_def + | wp (once) hoare_drop_imps)+ + apply (clarsimp simp: page_directory_pde_at_lookupI + pg_entry_align_def) + apply (clarsimp simp:lookup_pd_slot_def) + apply (clarsimp simp add: pd_bits_def pageBits_def + word_bits_conv pt_bits_def pde_bits_def) + apply (rule is_aligned_add[rotated]) + apply (rule is_aligned_shift) + apply (clarsimp simp add: obj_at_def pspace_aligned_def Ball_def dom_def) + apply (erule_tac x=pd in allE) + apply (clarsimp simp add: pd_bits_def pde_bits_def) + apply (rule is_aligned_dvd_k[where k=2048 and n=14]; clarsimp) + apply clarsimp + apply (simp add:pd_bits_def pageBits_def) + apply (rule corres_guard_imp) + apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres]) + apply (rule_tac F="is_aligned (lookup_pd_slot pd vptr) 7" + in corres_gen_asm) + apply (simp add: is_aligned_mask[symmetric]) + apply (rule corres_split) + apply (rule_tac P="page_directory_at pd and pspace_aligned and valid_etcbs + and K (valid_unmap sz (asid, vptr))" + in corres_mapM [where r=dc], simp, simp) + prefer 5 + apply (rule order_refl) + apply clarsimp + apply (rule corres_guard_imp, rule storePDE_corres') + apply (simp add:pde_relation_aligned_def)+ + apply clarsimp + apply (rule pde_at_aligned_vptr) + apply (simp add: superSectionPDEOffsets_def pde_bits_def)+ + apply (simp add: lookup_pd_slot_def vspace_bits_defs) + apply (simp add: valid_unmap_def) + apply assumption + apply (wp | simp | wp (once) hoare_drop_imps)+ + apply (rule corres_machine_op) + apply (clarsimp simp: last_byte_pde_def objBits_simps archObjSize_def) + apply (rule corres_Id, rule refl, simp) + apply (rule no_fail_cleanCacheRange_PoU) + apply (wpsimp | wp (once) hoare_drop_imps)+ + apply (clarsimp simp: valid_unmap_def page_directory_pde_at_lookupI + lookup_pd_slot_aligned_6 pg_entry_align_def + pd_aligned vmsz_aligned_def) + apply simp apply clarsimp apply (rule flushPage_corres) - apply (rule_tac F = "vptr < kernel_base" in corres_gen_asm) - apply (rule_tac P="\\ pd and page_directory_at pd and vspace_at_asid asid pd - and (\\ (lookup_pd_slot pd vptr && ~~ mask pd_bits)) - and valid_arch_state and valid_vspace_objs - and equal_kernel_mappings - and pspace_aligned and valid_etcbs and - K (valid_unmap sz (asid,vptr) )" and - P'="pspace_aligned' and pspace_distinct'" in corres_inst) - apply clarsimp - apply (rename_tac pd) - apply (cases sz, simp_all)[1] - apply (rule corres_guard_imp) - apply (rule_tac F = "vptr < kernel_base" in corres_gen_asm) - apply (rule corres_split_strengthen_ftE[OF lookupPTSlot_corres]) - apply simp - apply (rule corres_splitEE[OF checkMappingPPtr_corres]) - apply simp - apply (rule corres_split[OF storePTE_corres']) - apply (rule corres_machine_op) - apply (rule corres_Id, rule refl, simp) - apply (rule no_fail_cleanByVA_PoU) - apply (wp hoare_drop_imps lookup_pt_slot_inv - lookupPTSlot_inv lookup_pt_slot_is_aligned - | simp add: pte_relation_aligned_def valid_global_objs_def)+ - apply (clarsimp simp: page_directory_pde_at_lookupI - page_directory_at_aligned_pd_bits vmsz_aligned_def) - apply (simp add:valid_unmap_def pageBits_def)+ - apply (rule corres_guard_imp) - apply (rule corres_split_strengthen_ftE[OF lookupPTSlot_corres]) - apply (rule_tac F="is_aligned p 7" in corres_gen_asm) - apply (simp add: is_aligned_mask[symmetric]) - apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres]) - apply simp - apply (rule corres_split[OF corres_mapM]) - prefer 8 - apply (rule order_refl) - apply (rule corres_machine_op) - apply (clarsimp simp: last_byte_pte_def objBits_simps archObjSize_def) - apply (rule corres_Id, rule refl, simp) - apply (rule no_fail_cleanCacheRange_PoU) - apply simp - apply simp - apply clarsimp - apply (rule_tac P="(\s. \x\set largePagePTEOffsets. pte_at (x + pa) s) and pspace_aligned and valid_etcbs" - and P'="pspace_aligned' and pspace_distinct'" - in corres_guard_imp) - apply (rule storePTE_corres', simp add:pte_relation_aligned_def) - apply clarsimp - apply clarsimp - apply (wp store_pte_typ_at hoare_vcg_const_Ball_lift | clarsimp | wp (once) hoare_drop_imps)+ - (* this is dumb... *) - apply (subst mult_is_add.mult_commute) - apply (wpsimp wp: lookup_pt_slot_ptes lookup_pt_slot_inv lookupPTSlot_inv - lookup_pt_slot_is_aligned lookup_pt_slot_is_aligned_6 - simp: largePagePTEOffsets_def pte_bits_def)+ - apply (clarsimp simp: page_directory_pde_at_lookupI vmsz_aligned_def pd_aligned - pd_bits_def pageBits_def valid_unmap_def valid_global_objs_def - page_directory_at_aligned_pd_bits pde_bits_def) - apply (simp add:pd_bits_def pageBits_def) - apply (rule corres_guard_imp) - apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres]) - apply simp - apply (rule corres_split[OF storePDE_corres']) - apply (rule corres_machine_op) - apply (rule corres_Id, rule refl, simp) - apply (rule no_fail_cleanByVA_PoU) - apply (simp add: pde_relation_aligned_def) - apply (rule wp_post_taut)+ - apply (wp | simp add:pde_relation_aligned_def - | wp (once) hoare_drop_imps)+ - apply (clarsimp simp: page_directory_pde_at_lookupI - pg_entry_align_def) - apply (clarsimp simp:lookup_pd_slot_def) - apply (clarsimp simp add: pd_bits_def pageBits_def - word_bits_conv pt_bits_def pde_bits_def) - apply (rule is_aligned_add[rotated]) - apply (rule is_aligned_shift) - apply (clarsimp simp add: obj_at_def pspace_aligned_def Ball_def dom_def) - apply (erule_tac x=pd in allE) - apply (clarsimp simp add: pd_bits_def pde_bits_def) - apply (rule is_aligned_dvd_k[where k=2048 and n=14]; clarsimp) - apply clarsimp - apply (simp add:pd_bits_def pageBits_def) - apply (rule corres_guard_imp) - apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres]) - apply (rule_tac F="is_aligned (lookup_pd_slot pd vptr) 7" - in corres_gen_asm) - apply (simp add: is_aligned_mask[symmetric]) - apply (rule corres_split_deprecated) - apply (rule corres_machine_op) - apply (clarsimp simp: last_byte_pde_def objBits_simps archObjSize_def) - apply (rule corres_Id, rule refl, simp) - apply (rule no_fail_cleanCacheRange_PoU) - apply (rule_tac P="page_directory_at pd and pspace_aligned and valid_etcbs - and K (valid_unmap sz (asid, vptr))" - in corres_mapM [where r=dc], simp, simp) - prefer 5 - apply (rule order_refl) - apply clarsimp - apply (rule corres_guard_imp, rule storePDE_corres') - apply (simp add:pde_relation_aligned_def)+ - apply clarsimp - apply (rule pde_at_aligned_vptr) - apply (simp add: superSectionPDEOffsets_def pde_bits_def)+ - apply (simp add: lookup_pd_slot_def vspace_bits_defs) - apply (simp add: valid_unmap_def) - apply assumption - apply (wp | simp | wp (once) hoare_drop_imps)+ - apply (clarsimp simp: valid_unmap_def page_directory_pde_at_lookupI - lookup_pd_slot_aligned_6 pg_entry_align_def - pd_aligned vmsz_aligned_def) - apply simp - apply wp - apply (rule_tac Q'="\_. invs and vspace_at_asid asid pda" in hoare_post_imp_R) - apply (wpsimp wp: lookup_pt_slot_inv lookup_pt_slot_cap_to2' lookup_pt_slot_cap_to_multiple2 - store_pde_invs_unmap store_pde_pd_at_asid mapM_swp_store_pde_invs_unmap - simp: largePagePTEOffsets_def pte_bits_def - | wp hoare_drop_imps - | wp mapM_wp' | assumption)+ - apply auto[1] - apply (wpsimp wp: hoare_vcg_const_imp_lift_R lookupPTSlot_inv - | strengthen not_in_global_refs_vs_lookup - page_directory_at_lookup_mask_aligned_strg - page_directory_at_lookup_mask_add_aligned_strg - | wp hoare_vcg_const_Ball_lift_R mapM_wp')+ + apply wp + apply (rule_tac Q'="\_. invs and vspace_at_asid asid pda" in hoare_post_imp_R) + apply (wpsimp wp: lookup_pt_slot_inv lookup_pt_slot_cap_to2' lookup_pt_slot_cap_to_multiple2 + store_pde_invs_unmap store_pde_pd_at_asid mapM_swp_store_pde_invs_unmap + simp: largePagePTEOffsets_def pte_bits_def + | wp hoare_drop_imps + | wp mapM_wp' | assumption)+ + apply auto[1] + apply (wpsimp wp: hoare_vcg_const_imp_lift_R lookupPTSlot_inv + | strengthen not_in_global_refs_vs_lookup + page_directory_at_lookup_mask_aligned_strg + page_directory_at_lookup_mask_add_aligned_strg + | wp hoare_vcg_const_Ball_lift_R mapM_wp')+ apply (clarsimp simp add: valid_unmap_def valid_asid_def) apply (case_tac sz) apply (auto simp: invs_def valid_state_def @@ -2793,31 +2817,31 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split[OF pteCheckIfMapped_corres]) apply (rule corres_split[OF storePTE_corres']) - apply (rule corres_split_deprecated[where r' = dc, OF _ corres_store_pte_with_invalid_tail]) - apply (rule corres_split_deprecated[where r'=dc, OF _ corres_machine_op[OF corres_Id]]) - apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]]) - apply (clarsimp simp add: when_def) - apply (rule invalidate_tlb_by_asid_corres_ex) - apply wp - apply wp - apply (simp add: last_byte_pte_def objBits_simps archObjSize_def) - apply simp - apply (rule no_fail_cleanCacheRange_PoU) - apply (wpsimp, safe; wpsimp wp: hoare_vcg_ex_lift) - apply wpsimp + apply (clarsimp simp: pte_relation_aligned_def) + apply (clarsimp dest!: valid_slots_duplicated_pteD') + apply (rule corres_split[where r' = dc, OF corres_store_pte_with_invalid_tail]) apply (clarsimp simp: pte_relation_aligned_def) apply (clarsimp dest!: valid_slots_duplicated_pteD') apply (clarsimp simp: word_bits_def) - apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs - and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) - prefer 2 - apply auto[1] - apply (wp mapM_swp_store_pte_invs[where pte="ARM_A.pte.InvalidPTE", simplified] - hoare_vcg_ex_lift) - apply (wp mapM_UNIV_wp - | clarsimp simp add: swp_def split: prod.split simp del: fun_upd_apply)+ - apply (clarsimp simp: pte_relation_aligned_def) - apply (clarsimp dest!: valid_slots_duplicated_pteD') + apply (rule corres_split[where r'=dc, OF corres_machine_op[OF corres_Id]]) + apply (simp add: last_byte_pte_def objBits_simps archObjSize_def) + apply simp + apply (rule no_fail_cleanCacheRange_PoU) + apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]]) + apply (clarsimp simp add: when_def) + apply (rule invalidate_tlb_by_asid_corres_ex) + apply wp + apply wp + apply (wpsimp, safe; wpsimp wp: hoare_vcg_ex_lift) + apply wpsimp + apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs + and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) + prefer 2 + apply auto[1] + apply (wp mapM_swp_store_pte_invs[where pte="ARM_A.pte.InvalidPTE", simplified] + hoare_vcg_ex_lift) + apply (wp mapM_UNIV_wp + | clarsimp simp add: swp_def split: prod.split simp del: fun_upd_apply)+ apply (clarsimp simp del: fun_upd_apply simp add: cte_wp_at_caps_of_state) apply (wp add: hoare_vcg_const_Ball_lift store_pte_typ_at store_pte_cte_wp_at hoare_vcg_ex_lift)+ @@ -2853,30 +2877,30 @@ proof - apply (rule corres_guard_imp) apply (rule corres_split[OF pdeCheckIfMapped_corres]) apply (rule corres_split[OF storePDE_corres']) - apply (rule corres_split_deprecated[where r'=dc, OF _ corres_store_pde_with_invalid_tail]) - apply (rule corres_split_deprecated[where r'=dc,OF _ corres_machine_op[OF corres_Id]]) - apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]]) - apply (clarsimp simp: when_def) - apply (rule invalidate_tlb_by_asid_corres_ex) - apply wp - apply wp - apply (simp add: last_byte_pde_def objBits_simps archObjSize_def) - apply simp - apply (rule no_fail_cleanCacheRange_PoU) - apply (wpsimp, safe ; wpsimp wp: hoare_vcg_ex_lift) - apply wpsimp + apply (clarsimp simp: pde_relation_aligned_def) + apply (clarsimp dest!: valid_slots_duplicated_pdeD') + apply (rule corres_split[where r'=dc, OF corres_store_pde_with_invalid_tail]) apply (clarsimp simp: pde_relation_aligned_def) apply (clarsimp dest!: valid_slots_duplicated_pdeD') apply (simp add: word_bits_def) - apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs - and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) - prefer 2 - apply auto[1] - apply (wp mapM_swp_store_pde_invs_unmap[where pde="ARM_A.pde.InvalidPDE", simplified] - hoare_vcg_ex_lift) - apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def)+ - apply (clarsimp simp: pde_relation_aligned_def) - apply (clarsimp dest!: valid_slots_duplicated_pdeD') + apply (rule corres_split[where r'=dc,OF corres_machine_op[OF corres_Id]]) + apply (simp add: last_byte_pde_def objBits_simps archObjSize_def) + apply simp + apply (rule no_fail_cleanCacheRange_PoU) + apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]]) + apply (clarsimp simp: when_def) + apply (rule invalidate_tlb_by_asid_corres_ex) + apply wp + apply wp + apply (wpsimp, safe ; wpsimp wp: hoare_vcg_ex_lift) + apply wpsimp + apply (rule_tac Q="\_. K (word \ mask asid_bits \ word \ 0) and invs + and (\s. \pd. vspace_at_asid word pd s)" in hoare_strengthen_post) + prefer 2 + apply auto[1] + apply (wp mapM_swp_store_pde_invs_unmap[where pde="ARM_A.pde.InvalidPDE", simplified] + hoare_vcg_ex_lift) + apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def)+ apply (clarsimp simp add: cte_wp_at_caps_of_state simp del: fun_upd_apply) apply (wp hoare_vcg_const_Ball_lift store_pde_typ_at hoare_vcg_ex_lift store_pde_pd_at_asid) apply (rule hoare_vcg_conj_lift) @@ -3064,12 +3088,13 @@ lemma performPageTableInvocation_corres: apply (rule corres_guard_imp) apply (rule corres_split[OF updateCap_same_master]) apply assumption - apply (rule corres_split[OF storePDE_corres']) - apply (rule corres_machine_op) - apply (rule corres_Id, rule refl, simp) - apply (rule no_fail_cleanByVA_PoU) + apply (rule corres_split) + apply (rule storePDE_corres') apply (simp add: pde_relation_aligned_def) - apply (wp set_cap_typ_at)+ + apply (rule corres_machine_op) + apply (rule corres_Id, rule refl, simp) + apply (rule no_fail_cleanByVA_PoU) + apply (wp set_cap_typ_at)+ apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state is_arch_update_def) apply (clarsimp simp: is_cap_simps cap_master_cap_simps dest!: cap_master_cap_eqDs) @@ -3087,20 +3112,20 @@ lemma performPageTableInvocation_corres: apply (simp add: case_option_If2 getSlotCap_def split del: if_split) apply (rule corres_guard_imp) apply (rule corres_split_nor) - apply (simp add: liftM_def) - apply (rule corres_split[OF get_cap_corres]) - apply (rule_tac F="is_pt_cap x" in corres_gen_asm) - apply (rule updateCap_same_master) - apply (clarsimp simp: is_pt_cap_def update_map_data_def) - apply (wp get_cap_wp)+ - apply (rule corres_if[OF refl]) - apply (rule corres_split[OF unmapPageTable_corres]) - apply (rule corres_split_nor) + apply (rule corres_if[OF refl]) + apply (rule corres_split[OF unmapPageTable_corres]) + apply (rule corres_split_nor) + apply (rule clear_page_table_corres[simplified ptBits_def pteBits_def, simplified]) apply (rule corres_machine_op, rule corres_Id) apply simp+ - apply (rule clear_page_table_corres[simplified ptBits_def pteBits_def, simplified]) - apply wp+ - apply (rule corres_trivial, simp) + apply wp+ + apply (rule corres_trivial, simp) + apply (simp add: liftM_def) + apply (rule corres_split[OF get_cap_corres]) + apply (rule_tac F="is_pt_cap x" in corres_gen_asm) + apply (rule updateCap_same_master) + apply (clarsimp simp: is_pt_cap_def update_map_data_def) + apply ((wp get_cap_wp)+)[2] apply (simp add: cte_wp_at_caps_of_state pred_conj_def split del: if_split) apply (rule hoare_lift_Pf2[where f=caps_of_state]) @@ -3114,7 +3139,7 @@ lemma performPageTableInvocation_corres: apply (auto simp: valid_cap_def mask_def cap_master_cap_def cap_rights_update_def acap_rights_update_def split: option.split_asm)[1] - apply (auto simp: valid_pti'_def cte_wp_at_ctes_of) + apply (auto simp: valid_pti'_def cte_wp_at_ctes_of) done definition @@ -3149,6 +3174,7 @@ lemma performASIDPoolInvocation_corres: apply (rename_tac word1 word2 prod) apply (rule corres_guard_imp) apply (rule corres_split[OF getSlotCap_corres]) + apply simp apply (rule_tac F="\p asid. rv = Structures_A.ArchObjectCap (ARM_A.PageDirectoryCap p asid)" in corres_gen_asm) apply clarsimp apply (rule_tac Q="valid_objs and pspace_aligned and pspace_distinct and asid_pool_at word2 and valid_etcbs and @@ -3173,8 +3199,7 @@ lemma performASIDPoolInvocation_corres: apply (erule cte_wp_at_weakenE) apply (clarsimp simp: is_cap_simps cap_master_cap_simps dest!: cap_master_cap_eqDs) apply (wp getASID_wp) - apply (rule refl) - apply (wp get_cap_wp getCTE_wp)+ + apply (wp get_cap_wp getCTE_wp)+ apply (clarsimp simp: valid_apinv_def cte_wp_at_def cap_master_cap_def is_pd_cap_def obj_at_def) apply (clarsimp simp: a_type_def) apply (clarsimp simp: cte_wp_at_ctes_of valid_apinv'_def)