diff --git a/proof/access-control/Arch_AC.thy b/proof/access-control/Arch_AC.thy index 4a6894ac11..356e02621b 100644 --- a/proof/access-control/Arch_AC.thy +++ b/proof/access-control/Arch_AC.thy @@ -267,8 +267,7 @@ lemma perform_page_table_invocation_pas_refined [wp]: apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) cap_cur_auth_caps_of_state) apply simp - apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state - is_arch_diminished_def diminished_def mask_PTCap_eq) + apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state mask_PTCap_eq) apply (clarsimp simp: cap_auth_conferred_def update_map_data_def is_page_cap_def cap_links_asid_slot_def cap_links_irq_def aag_cap_auth_def) done @@ -478,13 +477,6 @@ lemma kernel_base_aligned_20: apply(simp add: kernel_base_def is_aligned_def) done -lemma diminished_PageCapD: - "diminished (ArchObjectCap (PageCap dev p R sz m)) cap - \ \R'. cap = ArchObjectCap (PageCap dev p R' sz m)" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (fastforce simp: acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) - done - (* FIXME: CLAG *) lemmas do_machine_op_bind = submonad_bind [OF submonad_do_machine_op submonad_do_machine_op @@ -669,11 +661,10 @@ proof - | elim conjE hd_valid_slots[THEN bspec[rotated]] | clarsimp dest!:set_tl_subset_mp | wpc )+ - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def - cap_auth_conferred_def cap_rights_update_def - acap_rights_update_def update_map_data_def is_pg_cap_def - valid_page_inv_def valid_cap_simps - dest!: diminished_PageCapD cap_master_cap_eqDs) + apply (clarsimp simp: cte_wp_at_caps_of_state cap_auth_conferred_def cap_rights_update_def + acap_rights_update_def update_map_data_def is_pg_cap_def + valid_page_inv_def valid_cap_simps + dest!: cap_master_cap_eqDs) apply (drule (1) clas_caps_of_state) apply (simp add: cap_links_asid_slot_def label_owns_asid_slot_def) apply (auto dest: pas_refined_Control)[1] @@ -710,9 +701,7 @@ lemma perform_page_invocation_pas_refined [wp]: pde_ref2_def auth_graph_map_mem pas_refined_refl split: sum.splits)+)[2] apply (clarsimp simp: cte_wp_at_caps_of_state is_transferable_is_arch_update[symmetric] - is_arch_diminished_def pte_ref_def pde_ref2_def - is_cap_simps is_pg_cap_def cap_auth_conferred_def - dest!: diminished_PageCapD) + pte_ref_def pde_ref2_def is_cap_simps is_pg_cap_def cap_auth_conferred_def) apply (frule(1) cap_cur_auth_caps_of_state, simp) apply (intro impI conjI; clarsimp; (* NB: for speed *) @@ -1134,8 +1123,8 @@ lemmas vmsz_aligned_t2n_neg_mask lemma decode_arch_invocation_authorised: "\invs and pas_refined aag - and cte_wp_at (diminished (cap.ArchObjectCap cap)) slot - and (\s. \(cap, slot) \ set excaps. cte_wp_at (diminished cap) slot s) + and cte_wp_at ((=) (cap.ArchObjectCap cap)) slot + and (\s. \(cap, slot) \ set excaps. cte_wp_at ((=) cap) slot s) and K (\(cap, slot) \ {(cap.ArchObjectCap cap, slot)} \ set excaps. aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \ is_subject aag (fst slot) \ (\v \ cap_asid' cap. is_subject_asid aag v))\ @@ -1155,7 +1144,7 @@ lemma decode_arch_invocation_authorised: split del: if_split)+ apply (clarsimp simp: authorised_asid_pool_inv_def authorised_page_table_inv_def neq_Nil_conv invs_psp_aligned invs_vspace_objs cli_no_irqs) - apply (drule diminished_cte_wp_at_valid_cap, clarsimp+) + apply (drule cte_wp_valid_cap, clarsimp+) apply (cases cap; simp) \ \asid pool\ apply (find_goal \match premises in "cap = ASIDPoolCap _ _" \ succeed\) diff --git a/proof/access-control/Syscall_AC.thy b/proof/access-control/Syscall_AC.thy index 909971f762..5e23efb51c 100644 --- a/proof/access-control/Syscall_AC.thy +++ b/proof/access-control/Syscall_AC.thy @@ -113,18 +113,6 @@ lemma perform_invocation_respects: declare AllowSend_def[simp] AllowRecv_def[simp] -lemma diminshed_IRQControlCap_eq: - "diminished IRQControlCap = ((=) IRQControlCap)" - apply (rule ext) - apply (case_tac x, auto simp: diminished_def mask_cap_def cap_rights_update_def split:bool.splits) - done - -lemma diminished_DomainCap_eq: - "diminished DomainCap = ((=) DomainCap)" - apply (rule ext) - apply (case_tac x, auto simp: diminished_def mask_cap_def cap_rights_update_def split:bool.splits) - done - lemma hoare_conjunct1_R: "\ P \ f \ \ r s. Q r s \ Q' r s\,- \ \ P \ f \ Q \,-" apply(auto intro: hoare_post_imp_R) @@ -136,14 +124,14 @@ lemma hoare_conjunct2_R: done lemma decode_invocation_authorised: - "\pas_refined aag and valid_cap cap and invs and ct_active and cte_wp_at (diminished cap) slot + "\pas_refined aag and valid_cap cap and invs and ct_active and cte_wp_at ((=) cap) slot and ex_cte_cap_to slot and (\s. \r\zobj_refs cap. ex_nonz_cap_to r s) and (\s. \r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_to r s) and (\s. \cap \ set excaps. \r\cte_refs (fst cap) (interrupt_irq_node s). ex_cte_cap_to r s) and (\s. \x \ set excaps. s \ (fst x)) and (\s. \x \ set excaps. \r\zobj_refs (fst x). ex_nonz_cap_to r s) - and (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. real_cte_at (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to is_cnode_cap (snd x) s) and (\s. \x \ set excaps. cte_wp_at (interrupt_derived (fst x)) (snd x) s) @@ -161,7 +149,7 @@ lemma decode_invocation_authorised: decode_cnode_inv_authorised decode_tcb_invocation_authorised decode_tcb_inv_wf decode_arch_invocation_authorised - | strengthen cnode_diminished_strg + | strengthen cnode_eq_strg | wpc | simp add: comp_def authorised_invocation_def decode_invocation_def split del: if_split del: hoare_True_E_R | wp (once) hoare_FalseE_R)+ @@ -178,17 +166,16 @@ lemma decode_invocation_authorised: apply (clarsimp simp: cap_auth_conferred_def cap_rights_to_auth_def pas_refined_Control[symmetric] reply_cap_rights_to_auth_def) - apply ((clarsimp simp: valid_cap_def cte_wp_at_eq_simp - is_cap_simps pas_refined_all_auth_is_owns + apply ((clarsimp simp: valid_cap_def is_cap_simps pas_refined_all_auth_is_owns ex_cte_cap_wp_to_weakenE[OF _ TrueI] cap_auth_conferred_def cap_rights_to_auth_def | rule conjI | (subst split_paired_Ex[symmetric], erule exI) | erule cte_wp_at_weakenE | drule(1) bspec - | erule diminished_no_cap_to_obj_with_diff_ref)+)[1] - apply (simp only: domain_sep_inv_def diminished_DomainCap_eq) + | erule eq_no_cap_to_obj_with_diff_ref)+)[1] + apply (simp only: domain_sep_inv_def) apply (rule impI, erule subst, rule pas_refined_sita_mem [OF sita_controlled], - auto simp: cte_wp_at_caps_of_state diminshed_IRQControlCap_eq)[1] + auto simp: cte_wp_at_caps_of_state)[1] apply (clarsimp simp add: cap_links_irq_def ) apply (drule (1) pas_refined_Control, simp) diff --git a/proof/crefine/ARM/Arch_C.thy b/proof/crefine/ARM/Arch_C.thy index 5564ec4790..7e000a7539 100644 --- a/proof/crefine/ARM/Arch_C.thy +++ b/proof/crefine/ARM/Arch_C.thy @@ -38,7 +38,7 @@ context kernel_m begin lemma performPageTableInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) \ cteCap) ctSlot + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) \ cteCap) ctSlot and (\_. isPageTableCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] @@ -115,7 +115,6 @@ lemma performPageTableInvocationUnmap_ccorres: apply (simp add: guard_is_UNIV_def) apply (clarsimp simp: cap_get_tag_isCap_ArchObject[symmetric] cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (frule_tac x=s in fun_cong[OF diminished_valid']) apply (frule valid_global_refsD_with_objSize, clarsimp) apply (clarsimp simp: cap_lift_page_table_cap cap_to_H_def cap_page_table_cap_lift_def isCap_simps @@ -123,8 +122,7 @@ lemma performPageTableInvocationUnmap_ccorres: ptBits_def pageBits_def capAligned_def to_bool_def mask_def page_table_at'_def capRange_def Int_commute pteBits_def - elim!: ccap_relationE cong: if_cong - dest!: diminished_capMaster) + elim!: ccap_relationE cong: if_cong) apply (drule spec[where x=0], clarsimp) done @@ -601,7 +599,7 @@ lemma decodeARMPageTableInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and valid_cap' (ArchObjectCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) @@ -867,7 +865,7 @@ lemma decodeARMPageTableInvocation_ccorres: word_less_nat_alt pageBits_def pteBits_def pdeBits_def ptBits_def) apply (frule length_ineq_not_Nil) - apply (frule cap_get_tag_isCap_unfolded_H_cap(15)) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (frule cap_get_tag_isCap_unfolded_H_cap(14)) apply (clarsimp simp: cap_lift_page_directory_cap hd_conv_nth cap_lift_page_table_cap @@ -2195,13 +2193,13 @@ lemma resolveVAddr_ccorres: split: pde.splits) done -lemma cte_wp_at_diminished_gsMaxObjectSize: - "cte_wp_at' (diminished' cap o cteCap) slot s +lemma cte_wp_at_eq_gsMaxObjectSize: + "cte_wp_at' ((=) cap o cteCap) slot s \ valid_global_refs' s \ 2 ^ capBits cap \ gsMaxObjectSize s" apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) valid_global_refsD_with_objSize) - apply (clarsimp simp: diminished'_def capMaster_eq_capBits_eq[OF capMasterCap_maskCapRights]) + apply (clarsimp simp: capMaster_eq_capBits_eq[OF capMasterCap_maskCapRights]) done lemma two_nat_power_pageBitsForSize_le: @@ -2248,7 +2246,7 @@ lemma decodeARMFrameInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -2669,53 +2667,53 @@ lemma decodeARMFrameInvocation_ccorres: apply (rename_tac word rghts pg_sz mapdata buffera cap excaps cte length___unsigned_long invLabel s s') apply (rule conjI) - apply (clarsimp, frule cte_wp_at_diminished_gsMaxObjectSize, clarsimp) + apply (clarsimp, frule cte_wp_at_eq_gsMaxObjectSize, clarsimp) apply (clarsimp simp: cte_wp_at_ctes_of is_aligned_mask[symmetric] vmsz_aligned'_def vmsz_aligned_addrFromPPtr) apply (frule ctes_of_valid', clarsimp+) - apply (simp add: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym, simp) apply (clarsimp simp: valid_cap'_def capAligned_def mask_def[where n=asid_bits] linorder_not_le) apply (prop_tac "extraCaps \ [] \ (s \' fst (extraCaps ! 0))") apply (clarsimp simp: neq_Nil_conv excaps_in_mem_def slotcap_in_mem_def linorder_not_le) apply (erule ctes_of_valid', clarsimp) (* Haskell side *) - subgoal - apply (clarsimp simp: ct_in_state'_def vmsz_aligned'_def isCap_simps valid_cap'_def - valid_tcb_state'_def page_directory_at'_def sysargs_rel_to_n - linorder_not_less excaps_map_def - | rule conjI | erule pred_tcb'_weakenE disjE - | erule(3) is_aligned_no_overflow3[OF vmsz_aligned_addrFromPPtr(3)[THEN iffD2]] - | drule st_tcb_at_idle_thread' interpret_excaps_eq - | erule order_le_less_trans[rotated] order_trans[where x=63, rotated] - | rule order_trans[where x=63, OF _ two_nat_power_pageBitsForSize_le, unfolded pageBits_def] - | clarsimp simp: neq_Nil_conv - | solves \rule word_plus_mono_right[OF word_less_sub_1], simp, - subst (asm) vmsz_aligned_addrFromPPtr(3)[symmetric], - erule is_aligned_no_wrap', clarsimp\ - | solves \frule vmsz_aligned_addrFromPPtr(3)[THEN iffD2], - (subst mask_add_aligned mask_add_aligned_right, erule is_aligned_weaken, - rule order_trans[OF _ pbfs_atleast_pageBits[simplified pageBits_def]], simp)+, - simp\)+ - apply (clarsimp simp: does_not_throw_def not_le word_aligned_add_no_wrap_bounded - split: option.splits) - apply (clarsimp simp: neq_Nil_conv dest!: st_tcb_at_idle_thread' interpret_excaps_eq) - apply (clarsimp | rule conjI | erule pred_tcb'_weakenE disjE - | solves \rule word_plus_mono_right[OF word_less_sub_1], simp, - subst (asm) vmsz_aligned_addrFromPPtr(3)[symmetric], - erule is_aligned_no_wrap', clarsimp\ - | solves \frule vmsz_aligned_addrFromPPtr(3)[THEN iffD2], - (subst mask_add_aligned mask_add_aligned_right, erule is_aligned_weaken, - rule order_trans[OF _ pbfs_atleast_pageBits[simplified pageBits_def]], simp)+, - simp\)+ (* 20s *) - done + subgoal + apply (clarsimp simp: ct_in_state'_def vmsz_aligned'_def isCap_simps valid_cap'_def + valid_tcb_state'_def page_directory_at'_def sysargs_rel_to_n + linorder_not_less excaps_map_def + | rule conjI | erule pred_tcb'_weakenE disjE + | erule(3) is_aligned_no_overflow3[OF vmsz_aligned_addrFromPPtr(3)[THEN iffD2]] + | drule st_tcb_at_idle_thread' interpret_excaps_eq + | erule order_le_less_trans[rotated] order_trans[where x=63, rotated] + | rule order_trans[where x=63, OF _ two_nat_power_pageBitsForSize_le, unfolded pageBits_def] + | clarsimp simp: neq_Nil_conv + | solves \rule word_plus_mono_right[OF word_less_sub_1], simp, + subst (asm) vmsz_aligned_addrFromPPtr(3)[symmetric], + erule is_aligned_no_wrap', clarsimp\ + | solves \frule vmsz_aligned_addrFromPPtr(3)[THEN iffD2], + (subst mask_add_aligned mask_add_aligned_right, erule is_aligned_weaken, + rule order_trans[OF _ pbfs_atleast_pageBits[simplified pageBits_def]], simp)+, + simp\)+ + apply (clarsimp simp: does_not_throw_def not_le word_aligned_add_no_wrap_bounded + split: option.splits) + apply (clarsimp simp: neq_Nil_conv dest!: st_tcb_at_idle_thread' interpret_excaps_eq) + apply ((clarsimp | rule conjI | erule pred_tcb'_weakenE disjE + | solves \rule word_plus_mono_right[OF word_less_sub_1], simp, + subst (asm) vmsz_aligned_addrFromPPtr(3)[symmetric], + erule is_aligned_no_wrap', clarsimp\ + | solves \frule vmsz_aligned_addrFromPPtr(3)[THEN iffD2], + (subst mask_add_aligned mask_add_aligned_right, erule is_aligned_weaken, + rule order_trans[OF _ pbfs_atleast_pageBits[simplified pageBits_def]], simp)+, + simp\)+)[1] (* 20s *) + done (* C side *) apply (clarsimp simp: rf_sr_ksCurThread "StrictC'_thread_state_defs" mask_eq_iff_w2p word_size word_less_nat_alt from_bool_0 excaps_map_def cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (clarsimp simp: diminished_valid'[symmetric] valid_cap'_def capAligned_def word_sless_def - word_sle_def) + apply (drule_tac t="cteCap ctea" in sym) + apply (clarsimp simp: valid_cap'_def capAligned_def word_sless_def word_sle_def) apply (prop_tac "cap_get_tag cap \ {scast cap_small_frame_cap, scast cap_frame_cap}") apply (clarsimp simp: cap_to_H_def cap_lift_def Let_def elim!: ccap_relationE split: if_split_asm) apply (rule conjI) @@ -2888,7 +2886,7 @@ lemma decodeARMPageDirectoryInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. invLabel_' s = label} @@ -3111,7 +3109,7 @@ lemma decodeARMPageDirectoryInvocation_ccorres: invs_valid_objs' invs_sch_act_wf' tcb_at_invs') apply (clarsimp simp: isCap_simps cte_wp_at_ctes_of invs_no_0_obj') apply (frule ctes_of_valid', clarsimp) - apply (simp only: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym) apply (intro conjI) apply (clarsimp simp: sysargs_rel_to_n word_le_nat_alt mask_def linorder_not_less linorder_not_le valid_cap_simps') @@ -3215,7 +3213,7 @@ lemma Arch_decodeInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -3786,7 +3784,8 @@ lemma Arch_decodeInvocation_ccorres: apply (rule conjI) apply (clarsimp simp: cte_wp_at_ctes_of ct_in_state'_def if_1_0_0 interpret_excaps_eq excaps_map_def) - apply (frule(1) ctes_of_valid', simp only: diminished_valid'[symmetric]) + apply (frule(1) ctes_of_valid') + apply (drule_tac t="cteCap ctea" in sym, simp) apply (cases "extraCaps") apply simp apply (frule interpret_excaps_eq[rule_format, where n=0], simp) @@ -3873,9 +3872,9 @@ lemma Arch_decodeInvocation_ccorres: apply (clarsimp simp: asid_low_bits_word_bits isCap_simps neq_Nil_conv excaps_map_def excaps_in_mem_def p2_gt_0[where 'a=32, folded word_bits_def]) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (frule cap_get_tag_isCap_unfolded_H_cap(13)) apply (frule ctes_of_valid', clarsimp) - apply (simp only: diminished_valid'[symmetric]) apply (frule interpret_excaps_eq[rule_format, where n=0], simp) apply (rule conjI) apply (clarsimp simp: cap_lift_asid_pool_cap cap_lift_page_directory_cap diff --git a/proof/crefine/ARM/Syscall_C.thy b/proof/crefine/ARM/Syscall_C.thy index 8e2388c14e..26e74e17fc 100644 --- a/proof/crefine/ARM/Syscall_C.thy +++ b/proof/crefine/ARM/Syscall_C.thy @@ -119,7 +119,7 @@ lemma decodeInvocation_ccorres: (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and (\s. \x \ zobj_refs' cp. ex_nonz_cap_to' x s) and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' cp \ cteCap) slot + and cte_wp_at' ((=) cp \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. \y \ zobj_refs' (fst v). ex_nonz_cap_to' y s) @@ -314,8 +314,6 @@ lemma decodeInvocation_ccorres: unat_eq_0 sysargs_rel_n_def n_msgRegisters_def valid_tcb_state'_def | rule conjI | erule pred_tcb'_weakenE disjE | drule st_tcb_at_idle_thread')+ - apply (fastforce dest: diminished_ReplyCap') - apply (fastforce dest!: diminished_ReplyCap') apply fastforce apply (simp add: cap_lift_capEPBadge_mask_eq) apply (clarsimp simp: rf_sr_ksCurThread Collect_const_mem @@ -953,7 +951,7 @@ lemma handleInvocation_ccorres: apply vcg apply (rule conseqPre, vcg) apply clarsimp - apply (simp, wp lcs_diminished'[unfolded o_def]) + apply (simp, wp lcs_eq[unfolded o_def]) apply clarsimp apply (vcg exspec= lookupCapAndSlot_modifies) apply simp diff --git a/proof/crefine/ARM/VSpace_C.thy b/proof/crefine/ARM/VSpace_C.thy index fdc94c8975..60cd4045be 100644 --- a/proof/crefine/ARM/VSpace_C.thy +++ b/proof/crefine/ARM/VSpace_C.thy @@ -2586,17 +2586,6 @@ lemma updateCap_frame_mapped_addr_ccorres: apply (clarsimp simp: cte_wp_at_ctes_of) done -(* FIXME: move *) -lemma diminished_PageCap: - "diminished' (ArchObjectCap (PageCap d p R sz a)) cap \ - \R'. cap = ArchObjectCap (PageCap d p R' sz a)" - apply (clarsimp simp: diminished'_def) - apply (clarsimp simp: maskCapRights_def Let_def) - apply (cases cap, simp_all add: isCap_simps) - apply (simp add: ARM_H.maskCapRights_def) - apply (simp add: isPageCap_def split: arch_capability.splits) - done - (* FIXME: move *) lemma ccap_relation_mapped_asid_0: "ccap_relation (ArchObjectCap (PageCap d v0 v1 v2 v3)) cap @@ -2708,7 +2697,7 @@ lemma ccap_relation_PageCap_generics: lemma performPageInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] (liftE (performPageInvocation (PageUnmap cap ctSlot))) @@ -2718,7 +2707,7 @@ lemma performPageInvocationUnmap_ccorres: apply csymbr apply (rule ccorres_guard_imp [where A= "invs' - and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot + and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)"]) apply wpc apply (rule_tac P=" ret__unsigned_long = 0" in ccorres_gen_asm) @@ -2766,7 +2755,7 @@ lemma performPageInvocationUnmap_ccorres: apply (simp add: cte_wp_at_ctes_of) apply wp apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps split: if_split) - apply (drule diminished_PageCap) + apply (drule_tac t="cteCap cte" in sym) apply clarsimp apply (drule ccap_relation_mapped_asid_0) apply (frule ctes_of_valid', clarsimp) @@ -2774,7 +2763,7 @@ lemma performPageInvocationUnmap_ccorres: apply (fastforce simp: mask_def valid_cap'_def) apply assumption apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps split: if_split) - apply (drule diminished_PageCap) + apply (drule_tac t="cteCap cte" in sym) apply clarsimp apply (frule (1) rf_sr_ctes_of_clift) apply (clarsimp simp: typ_heap_simps') diff --git a/proof/crefine/ARM_HYP/Arch_C.thy b/proof/crefine/ARM_HYP/Arch_C.thy index 4a83b27258..2df3fd4cb2 100644 --- a/proof/crefine/ARM_HYP/Arch_C.thy +++ b/proof/crefine/ARM_HYP/Arch_C.thy @@ -58,7 +58,7 @@ lemma objBits_InvalidPTE: lemma performPageTableInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) \ cteCap) ctSlot + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) \ cteCap) ctSlot and (\_. isPageTableCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] @@ -136,7 +136,6 @@ lemma performPageTableInvocationUnmap_ccorres: apply (simp add: guard_is_UNIV_def) apply (clarsimp simp: cap_get_tag_isCap_ArchObject[symmetric] cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (frule_tac x=s in fun_cong[OF diminished_valid']) apply (frule valid_global_refsD_with_objSize, clarsimp) apply (clarsimp simp: cap_lift_page_table_cap cap_to_H_def cap_page_table_cap_lift_def isCap_simps @@ -144,8 +143,7 @@ lemma performPageTableInvocationUnmap_ccorres: table_bits_defs capAligned_def to_bool_def mask_def page_table_at'_def capRange_def Int_commute asid_bits_def - elim!: ccap_relationE cong: if_cong - dest!: diminished_capMaster) + elim!: ccap_relationE cong: if_cong) apply (drule spec[where x=0], clarsimp) done @@ -643,7 +641,7 @@ lemma decodeARMPageTableInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and valid_cap' (ArchObjectCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) @@ -900,7 +898,7 @@ lemma decodeARMPageTableInvocation_ccorres: word_sle_def word_sless_def word_less_nat_alt) apply (frule length_ineq_not_Nil) - apply (frule cap_get_tag_isCap_unfolded_H_cap(15)) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (frule cap_get_tag_isCap_unfolded_H_cap(14)) apply (clarsimp simp: cap_lift_page_directory_cap hd_conv_nth cap_lift_page_table_cap table_bits_defs @@ -2631,13 +2629,13 @@ lemma resolveVAddr_ccorres: split: pde.splits) done -lemma cte_wp_at_diminished_gsMaxObjectSize: - "cte_wp_at' (diminished' cap o cteCap) slot s +lemma cte_wp_at_eq_gsMaxObjectSize: + "cte_wp_at' ((=) cap o cteCap) slot s \ valid_global_refs' s \ 2 ^ capBits cap \ gsMaxObjectSize s" apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) valid_global_refsD_with_objSize) - apply (clarsimp simp: diminished'_def capMaster_eq_capBits_eq[OF capMasterCap_maskCapRights]) + apply (clarsimp simp: capMaster_eq_capBits_eq[OF capMasterCap_maskCapRights]) done lemma two_nat_power_pageBitsForSize_le: @@ -2693,7 +2691,7 @@ lemma decodeARMFrameInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -3121,54 +3119,54 @@ lemma decodeARMFrameInvocation_ccorres: apply (wpsimp, (simp, vcg exspec=getSyscallArg_modifies))+ apply (rename_tac word rghts pg_sz mapdata buffera cap excaps cte length___unsigned_long invLabel s s') apply (rule conjI) - apply (clarsimp, frule cte_wp_at_diminished_gsMaxObjectSize, clarsimp) + apply (clarsimp, frule cte_wp_at_eq_gsMaxObjectSize, clarsimp) apply (clarsimp simp: cte_wp_at_ctes_of is_aligned_mask[symmetric] vmsz_aligned'_def vmsz_aligned_addrFromPPtr) apply (frule ctes_of_valid', clarsimp+) - apply (simp add: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym, simp) apply (clarsimp simp: valid_cap'_def capAligned_def mask_def[where n=asid_bits] linorder_not_le) apply (prop_tac "extraCaps \ [] \ (s \' fst (extraCaps ! 0))") apply (clarsimp simp: neq_Nil_conv excaps_in_mem_def slotcap_in_mem_def linorder_not_le) apply (erule ctes_of_valid', clarsimp) - (* Haskell side *) - subgoal - supply_local_method simplify_and_expand = - (clarsimp simp: ct_in_state'_def vmsz_aligned'_def isCap_simps valid_cap'_def - valid_tcb_state'_def page_directory_at'_def sysargs_rel_to_n - linorder_not_less excaps_map_def - simp del: less_1_simp - | rule conjI - | erule pred_tcb'_weakenE disjE - | drule st_tcb_at_idle_thread' interpret_excaps_eq)+ - - apply (local_method simplify_and_expand, - (erule order_le_less_trans[rotated] order_trans[where x=127, rotated] - | rule order_trans[where x=127, OF _ two_nat_power_pageBitsForSize_le, - unfolded pageBits_def])+, simp)+ - apply (clarsimp simp: does_not_throw_def not_le word_aligned_add_no_wrap_bounded - split: option.splits) - apply (clarsimp simp: neq_Nil_conv dest!: interpret_excaps_eq) - apply (local_method simplify_and_expand, - clarsimp simp: neq_Nil_conv, - (solves \rule word_plus_mono_right[OF word_less_sub_1], simp, - subst (asm) vmsz_aligned_addrFromPPtr(3)[symmetric], - erule is_aligned_no_wrap', clarsimp\), - intro conjI, - (solves \frule vmsz_aligned_addrFromPPtr(3)[THEN iffD2], - (subst mask_add_aligned mask_add_aligned_right, erule is_aligned_weaken, - rule order_trans[OF _ pbfs_atleast_pageBits[simplified pageBits_def]], simp)+, - simp\), - fastforce simp add: ptrFromPAddr_add_left is_aligned_no_overflow3[rotated -1])+ - apply fastforce - done + (* Haskell side *) + subgoal + supply_local_method simplify_and_expand = + (clarsimp simp: ct_in_state'_def vmsz_aligned'_def isCap_simps valid_cap'_def + valid_tcb_state'_def page_directory_at'_def sysargs_rel_to_n + linorder_not_less excaps_map_def + simp del: less_1_simp + | rule conjI + | erule pred_tcb'_weakenE disjE + | drule st_tcb_at_idle_thread' interpret_excaps_eq)+ + + apply (local_method simplify_and_expand, + (erule order_le_less_trans[rotated] order_trans[where x=127, rotated] + | rule order_trans[where x=127, OF _ two_nat_power_pageBitsForSize_le, + unfolded pageBits_def])+, simp)+ + apply (clarsimp simp: does_not_throw_def not_le word_aligned_add_no_wrap_bounded + split: option.splits) + apply (clarsimp simp: neq_Nil_conv dest!: interpret_excaps_eq) + apply (local_method simplify_and_expand, + clarsimp simp: neq_Nil_conv, + (solves \rule word_plus_mono_right[OF word_less_sub_1], simp, + subst (asm) vmsz_aligned_addrFromPPtr(3)[symmetric], + erule is_aligned_no_wrap', clarsimp\), + intro conjI, + (solves \frule vmsz_aligned_addrFromPPtr(3)[THEN iffD2], + (subst mask_add_aligned mask_add_aligned_right, erule is_aligned_weaken, + rule order_trans[OF _ pbfs_atleast_pageBits[simplified pageBits_def]], simp)+, + simp\), + fastforce simp add: ptrFromPAddr_add_left is_aligned_no_overflow3[rotated -1])+ + apply fastforce + done (* C side *) apply (clarsimp simp: rf_sr_ksCurThread "StrictC'_thread_state_defs" mask_eq_iff_w2p word_size word_less_nat_alt from_bool_0 excaps_map_def cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (clarsimp simp: diminished_valid'[symmetric] valid_cap'_def capAligned_def word_sless_def - word_sle_def) + apply (drule_tac t="cteCap ctea" in sym) + apply (clarsimp simp: valid_cap'_def capAligned_def word_sless_def word_sle_def) apply (prop_tac "cap_get_tag cap \ {scast cap_small_frame_cap, scast cap_frame_cap}") apply (clarsimp simp: cap_to_H_def cap_lift_def Let_def elim!: ccap_relationE split: if_split_asm) apply (rule conjI) @@ -3367,7 +3365,7 @@ lemma decodeARMPageDirectoryInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. invLabel_' s = label} @@ -3448,18 +3446,18 @@ lemma decodeARMPageDirectoryInvocation_ccorres: apply (ctac add: ccorres_injection_handler_csum1 [OF ccorres_injection_handler_csum1, OF findPDForASID_ccorres]) - apply (rule ccorres_cond_false_seq) - apply simp - apply (rule ccorres_if_cond_throws[rotated -1, where Q=\ and Q'=\]) - apply vcg - apply (clarsimp simp: isCap_simps) - apply (frule cap_get_tag_isCap_unfolded_H_cap) - apply (clarsimp simp: cap_lift_page_directory_cap - cap_to_H_def cap_page_directory_cap_lift_def - elim!: ccap_relationE split: if_split) - apply (simp add: injection_handler_throwError) - apply (rule syscall_error_throwError_ccorres_n) - apply (simp add:syscall_error_to_H_cases) + apply (rule ccorres_cond_false_seq) + apply simp + apply (rule ccorres_if_cond_throws[rotated -1, where Q=\ and Q'=\]) + apply vcg + apply (clarsimp simp: isCap_simps) + apply (frule cap_get_tag_isCap_unfolded_H_cap) + apply (clarsimp simp: cap_lift_page_directory_cap + cap_to_H_def cap_page_directory_cap_lift_def + elim!: ccap_relationE split: if_split) + apply (simp add: injection_handler_throwError) + apply (rule syscall_error_throwError_ccorres_n) + apply (simp add:syscall_error_to_H_cases) apply (simp add:injection_handler_liftE liftE_bindE) apply (rule ccorres_rhs_assoc2)+ apply (rule ccorres_rhs_assoc)+ @@ -3482,9 +3480,9 @@ lemma decodeARMPageDirectoryInvocation_ccorres: apply (simp add:performPageDirectoryInvocation_def liftE_case_sum liftE_bindE liftE_alternative) apply (ctac add: setThreadState_ccorres) - apply (rule ccorres_alternative2) - apply (simp add:returnOk_liftE[symmetric]) - apply (rule ccorres_return_CE,simp+)[1] + apply (rule ccorres_alternative2) + apply (simp add:returnOk_liftE[symmetric]) + apply (rule ccorres_return_CE,simp+)[1] apply wp apply (vcg exspec=setThreadState_modifies) apply csymbr @@ -3597,7 +3595,7 @@ lemma decodeARMPageDirectoryInvocation_ccorres: invs_valid_objs' invs_sch_act_wf' tcb_at_invs') apply (clarsimp simp: isCap_simps cte_wp_at_ctes_of invs_no_0_obj') apply (frule ctes_of_valid', clarsimp) - apply (simp only: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym, simp) apply (intro conjI) apply (clarsimp simp: sysargs_rel_to_n word_le_nat_alt mask_def linorder_not_less linorder_not_le valid_cap_simps') @@ -3695,7 +3693,7 @@ lemma decodeARMMMUInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -4260,7 +4258,8 @@ lemma decodeARMMMUInvocation_ccorres: apply (rule conjI) apply (clarsimp simp: cte_wp_at_ctes_of ct_in_state'_def if_1_0_0 interpret_excaps_eq excaps_map_def) - apply (frule(1) ctes_of_valid', simp only: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap ctea" in sym) + apply (frule(1) ctes_of_valid', simp) apply (cases "extraCaps") apply simp apply (frule interpret_excaps_eq[rule_format, where n=0], simp) @@ -4347,9 +4346,9 @@ lemma decodeARMMMUInvocation_ccorres: apply (clarsimp simp: asid_low_bits_word_bits isCap_simps neq_Nil_conv excaps_map_def excaps_in_mem_def p2_gt_0[where 'a=32, folded word_bits_def]) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (frule cap_get_tag_isCap_unfolded_H_cap(13)) apply (frule ctes_of_valid', clarsimp) - apply (simp only: diminished_valid'[symmetric]) apply (frule interpret_excaps_eq[rule_format, where n=0], simp) apply (rule conjI) apply (clarsimp simp: cap_lift_asid_pool_cap cap_lift_page_directory_cap @@ -5162,7 +5161,7 @@ lemma decodeARMVCPUInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs' and (valid_cap' (ArchObjectCap cp))) @@ -5223,7 +5222,7 @@ lemma Arch_decodeInvocation_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -5262,7 +5261,8 @@ proof - rule decodeARMMMUInvocation_ccorres, simp+)[1] apply (clarsimp simp: cte_wp_at_ctes_of ct_in_state'_def) - apply (frule(1) ctes_of_valid', simp only: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym, simp) + apply (frule(1) ctes_of_valid', simp) apply (clarsimp split: arch_capability.splits simp: isVCPUCap_def) done qed diff --git a/proof/crefine/ARM_HYP/Syscall_C.thy b/proof/crefine/ARM_HYP/Syscall_C.thy index 394d8aec1c..4cd5c37e68 100644 --- a/proof/crefine/ARM_HYP/Syscall_C.thy +++ b/proof/crefine/ARM_HYP/Syscall_C.thy @@ -125,7 +125,7 @@ lemma decodeInvocation_ccorres: (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and (\s. \x \ zobj_refs' cp. ex_nonz_cap_to' x s) and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' cp \ cteCap) slot + and cte_wp_at' ((=) cp \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. \y \ zobj_refs' (fst v). ex_nonz_cap_to' y s) @@ -320,8 +320,6 @@ lemma decodeInvocation_ccorres: unat_eq_0 sysargs_rel_n_def n_msgRegisters_def valid_tcb_state'_def | rule conjI | erule pred_tcb'_weakenE disjE | drule st_tcb_at_idle_thread')+ - apply (fastforce dest: diminished_ReplyCap') - apply (fastforce dest!: diminished_ReplyCap') apply fastforce apply (simp add: cap_lift_capEPBadge_mask_eq) apply (clarsimp simp: rf_sr_ksCurThread Collect_const_mem @@ -1027,7 +1025,7 @@ lemma handleInvocation_ccorres: apply vcg apply (rule conseqPre, vcg) apply clarsimp - apply (simp, wp lcs_diminished'[unfolded o_def]) + apply (simp, wp lcs_eq[unfolded o_def]) apply clarsimp apply (vcg exspec= lookupCapAndSlot_modifies) apply simp diff --git a/proof/crefine/ARM_HYP/VSpace_C.thy b/proof/crefine/ARM_HYP/VSpace_C.thy index a08025eb73..36edf581f2 100644 --- a/proof/crefine/ARM_HYP/VSpace_C.thy +++ b/proof/crefine/ARM_HYP/VSpace_C.thy @@ -3491,17 +3491,6 @@ lemma updateCap_frame_mapped_addr_ccorres: apply (clarsimp simp: cte_wp_at_ctes_of) done -(* FIXME: move *) -lemma diminished_PageCap: - "diminished' (ArchObjectCap (PageCap d p R sz a)) cap \ - \R'. cap = ArchObjectCap (PageCap d p R' sz a)" - apply (clarsimp simp: diminished'_def) - apply (clarsimp simp: maskCapRights_def Let_def) - apply (cases cap, simp_all add: isCap_simps) - apply (simp add: ARM_HYP_H.maskCapRights_def) - apply (simp add: isPageCap_def split: arch_capability.splits) - done - (* FIXME: move *) lemma ccap_relation_mapped_asid_0: @@ -3622,7 +3611,7 @@ lemma ccap_relation_PageCap_generics: lemma performPageInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] (liftE (performPageInvocation (PageUnmap cap ctSlot))) @@ -3632,7 +3621,7 @@ lemma performPageInvocationUnmap_ccorres: apply csymbr apply (rule ccorres_guard_imp [where A= "invs' - and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot + and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)"]) apply wpc apply (rule_tac P=" ret__unsigned_long = 0" in ccorres_gen_asm) @@ -3680,7 +3669,7 @@ lemma performPageInvocationUnmap_ccorres: apply (simp add: cte_wp_at_ctes_of) apply wp apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps split: if_split) - apply (drule diminished_PageCap) + apply (drule_tac t="cteCap cte" in sym) apply clarsimp apply (drule ccap_relation_mapped_asid_0) apply (frule ctes_of_valid', clarsimp) @@ -3689,7 +3678,7 @@ lemma performPageInvocationUnmap_ccorres: vmsz_aligned_aligned_pageBits) apply assumption apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps split: if_split) - apply (drule diminished_PageCap) + apply (drule_tac t="cteCap cte" in sym) apply clarsimp apply (frule (1) rf_sr_ctes_of_clift) apply (clarsimp simp: typ_heap_simps') diff --git a/proof/crefine/X64/Arch_C.thy b/proof/crefine/X64/Arch_C.thy index 0ad032c6ab..b73956213e 100644 --- a/proof/crefine/X64/Arch_C.thy +++ b/proof/crefine/X64/Arch_C.thy @@ -50,7 +50,7 @@ lemma objBits_InvalidPTE: lemma performPageTableInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) \ cteCap) ctSlot + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) \ cteCap) ctSlot and (\_. isPageTableCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] @@ -130,7 +130,7 @@ lemma performPageTableInvocationUnmap_ccorres: apply (simp add: guard_is_UNIV_def) apply (clarsimp simp: cap_get_tag_isCap_ArchObject[symmetric] cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (frule_tac x=s in fun_cong[OF diminished_valid']) + apply (drule_tac t="cteCap cte" in sym) apply (frule valid_global_refsD_with_objSize, clarsimp) apply (clarsimp simp: cap_lift_page_table_cap cap_to_H_def cap_page_table_cap_lift_def isCap_simps @@ -138,8 +138,7 @@ lemma performPageTableInvocationUnmap_ccorres: bit_simps capAligned_def to_bool_def mask_def page_table_at'_def capRange_def Int_commute asid_bits_def - elim!: ccap_relationE cong: if_cong - dest!: diminished_capMaster) + elim!: ccap_relationE cong: if_cong) apply (drule spec[where x=0]) apply (auto simp add: word_and_le1) done @@ -193,7 +192,7 @@ lemma clearMemory_setObject_PDE_ccorres: lemma performPageDirectoryInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) \ cteCap) ctSlot + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) \ cteCap) ctSlot and (\_. isPageDirectoryCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] @@ -273,7 +272,7 @@ lemma performPageDirectoryInvocationUnmap_ccorres: apply (simp add: guard_is_UNIV_def) apply (clarsimp simp: cap_get_tag_isCap_ArchObject[symmetric] cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (frule_tac x=s in fun_cong[OF diminished_valid']) + apply (drule_tac t="cteCap cte" in sym) apply (frule valid_global_refsD_with_objSize, clarsimp) apply (clarsimp simp: cap_lift_page_directory_cap cap_to_H_def cap_page_directory_cap_lift_def isCap_simps @@ -281,8 +280,7 @@ lemma performPageDirectoryInvocationUnmap_ccorres: bit_simps capAligned_def to_bool_def mask_def page_directory_at'_def capRange_def Int_commute asid_bits_def - elim!: ccap_relationE cong: if_cong - dest!: diminished_capMaster) + elim!: ccap_relationE cong: if_cong) apply (drule spec[where x=0]) apply (auto simp add: word_and_le1) done @@ -336,7 +334,7 @@ lemma clearMemory_setObject_PDPTE_ccorres: lemma performPDPTInvocationUnmap_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) \ cteCap) ctSlot + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) \ cteCap) ctSlot and (\_. isPDPointerTableCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) [] @@ -416,7 +414,7 @@ lemma performPDPTInvocationUnmap_ccorres: apply (simp add: guard_is_UNIV_def) apply (clarsimp simp: cap_get_tag_isCap_ArchObject[symmetric] cte_wp_at_ctes_of) apply (frule ctes_of_valid', clarsimp) - apply (frule_tac x=s in fun_cong[OF diminished_valid']) + apply (drule_tac t="cteCap cte" in sym) apply (frule valid_global_refsD_with_objSize, clarsimp) apply (clarsimp simp: cap_lift_pdpt_cap cap_to_H_def cap_pdpt_cap_lift_def isCap_simps @@ -424,8 +422,7 @@ lemma performPDPTInvocationUnmap_ccorres: bit_simps capAligned_def to_bool_def mask_def pd_pointer_table_at'_def capRange_def Int_commute asid_bits_def - elim!: ccap_relationE cong: if_cong - dest!: diminished_capMaster) + elim!: ccap_relationE cong: if_cong) apply (drule spec[where x=0]) apply (auto simp add: word_and_le1) done @@ -1012,7 +1009,7 @@ lemma decodeX64PageTableInvocation_ccorres: (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and valid_cap' (ArchObjectCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) @@ -1294,6 +1291,7 @@ lemma decodeX64PageTableInvocation_ccorres: word_sle_def word_sless_def typ_heap_simps' bit_simps) (* X64PageTableMap *) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (clarsimp simp: cap_get_tag_isCap_ArchObject isCap_simps word_sle_def word_sless_def word_less_nat_alt) @@ -1923,13 +1921,13 @@ where lemma valid_objs_valid_pte': "\ valid_objs' s ; ko_at' (ko :: pte) p s \ \ valid_pte' ko s" by (fastforce simp add: obj_at'_def ran_def valid_obj'_def projectKOs valid_objs'_def) -lemma cte_wp_at_diminished_gsMaxObjectSize: - "cte_wp_at' (diminished' cap o cteCap) slot s +lemma cte_wp_at_eq_gsMaxObjectSize: + "cte_wp_at' ((=) cap o cteCap) slot s \ valid_global_refs' s \ 2 ^ capBits cap \ gsMaxObjectSize s" apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) valid_global_refsD_with_objSize) - apply (clarsimp simp: diminished'_def capMaster_eq_capBits_eq[OF capMasterCap_maskCapRights]) + apply (clarsimp simp: capMaster_eq_capBits_eq[OF capMasterCap_maskCapRights]) done lemma two_nat_power_pageBitsForSize_le: @@ -2361,7 +2359,7 @@ lemma decodeX64FrameInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -2772,11 +2770,11 @@ lemma decodeX64FrameInvocation_ccorres: invLabel s s') apply (rule conjI) apply clarsimp - apply (frule cte_wp_at_diminished_gsMaxObjectSize, clarsimp) + apply (frule cte_wp_at_eq_gsMaxObjectSize, clarsimp) apply (clarsimp simp: cte_wp_at_ctes_of is_aligned_mask[symmetric] vmsz_aligned_def vmsz_aligned_addrFromPPtr) apply (frule ctes_of_valid', clarsimp+) - apply (simp add: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym, simp) apply (frule valid_cap'_PageCap_kernel_mappings[OF invs_pspace_in_kernel_mappings', where cap=cp], fastforce simp: isCap_simps, fastforce) apply (subgoal_tac "extraCaps \ [] \ (s \' fst (extraCaps ! 0))") @@ -2807,8 +2805,8 @@ lemma decodeX64FrameInvocation_ccorres: word_size word_less_nat_alt from_bool_0 excaps_map_def cte_wp_at_ctes_of n_msgRegisters_def) apply (frule(1) ctes_of_valid') - apply (clarsimp simp: diminished_valid'[symmetric] valid_cap'_def capAligned_def word_sless_def - word_sle_def) + apply (drule_tac t="cteCap ctea" in sym) + apply (clarsimp simp: valid_cap'_def capAligned_def word_sless_def word_sle_def) apply (frule ccap_relation_PageCap_generics) apply (frule cap_get_tag_isCap_unfolded_H_cap) apply clarsimp @@ -2996,7 +2994,7 @@ lemma decodeX64PageDirectoryInvocation_ccorres: (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and valid_cap' (ArchObjectCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) @@ -3273,6 +3271,7 @@ lemma decodeX64PageDirectoryInvocation_ccorres: ct_in_state'_def st_tcb_at'_def word_sle_def word_sless_def typ_heap_simps' bit_simps) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (clarsimp simp: cap_get_tag_isCap_ArchObject isCap_simps word_sle_def word_sless_def word_less_nat_alt) @@ -3471,7 +3470,7 @@ lemma decodeX64PDPTInvocation_ccorres: (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and valid_cap' (ArchObjectCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) @@ -3716,6 +3715,7 @@ lemma decodeX64PDPTInvocation_ccorres: ct_in_state'_def st_tcb_at'_def word_sle_def word_sless_def typ_heap_simps' bit_simps) + apply (drule_tac t="cteCap ctea" in sym, simp) apply (frule cap_get_tag_isCap_unfolded_H_cap) apply clarsimp apply (rename_tac pml4_mapped_asid) @@ -3777,7 +3777,7 @@ lemma decodeX64ModeMMUInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and valid_cap' (ArchObjectCap cp) and sysargs_rel args buffer and valid_objs') @@ -3823,7 +3823,7 @@ lemma decodeX64MMUInvocation_ccorres: ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -4376,7 +4376,8 @@ lemma decodeX64MMUInvocation_ccorres: apply (rule conjI) apply (clarsimp simp: cte_wp_at_ctes_of ct_in_state'_def interpret_excaps_eq excaps_map_def) - apply (frule(1) ctes_of_valid', simp only: diminished_valid'[symmetric]) + apply (drule_tac t="cteCap cte" in sym) + apply (frule(1) ctes_of_valid', simp) apply (cases "extraCaps") apply simp apply (frule interpret_excaps_eq[rule_format, where n=0], simp) @@ -4460,9 +4461,9 @@ lemma decodeX64MMUInvocation_ccorres: apply (clarsimp simp: asid_low_bits_word_bits isCap_simps neq_Nil_conv excaps_map_def excaps_in_mem_def p2_gt_0[where 'a=machine_word_len, folded word_bits_def]) + apply (drule_tac t="cteCap cte" in sym, simp) apply (frule cap_get_tag_isCap_unfolded_H_cap(13)) apply (frule ctes_of_valid', clarsimp) - apply (simp only: diminished_valid'[symmetric]) apply (frule interpret_excaps_eq[rule_format, where n=0], simp) apply (rule conjI) apply (clarsimp simp: cap_lift_asid_pool_cap cap_lift_page_directory_cap @@ -5318,7 +5319,7 @@ lemma decodeIOPortControlInvocation_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v) and sysargs_rel args buffer and valid_objs') @@ -5496,7 +5497,7 @@ lemma decodeIOPortInvocation_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} @@ -5821,7 +5822,7 @@ lemma Mode_decodeInvocation_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. label___unsigned_long_' s = label} @@ -5850,7 +5851,7 @@ lemma Arch_decodeInvocation_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' (ArchObjectCap cp) \ cteCap) slot + and cte_wp_at' ((=) (ArchObjectCap cp) \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer and valid_objs') (UNIV \ {s. invLabel_' s = label} diff --git a/proof/crefine/X64/Syscall_C.thy b/proof/crefine/X64/Syscall_C.thy index 945bb17f13..b72d4e96b1 100644 --- a/proof/crefine/X64/Syscall_C.thy +++ b/proof/crefine/X64/Syscall_C.thy @@ -124,7 +124,7 @@ lemma decodeInvocation_ccorres: (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and (\s. \x \ zobj_refs' cp. ex_nonz_cap_to' x s) and (excaps_in_mem extraCaps \ ctes_of) - and cte_wp_at' (diminished' cp \ cteCap) slot + and cte_wp_at' ((=) cp \ cteCap) slot and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. \y \ zobj_refs' (fst v). ex_nonz_cap_to' y s) @@ -316,10 +316,8 @@ lemma decodeInvocation_ccorres: simple_sane_strg) apply (clarsimp simp: cte_wp_at_ctes_of valid_cap'_def isCap_simps unat_eq_0 sysargs_rel_n_def n_msgRegisters_def valid_tcb_state'_def - | rule conjI | erule pred_tcb'_weakenE disjE - | drule st_tcb_at_idle_thread')+ - apply (fastforce dest: diminished_ReplyCap') - apply (fastforce dest!: diminished_ReplyCap') + | rule conjI | erule pred_tcb'_weakenE disjE + | drule st_tcb_at_idle_thread')+ apply fastforce apply (simp add: cap_lift_capEPBadge_mask_eq) apply (clarsimp simp: rf_sr_ksCurThread Collect_const_mem @@ -998,7 +996,7 @@ lemma handleInvocation_ccorres: apply vcg apply (rule conseqPre, vcg) apply clarsimp - apply (simp, wp lcs_diminished'[unfolded o_def]) + apply (simp, wp lcs_eq[unfolded o_def]) apply clarsimp apply (vcg exspec= lookupCapAndSlot_modifies) apply simp diff --git a/proof/crefine/X64/VSpace_C.thy b/proof/crefine/X64/VSpace_C.thy index d88094ef54..ce411ac73f 100644 --- a/proof/crefine/X64/VSpace_C.thy +++ b/proof/crefine/X64/VSpace_C.thy @@ -2066,17 +2066,6 @@ lemma updateCap_frame_mapped_addr_ccorres: X86_MappingNone_def asidInvalid_def) done -(* FIXME: move *) -lemma diminished_PageCap: - "diminished' (ArchObjectCap (PageCap p R mt sz d a)) cap \ - \R'. cap = ArchObjectCap (PageCap p R' mt sz d a)" - apply (clarsimp simp: diminished'_def) - apply (clarsimp simp: maskCapRights_def Let_def) - apply (cases cap, simp_all add: isCap_simps) - apply (simp add: X64_H.maskCapRights_def) - apply (simp add: isPageCap_def split: arch_capability.splits) - done - lemma ccap_relation_mapped_asid_0: "\ccap_relation (ArchObjectCap (PageCap d v0 v1 v2 v3 v4)) cap\ \ (capFMappedASID_CL (cap_frame_cap_lift cap) \ 0 \ v4 \ None) \ @@ -2109,7 +2098,7 @@ lemma framesize_from_H_bounded: lemma performPageInvocationUnmap_ccorres': "ccorres (\rv rv'. rv' = scast EXCEPTION_NONE) ret__unsigned_long_' - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\ctSlot = Ptr ctSlot\) hs (performPageInvocationUnmap cap ctSlot) @@ -2117,7 +2106,7 @@ lemma performPageInvocationUnmap_ccorres': apply (cinit lift: cap_' ctSlot_') apply csymbr apply (rule ccorres_guard_imp - [where A="invs' and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot + [where A="invs' and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)"]) apply wpc apply (rule_tac P="ret__unsigned_longlong = 0" in ccorres_gen_asm) @@ -2163,15 +2152,16 @@ lemma performPageInvocationUnmap_ccorres': apply (simp add: cte_wp_at_ctes_of) apply wp apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps split: if_split) - apply (drule diminished_PageCap) + apply (drule_tac t="cteCap cte" in sym) apply clarsimp apply (frule ccap_relation_mapped_asid_0) - apply (frule ctes_of_valid', clarsimp) - apply (drule valid_global_refsD_with_objSize, clarsimp) - apply (fastforce simp: mask_def valid_cap'_def - vmsz_aligned_aligned_pageBits) + apply (frule ctes_of_valid', clarsimp) + apply (drule valid_global_refsD_with_objSize, clarsimp) + apply (fastforce simp: mask_def valid_cap'_def + vmsz_aligned_aligned_pageBits) apply assumption apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps split: if_split) + apply (drule_tac t="cteCap cte" in sym) apply (clarsimp simp: cap_get_tag_isCap_unfolded_H_cap framesize_from_H_bounded framesize_from_to_H ccap_relation_PageCap_BasePtr ccap_relation_PageCap_Size @@ -2204,7 +2194,7 @@ lemma performPageInvocationUnmap_ccorres: notes Collect_const[simp del] shows "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') - (invs' and cte_wp_at' (diminished' (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) + (invs' and cte_wp_at' ((=) (ArchObjectCap cap) o cteCap) ctSlot and K (isPageCap cap)) (UNIV \ \ccap_relation (ArchObjectCap cap) \cap\ \ \\cte = Ptr ctSlot\) hs (liftE (performPageInvocation (PageUnmap cap ctSlot))) @@ -2226,7 +2216,7 @@ lemma performPageInvocationUnmap_ccorres: apply (rule ccorres_rhs_assoc) apply (drule_tac s=cap in sym, simp) (* schematic ugliness *) apply ccorres_rewrite - apply (rule ccorres_add_return2) thm ccorres_add_returnOk + apply (rule ccorres_add_return2) apply (ctac add: performPageInvocationUnmap_ccorres'[simplified K_def, simplified]) apply (rule_tac P=\ and P'=UNIV in ccorres_from_vcg_throws) apply (rule allI, rule conseqPre, vcg) diff --git a/proof/drefine/Arch_DR.thy b/proof/drefine/Arch_DR.thy index 0f4b6caae5..e6b960d989 100644 --- a/proof/drefine/Arch_DR.thy +++ b/proof/drefine/Arch_DR.thy @@ -606,7 +606,7 @@ lemma decode_invocation_archcap_corres: \ arch_invocation_relation rv ai)) \ (invs and valid_etcbs and valid_cap invoked_cap' and (\s. \x \ set (map fst excaps'). s \ x) - and (\s. \x \ set excaps'. cte_wp_at (diminished (fst x)) (snd x) s)) + and (\s. \x \ set excaps'. cte_wp_at ((=) (fst x)) (snd x) s)) (Decode_D.decode_invocation invoked_cap invoked_cap_ref excaps intent) (Decode_A.decode_invocation label' args' cap_index' invoked_cap_ref' invoked_cap' excaps')" apply (rule_tac F="\x \ set (map fst excaps'). cap_aligned x" in corres_req) @@ -1151,15 +1151,6 @@ shows "dcorres dc \ apply (auto simp add: rules) done -lemma diminished_PageTable [simp]: - "diminished (cap.ArchObjectCap (arch_cap.PageTableCap x mp)) = (\c. c = cap.ArchObjectCap (arch_cap.PageTableCap x mp))" - apply (rule ext) - apply (case_tac c, - simp_all add: diminished_def cap_rights_update_def acap_rights_update_def mask_cap_def) - apply (rename_tac arch_cap) - apply (case_tac arch_cap, auto) - done - lemma invoke_page_table_corres: "transform_page_table_inv ptinv' = Some ptinv \ dcorres dc \ (valid_pti ptinv' and invs and valid_etcbs) @@ -1209,9 +1200,9 @@ lemma invoke_page_table_corres: apply (rule_tac P="\y s. cte_wp_at ((=) x) (a,b) s \ s = s'" in set_cap_corres_stronger) apply clarsimp apply (drule cte_wp_at_eqD2, simp) - apply (clarsimp simp:is_arch_diminished_def transform_mapping_def update_map_data_def) + apply (clarsimp simp: transform_mapping_def update_map_data_def) apply (wp get_cap_cte_wp_at_rv | clarsimp)+ - apply (clarsimp simp:cte_wp_at_def is_arch_diminished_def is_arch_cap_def is_pt_cap_def) + apply (clarsimp simp:cte_wp_at_def is_arch_cap_def is_pt_cap_def) apply (clarsimp simp:invs_def valid_state_def not_idle_thread_def) apply (frule valid_idle_has_null_cap,simp+) apply (rule sym) @@ -1226,7 +1217,7 @@ lemma invoke_page_table_corres: apply (rule_tac P="\y s. cte_wp_at ((=) xb) (a,b) s \ caps_of_state s' = caps_of_state s" in set_cap_corres_stronger) apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (clarsimp simp:is_arch_diminished_def transform_mapping_def update_map_data_def) + apply (clarsimp simp: transform_mapping_def update_map_data_def) apply (wp get_cap_cte_wp_at_rv | clarsimp)+ apply (wp do_machine_op_wp | clarsimp simp:not_idle_thread_def)+ apply (wp mapM_x_wp) @@ -1242,8 +1233,7 @@ lemma invoke_page_table_corres: apply simp apply (simp add:valid_cap_def vmsz_aligned_def mask_2pm1) apply (simp add:cte_wp_at_def transform_cap_def update_map_data_def transform_mapping_def - is_arch_diminished_def is_arch_cap_def diminished_def - mask_cap_def cap_rights_update_def is_pt_cap_def cap_aligned_def) + is_arch_cap_def mask_cap_def cap_rights_update_def is_pt_cap_def cap_aligned_def) apply (rule ccontr,clarsimp simp:invs_def valid_state_def) apply (drule valid_idle_has_null_cap,simp+) apply (clarsimp simp:get_cap_caps_of_state) @@ -1268,15 +1258,6 @@ lemma set_vm_root_for_flush_dwp[wp]: apply (wp|clarsimp)+ done -lemma diminished_page_is_page: - "diminished (cap.ArchObjectCap (arch_cap.PageCap dev x rs sz mp)) c - \ \rs'. c = cap.ArchObjectCap (arch_cap.PageCap dev x rs' sz mp)" - apply (case_tac c, - simp_all add:diminished_def cap_rights_update_def acap_rights_update_def mask_cap_def) - apply (rename_tac arch_cap) - apply (case_tac arch_cap, (clarsimp simp:validate_vm_rights_def)+) - done - lemma ucast_add: " len_of TYPE('a) \ len_of TYPE('b) \ (ucast (a + b) :: (('a::len)word)) = ucast (a :: (('b ::len) word)) + (ucast b)" @@ -1560,11 +1541,9 @@ lemma invoke_page_corres: apply (rule_tac P="\y s. cte_wp_at ((=) x) (a,b) s \ s = s'" in set_cap_corres_stronger) apply clarsimp apply (drule cte_wp_at_eqD2, simp) - apply (clarsimp simp:is_arch_diminished_def transform_mapping_def update_map_data_def - dest!:diminished_page_is_page) + apply (clarsimp simp: transform_mapping_def update_map_data_def) apply (wp get_cap_cte_wp_at_rv | clarsimp)+ - apply (clarsimp simp:cte_wp_at_def is_arch_diminished_def is_arch_cap_def is_pt_cap_def - dest!:diminished_page_is_page) + apply (clarsimp simp:cte_wp_at_def is_arch_cap_def is_pt_cap_def) apply (clarsimp simp:invs_def valid_state_def not_idle_thread_def) apply (frule valid_idle_has_null_cap,simp+) apply (rule sym) @@ -1576,8 +1555,7 @@ lemma invoke_page_corres: caps_of_state s' = caps_of_state s" in set_cap_corres_stronger) apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (clarsimp simp:is_arch_diminished_def transform_mapping_def update_map_data_def - dest!:diminished_page_is_page) + apply (clarsimp simp: transform_mapping_def update_map_data_def) apply (wp get_cap_cte_wp_at_rv unmap_page_pred_tcb_at | clarsimp simp:valid_idle_def not_idle_thread_def)+ apply (rule_tac Q="\rv s. valid_etcbs s \ @@ -1587,8 +1565,7 @@ lemma invoke_page_corres: caps_of_state s' = caps_of_state s" in hoare_strengthen_post) apply (wps, wp unmap_page_pred_tcb_at, clarsimp simp: invs_def valid_state_def valid_idle_def) apply simp - apply (clarsimp simp:cte_wp_at_def is_arch_diminished_def is_arch_cap_def is_pt_cap_def - dest!:diminished_page_is_page) + apply (clarsimp simp: cte_wp_at_def is_arch_cap_def is_pt_cap_def) apply (rule conjI, simp) apply (rule conjI, simp add:invs_def valid_state_def valid_idle_def) apply (clarsimp simp:invs_def valid_state_def not_idle_thread_def) diff --git a/proof/drefine/Syscall_DR.thy b/proof/drefine/Syscall_DR.thy index 66ad0992ad..f2829ce57c 100644 --- a/proof/drefine/Syscall_DR.thy +++ b/proof/drefine/Syscall_DR.thy @@ -96,7 +96,7 @@ lemma decode_invocation_untypedcap_corres: dcorres (dc \ cdl_invocation_relation) \ (invs and cte_wp_at ((=) invoked_cap') invoked_cap_ref' and (\s. \x \ set (map fst excaps'). s \ x) - and (\s. \x \ set excaps'. cte_wp_at (diminished (fst x)) (snd x) s) + and (\s. \x \ set excaps'. cte_wp_at ((=) (fst x)) (snd x) s) and valid_etcbs) (Decode_D.decode_invocation invoked_cap invoked_cap_ref excaps intent) (Decode_A.decode_invocation label' args' cap_index' invoked_cap_ref' invoked_cap' excaps')" @@ -151,7 +151,8 @@ lemma decode_invocation_replycap_corres: invoked_cap = transform_cap invoked_cap'; excaps = transform_cap_list excaps'; invoked_cap' = cap.ReplyCap a b c \ \ - dcorres (dc \ cdl_invocation_relation) \ (cte_wp_at (Not\ is_master_reply_cap) invoked_cap_ref' and cte_wp_at (diminished invoked_cap') invoked_cap_ref') + dcorres (dc \ cdl_invocation_relation) \ (cte_wp_at (Not\ is_master_reply_cap) invoked_cap_ref' and + cte_wp_at ((=) invoked_cap') invoked_cap_ref') (Decode_D.decode_invocation invoked_cap invoked_cap_ref excaps intent) (Decode_A.decode_invocation label' args' cap_index' invoked_cap_ref' invoked_cap' excaps')" apply (clarsimp simp: Decode_A.decode_invocation_def Decode_D.decode_invocation_def ) @@ -564,8 +565,8 @@ lemma decode_invocation_corres: dcorres (dc \ cdl_invocation_relation) \ (invs and valid_cap cap and (\s. \e\set excaps'. valid_cap (fst e) s) and (cte_wp_at (Not \ is_master_reply_cap) slot - and cte_wp_at (diminished cap) slot) - and (\s. \x\set excaps'. cte_wp_at (diminished (fst x)) (snd x) s) + and cte_wp_at ((=) cap) slot) + and (\s. \x\set excaps'. cte_wp_at ((=) (fst x)) (snd x) s) and valid_etcbs) (Decode_D.decode_invocation invoked_cap invoked_cap_ref excaps intent) (Decode_A.decode_invocation label args cap_index slot cap excaps')" @@ -1020,8 +1021,8 @@ lemma decode_invocation_corres': \ dcorres (dc \ cdl_invocation_relation) \ ((=) s and (\(slot,cap,excaps,buffer) s. \ is_master_reply_cap (cap) \ valid_cap cap s \ valid_etcbs s \ evalMonad (lookup_ipc_buffer False (cur_thread s)) s = Some buffer - \ (\e\ set excaps. s \ fst e) \ cte_wp_at (Not \ is_master_reply_cap) slot s \ cte_wp_at (diminished cap) slot s - \ (\e\ set excaps. cte_wp_at (diminished (fst e)) (snd e) s)) rv') + \ (\e\ set excaps. s \ fst e) \ cte_wp_at (Not \ is_master_reply_cap) slot s \ cte_wp_at ((=) cap) slot s + \ (\e\ set excaps. cte_wp_at ((=) (fst e)) (snd e) s)) rv') ((\(cap, cap_ref, extra_caps). case_option (if ep_related_cap cap then Decode_D.decode_invocation cap cap_ref extra_caps undefined else Monads_D.throw) (Decode_D.decode_invocation cap cap_ref extra_caps) @@ -1226,14 +1227,10 @@ lemma not_master_reply_cap_lcs[wp]: lemma not_master_reply_cap_lcs'[wp]: "\valid_reply_masters and valid_objs\ CSpace_A.lookup_cap_and_slot t ptr \\rv s. cte_wp_at (Not \ is_master_reply_cap) (snd rv) s\,-" - apply (rule_tac Q' = "\rv s. \ is_master_reply_cap (fst rv) \ cte_wp_at (diminished (fst rv)) (snd rv) s" in hoare_post_imp_R) + apply (rule_tac Q' = "\rv s. \ is_master_reply_cap (fst rv) \ cte_wp_at ((=) (fst rv)) (snd rv) s" + in hoare_post_imp_R) apply (rule hoare_pre,wp,simp) apply (clarsimp simp:cte_wp_at_def) - apply (case_tac cap) - apply (simp_all add:is_master_reply_cap_def) - apply clarsimp - apply (case_tac a) - apply (simp_all add:diminished_def mask_cap_def cap_rights_update_def) done lemma set_thread_state_ct_active: @@ -1335,7 +1332,7 @@ lemma handle_invocation_corres: apply (rule_tac Q="\r s. s = s'a \ evalMonad (lookup_ipc_buffer False (cur_thread s'a)) s'a = Some r \ cte_wp_at (Not \ is_master_reply_cap) (snd x) s \ - cte_wp_at (diminished (fst x)) (snd x) s \ + cte_wp_at ((=) (fst x)) (snd x) s \ real_cte_at (snd x) s \ s \ fst x \ ex_cte_cap_wp_to (\_. True) (snd x) s \ diff --git a/proof/drefine/Untyped_DR.thy b/proof/drefine/Untyped_DR.thy index c12c48c422..d1a995c4fd 100644 --- a/proof/drefine/Untyped_DR.thy +++ b/proof/drefine/Untyped_DR.thy @@ -1745,7 +1745,7 @@ lemma decode_untyped_corres: dcorres (dc \ (\x y. x = translate_untyped_invocation y)) \ (cte_wp_at ((=) cap') slot' and invs and (\s. \x \ set (map fst excaps'). s \ x) - and (\s. \x \ set excaps'. cte_wp_at (diminished (fst x)) (snd x) s) and valid_etcbs) + and (\s. \x \ set excaps'. cte_wp_at ((=) (fst x)) (snd x) s) and valid_etcbs) (Untyped_D.decode_untyped_invocation cap slot excaps ui) (Decode_A.decode_untyped_invocation label' args' slot' cap' (map fst excaps'))" apply (simp add: transform_intent_def map_option_Some_eq2 diff --git a/proof/infoflow/Arch_IF.thy b/proof/infoflow/Arch_IF.thy index 312ac5cee6..97e51a87bc 100644 --- a/proof/infoflow/Arch_IF.thy +++ b/proof/infoflow/Arch_IF.thy @@ -1052,12 +1052,10 @@ lemma perform_page_invocation_reads_respects: set_mrs_reads_respects set_message_info_reads_respects | simp add: cleanByVA_PoU_def pte_check_if_mapped_def pde_check_if_mapped_def | wpc | wp (once) hoare_drop_imps[where R="\ r s. r"])+ apply(clarsimp simp: authorised_page_inv_def valid_page_inv_def) - apply (auto simp: cte_wp_at_caps_of_state is_arch_diminished_def valid_slots_def - cap_auth_conferred_def cap_rights_update_def acap_rights_update_def + apply (auto simp: cte_wp_at_caps_of_state valid_slots_def cap_auth_conferred_def update_map_data_def is_page_cap_def authorised_slots_def valid_page_inv_def valid_cap_simps - dest!: diminished_PageCapD bspec[OF _ rev_subsetD[OF _ tl_subseteq]] - + dest!: bspec[OF _ rev_subsetD[OF _ tl_subseteq]] | auto dest!: clas_caps_of_state simp: cap_links_asid_slot_def label_owns_asid_slot_def dest!: pas_refined_Control @@ -2175,13 +2173,6 @@ definition InvokePage oper \ authorised_for_globals_page_inv oper | _ \ \" -lemma diminished_PageDirectoryCapD: - "diminished (ArchObjectCap (PageDirectoryCap p x)) cap \ - cap = ArchObjectCap (PageDirectoryCap p x)" - apply(cases cap, auto simp: diminished_def mask_cap_def cap_rights_update_def) - apply(auto simp: acap_rights_update_def split: arch_cap.splits bool.splits) - done - lemma arch_perform_invocation_globals_equiv: "\globals_equiv s and invs and ct_active and valid_arch_inv ai and authorised_for_globals_arch_inv ai\ arch_perform_invocation ai \\_. globals_equiv s\" @@ -2210,8 +2201,8 @@ lemma find_pd_for_asid_authority3: done lemma decode_arch_invocation_authorised_for_globals: - "\invs and cte_wp_at (diminished (cap.ArchObjectCap cap)) slot - and (\s. \(cap, slot) \ set excaps. cte_wp_at (diminished cap) slot s)\ + "\invs and cte_wp_at ((=) (cap.ArchObjectCap cap)) slot + and (\s. \(cap, slot) \ set excaps. cte_wp_at ((=) cap) slot s)\ arch_decode_invocation label msg x_slot slot cap excaps \\rv. authorised_for_globals_arch_inv rv\, -" unfolding arch_decode_invocation_def authorised_for_globals_arch_inv_def @@ -2235,7 +2226,7 @@ lemma decode_arch_invocation_authorised_for_globals: apply((wp hoare_TrueI hoare_vcg_all_lift hoare_drop_imps | wpc | simp)+)[3] apply (clarsimp simp: authorised_asid_pool_inv_def authorised_page_table_inv_def neq_Nil_conv invs_psp_aligned invs_vspace_objs cli_no_irqs) - apply (drule diminished_cte_wp_at_valid_cap, clarsimp+) + apply (drule cte_wp_valid_cap, clarsimp+) apply (cases cap, simp_all) \ \PageCap\ apply (clarsimp simp: valid_cap_simps cli_no_irqs) @@ -2243,7 +2234,7 @@ lemma decode_arch_invocation_authorised_for_globals: \ \Map\ apply (rename_tac word cap_rights vmpage_size option arch) apply(clarsimp simp: isPageFlushLabel_def isPDFlushLabel_def | rule conjI)+ - apply(drule diminished_cte_wp_at_valid_cap) + apply(drule cte_wp_valid_cap) apply(clarsimp simp: invs_def valid_state_def) apply(simp add: valid_cap_def) apply(simp add: vmsz_aligned_def) @@ -2252,7 +2243,7 @@ lemma decode_arch_invocation_authorised_for_globals: apply(clarsimp) apply(fastforce simp: x_power_minus_1) apply(clarsimp) - apply(fastforce dest: diminished_cte_wp_at_valid_cap simp: invs_def valid_state_def valid_cap_def) + apply(fastforce dest: cte_wp_valid_cap simp: invs_def valid_state_def valid_cap_def) \ \Unmap\ apply(simp add: authorised_for_globals_page_inv_def)+ apply(clarsimp) @@ -2270,7 +2261,6 @@ lemma decode_arch_invocation_authorised_for_globals: set (arm_global_pts (arch_state s))) \ cap_range c \ {}" in cte_wp_at_weakenE) - apply(drule diminished_PageDirectoryCapD) apply(clarsimp simp: cap_range_def) apply(simp) by(fastforce) diff --git a/proof/infoflow/Decode_IF.thy b/proof/infoflow/Decode_IF.thy index edc7a516db..d2f96f959d 100644 --- a/proof/infoflow/Decode_IF.thy +++ b/proof/infoflow/Decode_IF.thy @@ -449,41 +449,11 @@ lemma pas_cap_cur_auth_ASIDControlCap: apply(rule pas_refined_Control_into_is_subject_asid, blast+) done -lemma cte_wp_at_diminished_cnode_cap: - "\cte_wp_at (diminished cap) slot s; is_cnode_cap cap\ \ - cte_wp_at ((=) cap) slot s" - apply (case_tac cap, simp_all) - apply (clarsimp simp: cte_wp_at_def diminished_def mask_cap_def) - apply (case_tac capa) - by (clarsimp simp: cap_rights_update_def split: bool.splits)+ - lemma owns_cnode_owns_obj_ref_of_child_cnodes: "\pas_refined aag s; is_subject aag (fst slot); - cte_wp_at (diminished cap) slot s; is_cnode_cap cap\ + cte_wp_at ((=) cap) slot s; is_cnode_cap cap\ \ is_subject aag (obj_ref_of cap)" - apply(drule (1) cte_wp_at_diminished_cnode_cap) - apply(blast intro: owns_cnode_owns_obj_ref_of_child_cnodes_threads_and_zombies) - done - -lemma cte_wp_at_diminished_PageDirectoryCap: - "\cte_wp_at (diminished cap) slot s; cap = ArchObjectCap (PageDirectoryCap x y)\ \ - cte_wp_at ((=) cap) slot s" - apply(clarsimp simp: cte_wp_at_def diminished_def mask_cap_def) - apply(case_tac capa) - apply(clarsimp simp: cap_rights_update_def split: bool.splits)+ - apply(rename_tac arch_cap) - apply(case_tac arch_cap, simp_all add: acap_rights_update_def split: bool.splits) - done - -lemma cte_wp_at_diminished_PageTableCap: - "\cte_wp_at (diminished cap) slot s; cap = ArchObjectCap (PageTableCap x y)\ \ - cte_wp_at ((=) cap) slot s" - apply(clarsimp simp: cte_wp_at_def diminished_def mask_cap_def) - apply(case_tac capa) - apply(clarsimp simp: cap_rights_update_def split: bool.splits)+ - apply(rename_tac arch_cap) - apply(case_tac arch_cap, simp_all add: acap_rights_update_def split: bool.splits) - done + by (blast intro: owns_cnode_owns_obj_ref_of_child_cnodes_threads_and_zombies) lemma vspace_cap_rights_to_auth_mono: "R \ S \ vspace_cap_rights_to_auth R \ vspace_cap_rights_to_auth S" @@ -567,8 +537,8 @@ lemma arch_decode_invocation_reads_respects_f: notes hoare_whenE_wps[wp_split del] shows "reads_respects_f aag l (silc_inv aag st and invs and pas_refined aag - and cte_wp_at (diminished (cap.ArchObjectCap cap)) slot - and (\s. \(cap, slot) \ set excaps. cte_wp_at (diminished cap) slot s) + and cte_wp_at ((=) (cap.ArchObjectCap cap)) slot + and (\s. \(cap, slot) \ set excaps. cte_wp_at ((=) cap) slot s) and K (\(cap, slot) \ {(cap.ArchObjectCap cap, slot)} \ set excaps. aag_cap_auth aag (pasObjectAbs aag (fst slot)) cap \ is_subject aag (fst slot) \ (\v \ cap_asid' cap. is_subject_asid aag v))) @@ -620,9 +590,7 @@ lemma arch_decode_invocation_reads_respects_f: apply(rule_tac cap="fst (excaps ! Suc 0)" and p="snd (excaps ! Suc 0)" in caps_of_state_pasObjectAbs_eq) apply(rule cte_wp_at_caps_of_state) - apply(rule cte_wp_at_diminished_cnode_cap) - apply fastforce - apply assumption + apply fastforce apply(erule cap_auth_conferred_cnode_cap) apply fastforce apply assumption @@ -634,14 +602,14 @@ lemma arch_decode_invocation_reads_respects_f: apply(simp add: lookup_pd_slot_def) apply(subgoal_tac "excaps ! 0 \ set excaps") apply(subst vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply fastforce apply(simp add: lookup_pd_slot_def) apply(subgoal_tac "excaps ! 0 \ set excaps") apply(subst vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply fastforce @@ -666,14 +634,14 @@ lemma arch_decode_invocation_reads_respects_f: apply(simp add: lookup_pd_slot_def) apply(subgoal_tac "excaps ! 0 \ set excaps") apply(subst vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply fastforce apply(simp add: lookup_pd_slot_def) apply(subgoal_tac "excaps ! 0 \ set excaps") apply(subst vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply fastforce @@ -682,7 +650,7 @@ lemma arch_decode_invocation_reads_respects_f: apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply fastforce apply fastforce - apply(fastforce dest: diminished_cte_wp_at_valid_cap simp: valid_cap_simps) + apply(fastforce dest: cte_wp_valid_cap simp: valid_cap_simps) apply(rule ball_subset[OF _ vspace_cap_rights_to_auth_mask_vm_rights]) apply(fastforce simp: aag_cap_auth_def cap_auth_conferred_def) apply(subgoal_tac "excaps ! 0 \ set excaps") @@ -690,26 +658,26 @@ lemma arch_decode_invocation_reads_respects_f: apply fastforce apply(subgoal_tac "excaps ! 0 \ set excaps") apply(subst vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply fastforce apply blast - apply(blast intro: cte_wp_at_diminished_PageTableCap) + apply blast apply (blast dest:aag_can_read_self) apply (force dest:silc_inv_not_subject) apply(simp add: lookup_pd_slot_def) apply(subst vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(fastforce dest: aag_cap_auth_PageDirectoryCap) apply(clarsimp simp: lookup_pd_slot_def split: option.splits kernel_object.splits arch_kernel_obj.splits pde.splits) apply(subst(asm) vaddr_segment_nonsense) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply(subst(asm) vaddr_segment_nonsense2) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def) apply (rule_tac pd=x and s=s in lookup_pt_slot_no_fail_is_subject) apply (erule exI) @@ -717,7 +685,7 @@ lemma arch_decode_invocation_reads_respects_f: apply (simp add: invs_def valid_state_def valid_pspace_def) apply assumption apply (erule(1) aag_cap_auth_PageDirectoryCap) - apply(fastforce dest: diminished_cte_wp_at_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def pd_bits) + apply(fastforce dest: cte_wp_valid_cap cap_aligned_valid simp: obj_ref_of_def cap_aligned_def cap_bits_def pd_bits) apply simp apply assumption apply assumption @@ -731,14 +699,14 @@ done lemma decode_invocation_reads_respects_f: "reads_respects_f aag l - (silc_inv aag st and pas_refined aag and valid_cap cap and invs and ct_active and cte_wp_at (diminished cap) slot + (silc_inv aag st and pas_refined aag and valid_cap cap and invs and ct_active and cte_wp_at ((=) cap) slot and ex_cte_cap_to slot and (\s. \r\zobj_refs cap. ex_nonz_cap_to r s) and (\s. \r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_to r s) and (\s. \cap \ set excaps. \r\cte_refs (fst cap) (interrupt_irq_node s). ex_cte_cap_to r s) and (\s. \x \ set excaps. s \ (fst x)) and (\s. \x \ set excaps. \r\zobj_refs (fst x). ex_nonz_cap_to r s) - and (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. real_cte_at (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to is_cnode_cap (snd x) s) and (\s. \x \ set excaps. cte_wp_at (interrupt_derived (fst x)) (snd x) s) @@ -768,11 +736,11 @@ lemma decode_invocation_reads_respects_f: | rule conjI | (subst split_paired_Ex[symmetric], erule exI) | erule cte_wp_at_weakenE | drule(1) bspec - | erule diminished_no_cap_to_obj_with_diff_ref + | erule eq_no_cap_to_obj_with_diff_ref | assumption)+)[1] apply (rule conjI, assumption) apply (rule impI, erule subst, rule pas_refined_sita_mem [OF sita_controlled], auto - simp: cte_wp_at_caps_of_state diminshed_IRQControlCap_eq)[1] + simp: cte_wp_at_caps_of_state)[1] apply (rename_tac arch_cap) apply (subgoal_tac "(\x\cap_asid' (ArchObjectCap arch_cap). is_subject_asid aag x) \ (\x\set excaps. \v\cap_asid' (fst x). is_subject_asid aag v)") diff --git a/proof/infoflow/FinalCaps.thy b/proof/infoflow/FinalCaps.thy index d998be219f..5de5d9fbec 100644 --- a/proof/infoflow/FinalCaps.thy +++ b/proof/infoflow/FinalCaps.thy @@ -2299,31 +2299,17 @@ lemma mapM_x_swp_store_pte_silc_inv[wp]: \\_. silc_inv aag st\" by (wp mapM_x_wp[OF _ subset_refl] | simp add: swp_def)+ -lemma is_arch_diminished_pt_is_pt_or_pg_cap: - "cte_wp_at (is_arch_diminished (ArchObjectCap (PageTableCap xa xb))) slot s +lemma is_arch_eq_pt_is_pt_or_pg_cap: + "cte_wp_at ((=) (ArchObjectCap (PageTableCap xa xb))) slot s \ cte_wp_at (\a. is_pt_cap a \ is_pg_cap a) slot s" apply (erule cte_wp_at_weakenE) - apply (clarsimp simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def - split: cap.splits arch_cap.splits - simp: acap_rights_update_def acap_rights_def) - apply (case_tac c;simp) - apply (rename_tac arch_cap) - apply (drule_tac x=arch_cap in spec) - apply (case_tac arch_cap, simp_all add: is_pt_cap_def)[1] - done + by (clarsimp simp: is_pg_cap_def is_pt_cap_def) -lemma is_arch_diminished_pg_is_pt_or_pg_cap: - "cte_wp_at (is_arch_diminished (ArchObjectCap (PageCap dev x xa xb xc))) slot s +lemma is_arch_eq_pg_is_pt_or_pg_cap: + "cte_wp_at ((=) (ArchObjectCap (PageCap dev x xa xb xc))) slot s \ cte_wp_at (\a. is_pt_cap a \ is_pg_cap a) slot s" apply (erule cte_wp_at_weakenE) - apply (clarsimp simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def - split: cap.splits arch_cap.splits - simp: acap_rights_update_def acap_rights_def) - apply (case_tac c;simp) - apply (rename_tac arch_cap) - apply (drule_tac x=arch_cap in spec) - apply (case_tac arch_cap, simp_all add: is_pg_cap_def)[1] - done + by (clarsimp simp: is_pg_cap_def is_pt_cap_def) lemma is_arch_update_overlaps: @@ -2354,7 +2340,7 @@ lemma perform_page_table_invocation_silc_inv: apply(clarsimp) defer apply(fastforce simp: silc_inv_def) - apply(fastforce dest: is_arch_diminished_pt_is_pt_or_pg_cap simp: silc_inv_def) + apply(fastforce dest: is_arch_eq_pt_is_pt_or_pg_cap simp: silc_inv_def) apply(drule_tac slot="(aa,ba)" in overlapping_slots_have_labelled_overlapping_caps[rotated]) apply(fastforce) apply(fastforce elim: is_arch_update_overlaps[rotated] cte_wp_at_weakenE) @@ -2460,7 +2446,7 @@ lemma perform_page_invocation_silc_inv: apply(fastforce elim: is_arch_update_overlaps[rotated] cte_wp_at_weakenE) apply fastforce apply(fastforce simp: silc_inv_def) - apply(fastforce dest: is_arch_diminished_pg_is_pt_or_pg_cap simp: silc_inv_def) + apply(fastforce dest: is_arch_eq_pg_is_pt_or_pg_cap simp: silc_inv_def) done lemma cap_insert_silc_inv': diff --git a/proof/infoflow/IRQMasks_IF.thy b/proof/infoflow/IRQMasks_IF.thy index 1a94d5c8fd..d3185abb4c 100644 --- a/proof/infoflow/IRQMasks_IF.thy +++ b/proof/infoflow/IRQMasks_IF.thy @@ -366,7 +366,7 @@ crunch irq_masks[wp]: reply_from_kernel "\s. P (irq_masks_of_state s)" lemma decode_invocation_IRQHandlerCap: - "\ cte_wp_at (diminished cap) slot \ + "\ cte_wp_at ((=) cap) slot \ decode_invocation label args cap_index slot cap blah \\rv s. (\x. rv = InvokeIRQHandler x \ diff --git a/proof/infoflow/Syscall_IF.thy b/proof/infoflow/Syscall_IF.thy index f1dd7d83ae..5f3bd89090 100644 --- a/proof/infoflow/Syscall_IF.thy +++ b/proof/infoflow/Syscall_IF.thy @@ -558,15 +558,15 @@ lemma authorised_for_globals_triv: done lemma decode_invocation_authorised_globals_inv: - "\cte_wp_at (diminished cap) slot and invs and + "\cte_wp_at ((=) cap) slot and invs and (\s. \x\set excaps. - cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (fst x)) (snd x) s)\ decode_invocation info_label args ptr slot cap excaps \\rv. authorised_for_globals_inv rv\, -" unfolding decode_invocation_def apply (rule hoare_pre) - apply wpc - apply((wp authorised_for_globals_triv | wpc | simp add: uncurry_def)+)[11] + apply wpc + apply((wp authorised_for_globals_triv | wpc | simp add: uncurry_def)+)[11] apply (simp add: authorised_for_globals_inv_def) apply wp apply (unfold comp_def) @@ -574,8 +574,8 @@ lemma decode_invocation_authorised_globals_inv: apply (wp decode_arch_invocation_authorised_for_globals) apply (intro impI conjI allI | clarsimp simp add: authorised_for_globals_inv_def)+ apply (erule_tac x="(a, aa, b)" in ballE) - apply simp+ -done + apply simp+ + done lemma set_thread_state_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" diff --git a/proof/invariant-abstract/ARM/ArchArch_AI.thy b/proof/invariant-abstract/ARM/ArchArch_AI.thy index b7f29f20f7..f3faaa3eaa 100644 --- a/proof/invariant-abstract/ARM/ArchArch_AI.thy +++ b/proof/invariant-abstract/ARM/ArchArch_AI.thy @@ -1117,7 +1117,7 @@ lemma valid_global_ptsD2: lemma create_mapping_entries_same_refs: "\valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\s. unique_table_refs (caps_of_state s)) and pspace_aligned and valid_objs and valid_kernel_mappings and \\ pd and - (\s. \pd_cap pd_cptr. cte_wp_at (diminished pd_cap) pd_cptr s + (\s. \pd_cap pd_cptr. cte_wp_at ((=) pd_cap) pd_cptr s \ pd_cap = cap.ArchObjectCap (arch_cap.PageDirectoryCap pd (Some asid))) and page_directory_at pd and K (vaddr < kernel_base \ (cap = (cap.ArchObjectCap (arch_cap.PageCap dev p rights' pgsz (Some (asid, vaddr))))))\ create_mapping_entries (addrFromPPtr p) vaddr pgsz rights attribs pd @@ -1138,10 +1138,8 @@ lemma create_mapping_entries_same_refs: word_bits_def vaddr_segment_nonsense3) apply (rule conjI, simp add: mask_def) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def + apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits bool.splits ) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (frule_tac p=pd and p'="ptrFromPAddr x" in vs_lookup_step) @@ -1156,7 +1154,7 @@ lemma create_mapping_entries_same_refs: apply (frule kernel_base_kernel_mapping_slots, simp add: pde_ref_def) apply simp apply (drule (1) ref_is_unique) - apply (rule not_kernel_slot_not_global_pt[simplified second_level_tables_def, rotated]) + apply (rule not_kernel_slot_not_global_pt[simplified second_level_tables_def, rotated]) apply (erule kernel_base_kernel_mapping_slots) apply (simp add: obj_at_def) apply (simp_all add: pde_ref_def valid_arch_state_def valid_objs_caps)[8] @@ -1173,10 +1171,8 @@ lemma create_mapping_entries_same_refs: word_bits_def vaddr_segment_nonsense3) apply (rule conjI, simp add: mask_def) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def + apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits bool.splits) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (frule_tac p=pd and p'="ptrFromPAddr x" in vs_lookup_step) @@ -1186,12 +1182,12 @@ lemma create_mapping_entries_same_refs: apply (rule conjI, rule refl) apply (simp add: vs_refs_def) apply (rule_tac x="(ucast (vaddr >> 20), ptrFromPAddr x)" in image_eqI) - apply (simp add: ucast_ucast_len[OF shiftr_less_t2n'] mask_32_max_word graph_of_def) - apply (clarsimp simp:graph_of_def) + apply (simp add: ucast_ucast_len[OF shiftr_less_t2n'] graph_of_def) + apply (clarsimp simp: graph_of_def) apply (frule kernel_base_kernel_mapping_slots, simp add: pde_ref_def) apply simp apply (drule (1) ref_is_unique) - apply (rule not_kernel_slot_not_global_pt[simplified second_level_tables_def, rotated]) + apply (rule not_kernel_slot_not_global_pt[simplified second_level_tables_def, rotated]) apply (erule kernel_base_kernel_mapping_slots) apply (simp add: obj_at_def) apply (simp_all add: pde_ref_def valid_arch_state_def valid_objs_caps)[8] @@ -1200,36 +1196,32 @@ lemma create_mapping_entries_same_refs: apply (frule (1) pd_aligned) apply (clarsimp simp: same_refs_def vs_cap_ref_def pde_ref_pages_def) apply (simp add: vaddr_segment_nonsense vaddr_segment_nonsense2) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def + apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits bool.splits) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (drule (1) ref_is_unique) - apply (clarsimp simp: valid_arch_state_def obj_at_def dest!:valid_global_ptsD2) + apply (clarsimp simp: valid_arch_state_def obj_at_def dest!: valid_global_ptsD2) apply (simp_all add: valid_arch_state_def valid_objs_caps)[6] - apply (wp returnOKE_R_wp | wpc)+ - apply (clarsimp simp: lookup_pd_slot_def) - apply (frule (1) pd_aligned) - apply (clarsimp simp: same_refs_def vs_cap_ref_def pde_ref_pages_def upto_enum_step_def upto_enum_word upt_conv_Cons) - apply (simp add: vaddr_segment_nonsense vaddr_segment_nonsense2) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def - mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits bool.splits) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) - apply (frule (1) vs_lookup_and_unique_refs) - apply (simp_all add: table_cap_ref_def obj_refs_def)[4] - apply (drule (1) ref_is_unique) - apply (clarsimp dest!: valid_global_ptsD2 simp: obj_at_def a_type_def valid_arch_state_def) - apply (simp_all add: valid_arch_state_def valid_objs_caps) + apply (wp returnOKE_R_wp | wpc)+ + apply (clarsimp simp: lookup_pd_slot_def) + apply (frule (1) pd_aligned) + apply (clarsimp simp: same_refs_def vs_cap_ref_def pde_ref_pages_def upto_enum_step_def upto_enum_word upt_conv_Cons) + apply (simp add: vaddr_segment_nonsense vaddr_segment_nonsense2) + apply (clarsimp simp: cte_wp_at_caps_of_state + mask_cap_def cap_rights_update_def) + apply (frule (1) vs_lookup_and_unique_refs) + apply (simp_all add: table_cap_ref_def obj_refs_def)[4] + apply (drule (1) ref_is_unique) + apply (clarsimp dest!: valid_global_ptsD2 simp: obj_at_def a_type_def valid_arch_state_def) + apply (simp_all add: valid_arch_state_def valid_objs_caps) done lemma create_mapping_entries_same_refs_ex: "\valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\s. unique_table_refs (caps_of_state s)) and pspace_aligned and valid_objs and valid_kernel_mappings and \\ pd and - (\s. \dev pd_cap pd_cptr asid rights'. cte_wp_at (diminished pd_cap) pd_cptr s + (\s. \dev pd_cap pd_cptr asid rights'. cte_wp_at ((=) pd_cap) pd_cptr s \ pd_cap = cap.ArchObjectCap (arch_cap.PageDirectoryCap pd (Some asid)) \ page_directory_at pd s \ vaddr < kernel_base \ (cap = (cap.ArchObjectCap (arch_cap.PageCap dev p rights' pgsz (Some (asid, vaddr))))))\ create_mapping_entries (addrFromPPtr p) vaddr pgsz rights attribs pd @@ -1240,27 +1232,10 @@ lemma create_mapping_entries_same_refs_ex: done -lemma diminished_pd_capD: - "diminished (ArchObjectCap (PageDirectoryCap a b)) cap - \ cap = (ArchObjectCap (PageDirectoryCap a b))" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) - done - - -lemma diminished_pd_self: - "diminished (ArchObjectCap (PageDirectoryCap a b)) (ArchObjectCap (PageDirectoryCap a b))" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits) - done - - lemma cte_wp_at_page_cap_weaken: - "cte_wp_at (diminished (ArchObjectCap (PageCap dev word seta vmpage_size None))) slot s \ + "cte_wp_at ((=) (ArchObjectCap (PageCap dev word seta vmpage_size None))) slot s \ cte_wp_at (\a. \dev p R sz m. a = ArchObjectCap (PageCap dev p R sz m)) slot s" - apply (clarsimp simp: cte_wp_at_def diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) - done + by (clarsimp simp: cte_wp_at_def mask_cap_def cap_rights_update_def) lemma find_pd_for_asid_lookup_pd_wp: "\ \s. valid_vspace_objs s \ (\pd. vspace_at_asid asid pd s \ page_directory_at pd s @@ -1291,8 +1266,8 @@ lemma aligned_sum_less_kernel_base: lemma arch_decode_inv_wf[wp]: "\invs and valid_cap (cap.ArchObjectCap arch_cap) and - cte_wp_at (diminished (cap.ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (cap.ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ arch_decode_invocation label args cap_index slot arch_cap excaps \valid_arch_inv\,-" apply (cases arch_cap) @@ -1325,8 +1300,8 @@ lemma arch_decode_inv_wf[wp]: apply (rule conjI) apply (clarsimp simp add: cte_wp_at_caps_of_state) apply (rename_tac c c') - apply (frule_tac cap=c' in caps_of_state_valid, assumption) - apply (drule (1) diminished_is_update) + apply (frule_tac cap="(ArchObjectCap (PageDirectoryCap xb None))" in caps_of_state_valid, + assumption) apply (clarsimp simp: is_pd_cap_def cap_rights_update_def acap_rights_update_def) apply (clarsimp simp: word_neq_0_conv) @@ -1369,22 +1344,14 @@ lemma arch_decode_inv_wf[wp]: apply clarsimp apply (rule conjI) apply (drule cte_wp_at_norm, clarsimp, drule cte_wp_valid_cap, fastforce)+ - apply (clarsimp simp add: diminished_def) + apply assumption apply (rule conjI) apply clarsimp apply (simp add: ex_cte_cap_wp_to_def) apply (rule_tac x=ac in exI) apply (rule_tac x=ba in exI) - apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: is_cap_simps cap_rights_update_def) - apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: cap_rights_update_def) + apply (clarsimp simp add: cte_wp_at_caps_of_state)+ \ \PageCap\ - apply (clarsimp simp: diminished_def) apply (simp add: arch_decode_invocation_def Let_def split_def cong: if_cong split del: if_split) supply if_split[split del] apply (cases "invocation_type label = ArchInvocationLabel ARMPageMap") @@ -1400,13 +1367,8 @@ lemma arch_decode_inv_wf[wp]: | simp add: valid_arch_inv_def valid_page_inv_def is_pg_cap_def cte_wp_at_caps_of_state[where P="\c. same_refs rv c s" for rv s])+ apply (clarsimp simp: neq_Nil_conv invs_vspace_objs) - apply (frule diminished_cte_wp_at_valid_cap[where p="(a, b)" for a b], clarsimp) - apply (frule diminished_cte_wp_at_valid_cap[where p=slot], clarsimp) - apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def - diminished_def[where cap="ArchObjectCap (PageCap d x y z w)" for d x y z w] - dest!: diminished_pd_capD) - apply (clarsimp simp: cap_rights_update_def acap_rights_update_def - split: cap.splits arch_cap.splits bool.splits) + apply (frule(1) caps_of_state_valid) + apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def) apply (rule conjI[rotated]; clarsimp split: if_splits simp: invs_vspace_objs) apply (auto, auto simp: cte_wp_at_caps_of_state invs_def valid_state_def valid_cap_simps is_arch_update_def @@ -1425,13 +1387,10 @@ lemma arch_decode_inv_wf[wp]: apply (rule hoare_pre, wp) apply (clarsimp simp: valid_arch_inv_def valid_page_inv_def) apply (thin_tac "Ball S P" for S P) - apply (rule conjI) apply (clarsimp split: option.split) apply (clarsimp simp: valid_cap_def cap_aligned_def) apply (simp add: valid_unmap_def) apply (fastforce simp: vmsz_aligned_def elim: is_aligned_weaken intro!: pbfs_atleast_pageBits) - apply (erule cte_wp_at_weakenE) - apply (clarsimp simp: is_arch_diminished_def is_cap_simps) apply (cases "isPageFlushLabel (invocation_type label)") apply (rule hoare_pre) apply simp @@ -1488,14 +1447,12 @@ lemma arch_decode_inv_wf[wp]: apply (clarsimp simp: valid_cap_def cap_aligned_def) apply (rule conjI) apply (drule cte_wp_at_norm, clarsimp, drule cte_wp_valid_cap, fastforce)+ - apply (drule (1) diminished_is_update[rotated])+ apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (clarsimp simp: valid_cap_def cap_aligned_def pt_bits_def pageBits_def linorder_not_le order_le_less_trans[OF word_and_le2]) apply (rule conjI) apply (clarsimp simp add: cte_wp_at_caps_of_state) apply (drule (1) caps_of_state_valid[rotated]) - apply (drule (1) diminished_is_update) apply clarsimp apply (clarsimp simp: cap_master_cap_def is_arch_update_def) apply (clarsimp simp: cap_asid_def cap_rights_update_def acap_rights_update_def is_cap_simps @@ -1506,7 +1463,6 @@ lemma arch_decode_inv_wf[wp]: apply (frule invs_pd_caps) apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) caps_of_state_valid[rotated]) - apply (drule (1) diminished_is_update) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def valid_cap_def) apply (drule (2) valid_table_caps_ptD) apply (rule conjI, fastforce simp:)+ @@ -1515,7 +1471,7 @@ lemma arch_decode_inv_wf[wp]: apply (drule le_shiftr[where n=20], drule(1) order_trans) apply (simp add: kernel_base_def) apply (simp add: valid_arch_inv_def valid_pti_def) - apply (clarsimp simp: cte_wp_at_def is_arch_diminished_def is_cap_simps) + apply (clarsimp simp: cte_wp_at_def is_cap_simps) apply (simp add: arch_decode_invocation_def Let_def) apply (cases "isPDFlushLabel (invocation_type label)") apply simp @@ -1553,24 +1509,6 @@ lemma arch_pinv_st_tcb_at: fastforce elim!: pred_tcb_weakenE) done - -lemma get_cap_diminished: - "\valid_objs\ get_cap slot \\cap. cte_wp_at (diminished cap) slot\" - apply (wp get_cap_wp) - apply (intro allI impI) - apply (simp add: cte_wp_at_caps_of_state diminished_def) - apply (frule (1) caps_of_state_valid_cap) - apply (clarsimp simp add: valid_cap_def2 wellformed_cap_def mask_cap_def - cap_rights_update_def acap_rights_update_def - split: cap.splits arch_cap.splits bool.splits) - apply fastforce+ - apply (clarsimp simp add: wellformed_acap_def - split: cap.splits arch_cap.splits) - apply (rename_tac rights vmpage_size option) - apply (rule_tac x=rights in exI) - apply auto - done - end @@ -1585,7 +1523,6 @@ requalify_facts sts_valid_arch_inv arch_decode_inv_wf arch_pinv_st_tcb_at - get_cap_diminished end diff --git a/proof/invariant-abstract/ARM/ArchSyscall_AI.thy b/proof/invariant-abstract/ARM/ArchSyscall_AI.thy index 4f6383361f..0aeedc671e 100644 --- a/proof/invariant-abstract/ARM/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/ARM/ArchSyscall_AI.thy @@ -47,13 +47,12 @@ lemma table_cap_ref_mask_cap [Syscall_AI_assms]: by (clarsimp simp add:mask_cap_def table_cap_ref_def acap_rights_update_def cap_rights_update_def split:cap.splits arch_cap.splits bool.splits) -lemma diminished_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: - "\ cte_wp_at (diminished cap) p s; valid_arch_caps s \ +lemma eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: + "\ cte_wp_at ((=) cap) p s; valid_arch_caps s \ \ no_cap_to_obj_with_diff_ref cap S s" apply (clarsimp simp: cte_wp_at_caps_of_state valid_arch_caps_def) apply (frule(1) unique_table_refs_no_cap_asidD) - apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def - table_cap_ref_mask_cap diminished_def Ball_def) + apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def table_cap_ref_mask_cap Ball_def) done lemma getDFSR_invs[wp]: diff --git a/proof/invariant-abstract/ARM/ArchUntyped_AI.thy b/proof/invariant-abstract/ARM/ArchUntyped_AI.thy index 96de937977..49f7fb93f2 100644 --- a/proof/invariant-abstract/ARM/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/ARM/ArchUntyped_AI.thy @@ -81,15 +81,15 @@ proof - unat (args ! 5) \ 2 ^ bits_of node_cap - unat (args ! 4);valid_cap node_cap s\ \ inj_on (Pair (obj_ref_of node_cap) \ nat_to_cref (bits_of node_cap)) {unat (args ! 4)..S a f s. (\x\S. cte_wp_at ((=) cap.NullCap) (a, f x) s) @@ -97,63 +97,59 @@ proof - \ slot \ (Pair a \ f) ` S" by (auto simp:cte_wp_at_caps_of_state) show ?thesis - apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] - unlessE_whenE - split del: if_split) - apply (rule validE_R_sp[OF whenE_throwError_sp] - validE_R_sp[OF data_to_obj_type_sp] - validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ - apply clarsimp - apply (rule hoare_pre) - apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp - map_ensure_empty_wp) - apply (clarsimp simp: distinct_map cases_imp_eq) - apply (subgoal_tac "s \ node_cap") - prefer 2 - apply (erule disjE) - apply (drule bspec [where x = "cs ! 0"],clarsimp)+ - apply fastforce - apply clarsimp - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (drule(1) caps_of_state_valid[rotated])+ - apply (clarsimp simp: is_cap_simps diminished_def mask_cap_def - cap_rights_update_def, - simp split: cap.splits bool.splits) - apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (frule(1) caps_of_state_valid[rotated]) - apply (clarsimp simp:not_less) - apply (frule(2) inj) - apply (clarsimp simp:comp_def) - apply (frule(1) caps_of_state_valid) - apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) - apply (intro conjI) - apply (intro impI) - apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] - apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ - apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) - apply (erule range_cover.sz) - apply (simp add:range_cover_def) - apply (clarsimp simp:get_free_ref_def is_aligned_neg_mask_eq empty_descendants_range_in) - apply (rule conjI[rotated], blast, clarsimp) - apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec) - apply (clarsimp simp:is_cap_simps nat_to_cref_def word_bits_def - bits_of_def valid_cap_simps cap_aligned_def)+ - apply (simp add: free_index_of_def) - apply (frule(1) range_cover_stuff[where sz = sz]) - apply (clarsimp dest!:valid_cap_aligned simp:cap_aligned_def word_bits_def)+ - apply simp+ - apply (clarsimp simp:get_free_ref_def) - apply (erule disjE) - apply (drule_tac x= "cs!0" in bspec) - subgoal by clarsimp + apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] + unlessE_whenE + split del: if_split) + apply (rule validE_R_sp[OF whenE_throwError_sp] + validE_R_sp[OF data_to_obj_type_sp] + validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ + apply clarsimp + apply (rule hoare_pre) + apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp + map_ensure_empty_wp) + apply (clarsimp simp: distinct_map cases_imp_eq) + apply (subgoal_tac "s \ node_cap") + prefer 2 + apply (erule disjE) + apply (drule bspec [where x = "cs ! 0"],clarsimp)+ + apply fastforce + apply clarsimp + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (drule(1) caps_of_state_valid[rotated])+ + apply assumption + apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (frule(1) caps_of_state_valid[rotated]) + apply (clarsimp simp: not_less) + apply (frule(2) inj) + apply (clarsimp simp: comp_def) + apply (frule(1) caps_of_state_valid) + apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) + apply (intro conjI) + apply (intro impI) + apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] + apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ + apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) + apply (erule range_cover.sz) + apply (simp add: range_cover_def) + apply (clarsimp simp: get_free_ref_def empty_descendants_range_in) + apply (rule conjI[rotated], blast, clarsimp) + apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec) + apply (clarsimp simp: is_cap_simps nat_to_cref_def word_bits_def + bits_of_def valid_cap_simps cap_aligned_def)+ + apply (simp add: free_index_of_def) + apply (frule(1) range_cover_stuff[where sz = sz]) + apply (clarsimp dest!: valid_cap_aligned simp: cap_aligned_def word_bits_def)+ + apply simp+ + apply (clarsimp simp: get_free_ref_def) + apply (erule disjE) + apply (drule_tac x= "cs!0" in bspec) + subgoal by clarsimp subgoal by simp - apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) - apply (rule_tac x=aa in exI,rule exI,rule exI) - apply (rule conjI, assumption) - apply (clarsimp simp: diminished_def is_cap_simps mask_cap_def - cap_rights_update_def, - simp split: cap.splits bool.splits) + apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) + apply (rule_tac x=aa in exI,rule exI,rule exI) + apply (rule conjI, assumption) + apply simp done qed diff --git a/proof/invariant-abstract/ARM/ArchVSpace_AI.thy b/proof/invariant-abstract/ARM/ArchVSpace_AI.thy index 25fc35573f..d64e57a6c8 100644 --- a/proof/invariant-abstract/ARM/ArchVSpace_AI.thy +++ b/proof/invariant-abstract/ARM/ArchVSpace_AI.thy @@ -1457,7 +1457,7 @@ definition | PageUnmap cap ptr \ \s. \dev r R sz m. cap = PageCap dev r R sz m \ case_option True (valid_unmap sz) m \ - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) ptr s \ + cte_wp_at ((=) (cap.ArchObjectCap cap)) ptr s \ s \ (cap.ArchObjectCap cap) | PageFlush typ start end pstart pd asid \ vspace_at_asid asid pd and K (asid \ mask asid_bits \ asid \ 0) @@ -1523,7 +1523,7 @@ definition \ hd (the (vs_cap_ref cap)) \ kernel_vsrefs) and K (is_pt_cap cap \ cap_asid cap \ None) | PageTableUnmap cap ptr \ - cte_wp_at (\c. is_arch_diminished cap c) ptr and valid_cap cap + cte_wp_at ((=) cap) ptr and valid_cap cap and is_final_cap' cap and K (is_pt_cap cap)" @@ -3547,10 +3547,10 @@ lemma perform_page_table_invocation_invs[wp]: apply (wp dmo_invs) apply (rule_tac Q="\_. invs" in hoare_post_imp) apply safe - apply (drule_tac Q="\_ m'. underlying_memory m' p = - underlying_memory m p" in use_valid) - apply ((clarsimp simp: machine_op_lift_def - machine_rest_lift_def split_def | wp)+)[3] + apply (drule_tac Q="\_ m'. underlying_memory m' p = + underlying_memory m p" in use_valid) + apply ((clarsimp simp: machine_op_lift_def + machine_rest_lift_def split_def | wp)+)[3] apply(erule use_valid, wp no_irq_cleanByVA_PoU no_irq, assumption) apply (wp store_pde_map_invs)[1] apply simp @@ -3598,8 +3598,8 @@ lemma perform_page_table_invocation_invs[wp]: apply safe[1] apply (drule_tac Q="\_ m'. underlying_memory m' p = underlying_memory m p" in use_valid) - apply ((clarsimp | wp)+)[3] - apply(erule use_valid, wp no_irq_cleanCacheRange_PoU, assumption) + apply ((clarsimp | wp)+)[3] + apply(erule use_valid, wp no_irq_cleanCacheRange_PoU, assumption) apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift valid_cap_typ[OF do_machine_op_obj_at] mapM_x_swp_store_pte_invs[unfolded cte_wp_at_caps_of_state] @@ -3610,12 +3610,10 @@ lemma perform_page_table_invocation_invs[wp]: | wp (once) mapM_x_wp' | simp)+ apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state - is_arch_diminished_def is_cap_simps + is_cap_simps is_arch_update_def cap_rights_update_def acap_rights_update_def cap_master_cap_simps update_map_data_def) - apply (frule (2) diminished_is_update') - apply (simp add: cap_rights_update_def acap_rights_update_def) apply (rule conjI) apply (clarsimp simp: vs_cap_ref_def) apply (drule invs_pd_caps) @@ -3633,7 +3631,7 @@ lemma perform_page_table_invocation_invs[wp]: apply (subgoal_tac "(\x\set [word , word + 4 .e. word + 2 ^ pt_bits - 1]. x && ~~ mask pt_bits = word)") apply (intro conjI) - apply (simp add: cap_master_cap_def) + apply (simp add: cap_master_cap_def) apply fastforce apply (clarsimp simp: image_def) apply (subgoal_tac "word + (ucast x << 2) @@ -4629,8 +4627,7 @@ lemma perform_page_invs [wp]: apply (simp add: cte_wp_at_caps_of_state) apply (wp unmap_page_invs hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_imp_lift unmap_page_unmapped)+ - apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state is_arch_diminished_def) - apply (drule (2) diminished_is_update') + apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state) apply (clarsimp simp: is_cap_simps cap_master_cap_simps is_arch_update_def update_map_data_def cap_rights_update_def acap_rights_update_def) using valid_validate_vm_rights[simplified valid_vm_rights_def] diff --git a/proof/invariant-abstract/ARM_HYP/ArchArch_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchArch_AI.thy index c0dc01ef82..9aefc0974e 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchArch_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchArch_AI.thy @@ -1290,7 +1290,7 @@ lemma vs_lookup_and_unique_refs: lemma create_mapping_entries_same_refs: "\valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\s. unique_table_refs (caps_of_state s)) and pspace_aligned and valid_objs and valid_kernel_mappings and \\ pd and - (\s. \dev pd_cap pd_cptr. cte_wp_at (diminished pd_cap) pd_cptr s + (\s. \dev pd_cap pd_cptr. cte_wp_at ((=) pd_cap) pd_cptr s \ pd_cap = ArchObjectCap (PageDirectoryCap pd (Some asid))) and page_directory_at pd and K (vaddr < kernel_base \ (cap = (ArchObjectCap (PageCap dev p rights' pgsz (Some (asid, vaddr))))))\ create_mapping_entries (addrFromPPtr p) vaddr pgsz rights attribs pd @@ -1311,10 +1311,7 @@ lemma create_mapping_entries_same_refs: word_bits_def pageBits_def vaddr_segment_nonsense3) apply (rule conjI, simp add: mask_def pt_bits_def pte_bits_def) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def - mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) + apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (frule_tac p=pd and p'="ptrFromPAddr x" in vs_lookup_step) @@ -1324,7 +1321,7 @@ lemma create_mapping_entries_same_refs: apply (rule conjI, rule refl) apply (simp add: vs_refs_def) apply (rule_tac x="(ucast (vaddr >> 21), ptrFromPAddr x)" in image_eqI) - apply (simp add: ucast_ucast_len[OF shiftr_less_t2n'] mask_32_max_word graph_of_def) + apply (simp add: ucast_ucast_len[OF shiftr_less_t2n'] graph_of_def) apply (clarsimp simp:graph_of_def) apply (simp add: pde_ref_def) apply simp @@ -1347,10 +1344,7 @@ lemma create_mapping_entries_same_refs: vaddr_segment_nonsense3) apply (simp add: pt_bits_def pte_bits_def) apply (rule conjI, simp add: mask_def) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def - mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits bool.splits) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) + apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (frule_tac p=pd and p'="ptrFromPAddr x" in vs_lookup_step) @@ -1360,7 +1354,7 @@ lemma create_mapping_entries_same_refs: apply (rule conjI, rule refl) apply (simp add: vs_refs_def) apply (rule_tac x="(ucast (vaddr >> 21), ptrFromPAddr x)" in image_eqI) - apply (simp add: ucast_ucast_len[OF shiftr_less_t2n'] mask_32_max_word graph_of_def) + apply (simp add: ucast_ucast_len[OF shiftr_less_t2n'] graph_of_def) apply (clarsimp simp:graph_of_def) apply (simp add: pde_ref_def) apply simp @@ -1373,24 +1367,18 @@ lemma create_mapping_entries_same_refs: apply (clarsimp simp: same_refs_def vs_cap_ref_def pde_ref_pages_def) apply (simp add: vaddr_segment_nonsense vaddr_segment_nonsense2 pageBits_def pt_bits_def pte_bits_def pde_bits_def) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def - mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits bool.splits) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) + apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (drule (1) ref_is_unique) - apply (simp_all add: valid_arch_state_def valid_objs_caps)[7] + apply (simp_all add: valid_arch_state_def valid_objs_caps)[7] apply (wp returnOKE_R_wp | wpc)+ apply (clarsimp simp: lookup_pd_slot_def) apply (frule (1) pd_aligned) apply (simp add: superSectionPDE_offsets_def pde_bits_def pageBits_def pt_bits_def) apply (clarsimp simp: same_refs_def vs_cap_ref_def pde_ref_pages_def upto_enum_step_def upto_enum_word upt_conv_Cons) apply (simp add: vaddr_segment_nonsense vaddr_segment_nonsense2 pageBits_def pt_bits_def) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def - mask_cap_def cap_rights_update_def) - apply (clarsimp split: Structures_A.cap.splits ) - apply (clarsimp simp: acap_rights_update_def split: arch_cap.splits) + apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) vs_lookup_and_unique_refs) apply (simp_all add: table_cap_ref_def obj_refs_def)[4] apply (drule (1) ref_is_unique) @@ -1402,7 +1390,7 @@ lemma create_mapping_entries_same_refs: lemma create_mapping_entries_same_refs_ex: "\valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\s. unique_table_refs (caps_of_state s)) and pspace_aligned and valid_objs and valid_kernel_mappings and \\ pd and - (\s. \dev pd_cap pd_cptr asid rights'. cte_wp_at (diminished pd_cap) pd_cptr s + (\s. \dev pd_cap pd_cptr asid rights'. cte_wp_at ((=) pd_cap) pd_cptr s \ pd_cap = cap.ArchObjectCap (arch_cap.PageDirectoryCap pd (Some asid)) \ page_directory_at pd s \ vaddr < kernel_base \ (cap = (cap.ArchObjectCap (arch_cap.PageCap dev p rights' pgsz (Some (asid, vaddr))))))\ create_mapping_entries (Platform.ARM_HYP.addrFromPPtr p) vaddr pgsz rights attribs pd @@ -1413,29 +1401,6 @@ lemma create_mapping_entries_same_refs_ex: done -lemma diminished_pd_capD: - "diminished (ArchObjectCap (PageDirectoryCap a b)) cap - \ cap = (ArchObjectCap (PageDirectoryCap a b))" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) - done - - -lemma diminished_pd_self: - "diminished (ArchObjectCap (PageDirectoryCap a b)) (ArchObjectCap (PageDirectoryCap a b))" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits) - done - - -lemma cte_wp_at_page_cap_weaken: - "cte_wp_at (diminished (ArchObjectCap (PageCap dev word seta vmpage_size None))) slot s \ - cte_wp_at (\a. \dev p R sz m. a = ArchObjectCap (PageCap dev p R sz m)) slot s" - apply (clarsimp simp: cte_wp_at_def diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) - done - - lemma find_pd_for_asid_lookup_pd_wp: "\ \s. valid_vspace_objs s \ (\pd. vspace_at_asid asid pd s \ page_directory_at pd s \ (\\ pd) s \ Q pd s) \ find_pd_for_asid asid \ Q \, -" @@ -1462,18 +1427,6 @@ lemma aligned_sum_less_kernel_base: apply (case_tac sz,simp_all add:kernel_base_def is_aligned_def)+ done -lemma diminished_VCPUCap[simp]: - "diminished (ArchObjectCap (VCPUCap vcpu_ptr)) c = (c = ArchObjectCap (VCPUCap vcpu_ptr))" - apply (cases c; simp add: diminished_def mask_cap_def cap_rights_update_def) - apply (rename_tac acap) - apply (case_tac acap; simp add: acap_rights_update_def) - apply auto - done - -lemma diminshed_ThreadCap[simp]: - "diminished (ThreadCap t) c = (c = ThreadCap t)" - by (cases c) (auto simp: diminished_def mask_cap_def cap_rights_update_def) - lemma find_pd_for_asid_pde_unfolded[wp]: "\valid_vspace_objs and pspace_aligned\ find_pd_for_asid asid @@ -1484,8 +1437,8 @@ lemma find_pd_for_asid_pde_unfolded[wp]: lemma arch_decode_inv_wf[wp]: "\invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ arch_decode_invocation label args cap_index slot arch_cap excaps \valid_arch_inv\,-" supply if_split[split del] @@ -1519,8 +1472,8 @@ lemma arch_decode_inv_wf[wp]: apply (rule conjI) apply (clarsimp simp add: cte_wp_at_caps_of_state) apply (rename_tac c c') - apply (frule_tac cap=c' in caps_of_state_valid, assumption) - apply (drule (1) diminished_is_update) + apply (frule_tac cap="(ArchObjectCap (PageDirectoryCap xb None))" in caps_of_state_valid, + assumption) apply (clarsimp simp: is_pd_cap_def cap_rights_update_def acap_rights_update_def) apply (clarsimp simp: word_neq_0_conv) apply (rule conjI) @@ -1562,22 +1515,15 @@ lemma arch_decode_inv_wf[wp]: apply clarsimp apply (rule conjI) apply (drule cte_wp_at_norm, clarsimp, drule cte_wp_valid_cap, fastforce)+ - apply (clarsimp simp add: diminished_def) + apply assumption apply (rule conjI) apply clarsimp apply (simp add: ex_cte_cap_wp_to_def) apply (rule_tac x=ac in exI) apply (rule_tac x=ba in exI) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - - apply (clarsimp simp: is_cap_simps cap_rights_update_def) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: cap_rights_update_def) - apply (clarsimp simp:diminished_def) + apply (clarsimp simp: cap_rights_update_def) apply (simp add: arch_decode_invocation_def Let_def split_def decode_mmu_invocation_def cong: if_cong) apply (cases "invocation_type label = ArchInvocationLabel ARMPageMap") @@ -1590,12 +1536,9 @@ lemma arch_decode_inv_wf[wp]: simp: valid_arch_inv_def valid_page_inv_def is_pg_cap_def cte_wp_at_caps_of_state[where P="\c. same_refs rv c s" for rv s]) apply (clarsimp simp: neq_Nil_conv) - apply (frule diminished_cte_wp_at_valid_cap[where p="(a, b)" for a b], clarsimp) - apply (frule diminished_cte_wp_at_valid_cap[where p=slot], clarsimp) - apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def conj_ac - diminished_def[where cap="ArchObjectCap (PageCap x y z v w)" for x y z v w] - linorder_not_le aligned_sum_less_kernel_base - dest!: diminished_pd_capD) + apply (frule cte_wp_valid_cap[where p="(a, b)" for a b], clarsimp) + apply (frule cte_wp_valid_cap[where p=slot], clarsimp) + apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits if_splits) apply (rename_tac page_size mapped_data) @@ -1611,13 +1554,10 @@ lemma arch_decode_inv_wf[wp]: apply (rule hoare_pre, wp) apply (clarsimp simp: valid_arch_inv_def valid_page_inv_def) apply (thin_tac "Ball S P" for S P) - apply (rule conjI) - apply (clarsimp split: option.split) - apply (clarsimp simp: valid_cap_def cap_aligned_def) - apply (simp add: valid_unmap_def) - apply (fastforce simp: vmsz_aligned_def elim: is_aligned_weaken intro!: pbfs_atleast_pageBits) - apply (erule cte_wp_at_weakenE) - apply (clarsimp simp: is_arch_diminished_def is_cap_simps) + apply (clarsimp split: option.split) + apply (clarsimp simp: valid_cap_def cap_aligned_def) + apply (simp add: valid_unmap_def) + apply (fastforce simp: vmsz_aligned_def elim: is_aligned_weaken intro!: pbfs_atleast_pageBits) apply (cases "isPageFlushLabel (invocation_type label)") apply simp apply (rule hoare_pre) @@ -1637,12 +1577,12 @@ lemma arch_decode_inv_wf[wp]: cong: if_cong) apply (rename_tac word option) apply (rule hoare_pre) - apply ((wp whenE_throwError_wp check_vp_wpR get_master_pde_wp hoare_vcg_all_lift_R| - wpc| - simp add: valid_arch_inv_def valid_pti_def unlessE_whenE vs_cap_ref_def - split: if_split| - rule_tac x="fst p" in hoare_imp_eq_substR| - wp (once) hoare_vcg_ex_lift_R)+)[1] + apply ((wp whenE_throwError_wp check_vp_wpR get_master_pde_wp hoare_vcg_all_lift_R + | wpc + | simp add: valid_arch_inv_def valid_pti_def unlessE_whenE vs_cap_ref_def + split: if_split + | rule_tac x="fst p" in hoare_imp_eq_substR + | wp (once) hoare_vcg_ex_lift_R)+)[1] apply (rule_tac Q'="\a b. ko_at (ArchObj (PageDirectory pd)) (a + (args ! 0 >> 21 << 3) && ~~ mask pd_bits) b \ pd (ucast (a + (args ! 0 >> 21 << 3) && mask pd_bits >> 3)) = @@ -1675,7 +1615,6 @@ lemma arch_decode_inv_wf[wp]: apply (clarsimp simp: valid_cap_def cap_aligned_def) apply (rule conjI) apply (drule cte_wp_at_norm, clarsimp, drule cte_wp_valid_cap, fastforce)+ - apply (drule (1) diminished_is_update[rotated])+ apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (clarsimp simp: valid_cap_def cap_aligned_def pt_bits_def pageBits_def @@ -1684,7 +1623,6 @@ lemma arch_decode_inv_wf[wp]: apply (rule conjI) apply (clarsimp simp add: cte_wp_at_caps_of_state) apply (drule (1) caps_of_state_valid[rotated]) - apply (drule (1) diminished_is_update) apply clarsimp apply (clarsimp simp: cap_master_cap_def is_arch_update_def) apply (clarsimp simp: cap_asid_def cap_rights_update_def acap_rights_update_def is_cap_simps @@ -1695,13 +1633,12 @@ lemma arch_decode_inv_wf[wp]: apply (frule invs_pd_caps) apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule (1) caps_of_state_valid[rotated]) - apply (drule (1) diminished_is_update) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def valid_cap_def) apply (drule (2) valid_table_caps_ptD) apply (rule conjI, fastforce)+ apply (clarsimp simp: kernel_vsrefs_def) apply fastforce - apply (clarsimp simp: cte_wp_at_def is_arch_diminished_def is_cap_simps + apply (clarsimp simp: cte_wp_at_def is_cap_simps valid_arch_inv_def valid_pti_def) apply (simp add: arch_decode_invocation_def Let_def decode_mmu_invocation_def) apply (cases "isPDFlushLabel (invocation_type label)") @@ -1718,7 +1655,7 @@ lemma arch_decode_inv_wf[wp]: apply (clarsimp simp: valid_cap_def mask_def) apply (clarsimp, wp throwError_validE_R) - (* VCPU *) +(* VCPU *) apply (rename_tac vcpu_ptr) apply (clarsimp simp: arch_decode_invocation_def decode_vcpu_invocation_def) apply (cases "invocation_type label"; (simp, wp?)) @@ -1728,7 +1665,7 @@ lemma arch_decode_inv_wf[wp]: apply (rule hoare_pre, wpsimp) apply (clarsimp simp: valid_arch_inv_def valid_vcpu_invocation_def) apply (rename_tac tcb_ptr) - apply (frule_tac c="ThreadCap tcb_ptr" in diminished_cte_wp_at_valid_cap, fastforce) + apply (frule_tac c="ThreadCap tcb_ptr" in cte_wp_valid_cap, fastforce) apply (simp add: valid_cap_def) apply (cases slot) apply (clarsimp simp: ex_nonz_cap_to_def) @@ -1795,24 +1732,6 @@ lemma arch_pinv_st_tcb_at: fastforce elim!: pred_tcb_weakenE) done - -lemma get_cap_diminished: - "\valid_objs\ get_cap slot \\cap. cte_wp_at (diminished cap) slot\" - apply (wp get_cap_wp) - apply (intro allI impI) - apply (simp add: cte_wp_at_caps_of_state diminished_def) - apply (frule (1) caps_of_state_valid_cap) - apply (clarsimp simp add: valid_cap_def2 wellformed_cap_def mask_cap_def - cap_rights_update_def acap_rights_update_def - split: cap.splits arch_cap.splits bool.splits) - apply fastforce+ - apply (clarsimp simp add: wellformed_acap_def - split: cap.splits arch_cap.splits) - apply (rename_tac rights vmpage_size option) - apply (rule_tac x=rights in exI) - apply auto - done - end @@ -1827,7 +1746,6 @@ requalify_facts sts_valid_arch_inv arch_decode_inv_wf arch_pinv_st_tcb_at - get_cap_diminished end diff --git a/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy index 152dce412d..5114ffde2d 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy @@ -46,13 +46,12 @@ lemma table_cap_ref_mask_cap [Syscall_AI_assms]: cap_rights_update_def arch_cap_fun_lift_def split:cap.splits arch_cap.splits) -lemma diminished_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: - "\ cte_wp_at (diminished cap) p s; valid_arch_caps s \ +lemma eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: + "\ cte_wp_at ((=) cap) p s; valid_arch_caps s \ \ no_cap_to_obj_with_diff_ref cap S s" apply (clarsimp simp: cte_wp_at_caps_of_state valid_arch_caps_def) apply (frule(1) unique_table_refs_no_cap_asidD) - apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def - table_cap_ref_mask_cap diminished_def Ball_def) + apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def) done lemma getDFSR_invs[wp]: diff --git a/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy index bb1cda0ab6..e1dd768a69 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy @@ -81,78 +81,73 @@ proof - unat (args ! 5) \ 2 ^ bits_of node_cap - unat (args ! 4);valid_cap node_cap s\ \ inj_on (Pair (obj_ref_of node_cap) \ nat_to_cref (bits_of node_cap)) {unat (args ! 4)..S a f s. (\x\S. cte_wp_at ((=) cap.NullCap) (a, f x) s) \ cte_wp_at (\c. c \ cap.NullCap) slot s \ slot \ (Pair a \ f) ` S" - by (auto simp:cte_wp_at_caps_of_state) + by (auto simp: cte_wp_at_caps_of_state) show ?thesis - apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] - unlessE_whenE - split del: if_split) - apply (rule validE_R_sp[OF whenE_throwError_sp] - validE_R_sp[OF data_to_obj_type_sp] - validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ - apply clarsimp - apply (rule hoare_pre) - apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp - map_ensure_empty_wp) - apply (clarsimp simp: distinct_map cases_imp_eq) - apply (subgoal_tac "s \ node_cap") - prefer 2 - apply (erule disjE) - apply (drule bspec [where x = "cs ! 0"],clarsimp)+ - apply fastforce - apply clarsimp - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (drule(1) caps_of_state_valid[rotated])+ - apply (clarsimp simp:is_cap_simps diminished_def mask_cap_def - cap_rights_update_def ,simp split:cap.splits) - apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (frule(1) caps_of_state_valid[rotated]) - apply (clarsimp simp:not_less) - apply (frule(2) inj) - apply (clarsimp simp:comp_def) - apply (frule(1) caps_of_state_valid) - apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) - apply (intro conjI) - apply (intro impI) - apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] - apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ - apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) - apply (erule range_cover.sz) - apply (simp add:range_cover_def) - apply (clarsimp simp:get_free_ref_def is_aligned_neg_mask_eq empty_descendants_range_in) - apply (rule conjI[rotated], blast, clarsimp) - apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec) - apply (clarsimp simp:is_cap_simps nat_to_cref_def word_bits_def - bits_of_def valid_cap_simps cap_aligned_def)+ - apply (simp add: free_index_of_def) - apply (frule(1) range_cover_stuff[where sz = sz]) - apply (clarsimp dest!:valid_cap_aligned simp:cap_aligned_def word_bits_def)+ - apply simp+ - apply (clarsimp simp:get_free_ref_def) - apply (erule disjE) - apply (drule_tac x= "cs!0" in bspec) - subgoal by clarsimp + apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] + unlessE_whenE + split del: if_split) + apply (rule validE_R_sp[OF whenE_throwError_sp] + validE_R_sp[OF data_to_obj_type_sp] + validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ + apply clarsimp + apply (rule hoare_pre) + apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp map_ensure_empty_wp) + apply (clarsimp simp: distinct_map cases_imp_eq) + apply (subgoal_tac "s \ node_cap") + prefer 2 + apply (erule disjE) + apply (drule bspec [where x = "cs ! 0"],clarsimp)+ + apply fastforce + apply clarsimp + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (drule(1) caps_of_state_valid[rotated])+ + apply simp + apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (frule(1) caps_of_state_valid[rotated]) + apply (clarsimp simp: not_less) + apply (frule(2) inj) + apply (clarsimp simp: comp_def) + apply (frule(1) caps_of_state_valid) + apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) + apply (intro conjI) + apply (intro impI) + apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] + apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ + apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) + apply (erule range_cover.sz) + apply (simp add: range_cover_def) + apply (clarsimp simp: get_free_ref_def empty_descendants_range_in) + apply (rule conjI[rotated], blast, clarsimp) + apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec) + apply (clarsimp simp: is_cap_simps nat_to_cref_def word_bits_def + bits_of_def valid_cap_simps cap_aligned_def)+ + apply (simp add: free_index_of_def) + apply (frule(1) range_cover_stuff[where sz = sz]) + apply (clarsimp dest!: valid_cap_aligned simp:cap_aligned_def word_bits_def)+ + apply simp+ + apply (clarsimp simp: get_free_ref_def) + apply (erule disjE) + apply (drule_tac x= "cs!0" in bspec) + subgoal by clarsimp subgoal by simp - apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) - apply (rule_tac x=aa in exI,rule exI,rule exI) - apply (rule conjI, assumption) - apply (clarsimp simp: diminished_def is_cap_simps mask_cap_def - cap_rights_update_def, - simp split: cap.splits bool.splits) + apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) + apply (rule_tac x=aa in exI,rule exI,rule exI) + apply (rule conjI, assumption) + apply simp done qed diff --git a/proof/invariant-abstract/ARM_HYP/ArchVSpace_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchVSpace_AI.thy index d4313fff52..173d8380c1 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchVSpace_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchVSpace_AI.thy @@ -1880,7 +1880,7 @@ definition | PageUnmap cap ptr \ \s. \dev r R sz m. cap = PageCap dev r R sz m \ case_option True (valid_unmap sz) m \ - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) ptr s \ + cte_wp_at ((=) (cap.ArchObjectCap cap)) ptr s \ s \ (cap.ArchObjectCap cap) | PageFlush typ start end pstart pd asid \ vspace_at_asid asid pd and K (asid \ mask asid_bits \ asid \ 0) @@ -1957,7 +1957,7 @@ definition \ \\ hd (the (vs_cap_ref cap)) \ kernel_vsrefs\) and K (is_pt_cap cap \ cap_asid cap \ None) | PageTableUnmap cap ptr \ - cte_wp_at (\c. is_arch_diminished cap c) ptr and valid_cap cap + cte_wp_at ((=) cap) ptr and valid_cap cap and is_final_cap' cap and K (is_pt_cap cap)" @@ -4684,13 +4684,10 @@ lemma perform_page_table_invocation_invs[wp]: | wp (once) hoare_vcg_conj_lift | wp (once) mapM_x_wp' | simp)+ - apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state - is_arch_diminished_def is_cap_simps + apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state is_cap_simps is_arch_update_def cap_rights_update_def acap_rights_update_def cap_master_cap_simps update_map_data_def) - apply (frule (2) diminished_is_update') - apply (simp add: cap_rights_update_def acap_rights_update_def) apply (rule conjI) apply (clarsimp simp: vs_cap_ref_def) apply (drule invs_pd_caps) @@ -4706,7 +4703,6 @@ lemma perform_page_table_invocation_invs[wp]: apply (subgoal_tac "(\x\set [word , word + 8 .e. word + 2 ^ pt_bits - 1]. x && ~~ mask pt_bits = word)") apply (intro conjI) - apply (simp add: cap_master_cap_def) apply (fastforce simp: vspace_bits_defs) apply (clarsimp simp: image_def vspace_bits_defs) apply (subgoal_tac "word + (ucast x << 3) @@ -4730,7 +4726,7 @@ lemma perform_page_table_invocation_invs[wp]: apply (rule shiftl_less_t2n) apply (rule word_leq_minus_one_le) apply (simp add: vspace_bits_defs)+ -done + done crunch cte_wp_at [wp]: unmap_page "\s. P (cte_wp_at P' p s)" (wp: crunch_wps simp: crunch_simps) @@ -5733,8 +5729,6 @@ lemma perform_page_invs [wp]: apply (wp unmap_page_invs hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_imp_lift unmap_page_unmapped)+ apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state) - apply (clarsimp simp: is_arch_diminished_def) - apply (drule (2) diminished_is_update') apply (clarsimp simp: is_cap_simps cap_master_cap_simps is_arch_update_def update_map_data_def cap_rights_update_def acap_rights_update_def) diff --git a/proof/invariant-abstract/Arch_AI.thy b/proof/invariant-abstract/Arch_AI.thy index e3d95a666f..9bd8ea62fe 100644 --- a/proof/invariant-abstract/Arch_AI.thy +++ b/proof/invariant-abstract/Arch_AI.thy @@ -196,13 +196,6 @@ lemma sts_pspace_no_overlap [wp]: by (wp pspace_no_overlap_typ_at_lift) -lemma diminished_cte_wp_at_valid_cap: - "cte_wp_at (diminished c) p s \ valid_objs s \ s \ c" - apply (drule(1) cte_wp_at_valid_objs_valid_cap) - apply (clarsimp simp: diminished_def) - done - - lemma delete_objects_st_tcb_at: "\pred_tcb_at proj P t and invs and K (t \ {ptr .. ptr + 2 ^ bits - 1})\ delete_objects ptr bits diff --git a/proof/invariant-abstract/CSpaceInv_AI.thy b/proof/invariant-abstract/CSpaceInv_AI.thy index 00ef76b46b..bcb7236db2 100644 --- a/proof/invariant-abstract/CSpaceInv_AI.thy +++ b/proof/invariant-abstract/CSpaceInv_AI.thy @@ -2100,17 +2100,4 @@ lemma cap_rights_update_id [intro!, simp]: by (cases c; fastforce simp: valid_cap_def split: bool.splits) -lemma diminished_is_update: - "valid_cap c' s \ diminished c c' \ \R. c' = cap_rights_update R c" - apply (clarsimp simp: diminished_def mask_cap_def) - apply (rule exI) - apply (rule sym) - apply (frule (1) cap_rights_update_id) - done - - -lemmas diminished_is_update' = - diminished_is_update[OF caps_of_state_valid_cap[OF _ invs_valid_objs]] - - end diff --git a/proof/invariant-abstract/LevityCatch_AI.thy b/proof/invariant-abstract/LevityCatch_AI.thy index fec77e7dce..890f311fad 100644 --- a/proof/invariant-abstract/LevityCatch_AI.thy +++ b/proof/invariant-abstract/LevityCatch_AI.thy @@ -35,11 +35,6 @@ lemma obj_ref_elemD: "r \ obj_refs cap \ obj_refs cap = {r}" by (cases cap, simp_all) - -definition - "diminished cap cap' \ \R. cap = mask_cap R cap'" - - lemma const_on_failure_wp : "\P\ m \Q\, \\rv. Q n\ \ \P\ const_on_failure n m \Q\" apply (simp add: const_on_failure_def) diff --git a/proof/invariant-abstract/RISCV64/ArchArch_AI.thy b/proof/invariant-abstract/RISCV64/ArchArch_AI.thy index e9ff351d76..64dd2de935 100644 --- a/proof/invariant-abstract/RISCV64/ArchArch_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchArch_AI.thy @@ -1032,13 +1032,6 @@ lemma valid_mask_vm_rights[simp]: "mask_vm_rights V R \ valid_vm_rights" by (simp add: mask_vm_rights_def) -lemma cte_wp_at_page_cap_weaken: - "cte_wp_at (diminished (ArchObjectCap (FrameCap word seta vmpage_size dev None))) slot s \ - cte_wp_at (\a. \p R sz dev m. a = ArchObjectCap (FrameCap p R sz dev m)) slot s" - apply (clarsimp simp: cte_wp_at_def diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits) - done - lemma le_user_vtop_less_pptr_base[simp]: "x \ user_vtop \ x < pptr_base" using dual_order.strict_trans2 by blast @@ -1086,8 +1079,8 @@ lemma vmpage_size_of_level_pt_bits_left: lemma decode_fr_inv_map_wf[wp]: "arch_cap = FrameCap p rights vmpage_size dev option \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_fr_inv_map label args slot arch_cap excaps \valid_arch_inv\,-" unfolding decode_fr_inv_map_def Let_def @@ -1138,13 +1131,13 @@ lemma decode_fr_inv_map_wf[wp]: lemma decode_frame_invocation_wf[wp]: "arch_cap = FrameCap word rights vmpage_size dev option \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_frame_invocation label args slot arch_cap excaps \valid_arch_inv\,-" unfolding decode_frame_invocation_def by (wpsimp simp: valid_arch_inv_def valid_page_inv_def cte_wp_at_caps_of_state - is_arch_diminished_def is_cap_simps valid_arch_cap_def valid_cap_def + is_cap_simps valid_arch_cap_def valid_cap_def valid_unmap_def wellformed_mapdata_def vmsz_aligned_def split: option.split) @@ -1159,8 +1152,8 @@ lemma neg_mask_user_region: lemma decode_pt_inv_map_wf[wp]: "arch_cap = PageTableCap pt_ptr pt_map_data \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_pt_inv_map label args slot arch_cap excaps \valid_arch_inv\,-" unfolding decode_pt_inv_map_def Let_def @@ -1187,13 +1180,13 @@ lemma decode_pt_inv_map_wf[wp]: lemma decode_page_table_invocation_wf[wp]: "arch_cap = PageTableCap pt_ptr pt_map_data \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and real_cte_at slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and real_cte_at slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_page_table_invocation label args slot arch_cap excaps \valid_arch_inv\,-" unfolding decode_page_table_invocation_def is_final_cap_def apply (wpsimp simp: valid_arch_inv_def valid_pti_def valid_arch_cap_def valid_cap_def - cte_wp_at_caps_of_state is_arch_diminished_def is_cap_simps) + cte_wp_at_caps_of_state is_cap_simps) apply (rule conjI; clarsimp) done @@ -1211,8 +1204,8 @@ lemma asid_low_hi_cast: lemma decode_asid_pool_invocation_wf[wp]: "arch_cap = ASIDPoolCap ap asid \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) and + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. s \ (fst x))\ decode_asid_pool_invocation label args slot arch_cap excaps \valid_arch_inv\, -" @@ -1227,8 +1220,8 @@ lemma decode_asid_pool_invocation_wf[wp]: lemma decode_asid_control_invocation_wf[wp]: "arch_cap = ASIDControlCap \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) and + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. s \ (fst x))\ decode_asid_control_invocation label args slot ASIDControlCap excaps \valid_arch_inv\, -" @@ -1256,19 +1249,13 @@ lemma decode_asid_control_invocation_wf[wp]: apply (rule_tac x=ac in exI) apply (rule_tac x=ba in exI) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: is_cap_simps cap_rights_update_def) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: cap_rights_update_def) done lemma arch_decode_inv_wf[wp]: "\invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and real_cte_at slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) and + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and real_cte_at slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. s \ (fst x))\ arch_decode_invocation label args x_slot slot arch_cap excaps \valid_arch_inv\,-" @@ -1290,15 +1277,6 @@ lemma arch_pinv_st_tcb_at: apply (wp perform_asid_control_invocation_st_tcb_at; fastforce elim!: pred_tcb_weakenE)+ done -lemma get_cap_diminished: - "\valid_objs\ get_cap slot \\cap. cte_wp_at (diminished cap) slot\" - apply (wp get_cap_wp) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def mask_cap_def) - apply (frule (1) caps_of_state_valid_cap) - apply (rule exI[of _ "UNIV"]) - apply simp - done - end @@ -1313,7 +1291,6 @@ requalify_facts sts_valid_arch_inv arch_decode_inv_wf arch_pinv_st_tcb_at - get_cap_diminished end diff --git a/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy b/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy index d8f83602e1..0f32bfd7e9 100644 --- a/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy @@ -44,13 +44,13 @@ lemma table_cap_ref_mask_cap [Syscall_AI_assms]: by (clarsimp simp add:mask_cap_def table_cap_ref_def acap_rights_update_def cap_rights_update_def split:cap.splits arch_cap.splits) -lemma diminished_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: - "\ cte_wp_at (diminished cap) p s; valid_arch_caps s \ +lemma eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: + "\ cte_wp_at ((=) cap) p s; valid_arch_caps s \ \ no_cap_to_obj_with_diff_ref cap S s" apply (clarsimp simp: cte_wp_at_caps_of_state valid_arch_caps_def) apply (frule(1) unique_table_refs_no_cap_asidD) apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def - table_cap_ref_mask_cap diminished_def Ball_def) + table_cap_ref_mask_cap Ball_def) done lemma hv_invs[wp, Syscall_AI_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" diff --git a/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy b/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy index b3e52df440..670d1b9590 100644 --- a/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy @@ -81,15 +81,15 @@ proof - unat (args ! 5) \ 2 ^ bits_of node_cap - unat (args ! 4);valid_cap node_cap s\ \ inj_on (Pair (obj_ref_of node_cap) \ nat_to_cref (bits_of node_cap)) {unat (args ! 4)..S a f s. (\x\S. cte_wp_at ((=) cap.NullCap) (a, f x) s) @@ -97,64 +97,58 @@ proof - \ slot \ (Pair a \ f) ` S" by (auto simp:cte_wp_at_caps_of_state) show ?thesis - apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] - unlessE_whenE - split del: if_split) - apply (rule validE_R_sp[OF whenE_throwError_sp] - validE_R_sp[OF data_to_obj_type_sp] - validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ - apply clarsimp - apply (rule hoare_pre) - apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp - map_ensure_empty_wp) - apply (clarsimp simp: distinct_map cases_imp_eq) - apply (subgoal_tac "s \ node_cap") - prefer 2 - apply (erule disjE) - apply (drule bspec [where x = "cs ! 0"],clarsimp)+ - apply fastforce - apply clarsimp - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (drule(1) caps_of_state_valid[rotated])+ - apply (clarsimp simp: is_cap_simps diminished_def mask_cap_def - cap_rights_update_def, - simp split: cap.splits) - apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (frule(1) caps_of_state_valid[rotated]) - apply (clarsimp simp:not_less) - apply (frule(2) inj) - apply (clarsimp simp:comp_def) - apply (frule(1) caps_of_state_valid) - apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) - apply (intro conjI) - apply (intro impI) - apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] - apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ - apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) - apply (erule range_cover.sz) - apply (simp add:range_cover_def) - apply (clarsimp simp:get_free_ref_def is_aligned_neg_mask_eq empty_descendants_range_in) - apply (rule conjI[rotated], blast, clarsimp) - apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec) - apply (clarsimp simp:is_cap_simps nat_to_cref_def word_bits_def - bits_of_def valid_cap_simps cap_aligned_def)+ - apply (simp add: free_index_of_def) - apply (frule(1) range_cover_stuff[where sz = sz]) - apply (clarsimp dest!:valid_cap_aligned simp:cap_aligned_def word_bits_def)+ - apply simp+ - apply (clarsimp simp:get_free_ref_def) - apply (erule disjE) - apply (drule_tac x= "cs!0" in bspec) - subgoal by clarsimp - subgoal by simp - apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) - apply (rule_tac x=aa in exI,rule exI,rule exI) - apply (rule conjI, assumption) - apply (clarsimp simp: diminished_def is_cap_simps mask_cap_def - cap_rights_update_def, - simp split: cap.splits bool.splits) - done + apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] + unlessE_whenE + split del: if_split) + apply (rule validE_R_sp[OF whenE_throwError_sp] + validE_R_sp[OF data_to_obj_type_sp] + validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ + apply clarsimp + apply (rule hoare_pre) + apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp + map_ensure_empty_wp) + apply (clarsimp simp: distinct_map cases_imp_eq) + apply (subgoal_tac "s \ node_cap") + prefer 2 + apply (erule disjE) + apply (drule bspec [where x = "cs ! 0"],clarsimp)+ + apply fastforce + apply clarsimp + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (drule(1) caps_of_state_valid[rotated])+ + apply assumption + apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (frule(1) caps_of_state_valid[rotated]) + apply (clarsimp simp: not_less) + apply (frule(2) inj) + apply (clarsimp simp: comp_def) + apply (frule(1) caps_of_state_valid) + apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) + apply (intro conjI) + apply (intro impI) + apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] + apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ + apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) + apply (erule range_cover.sz) + apply (simp add: range_cover_def) + apply (clarsimp simp: get_free_ref_def empty_descendants_range_in) + apply (rule conjI[rotated], blast, clarsimp) + apply (drule_tac x = "(obj_ref_of node_cap, nat_to_cref (bits_of node_cap) slota)" in bspec) + apply (clarsimp simp: is_cap_simps nat_to_cref_def word_bits_def bits_of_def valid_cap_simps + cap_aligned_def)+ + apply (simp add: free_index_of_def) + apply (frule(1) range_cover_stuff[where sz = sz]) + apply (clarsimp dest!: valid_cap_aligned simp: cap_aligned_def word_bits_def)+ + apply simp+ + apply (clarsimp simp: get_free_ref_def) + apply (erule disjE) + apply (drule_tac x= "cs!0" in bspec, clarsimp) + apply simp + apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) + apply (rule_tac x=aa in exI, rule exI, rule exI) + apply simp + done qed lemma asid_bits_ge_0: diff --git a/proof/invariant-abstract/RISCV64/ArchVSpace_AI.thy b/proof/invariant-abstract/RISCV64/ArchVSpace_AI.thy index d705d91e95..cfa714f301 100644 --- a/proof/invariant-abstract/RISCV64/ArchVSpace_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchVSpace_AI.thy @@ -183,7 +183,7 @@ definition \s. \dev r R sz m. acap = FrameCap r R sz dev m \ case_option True (valid_unmap sz) m \ - cte_wp_at (is_arch_diminished (ArchObjectCap acap)) cslot s \ + cte_wp_at ((=) (ArchObjectCap acap)) cslot s \ valid_arch_cap acap s | PageGetAddr ptr \ \" @@ -204,7 +204,7 @@ definition \ vref \ user_region) and K (is_PageTableCap acap \ cap_asid_arch acap \ None) | PageTableUnmap acap cslot \ - cte_wp_at (\c. is_arch_diminished (ArchObjectCap acap) c) cslot + cte_wp_at ((=) (ArchObjectCap acap)) cslot and real_cte_at cslot and valid_arch_cap acap and is_final_cap' (ArchObjectCap acap) @@ -1065,21 +1065,6 @@ lemma mapM_x_typ_at[wp]: "mapM_x (swp store_pte InvalidPTE) slots \\s. P (typ_at T p s)\" by (wpsimp wp: mapM_x_wp') -lemma diminished_FrameCap[simp]: - "diminished (ArchObjectCap (FrameCap p rights sz dev m)) cap = - (\R R'. cap = ArchObjectCap (FrameCap p R sz dev m) \ rights = validate_vm_rights (R \ R'))" - apply (cases cap; simp add: diminished_def mask_cap_def cap_rights_update_def) - apply (rename_tac acap, case_tac acap; simp add: acap_rights_update_def) - apply auto - done - -lemma diminished_pt_cap[simp]: - "diminished (ArchObjectCap (PageTableCap p m)) cap = (cap = ArchObjectCap (PageTableCap p m))" - apply (cases cap; simp add: diminished_def mask_cap_def cap_rights_update_def) - apply (rename_tac acap, case_tac acap; simp add: acap_rights_update_def) - apply auto - done - crunches unmap_page_table for global_refs[wp]: "\s. P (global_refs s)" and vspace_for_asid[wp]: "\s. P (vspace_for_asid asid s)" @@ -1099,17 +1084,14 @@ lemma perform_pt_inv_unmap_invs[wp]: unmap_page_table_not_target real_cte_at_typ_valid simp: cte_wp_at_caps_of_state) apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state) - apply (rename_tac cap' cap'') - apply (prop_tac "cap'' = cap'", fastforce) - apply (clarsimp simp: is_arch_update_def is_cap_simps - cap_master_cap_simps is_arch_diminished_def is_PageTableCap_def + apply (clarsimp simp: is_arch_update_def is_cap_simps is_PageTableCap_def update_map_data_def valid_cap_def valid_arch_cap_def cap_aligned_def) apply (frule caps_of_state_valid_cap, clarsimp) apply (rule conjI; clarsimp) apply (simp add: valid_cap_def cap_aligned_def) apply (erule valid_table_caps_pdD, fastforce) apply (rename_tac p asid vref) - apply (clarsimp simp: wellformed_mapdata_def valid_cap_def cap_aligned_def) + apply (clarsimp simp: wellformed_mapdata_def valid_cap_def cap_aligned_def cap_master_cap_simps) apply (rule conjI) apply clarsimp apply (prop_tac "is_aligned p pt_bits", simp add: bit_simps) @@ -1424,8 +1406,8 @@ lemma perform_pg_inv_unmap[wp]: hoare_vcg_all_lift hoare_vcg_const_imp_lift get_cap_wp unmap_page_cte_wp_at hoare_vcg_imp_lift' unmap_page_not_target unmap_page_invs) - apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state is_arch_diminished_def - is_cap_simps is_arch_update_def update_map_data_def cap_master_cap_simps) + apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state is_cap_simps is_arch_update_def + update_map_data_def cap_master_cap_simps) apply (frule caps_of_state_valid, clarsimp) apply (case_tac m; simp) apply (clarsimp simp: valid_cap_def valid_arch_cap_def cap_aligned_def cap_master_cap_simps) diff --git a/proof/invariant-abstract/Syscall_AI.thy b/proof/invariant-abstract/Syscall_AI.thy index cd134cbb62..c820264567 100644 --- a/proof/invariant-abstract/Syscall_AI.thy +++ b/proof/invariant-abstract/Syscall_AI.thy @@ -471,9 +471,9 @@ locale Syscall_AI = Systemcall_AI_Pre:Systemcall_AI_Pre _ state_ext_t "\rs cap. obj_refs (cap_rights_update rs cap) = obj_refs cap" assumes table_cap_ref_mask_cap: "\R cap. table_cap_ref (mask_cap R cap) = table_cap_ref cap" - assumes diminished_no_cap_to_obj_with_diff_ref: + assumes eq_no_cap_to_obj_with_diff_ref: "\cap p (s::'state_ext state) S. - \ cte_wp_at (diminished cap) p s; valid_arch_caps s \ + \ cte_wp_at ((=) cap) p s; valid_arch_caps s \ \ no_cap_to_obj_with_diff_ref cap S s" assumes hv_invs[wp]: "\t' flt. \invs :: 'state_ext state \ bool\ handle_vm_fault t' flt \\r. invs\" @@ -610,33 +610,12 @@ lemma decode_inv_inv[wp]: (wpsimp wp: decode_tcb_inv_inv decode_domain_inv_inv)+) done -lemma diminished_Untyped [simp]: - "diminished (cap.UntypedCap d x xa idx) = (\c. c = cap.UntypedCap d x xa idx)" - apply (rule ext) - apply (case_tac c, - auto simp: diminished_def cap_rights_update_def mask_cap_def split:bool.splits) - done - -lemma diminished_Reply: - "diminished (cap.ReplyCap x y R) cap \ \ R'. cap = cap.ReplyCap x y R'" - by (cases cap, - auto simp: diminished_def cap_rights_update_def mask_cap_def split: bool.splits) - -lemma diminished_IRQHandler [simp]: - "diminished (cap.IRQHandlerCap irq) = (\c. c = cap.IRQHandlerCap irq)" - apply (rule ext) - apply (case_tac c, - auto simp: diminished_def cap_rights_update_def mask_cap_def split:bool.splits) - done - -lemma cnode_diminished_strg: - "(\ptr. cte_wp_at (diminished cap) ptr s) +lemma cnode_eq_strg: + "(\ptr. cte_wp_at ((=) cap) ptr s) \ (is_cnode_cap cap \ (\ref \ cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap ref s))" apply (clarsimp simp: ex_cte_cap_wp_to_def) - apply (intro exI, erule cte_wp_at_weakenE) - apply (clarsimp simp: diminished_def) - done + by (intro exI, erule cte_wp_at_weakenE, simp) lemma invs_valid_arch_caps[elim!]: @@ -647,7 +626,7 @@ lemma invs_valid_arch_caps[elim!]: context Syscall_AI begin lemma decode_inv_wf[wp]: - "\valid_cap cap and invs and cte_wp_at (diminished cap) slot + "\valid_cap cap and invs and cte_wp_at ((=) cap) slot and real_cte_at slot and ex_cte_cap_to slot and (\s::'state_ext state. \r\zobj_refs cap. ex_nonz_cap_to r s) @@ -655,27 +634,24 @@ lemma decode_inv_wf[wp]: and (\s. \cap \ set excaps. \r\cte_refs (fst cap) (interrupt_irq_node s). ex_cte_cap_to r s) and (\s. \x \ set excaps. s \ (fst x)) and (\s. \x \ set excaps. \r\zobj_refs (fst x). ex_nonz_cap_to r s) - and (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. real_cte_at (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to is_cnode_cap (snd x) s) and (\s. \x \ set excaps. cte_wp_at (interrupt_derived (fst x)) (snd x) s)\ decode_invocation label args cap_index slot cap excaps \valid_invocation\,-" - apply (simp add: decode_invocation_def - cong: cap.case_cong if_cong - split del: if_split) + apply (simp add: decode_invocation_def cong: cap.case_cong if_cong split del: if_split) apply (rule hoare_pre) apply (wp Tcb_AI.decode_tcb_inv_wf decode_domain_inv_wf[simplified split_def] | wpc | simp add: o_def uncurry_def split_def del: is_cnode_cap.simps cte_refs.simps)+ - apply (strengthen cnode_diminished_strg) + apply (strengthen cnode_eq_strg) apply (clarsimp simp: valid_cap_def cte_wp_at_eq_simp is_cap_simps - cap_rights_update_def ex_cte_cap_wp_to_weakenE[OF _ TrueI] - cte_wp_at_caps_of_state - split: cap.splits option.splits) - apply (thin_tac " \x\set excaps. P x \ Q x" for P Q)+ - apply (drule (1) bspec)+ - apply (subst split_paired_Ex[symmetric], rule exI, simp) - using diminished_Reply apply fastforce + cap_rights_update_def ex_cte_cap_wp_to_weakenE[OF _ TrueI] + cte_wp_at_caps_of_state + split: cap.splits option.splits) + apply (thin_tac " \x\set excaps. P x \ Q x" for P Q)+ + apply (drule (1) bspec)+ + apply (subst split_paired_Ex[symmetric], rule exI, simp) apply (thin_tac " \x\set excaps. P x \ Q x" for P Q)+ apply (rule conjI) apply (subst split_paired_Ex[symmetric], rule_tac x=slot in exI, simp) @@ -685,17 +661,13 @@ lemma decode_inv_wf[wp]: apply (thin_tac " \x\set excaps. P x \ Q x" for P Q)+ apply (drule (1) bspec)+ apply (clarsimp simp add: ex_cte_cap_wp_to_weakenE[OF _ TrueI]) - apply (rule diminished_no_cap_to_obj_with_diff_ref) + apply (rule eq_no_cap_to_obj_with_diff_ref) apply (fastforce simp add: cte_wp_at_caps_of_state) apply (simp add: invs_valid_arch_caps) apply (simp add: invs_valid_objs invs_valid_global_refs) apply (thin_tac " \x\set excaps. P x \ Q x" for P Q)+ - apply (rule conjI) - apply clarsimp - apply (drule (1) bspec)+ - apply (subst split_paired_Ex[symmetric], rule exI, simp) - apply (clarsimp simp add: diminished_def mask_cap_def cap_rights_update_def - split: cap.splits bool.splits) + apply (drule (1) bspec)+ + apply (subst split_paired_Ex[symmetric], rule exI, simp) apply (thin_tac " \x\set excaps. P x \ Q x" for P Q)+ apply (subst split_paired_Ex[symmetric], rule exI, simp) done @@ -924,24 +896,13 @@ lemma lec_derived[wp]: lemma lookup_cap_and_slot_dimished [wp]: "\valid_objs\ lookup_cap_and_slot thread cptr - \\x. cte_wp_at (diminished (fst x)) (snd x)\, -" - apply (simp add: lookup_cap_and_slot_def split_def) - apply (wp get_cap_wp) - apply (rule hoare_post_imp_R [where Q'="\_. valid_objs"]) - apply wp - apply simp - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def) - apply (rule exI, rule cap_mask_UNIV[symmetric]) - apply (drule (1) caps_of_state_valid_cap, simp add: valid_cap_def2) - apply simp - done + \\x. cte_wp_at ((=) (fst x)) (snd x)\, -" + by (wpsimp wp: get_cap_wp simp: lookup_cap_and_slot_def) -lemma lookup_extra_caps_diminished [wp]: +lemma lookup_extra_caps_eq [wp]: "\valid_objs\ lookup_extra_caps thread xb info - \\rv s. (\x\set rv. cte_wp_at (diminished (fst x)) (snd x) s)\,-" - apply (simp add: lookup_extra_caps_def) - apply (wp mapME_set|simp)+ - done + \\rv s. (\x\set rv. cte_wp_at ((=) (fst x)) (snd x) s)\,-" + by (wpsimp wp: mapME_set simp: lookup_extra_caps_def) (*FIXME: move to NonDetMonadVCG.valid_validE_R *) diff --git a/proof/invariant-abstract/Untyped_AI.thy b/proof/invariant-abstract/Untyped_AI.thy index 3025108b24..1fa81b28ce 100644 --- a/proof/invariant-abstract/Untyped_AI.thy +++ b/proof/invariant-abstract/Untyped_AI.thy @@ -253,20 +253,13 @@ lemma dui_sp_helper: else doE node_slot \ lookup_target_slot root_cap (to_bl (args ! 2)) (unat (args ! 3)); liftE $ get_cap node_slot - odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at (diminished rv) slot s)) \ P s\, -" + odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at ((=) rv) slot s)) \ P s\, -" apply (simp add: split_def lookup_target_slot_def) apply (intro impI conjI) apply wpsimp apply (wp get_cap_wp) - apply (rule hoare_post_imp_R [where Q'="\rv. valid_objs and P"]) - apply wp - apply simp - apply (clarsimp simp: cte_wp_at_caps_of_state) - apply (simp add: diminished_def) - apply (elim allE, drule(1) mp) - apply (elim allE, subst(asm) cap_mask_UNIV) - apply (frule caps_of_state_valid_cap, simp, simp add: valid_cap_def2) - apply simp + apply (rule hoare_post_imp_R [where Q'="\rv. valid_objs and P"] + ; wpsimp simp: cte_wp_at_caps_of_state) apply simp done diff --git a/proof/invariant-abstract/VSpacePre_AI.thy b/proof/invariant-abstract/VSpacePre_AI.thy index 78913673f4..b2921444e7 100644 --- a/proof/invariant-abstract/VSpacePre_AI.thy +++ b/proof/invariant-abstract/VSpacePre_AI.thy @@ -38,10 +38,6 @@ definition "is_arch_update cap cap' \ is_arch_cap cap \ cap_master_cap cap = cap_master_cap cap'" -definition - "is_arch_diminished cap cap' \ is_arch_cap cap \ diminished cap cap'" - - lemma dmo_asid_map [wp]: "\valid_asid_map\ do_machine_op f \\_. valid_asid_map\" apply (simp add: do_machine_op_def split_def) diff --git a/proof/invariant-abstract/X64/ArchArch_AI.thy b/proof/invariant-abstract/X64/ArchArch_AI.thy index 640ab11915..f39b571209 100644 --- a/proof/invariant-abstract/X64/ArchArch_AI.thy +++ b/proof/invariant-abstract/X64/ArchArch_AI.thy @@ -1213,7 +1213,7 @@ lemma create_mapping_entries_same_refs: "\valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\s. unique_table_refs (caps_of_state s)) and pspace_aligned and valid_objs and valid_kernel_mappings and \\ pm - and (\s. \pm_cap pm_cptr. cte_wp_at (diminished pm_cap) pm_cptr s + and (\s. \pm_cap pm_cptr. cte_wp_at ((=) pm_cap) pm_cptr s \ pm_cap = ArchObjectCap (PML4Cap pm (Some asid))) and page_map_l4_at pm and K (vaddr < pptr_base \ canonical_address vaddr @@ -1227,9 +1227,7 @@ lemma create_mapping_entries_same_refs: valid_arch_state_def pte_ref_pages_def pdpte_ref_pages_def lookup_pml4_slot_def) - apply (all \clarsimp simp: cte_wp_at_caps_of_state diminished_def mask_cap_def - cap_rights_update_def; - clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits\) + apply (all \clarsimp simp: cte_wp_at_caps_of_state mask_cap_def\) apply (all \frule valid_objs_caps\) apply (all \frule (1) is_aligned_pml4; clarsimp simp: pml4_shifting\) apply (all \frule (2) valid_vspace_objsD[where ao="PageMapL4 t" for t, rotated]; clarsimp\) @@ -1257,7 +1255,7 @@ end lemma create_mapping_entries_same_refs_ex: "\valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\s. unique_table_refs (caps_of_state s)) and pspace_aligned and valid_objs and valid_kernel_mappings and \\ pm and - (\s. \dev pm_cap pm_cptr asid rights' mt. cte_wp_at (diminished pm_cap) pm_cptr s + (\s. \dev pm_cap pm_cptr asid rights' mt. cte_wp_at ((=) pm_cap) pm_cptr s \ pm_cap = ArchObjectCap (PML4Cap pm (Some asid)) \ page_map_l4_at pm s \ vaddr < pptr_base \ canonical_address vaddr \ (cap = (ArchObjectCap (PageCap dev p rights' mt pgsz (Some (asid, vaddr))))))\ @@ -1269,29 +1267,6 @@ lemma create_mapping_entries_same_refs_ex: done -lemma diminished_pm_capD: - "diminished (ArchObjectCap (PML4Cap a b)) cap - \ cap = (ArchObjectCap (PML4Cap a b))" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits) - done - - -lemma diminished_pm_self: - "diminished (ArchObjectCap (PML4Cap a b)) (ArchObjectCap (PML4Cap a b))" - apply (clarsimp simp: diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits) - done - - -lemma cte_wp_at_page_cap_weaken: - "cte_wp_at (diminished (ArchObjectCap (PageCap dev word seta mt vmpage_size None))) slot s \ - cte_wp_at (\a. \dev p R mt sz m. a = ArchObjectCap (PageCap dev p R mt sz m)) slot s" - apply (clarsimp simp: cte_wp_at_def diminished_def mask_cap_def cap_rights_update_def) - apply (clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits) - done - - lemma find_vspace_for_asid_lookup_vspace_wp: "\ \s. valid_vspace_objs s \ (\pm. vspace_at_asid asid pm s \ page_map_l4_at pm s \ (\\ pm) s \ Q pm s) \ find_vspace_for_asid asid \ Q \, -" @@ -1371,8 +1346,8 @@ lemma and_not_mask_pml4_not_kernel_mapping_slots: lemma decode_page_invocation_wf[wp]: "arch_cap = PageCap dev word rights map_type vmpage_size option \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_page_invocation label args slot arch_cap excaps \valid_arch_inv\,-" apply (simp add: arch_decode_invocation_def decode_page_invocation_def Let_def split_def @@ -1392,54 +1367,40 @@ lemma decode_page_invocation_wf[wp]: apply (clarsimp simp: cte_wp_at_def is_arch_update_def, rule conjI) apply (clarsimp simp: is_arch_cap_def) apply (clarsimp simp: cap_master_cap_simps) - apply (case_tac cap; clarsimp simp: cap_master_cap_simps diminished_def mask_cap_def - cap_rights_update_def) - apply (rename_tac acap rghts) - apply (case_tac acap; clarsimp simp: cap_master_cap_simps acap_rights_update_def) apply (clarsimp simp: neq_Nil_conv invs_vspace_objs) - apply (frule diminished_cte_wp_at_valid_cap[where p="(a, b)" for a b], clarsimp) - apply (frule diminished_cte_wp_at_valid_cap[where p=slot], clarsimp) - apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def - diminished_def[where cap="ArchObjectCap (PageCap d x y t z w)" for d x y t z w] - linorder_not_le aligned_sum_less_kernel_base - dest!: diminished_pm_capD) + apply (frule cte_wp_valid_cap[where p="(a, b)" for a b], clarsimp) + apply (frule cte_wp_valid_cap[where p=slot], clarsimp) + apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def linorder_not_le + aligned_sum_less_kernel_base) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def invs_implies is_cap_simps is_aligned_pml4 not_less cong: conj_cong split: cap.splits arch_cap.splits) apply (prop_tac "args ! 0 < pptr_base \ canonical_address (args ! 0)", clarsimp dest!: aligned_sum_le_user_vtop, simp) - apply (extract_conjunct \match conclusion in \\a b cap. P a b cap\ for P \ \-\\, - fastforce simp: diminished_def mask_cap_def cap_rights_update_def acap_rights_update_def) apply (extract_conjunct \match conclusion in \data_at vmpage_size word _\ \ \-\\, clarsimp simp: valid_cap_simps data_at_def split: if_splits) apply (extract_conjunct \match conclusion in \_ \ _\ \ \-\\, clarsimp simp: valid_cap_simps cap_aligned_def vmsz_aligned_def) - apply (clarsimp simp: vs_cap_ref_def split: vmpage_size.split) + apply (fastforce simp: vs_cap_ref_def split: vmpage_size.split) apply (clarsimp simp: cte_wp_at_caps_of_state invs_implies is_aligned_pml4) apply (drule bspec[where x="excaps ! 0"]; clarsimp) - apply (extract_conjunct \match conclusion in \\a b cap. caps_of_state _ _ = _ \ _\ \ \-\\, - cases "snd (excaps ! 0)", fastforce) apply (extract_conjunct \match conclusion in \data_at vmpage_size word _\ \ \-\\, clarsimp simp: valid_cap_simps data_at_def split: if_splits) apply (prop_tac "args ! 0 < pptr_base \ canonical_address (args ! 0)", clarsimp simp: valid_cap_simps, simp) - apply (drule (2) diminished_is_update'[rotated 2]; clarsimp)+ apply (clarsimp simp: cap_rights_update_def acap_rights_update_def) apply (clarsimp simp: is_arch_update_reset_page get_cap_caps_of_state) - apply (cases "snd (excaps ! 0)", fastforce simp: diminished_def mask_cap_def cap_rights_update_def + apply (cases "snd (excaps ! 0)", fastforce simp: mask_cap_def cap_rights_update_def acap_rights_update_def) apply (cases "invocation_type label = ArchInvocationLabel X64PageUnmap") apply (simp split del: if_split) apply (rule hoare_pre, wp) apply (clarsimp simp: valid_arch_inv_def valid_page_inv_def) apply (thin_tac "Ball S P" for S P) - apply (rule conjI) - apply (clarsimp split: option.split) - apply (clarsimp simp: valid_cap_simps cap_aligned_def) - apply (simp add: valid_unmap_def) - apply (erule cte_wp_at_weakenE) - apply (clarsimp simp: is_arch_diminished_def is_cap_simps) + apply (clarsimp split: option.split) + apply (clarsimp simp: valid_cap_simps cap_aligned_def) + apply (simp add: valid_unmap_def) apply (cases "invocation_type label = ArchInvocationLabel X64PageGetAddress" ; simp split del: if_split ; wpsimp simp: valid_arch_inv_def valid_page_inv_def) @@ -1448,20 +1409,19 @@ lemma decode_page_invocation_wf[wp]: lemma decode_page_table_invocation_wf[wp]: "arch_cap = PageTableCap pt_ptr pt_map_data \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_page_table_invocation label args slot arch_cap excaps \valid_arch_inv\,-" apply (simp add: arch_decode_invocation_def decode_page_table_invocation_def Let_def split_def is_final_cap_def cong: if_cong split del: if_split) - apply ((wp whenE_throwError_wp lookup_pd_slot_wp find_vspace_for_asid_lookup_vspace_wp + apply (wp whenE_throwError_wp lookup_pd_slot_wp find_vspace_for_asid_lookup_vspace_wp get_pde_wp - | wpc - | simp add: valid_arch_inv_def valid_pti_def unlessE_whenE vs_cap_ref_def - split del: if_split)+)[1] - apply (rule conjI; clarsimp simp: is_arch_diminished_def is_cap_simps - elim!: cte_wp_at_weakenE) + | wpc + | simp add: valid_arch_inv_def valid_pti_def unlessE_whenE vs_cap_ref_def + split del: if_split)+ + apply (rule conjI; clarsimp simp: is_cap_simps elim!: cte_wp_at_weakenE) apply (rule conjI; clarsimp) apply (drule_tac x=ref in spec; erule impE; clarsimp) apply (fastforce elim!: is_aligned_pml4) @@ -1469,7 +1429,7 @@ lemma decode_page_table_invocation_wf[wp]: apply (strengthen not_in_global_refs_vs_lookup, rule conjI, fastforce) apply (clarsimp simp: neq_Nil_conv) apply (thin_tac "Ball S P" for S P) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_table_cap_simps valid_vm_rights_def + apply (clarsimp simp: cte_wp_at_caps_of_state valid_vm_rights_def is_arch_update_def cap_master_cap_def is_cap_simps) apply (frule_tac p="(aa,b)" in valid_capsD[OF _ valid_objs_caps], fastforce) apply (rule conjI) @@ -1487,18 +1447,17 @@ lemma decode_page_table_invocation_wf[wp]: lemma decode_page_directory_invocation_wf[wp]: "arch_cap = PageDirectoryCap pd_ptr pd_map_data \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_page_directory_invocation label args slot arch_cap excaps \valid_arch_inv\,-" apply (simp add: arch_decode_invocation_def decode_page_directory_invocation_def Let_def split_def is_final_cap_def cong: if_cong split del: if_split) apply ((wp whenE_throwError_wp lookup_pdpt_slot_wp find_vspace_for_asid_lookup_vspace_wp get_pdpte_wp - | wpc | simp add: valid_arch_inv_def valid_pdi_def unlessE_whenE vs_cap_ref_def - split del: if_split)+)[1] - apply (rule conjI; clarsimp simp: is_arch_diminished_def is_cap_simps - elim!: cte_wp_at_weakenE) + | wpc | simp add: valid_arch_inv_def valid_pdi_def unlessE_whenE vs_cap_ref_def + split del: if_split)+)[1] + apply (rule conjI; clarsimp simp: is_cap_simps elim!: cte_wp_at_weakenE) apply (rule conjI; clarsimp) apply (drule_tac x=ref in spec; erule impE; clarsimp) apply (fastforce elim!: is_aligned_pml4) @@ -1506,14 +1465,14 @@ lemma decode_page_directory_invocation_wf[wp]: apply (strengthen not_in_global_refs_vs_lookup, rule conjI, fastforce) apply (clarsimp simp: neq_Nil_conv) apply (thin_tac "Ball S P" for S P) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_table_cap_simps valid_vm_rights_def - is_arch_update_def cap_master_cap_def is_cap_simps) + apply (clarsimp simp: cte_wp_at_caps_of_state valid_vm_rights_def + is_arch_update_def cap_master_cap_def is_cap_simps) apply (frule_tac p="(aa,b)" in valid_capsD[OF _ valid_objs_caps], fastforce) apply (rule conjI) apply (clarsimp simp: valid_cap_simps cap_aligned_def is_aligned_addrFromPPtr_n table_size) apply (rule conjI) - apply (clarsimp simp: wellformed_mapdata_def vmsz_aligned_def valid_cap_def cap_aligned_def - order_le_less_trans[OF word_and_le2]) + apply (clarsimp simp: wellformed_mapdata_def vmsz_aligned_def valid_cap_def cap_aligned_def + order_le_less_trans[OF word_and_le2]) apply (frule valid_table_caps_pdD; clarsimp) apply (clarsimp simp: vspace_at_asid_def; drule (2) vs_lookup_invs_ref_is_unique; clarsimp) apply (clarsimp simp: pdpte_ref_pages_def get_pd_index_def get_pdpt_index_def get_pml4_index_def) @@ -1525,8 +1484,8 @@ lemma decode_page_directory_invocation_wf[wp]: lemma decode_pdpt_invocation_wf[wp]: "arch_cap = PDPointerTableCap pdpt_ptr pdpt_map_data \ \invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\ + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s)\ decode_pdpt_invocation label args slot arch_cap excaps \valid_arch_inv\,-" apply (simp add: arch_decode_invocation_def decode_pdpt_invocation_def @@ -1535,16 +1494,15 @@ lemma decode_pdpt_invocation_wf[wp]: apply ((wp whenE_throwError_wp find_vspace_for_asid_lookup_vspace_wp get_pml4e_wp | wpc | simp add: valid_arch_inv_def valid_pdpti_def unlessE_whenE vs_cap_ref_def split del: if_split)+)[1] - apply (rule conjI; clarsimp simp: is_arch_diminished_def is_cap_simps - elim!: cte_wp_at_weakenE) + apply (rule conjI; clarsimp simp: is_cap_simps elim!: cte_wp_at_weakenE) apply (rule conjI; clarsimp) apply (frule is_aligned_pml4, fastforce) apply (frule valid_arch_cap_typ_at; clarsimp simp: pml4_shifting) apply (strengthen not_in_global_refs_vs_lookup, rule conjI, fastforce) apply (clarsimp simp: neq_Nil_conv) apply (thin_tac "Ball S P" for S P) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_table_cap_simps valid_vm_rights_def - is_arch_update_def cap_master_cap_def is_cap_simps) + apply (clarsimp simp: cte_wp_at_caps_of_state valid_vm_rights_def is_arch_update_def + cap_master_cap_def is_cap_simps) apply (frule_tac p="(aa,b)" in valid_capsD[OF _ valid_objs_caps], fastforce) apply (rule conjI) apply (clarsimp simp: valid_cap_simps cap_aligned_def is_aligned_addrFromPPtr_n table_size) @@ -1607,16 +1565,11 @@ lemma decode_ioport_control_inv_wf[wp]: apply (cases excaps, auto) done -lemma diminished_IOPortControl[iff]: - "diminished (ArchObjectCap IOPortControlCap) cap = (cap = ArchObjectCap IOPortControlCap)" - apply (case_tac cap; clarsimp simp: diminished_def mask_cap_def cap_rights_update_def acap_rights_update_def) - by (case_tac x12; clarsimp) - lemma arch_decode_inv_wf[wp]: "\invs and valid_cap (ArchObjectCap arch_cap) and - cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and - (\s. \x \ set excaps. cte_wp_at (diminished (fst x)) (snd x) s) and + cte_wp_at ((=) (ArchObjectCap arch_cap)) slot and + (\s. \x \ set excaps. cte_wp_at ((=) (fst x)) (snd x) s) and (\s. \x \ set excaps. s \ (fst x))\ arch_decode_invocation label args x_slot slot arch_cap excaps \valid_arch_inv\,-" @@ -1637,7 +1590,7 @@ lemma arch_decode_inv_wf[wp]: apply (clarsimp simp: valid_cap_def) apply (rule conjI) apply (clarsimp simp: obj_at_def) - apply (subgoal_tac "asid_low_bits_of (ucast xa + word2) = xa") + apply (subgoal_tac "asid_low_bits_of (ucast xa + word2) = xa") apply simp apply (simp add: is_aligned_nth) apply (subst word_plus_and_or_coroll) @@ -1646,16 +1599,15 @@ lemma arch_decode_inv_wf[wp]: apply (drule test_bit_size) apply (simp add: word_size asid_low_bits_def) apply (rule word_eqI) - apply (clarsimp simp: asid_bits_of_defs asid_bits_defs word_size word_bits_def nth_ucast) + apply (clarsimp simp: asid_bits_of_defs asid_bits_defs word_size word_bits_def nth_ucast) apply (rule conjI) apply (clarsimp simp add: cte_wp_at_caps_of_state) apply (rename_tac c c') - apply (frule_tac cap=c' in caps_of_state_valid, assumption) - apply (drule (1) diminished_is_update) + apply (frule_tac cap="(ArchObjectCap (PML4Cap xb None))" in caps_of_state_valid, assumption) apply (clarsimp simp: is_pml4_cap_def cap_rights_update_def acap_rights_update_def) - apply (clarsimp simp: word_neq_0_conv asid_high_bits_of_def asid_wf_low_add) - apply (drule vs_lookup_atI, erule_tac s="word2 >> asid_low_bits" in rsubst) - apply (simp add: asid_bits_defs aligned_shift[OF ucast_less[where 'b=9], simplified]) + apply (clarsimp simp: word_neq_0_conv asid_high_bits_of_def asid_wf_low_add) + apply (drule vs_lookup_atI, erule_tac s="word2 >> asid_low_bits" in rsubst) + apply (simp add: asid_bits_defs aligned_shift[OF ucast_less[where 'b=9], simplified]) (* ASIDControlCap \ X64ASIDControlMakePool *) apply (simp add: arch_decode_invocation_def Let_def split_def cong: if_cong split del: if_split) @@ -1683,31 +1635,22 @@ lemma arch_decode_inv_wf[wp]: apply (rule_tac x=ac in exI) apply (rule_tac x=ba in exI) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: is_cap_simps cap_rights_update_def) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: cap_rights_update_def) - (* IOPortCap *) + apply (clarsimp simp: cap_rights_update_def) + (* IOPortCap *) apply (simp add: arch_decode_invocation_def decode_port_invocation_def) apply (rule hoare_pre) apply (wp whenE_throwError_wp | wpc | simp)+ apply (simp add: valid_arch_inv_def) (* IOPortControlCap *) apply (simp add: arch_decode_invocation_def) - apply (wpsimp) - apply (rule conjI, clarsimp simp: cte_wp_at_caps_of_state) - apply clarsimp + apply wpsimp apply (drule_tac x="(a,aa,b)" in bspec, assumption)+ apply (simp add: ex_cte_cap_wp_to_def) apply (rule_tac x=aa in exI) apply (rule_tac x=b in exI) apply (clarsimp simp add: cte_wp_at_caps_of_state) - apply (drule (1) caps_of_state_valid[rotated])+ - apply (drule (1) diminished_is_update)+ - apply (clarsimp simp: is_cap_simps cap_rights_update_def) + apply (clarsimp simp: is_cap_simps cap_rights_update_def) (* PageCap *) apply (simp add: arch_decode_invocation_def) apply (wp, simp, simp) @@ -1742,15 +1685,6 @@ lemma arch_pinv_st_tcb_at: apply (wp perform_asid_control_invocation_st_tcb_at; fastforce elim!: pred_tcb_weakenE)+ done -lemma get_cap_diminished: - "\valid_objs\ get_cap slot \\cap. cte_wp_at (diminished cap) slot\" - apply (wp get_cap_wp) - apply (clarsimp simp: cte_wp_at_caps_of_state diminished_def mask_cap_def) - apply (frule (1) caps_of_state_valid_cap) - apply (rule exI[of _ "UNIV"]) - apply simp - done - end @@ -1765,7 +1699,6 @@ requalify_facts sts_valid_arch_inv arch_decode_inv_wf arch_pinv_st_tcb_at - get_cap_diminished end diff --git a/proof/invariant-abstract/X64/ArchSyscall_AI.thy b/proof/invariant-abstract/X64/ArchSyscall_AI.thy index e7643c2b59..f20a3b0c9e 100644 --- a/proof/invariant-abstract/X64/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/X64/ArchSyscall_AI.thy @@ -44,13 +44,12 @@ lemma table_cap_ref_mask_cap [Syscall_AI_assms]: by (clarsimp simp add:mask_cap_def table_cap_ref_def acap_rights_update_def cap_rights_update_def split:cap.splits arch_cap.splits) -lemma diminished_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: - "\ cte_wp_at (diminished cap) p s; valid_arch_caps s \ +lemma eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: + "\ cte_wp_at ((=) cap) p s; valid_arch_caps s \ \ no_cap_to_obj_with_diff_ref cap S s" apply (clarsimp simp: cte_wp_at_caps_of_state valid_arch_caps_def) apply (frule(1) unique_table_refs_no_cap_asidD) - apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def - table_cap_ref_mask_cap diminished_def Ball_def) + apply (clarsimp simp add: no_cap_to_obj_with_diff_ref_def table_cap_ref_mask_cap Ball_def) done lemma getFaultAddress_invs[wp]: diff --git a/proof/invariant-abstract/X64/ArchUntyped_AI.thy b/proof/invariant-abstract/X64/ArchUntyped_AI.thy index 9b88470684..9766a7e105 100644 --- a/proof/invariant-abstract/X64/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/X64/ArchUntyped_AI.thy @@ -81,15 +81,14 @@ proof - unat (args ! 5) \ 2 ^ bits_of node_cap - unat (args ! 4);valid_cap node_cap s\ \ inj_on (Pair (obj_ref_of node_cap) \ nat_to_cref (bits_of node_cap)) {unat (args ! 4)..S a f s. (\x\S. cte_wp_at ((=) cap.NullCap) (a, f x) s) @@ -97,64 +96,59 @@ proof - \ slot \ (Pair a \ f) ` S" by (auto simp:cte_wp_at_caps_of_state) show ?thesis - apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] - unlessE_whenE - split del: if_split) - apply (rule validE_R_sp[OF whenE_throwError_sp] - validE_R_sp[OF data_to_obj_type_sp] - validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ - apply clarsimp - apply (rule hoare_pre) - apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp - map_ensure_empty_wp) - apply (clarsimp simp: distinct_map cases_imp_eq) - apply (subgoal_tac "s \ node_cap") - prefer 2 - apply (erule disjE) - apply (drule bspec [where x = "cs ! 0"],clarsimp)+ - apply fastforce - apply clarsimp - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (drule(1) caps_of_state_valid[rotated])+ - apply (clarsimp simp: is_cap_simps diminished_def mask_cap_def - cap_rights_update_def, - simp split: cap.splits) - apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") - apply (clarsimp simp:cte_wp_at_caps_of_state) - apply (frule(1) caps_of_state_valid[rotated]) - apply (clarsimp simp:not_less) - apply (frule(2) inj) - apply (clarsimp simp:comp_def) - apply (frule(1) caps_of_state_valid) - apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) - apply (intro conjI) - apply (intro impI) - apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] - apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ - apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) - apply (erule range_cover.sz) - apply (simp add:range_cover_def) - apply (clarsimp simp:get_free_ref_def is_aligned_neg_mask_eq empty_descendants_range_in) - apply (rule conjI[rotated], blast, clarsimp) - apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec) - apply (clarsimp simp:is_cap_simps nat_to_cref_def word_bits_def - bits_of_def valid_cap_simps cap_aligned_def)+ - apply (simp add: free_index_of_def) - apply (frule(1) range_cover_stuff[where sz = sz]) - apply (clarsimp dest!:valid_cap_aligned simp:cap_aligned_def word_bits_def)+ - apply simp+ - apply (clarsimp simp:get_free_ref_def) - apply (erule disjE) - apply (drule_tac x= "cs!0" in bspec) - subgoal by clarsimp - subgoal by simp - apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) - apply (rule_tac x=aa in exI,rule exI,rule exI) - apply (rule conjI, assumption) - apply (clarsimp simp: diminished_def is_cap_simps mask_cap_def - cap_rights_update_def, - simp split: cap.splits bool.splits) - done + apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric] unlessE_whenE + split del: if_split) + apply (rule validE_R_sp[OF whenE_throwError_sp] + validE_R_sp[OF data_to_obj_type_sp] + validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+ + apply clarsimp + apply (rule hoare_pre) + apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp + map_ensure_empty_wp) + apply (clarsimp simp: distinct_map cases_imp_eq) + apply (subgoal_tac "s \ node_cap") + prefer 2 + apply (erule disjE) + apply (drule bspec [where x = "cs ! 0"],clarsimp)+ + apply fastforce + apply clarsimp + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (drule(1) caps_of_state_valid[rotated])+ + apply assumption + apply (subgoal_tac "\r\cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s") + apply (clarsimp simp: cte_wp_at_caps_of_state) + apply (frule(1) caps_of_state_valid[rotated]) + apply (clarsimp simp: not_less) + apply (frule(2) inj) + apply (clarsimp simp: comp_def) + apply (frule(1) caps_of_state_valid) + apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state) + apply (intro conjI) + apply (intro impI) + apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1] + apply (clarsimp simp: valid_cap_simps cap_aligned_def)+ + apply (frule alignUp_idem[OF is_aligned_weaken,where a = w]) + apply (erule range_cover.sz) + apply (simp add: range_cover_def) + apply (clarsimp simp: get_free_ref_def empty_descendants_range_in) + apply (rule conjI[rotated], blast, clarsimp) + apply (drule_tac x = "(obj_ref_of node_cap, nat_to_cref (bits_of node_cap) slota)" in bspec) + apply (clarsimp simp: is_cap_simps nat_to_cref_def word_bits_def + bits_of_def valid_cap_simps cap_aligned_def)+ + apply (simp add: free_index_of_def) + apply (frule(1) range_cover_stuff[where sz = sz]) + apply (clarsimp dest!: valid_cap_aligned simp:cap_aligned_def word_bits_def)+ + apply simp+ + apply (clarsimp simp: get_free_ref_def) + apply (erule disjE) + apply (drule_tac x= "cs!0" in bspec, clarsimp) + apply simp + apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def) + apply (rule_tac x=aa in exI, rule exI, rule exI) + apply (rule conjI, assumption) + apply (rule conjI, assumption) + apply (clarsimp simp: is_cap_simps mask_cap_def cap_rights_update_def) + done qed lemma asid_bits_ge_0: diff --git a/proof/invariant-abstract/X64/ArchVSpace_AI.thy b/proof/invariant-abstract/X64/ArchVSpace_AI.thy index 2f3438705f..d4e17ca24b 100644 --- a/proof/invariant-abstract/X64/ArchVSpace_AI.thy +++ b/proof/invariant-abstract/X64/ArchVSpace_AI.thy @@ -714,7 +714,7 @@ definition | PageUnmap cap ptr \ \s. \d r R maptyp sz m. cap = PageCap d r R maptyp sz m \ case_option True (valid_unmap sz) m \ - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) ptr s \ + cte_wp_at ((=) (cap.ArchObjectCap cap)) ptr s \ s \ (cap.ArchObjectCap cap) | PageGetAddr ptr \ \" @@ -783,7 +783,7 @@ definition \ vs_cap_ref cap = Some (VSRef ((p && mask pd_bits >> word_size_bits) && mask ptTranslationBits) (Some APageDirectory) # ref)) and K (is_pt_cap cap) | PageTableUnmap cap ptr \ - cte_wp_at (\c. is_arch_diminished cap c) ptr and valid_cap cap + cte_wp_at ((=) cap) ptr and valid_cap cap and is_final_cap' cap and K (is_pt_cap cap)" @@ -805,7 +805,7 @@ definition (Some APDPointerTable) # ref)) and K (is_pd_cap cap) | PageDirectoryUnmap cap cptr \ - cte_wp_at (\c. is_arch_diminished cap c) cptr and valid_cap cap and is_final_cap' cap and K (is_pd_cap cap)" + cte_wp_at ((=) cap) cptr and valid_cap cap and is_final_cap' cap and K (is_pd_cap cap)" definition "valid_pdpti pdpti \ case pdpti of @@ -825,7 +825,7 @@ definition \ hd (the (vs_cap_ref cap)) \ kernel_vsrefs) and K (is_pdpt_cap cap) | PDPTUnmap cap cptr \ - cte_wp_at (\c. is_arch_diminished cap c) cptr and valid_cap cap and is_final_cap' cap and K (is_pdpt_cap cap)" + cte_wp_at ((=) cap) cptr and valid_cap cap and is_final_cap' cap and K (is_pdpt_cap cap)" lemmas mapM_x_wp_inv_weak = mapM_x_wp_inv[OF hoare_weaken_pre] @@ -3013,54 +3013,55 @@ lemma perform_page_directory_invocation_invs[wp]: apply (cases pdi) apply (rename_tac cap cslot_ptr pdpte obj_ref vspace) apply (rule hoare_pre) - apply (clarsimp simp: perform_page_directory_invocation_def) - apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift - store_pdpte_invs arch_update_cap_invs_map + apply (clarsimp simp: perform_page_directory_invocation_def) + apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift + store_pdpte_invs arch_update_cap_invs_map | strengthen obj_at_empty_refs_strg - | simp add: empty_table.arch_only del: split_paired_All | wps - | rule set_cap.aobj_at |wpc)+ - apply (rule set_cap_cte_wp_at_ex[simplified]) - apply wp+ - apply (clarsimp simp: valid_pdi_def is_arch_update_def cte_wp_at_caps_of_state - vs_cap_ref_of_table_capNone - simp del: split_paired_All) - apply (frule vs_lookup_pages_vs_lookupI) - apply (rule conjI) - apply (clarsimp dest!: same_master_cap_same_types simp: vs_cap_ref_of_table_capNone) - apply (intro conjI allI) - apply clarsimp - apply (drule_tac ref = ref in valid_vs_lookupD) - apply fastforce - apply (rule ccontr, clarsimp) - apply (frule_tac cap = x and cap' = cap in unique_table_caps_pdptD2[OF _ _ _ _ obj_refs_eqI invs_unique_table_caps]) - apply assumption+ - apply (erule caps_of_state_valid, fastforce) + | simp add: empty_table.arch_only del: split_paired_All | wps + | rule set_cap.aobj_at | wpc)+ + apply (rule set_cap_cte_wp_at_ex[simplified]) + apply wp+ + apply (clarsimp simp: valid_pdi_def is_arch_update_def cte_wp_at_caps_of_state + vs_cap_ref_of_table_capNone + simp del: split_paired_All) + apply (frule vs_lookup_pages_vs_lookupI) + apply (rule conjI) + apply (clarsimp dest!: same_master_cap_same_types simp: vs_cap_ref_of_table_capNone) + apply (intro conjI allI) + apply clarsimp + apply (drule_tac ref = ref in valid_vs_lookupD) + apply fastforce + apply (rule ccontr, clarsimp) + apply (frule_tac cap = x and cap' = cap in unique_table_caps_pdptD2[OF _ _ _ _ obj_refs_eqI invs_unique_table_caps]) + apply assumption+ apply (erule caps_of_state_valid, fastforce) - apply (clarsimp simp: is_cap_simps cap_asid_def vs_cap_ref_def split: option.split_asm) - apply (clarsimp simp: is_cap_simps) - apply (rule ref_is_unique) + apply (erule caps_of_state_valid, fastforce) + apply (clarsimp simp: is_cap_simps cap_asid_def vs_cap_ref_def split: option.split_asm) + apply (clarsimp simp: is_cap_simps) + apply (rule ref_is_unique) apply simp apply (erule(1) vs_lookup_vs_lookup_pagesI) apply fastforce+ - apply (simp add:global_refs_def) + apply (simp add: global_refs_def) apply (fastforce simp: second_level_tables_def)+ - apply (clarsimp dest!:invs_valid_objs valid_objs_caps) + apply (clarsimp dest!: invs_valid_objs valid_objs_caps) apply (rename_tac cap cslot) apply (clarsimp simp: perform_page_directory_invocation_def) apply (rule hoare_name_pre_state) apply (clarsimp simp: valid_pdi_def is_cap_simps) apply (rule hoare_pre) apply (wpc | clarsimp simp: cte_wp_at_caps_of_state | wp arch_update_cap_invs_unmap_page_directory get_cap_wp)+ - apply (rule_tac P = "is_pd_cap cap" in hoare_gen_asm) - apply (rule_tac Q = "\r. cte_wp_at ((=) cap) (a,b) and invs and is_final_cap' cap + apply (rule_tac P = "is_pd_cap (ArchObjectCap (PageDirectoryCap p (Some (x1, x2a))))" in hoare_gen_asm) + apply (rule_tac Q = "\r. cte_wp_at ((=) (ArchObjectCap (PageDirectoryCap p (Some (x1, x2a))))) (a,b) + and invs and is_final_cap' (ArchObjectCap (PageDirectoryCap p (Some (x1, x2a)))) and (\s. (the (vs_cap_ref (ArchObjectCap (PageDirectoryCap p (Some (x1, x2a))))), p) \ vs_lookup_pages s) - and obj_at (empty_table {}) (the (aobj_ref (update_map_data (Structures_A.the_arch_cap cap) None None)))" + and obj_at (empty_table {}) (the (aobj_ref (update_map_data + (Structures_A.the_arch_cap (ArchObjectCap (PageDirectoryCap p (Some (x1, x2a))))) None None)))" in hoare_post_imp) apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps update_map_data_def is_arch_update_def cap_master_cap_simps) apply (clarsimp dest!: caps_of_state_valid_cap[OF _ invs_valid_objs] split: option.split_asm - simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def - acap_rights_update_def vs_cap_ref_simps) + simp: mask_cap_def cap_rights_update_def acap_rights_update_def vs_cap_ref_simps) apply (wp hoare_vcg_conj_lift) apply (wp mapM_x_wp, force) apply (rule mapM_x_swp_store_pde_invs_unmap[unfolded swp_def]) @@ -3068,25 +3069,19 @@ lemma perform_page_directory_invocation_invs[wp]: apply force apply (wp store_invalid_pde_vs_lookup_pages_shrink) apply (wp mapM_x_swp_store_empty_pd[unfolded swp_def]) - apply (clarsimp simp: cte_wp_at_caps_of_state vs_cap_ref_def is_arch_diminished_def - is_cap_simps diminished_def mask_cap_def) - apply (clarsimp simp: cap_rights_update_def - acap_rights_update_def - split: cap.split_asm arch_cap.split_asm) + apply (clarsimp simp: cte_wp_at_caps_of_state vs_cap_ref_def + is_cap_simps mask_cap_def) apply (wp unmap_pd_vs_lookup_pages) apply (clarsimp simp: is_final_cap'_def2 gen_obj_refs_def acap_rights_update_def cte_wp_at_caps_of_state - is_arch_diminished_def diminished_def mask_cap_def - del: ) + mask_cap_def) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def is_arch_update_def is_cap_simps - update_map_data_def vs_cap_ref_simps invs_psp_aligned pd_bits_def - split: cap.split_asm arch_cap.split_asm) - apply (intro conjI impI) - apply fastforce + update_map_data_def vs_cap_ref_simps invs_psp_aligned pd_bits_def) + apply (rule conjI) apply (clarsimp simp: valid_cap_def) apply (drule valid_table_caps_pdD, force) apply (clarsimp simp: obj_at_def empty_table_def) - apply (strengthen range_neg_mask_strengthen[mk_strg] vtable_range_univ[THEN subset_refl_subst, mk_strg]) - apply (frule valid_global_refsD2, force) + apply (strengthen range_neg_mask_strengthen[mk_strg] vtable_range_univ[THEN subset_refl_subst, mk_strg]) + apply (frule valid_global_refsD2, force) apply (clarsimp simp: valid_cap_def wellformed_mapdata_def image_def le_mask_iff_lt_2n cap_aligned_def cap_range_def invs_vspace_objs pd_bits_def vtable_range_univ invs_arch_state) done @@ -3100,54 +3095,55 @@ lemma perform_page_table_invocation_invs[wp]: apply (cases pti) apply (rename_tac cap cslot_ptr pdpte obj_ref vspace) apply (rule hoare_pre) - apply (clarsimp simp: perform_page_table_invocation_def) - apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift - store_pde_invs arch_update_cap_invs_map + apply (clarsimp simp: perform_page_table_invocation_def) + apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift + store_pde_invs arch_update_cap_invs_map | strengthen obj_at_empty_refs_strg | simp add: empty_table.arch_only del: split_paired_all split_paired_All | wps | wp set_cap.aobj_at | wpc)+ - apply (rule set_cap_cte_wp_at_ex[simplified]) - apply (wp)+ - apply (clarsimp simp: valid_pti_def is_arch_update_def cte_wp_at_caps_of_state - vs_cap_ref_of_table_capNone - simp del: split_paired_All) - apply (frule vs_lookup_pages_vs_lookupI) - apply (rule conjI) - apply (clarsimp dest!: same_master_cap_same_types simp: vs_cap_ref_of_table_capNone) - apply (intro conjI allI) - apply clarsimp - apply (drule_tac ref = ref in valid_vs_lookupD) - apply fastforce - apply (rule ccontr, clarsimp) - apply (frule_tac cap = x and cap' = cap in unique_table_caps_pdD2[OF _ _ _ _ obj_refs_eqI invs_unique_table_caps]) - apply assumption+ - apply (erule caps_of_state_valid, fastforce) + apply (rule set_cap_cte_wp_at_ex[simplified]) + apply wp+ + apply (clarsimp simp: valid_pti_def is_arch_update_def cte_wp_at_caps_of_state + vs_cap_ref_of_table_capNone + simp del: split_paired_All) + apply (frule vs_lookup_pages_vs_lookupI) + apply (rule conjI) + apply (clarsimp dest!: same_master_cap_same_types simp: vs_cap_ref_of_table_capNone) + apply (intro conjI allI) + apply clarsimp + apply (drule_tac ref = ref in valid_vs_lookupD) + apply fastforce + apply (rule ccontr, clarsimp) + apply (frule_tac cap = x and cap' = cap in unique_table_caps_pdD2[OF _ _ _ _ obj_refs_eqI invs_unique_table_caps]) + apply assumption+ apply (erule caps_of_state_valid, fastforce) - apply (clarsimp simp: is_cap_simps cap_asid_def vs_cap_ref_def split: option.split_asm) - apply (clarsimp simp: is_cap_simps) - apply (rule ref_is_unique) + apply (erule caps_of_state_valid, fastforce) + apply (clarsimp simp: is_cap_simps cap_asid_def vs_cap_ref_def split: option.split_asm) + apply (clarsimp simp: is_cap_simps) + apply (rule ref_is_unique) apply simp apply (erule(1) vs_lookup_vs_lookup_pagesI) apply fastforce+ - apply (simp add:global_refs_def) + apply (simp add:global_refs_def) apply (fastforce simp: second_level_tables_def)+ - apply (clarsimp dest!:invs_valid_objs valid_objs_caps) + apply (clarsimp dest!: invs_valid_objs valid_objs_caps) apply (rename_tac cap cslot) apply (clarsimp simp: perform_page_table_invocation_def) apply (rule hoare_name_pre_state) apply (clarsimp simp: valid_pti_def is_cap_simps) apply (rule hoare_pre) apply (wpc | clarsimp simp: cte_wp_at_caps_of_state | wp arch_update_cap_invs_unmap_page_table get_cap_wp)+ - apply (rule_tac P = "is_pt_cap cap" in hoare_gen_asm) - apply (rule_tac Q = "\r. cte_wp_at ((=) cap) (a,b) and invs and is_final_cap' cap + apply (rule_tac P = "is_pt_cap (ArchObjectCap (PageTableCap p (Some (x1, x2a))))" in hoare_gen_asm) + apply (rule_tac Q = "\r. cte_wp_at ((=) (ArchObjectCap (PageTableCap p (Some (x1, x2a))))) (a,b) + and invs and is_final_cap' (ArchObjectCap (PageTableCap p (Some (x1, x2a)))) and (\s. (the (vs_cap_ref (ArchObjectCap (PageTableCap p (Some (x1, x2a))))), p) \ vs_lookup_pages s) - and obj_at (empty_table {}) (the (aobj_ref (update_map_data (Structures_A.the_arch_cap cap) None None)))" + and obj_at (empty_table {}) (the (aobj_ref (update_map_data + (Structures_A.the_arch_cap (ArchObjectCap (PageTableCap p (Some (x1, x2a))))) None None)))" in hoare_post_imp) apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps update_map_data_def is_arch_update_def cap_master_cap_simps) apply (clarsimp dest!: caps_of_state_valid_cap[OF _ invs_valid_objs] split: option.split_asm - simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def - acap_rights_update_def vs_cap_ref_simps) + simp: mask_cap_def cap_rights_update_def acap_rights_update_def vs_cap_ref_simps) apply (wp hoare_vcg_conj_lift) apply (wp mapM_x_wp, force) apply (rule mapM_x_swp_store_pte_invs_unmap[unfolded swp_def]) @@ -3155,25 +3151,19 @@ lemma perform_page_table_invocation_invs[wp]: apply force apply (wp store_invalid_pte_vs_lookup_pages_shrink) apply (wp mapM_x_swp_store_empty_pt[unfolded swp_def]) - apply (clarsimp simp: cte_wp_at_caps_of_state vs_cap_ref_def is_arch_diminished_def - is_cap_simps diminished_def mask_cap_def) - apply (clarsimp simp: cap_rights_update_def - acap_rights_update_def - split: cap.split_asm arch_cap.split_asm) + apply (clarsimp simp: cte_wp_at_caps_of_state vs_cap_ref_def is_cap_simps mask_cap_def) apply (wp unmap_pt_vs_lookup_pages unmap_page_table_caps_of_state) apply (clarsimp simp: is_final_cap'_def2 gen_obj_refs_def acap_rights_update_def cte_wp_at_caps_of_state - is_arch_diminished_def diminished_def mask_cap_def - del: ) + mask_cap_def) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def is_arch_update_def is_cap_simps update_map_data_def vs_cap_ref_simps invs_psp_aligned pt_bits_def split: cap.split_asm arch_cap.split_asm) - apply (intro conjI impI) - apply fastforce + apply (rule conjI) apply (clarsimp simp: valid_cap_def) apply (drule valid_table_caps_empty_ptD, force) apply (clarsimp simp: obj_at_def empty_table_def) apply (strengthen range_neg_mask_strengthen[mk_strg]) - apply (frule valid_global_refsD2, force) + apply (frule valid_global_refsD2, force) apply (clarsimp simp: valid_cap_def wellformed_mapdata_def image_def le_mask_iff_lt_2n cap_range_def invs_vspace_objs vtable_range_univ invs_arch_state cap_aligned_def) done @@ -3204,7 +3194,6 @@ lemma valid_global_refs_pdptD: apply (clarsimp simp: cap_range_def global_refs_def second_level_tables_def) done -(* FIXME x64: indenting *) lemma perform_pdpt_invocation_invs[wp]: "\invs and valid_pdpti pdpti\ perform_pdpt_invocation pdpti @@ -3212,42 +3201,42 @@ lemma perform_pdpt_invocation_invs[wp]: apply (cases pdpti) apply (rename_tac cap cslot_ptr pml4e obj_ref vspace) apply (rule hoare_pre) - apply (clarsimp simp: perform_pdpt_invocation_def) - apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift - store_pml4e_invs arch_update_cap_invs_map + apply (clarsimp simp: perform_pdpt_invocation_def) + apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift + store_pml4e_invs arch_update_cap_invs_map | strengthen obj_at_empty_refs_strg | simp add: empty_table.arch_only del: split_paired_all split_paired_All | wps - | rule set_cap.aobj_at |wpc)+ - apply (rule set_cap_cte_wp_at_ex[simplified]) + | rule set_cap.aobj_at | wpc)+ + apply (rule set_cap_cte_wp_at_ex[simplified]) apply (wp hoare_vcg_all_lift set_cap.aobj_at, simp) apply wp+ apply (clarsimp simp: valid_pdpti_def is_arch_update_def cte_wp_at_caps_of_state - vs_cap_ref_of_table_capNone - simp del: split_paired_All) + vs_cap_ref_of_table_capNone + simp del: split_paired_All) apply (frule vs_lookup_pages_vs_lookupI) - apply (rule conjI) - apply (clarsimp dest!: same_master_cap_same_types simp: vs_cap_ref_of_table_capNone) + apply (rule conjI) + apply (clarsimp dest!: same_master_cap_same_types simp: vs_cap_ref_of_table_capNone) apply (rule conjI) apply (frule same_master_cap_same_types) apply (clarsimp simp: is_cap_simps cap_master_cap_def kernel_vsrefs_kernel_mapping_slots dest!: valid_global_refs_pdptD[OF _ invs_valid_global_refs]) apply (intro conjI allI) - apply clarsimp - apply (drule_tac ref = ref in valid_vs_lookupD) - apply fastforce - apply (rule ccontr, clarsimp) - apply (frule_tac cap = x and cap' = cap in unique_table_caps_pml4D2[OF _ _ _ _ obj_refs_eqI invs_unique_table_caps]) - apply assumption+ + apply clarsimp + apply (drule_tac ref = ref in valid_vs_lookupD) + apply fastforce + apply (rule ccontr, clarsimp) + apply (frule_tac cap = x and cap' = cap in unique_table_caps_pml4D2[OF _ _ _ _ obj_refs_eqI invs_unique_table_caps]) + apply assumption+ apply (erule caps_of_state_valid, fastforce) apply (erule caps_of_state_valid, fastforce) apply (clarsimp simp: is_cap_simps cap_asid_def vs_cap_ref_def split: option.split_asm) apply (clarsimp simp: is_cap_simps) apply (rule ref_is_unique) - apply simp - apply (erule(1) vs_lookup_vs_lookup_pagesI) - apply fastforce+ + apply simp + apply (erule(1) vs_lookup_vs_lookup_pagesI) + apply fastforce+ apply (simp add:global_refs_def) - apply (fastforce simp: second_level_tables_def)+ + apply (fastforce simp: second_level_tables_def)+ apply (clarsimp dest!:invs_valid_objs valid_objs_caps) apply (clarsimp simp: kernel_vsrefs_kernel_mapping_slots) apply (rename_tac cap cslot) @@ -3256,16 +3245,17 @@ lemma perform_pdpt_invocation_invs[wp]: apply (clarsimp simp: valid_pdpti_def is_cap_simps) apply (rule hoare_pre) apply (wpc | clarsimp simp: cte_wp_at_caps_of_state | wp arch_update_cap_invs_unmap_pd_pointer_table get_cap_wp)+ - apply (rule_tac P = "is_pdpt_cap cap" in hoare_gen_asm) - apply (rule_tac Q = "\r. cte_wp_at ((=) cap) (a,b) and invs and is_final_cap' cap + apply (rule_tac P = "is_pdpt_cap (ArchObjectCap (PDPointerTableCap p (Some (x1, x2a))))" in hoare_gen_asm) + apply (rule_tac Q = "\r. cte_wp_at ((=) (ArchObjectCap (PDPointerTableCap p (Some (x1, x2a))))) (a,b) + and invs and is_final_cap' (ArchObjectCap (PDPointerTableCap p (Some (x1, x2a)))) and (\s. (the (vs_cap_ref (ArchObjectCap (PDPointerTableCap p (Some (x1, x2a))))), p) \ vs_lookup_pages s) - and obj_at (empty_table {}) (the (aobj_ref (update_map_data (Structures_A.the_arch_cap cap) None None)))" + and obj_at (empty_table {}) (the (aobj_ref (update_map_data + (Structures_A.the_arch_cap (ArchObjectCap (PDPointerTableCap p (Some (x1, x2a))))) None None)))" in hoare_post_imp) apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps update_map_data_def is_arch_update_def cap_master_cap_simps) apply (clarsimp dest!: caps_of_state_valid_cap[OF _ invs_valid_objs] split: option.split_asm - simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def - acap_rights_update_def vs_cap_ref_simps) + simp: mask_cap_def cap_rights_update_def acap_rights_update_def vs_cap_ref_simps) apply (wp hoare_vcg_conj_lift) apply (wp mapM_x_wp, force) apply (rule mapM_x_swp_store_pdpte_invs_unmap[unfolded swp_def]) @@ -3273,25 +3263,20 @@ lemma perform_pdpt_invocation_invs[wp]: apply force apply (wp store_invalid_pdpte_vs_lookup_pages_shrink) apply (wp mapM_x_swp_store_empty_pdpt[unfolded swp_def]) - apply (clarsimp simp: cte_wp_at_caps_of_state vs_cap_ref_def is_arch_diminished_def - is_cap_simps diminished_def mask_cap_def) - apply (clarsimp simp: cap_rights_update_def - acap_rights_update_def - split: cap.split_asm arch_cap.split_asm) + apply (clarsimp simp: cte_wp_at_caps_of_state vs_cap_ref_def is_cap_simps mask_cap_def) apply (wp unmap_pdpt_vs_lookup_pages) apply (clarsimp simp: is_final_cap'_def2 gen_obj_refs_Int acap_rights_update_def cte_wp_at_caps_of_state - is_arch_diminished_def diminished_def mask_cap_def) + mask_cap_def) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def is_arch_update_def is_cap_simps update_map_data_def vs_cap_ref_simps invs_psp_aligned pd_bits_def split: cap.split_asm arch_cap.split_asm) apply (intro conjI impI) - apply fastforce apply (clarsimp simp: valid_cap_def) apply (drule valid_table_caps_pdptD, force) apply (clarsimp simp: obj_at_def empty_table_def) apply (simp add: pdpt_bits_def) apply (strengthen range_neg_mask_strengthen[mk_strg] vtable_range_univ[THEN subset_refl_subst, mk_strg]) - apply (frule valid_global_refsD2, force) + apply (frule valid_global_refsD2, force) apply (clarsimp simp: valid_cap_def wellformed_mapdata_def image_def le_mask_iff_lt_2n cap_aligned_def cap_range_def invs_vspace_objs pdpt_bits_def vtable_range_univ invs_arch_state) done @@ -3578,8 +3563,6 @@ lemma perform_page_invs [wp]: apply (wp unmap_page_invs hoare_vcg_ex_lift hoare_vcg_all_lift hoare_vcg_imp_lift unmap_page_unmapped)+ apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state) - apply (clarsimp simp: is_arch_diminished_def) - apply (drule (2) diminished_is_update') apply (clarsimp simp: is_cap_simps cap_master_cap_simps is_arch_update_def update_map_data_def cap_rights_update_def acap_rights_update_def) @@ -3587,7 +3570,7 @@ lemma perform_page_invs [wp]: apply (auto simp: valid_cap_simps cap_aligned_def mask_def vs_cap_ref_def data_at_def split: vmpage_size.splits option.splits if_splits)[1] apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state valid_cap_def mask_def) - \ \PageFlush\ + \ \PageGetAddr\ apply wp apply (simp add: valid_page_inv_def tcb_at_invs) done @@ -3902,26 +3885,6 @@ context assumes vsc: "is_vspace_table_cap c" begin -lemma diminished_table_cap_refl: "diminished c c" - using vsc - apply (simp add: diminished_def mask_cap_def; cases c; simp add: is_cap_simps) - apply (rename_tac ac; case_tac ac; simp add: cap_rights_update_def acap_rights_update_def) - done - -lemma diminished_table_cap_iff_eq: "diminished c c' \ c = c'" - apply (rule iffI; (drule sym; simp add: diminished_table_cap_refl)?) - using vsc - apply (cases c; simp add: is_cap_simps; - rename_tac ac; case_tac ac; clarsimp simp: is_cap_simps) - apply (all \thin_tac "c = _"\) - apply (all \clarsimp simp: diminished_def; rule sym; drule sym; simp\) - apply (all \cases c'; simp add: mask_cap_def cap_rights_update_def acap_rights_update_def; - rename_tac ac'; case_tac ac'; simp\) - done - -lemma diminished_table_cap_eq: "diminished c = ((=) c)" - by (rule ext, rule diminished_table_cap_iff_eq) - end context begin @@ -3933,9 +3896,6 @@ private lemma is_vspace_table_cap: "is_vspace_table_cap (ArchObjectCap (PML4Cap ptr asid))" by (auto simp: is_cap_simps) -lemmas diminished_table_cap_simps - = is_vspace_table_cap[THEN diminished_table_cap_eq] - end lemma valid_vspace_obj_default: diff --git a/proof/refine/ARM/Arch_R.thy b/proof/refine/ARM/Arch_R.thy index 2b6c9e3908..40175b9001 100644 --- a/proof/refine/ARM/Arch_R.thy +++ b/proof/refine/ARM/Arch_R.thy @@ -537,8 +537,7 @@ lemma dec_arch_inv_page_flush_corres: (invs and valid_cap (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option)) and cte_wp_at - (is_arch_diminished - (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option))) + ((=) (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option))) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and @@ -799,7 +798,7 @@ shows corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap arch_cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap arch_cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap arch_cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap arch_cap') and (\s. \x\set excaps'. s \' fst x \ cte_at' (snd x) s) and @@ -1050,7 +1049,6 @@ shows apply (simp add: unlessE_whenE) apply (rule corres_splitEE) prefer 2 - apply (rule corres_whenE) apply clarsimp apply (case_tac oldpde, simp_all)[1] @@ -1063,7 +1061,7 @@ shows apply (clarsimp simp: attribs_from_word_def attribsFromWord_def Let_def) apply (simp add: shiftr_shiftl1 pageBits_def ptBits_def pdeBits_def pteBits_def) apply (wp hoare_whenE_wp get_master_pde_wp getPDE_wp find_pd_for_asid_inv - | wp (once) hoare_drop_imps)+ + | wp (once) hoare_drop_imps)+ apply (fastforce simp: valid_cap_def mask_def invs_vspace_objs[simplified]) apply (clarsimp simp: valid_cap'_def) @@ -1085,17 +1083,12 @@ shows apply (clarsimp) apply (rule no_fail_pre, rule no_fail_getCTE) apply (erule conjunct2) - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def + apply (clarsimp simp: cte_wp_at_caps_of_state cap_rights_update_def acap_rights_update_def) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) - apply (clarsimp simp: cte_wp_at_ctes_of is_arch_diminished_def + apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) + apply (clarsimp simp: cte_wp_at_ctes_of cap_rights_update_def acap_rights_update_def cte_wp_at_caps_of_state) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (drule pspace_relation_ctes_ofI[OF _ caps_of_state_cteD, rotated], erule invs_pspace_aligned', clarsimp+) apply (simp add: isCap_simps) @@ -1143,11 +1136,10 @@ shows apply (rule corres_trivial) apply (rule corres_returnOk) apply (clarsimp simp: archinv_relation_def page_directory_invocation_map_def - flush_type_map)+ - + flush_type_map)+ apply (clarsimp simp: state_relation_def) apply (frule pspace_relation_cte_wp_at, - simp add: cte_wp_at_caps_of_state, simp+) + simp add: cte_wp_at_caps_of_state, simp+) apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule(1) valid_global_refsD_with_objSize) subgoal by (clarsimp simp: is_page_cap_def split: cap.split_asm) @@ -1433,10 +1425,9 @@ lemma findPDForASID_valid_offset'[wp]: apply (erule less_kernelBase_valid_pde_offset'') done -lemma diminished_arch_update': - "diminished' (ArchObjectCap cp) (cteCap cte) \ is_arch_update' (ArchObjectCap cp) cte" - by (clarsimp simp: is_arch_update'_def isCap_simps - diminished'_def) +lemma eq_arch_update': + "ArchObjectCap cp = cteCap cte \ is_arch_update' (ArchObjectCap cp) cte" + by (clarsimp simp: is_arch_update'_def isCap_simps) lemma lookupPTSlot_page_table_at': "\valid_objs'\ lookupPTSlot pd vptr @@ -1610,11 +1601,10 @@ lemma arch_decodeARMPageFlush_wf: valid_cap' (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size option)) and cte_wp_at' - (diminished' - (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size option)) \ + ((=) (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size option)) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple and (\s. vs_valid_duplicates' (ksPSpace s))\ decodeARMPageFlush label args (arch_capability.PageCap d word vmrights vmpage_size option) @@ -1629,24 +1619,22 @@ lemma arch_decodeARMPageFlush_wf: lemma arch_decodeInvocation_wf[wp]: notes ensureSafeMapping_inv[wp del] shows "\invs' and valid_cap' (ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (ArchObjectCap arch_cap) o cteCap) slot and - (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) and + cte_wp_at' ((=) (ArchObjectCap arch_cap) o cteCap) slot and + (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and sch_act_simple and (\s. vs_valid_duplicates' (ksPSpace s))\ Arch.decodeInvocation label args cap_index slot arch_cap excaps \valid_arch_inv'\,-" apply (cases arch_cap) apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def Let_def split_def isCap_simps - cong: if_cong split del: if_split) + cong: if_cong split del: if_split) apply (rule hoare_pre) - apply ((wp whenE_throwError_wp getASID_wp| - wpc| - simp add: valid_arch_inv'_def valid_apinv'_def)+)[1] - apply (clarsimp simp: word_neq_0_conv valid_cap'_def - valid_arch_inv'_def valid_apinv'_def) + apply ((wp whenE_throwError_wp getASID_wp + | wpc | simp add: valid_arch_inv'_def valid_apinv'_def)+)[1] + apply (clarsimp simp: word_neq_0_conv valid_cap'_def valid_arch_inv'_def valid_apinv'_def) apply (rule conjI) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: diminished_isPDCap) + apply (simp, drule_tac t="cteCap c" in sym, simp) apply (subst (asm) conj_assoc [symmetric]) apply (subst (asm) assocs_empty_dom_comp [symmetric]) apply (drule dom_hd_assocsD) @@ -1656,21 +1644,24 @@ lemma arch_decodeInvocation_wf[wp]: apply assumption apply (simp add: asid_low_bits_def asid_bits_def) apply assumption + \ \ASIDControlCap\ apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def - Let_def split_def isCap_simps - cong: if_cong invocation_label.case_cong arch_invocation_label.case_cong list.case_cong prod.case_cong - split del: if_split) + Let_def split_def isCap_simps + cong: if_cong invocation_label.case_cong arch_invocation_label.case_cong + list.case_cong prod.case_cong + split del: if_split) apply (rule hoare_pre) - apply ((wp whenE_throwError_wp ensureEmptySlot_stronger| - wpc| - simp add: valid_arch_inv'_def valid_aci'_def is_aligned_shiftl_self - split del: if_split)+)[1] + apply ((wp whenE_throwError_wp ensureEmptySlot_stronger + | wpc + | simp add: valid_arch_inv'_def valid_aci'_def is_aligned_shiftl_self + split del: if_split)+)[1] apply (rule_tac Q'= "\rv. K (fst (hd [p\assocs asidTable . fst p \ 2 ^ asid_high_bits - 1 \ snd p = None]) << asid_low_bits \ 2 ^ asid_bits - 1) and real_cte_at' rv and ex_cte_cap_to' rv and - cte_wp_at' (\cte. \idx. cteCap cte = (UntypedCap False frame pageBits idx)) (snd (excaps!0)) and + cte_wp_at' (\cte. \idx. cteCap cte = (UntypedCap False frame pageBits idx)) + (snd (excaps!0)) and sch_act_simple and (\s. descendants_of' (snd (excaps!0)) (ctes_of s) = {}) " in hoare_post_imp_R) @@ -1692,18 +1683,18 @@ lemma arch_decodeInvocation_wf[wp]: apply (rule conjI, fastforce) apply (clarsimp simp: cte_wp_at_ctes_of objBits_simps archObjSize_def) apply (rule conjI) - apply (case_tac cteb) - apply clarsimp + apply (case_tac cteb; clarsimp) apply (drule ctes_of_valid_cap', fastforce) - apply (simp add: diminished_valid') - apply clarsimp + apply assumption apply (simp add: ex_cte_cap_to'_def cte_wp_at_ctes_of) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (drule_tac t="cteCap cte" in sym, clarsimp) apply (rule_tac x=ba in exI) - apply (simp add: diminished_cte_refs') + apply simp + \ \PageCap\ apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def Let_def split_def isCap_simps cong: if_cong split del: if_split) - apply (cases "invocation_type label = ArchInvocationLabel ARMPageMap") apply (rename_tac word vmrights vmpage_size option) apply (simp add: split_def split del: if_split @@ -1718,10 +1709,10 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: neq_Nil_conv invs_valid_objs' linorder_not_le cte_wp_at_ctes_of) apply (drule ctes_of_valid', fastforce)+ - apply (case_tac option; clarsimp) - apply (clarsimp simp: diminished_valid' [symmetric] valid_cap'_def ptBits_def pageBits_def + apply (case_tac option; clarsimp, drule_tac t="cteCap cte" in sym, simp) + apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def is_arch_update'_def isCap_simps capAligned_def vmsz_aligned'_def - dest!: diminished_capMaster cong: conj_cong) + cong: conj_cong) apply (rule conjI) apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size, simp_all)[1] apply (simp add: vmsz_aligned_def) @@ -1729,24 +1720,23 @@ lemma arch_decodeInvocation_wf[wp]: apply (erule order_le_less_trans[rotated]) apply (erule is_aligned_no_overflow'[simplified field_simps]) apply (clarsimp simp: page_directory_at'_def pdBits_eq lookup_pd_slot_eq)+ - apply (clarsimp simp: diminished_valid' [symmetric] valid_cap'_def ptBits_def pageBits_def + apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def is_arch_update'_def isCap_simps capAligned_def vmsz_aligned'_def - dest!: diminished_capMaster cong: conj_cong) - + cong: conj_cong) apply (rule conjI) apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size, simp_all)[1] apply (simp add: vmsz_aligned_def pd_bits) apply (clarsimp simp: page_directory_at'_def lookup_pd_slot_eq[simplified pd_bits]) - apply (cases "invocation_type label = ArchInvocationLabel ARMPageUnmap") apply (simp split del: if_split) apply (rule hoare_pre, wp) apply (clarsimp simp: valid_arch_inv'_def valid_page_inv'_def) apply (thin_tac "Ball S P" for S P) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: is_arch_update'_def isCap_simps dest!: diminished_capMaster) + apply (clarsimp simp: is_arch_update'_def isCap_simps) apply (cases "ARM_H.isPageFlushLabel (invocation_type label)") - apply (clarsimp simp: ARM_H.isPageFlushLabel_def split: invocation_label.splits arch_invocation_label.splits) + apply (clarsimp simp: ARM_H.isPageFlushLabel_def + split: invocation_label.splits arch_invocation_label.splits) apply (rule arch_decodeARMPageFlush_wf, clarsimp simp: ARM_H.isPageFlushLabel_def)+ apply (cases "invocation_type label = ArchInvocationLabel ARMPageGetAddress") @@ -1755,69 +1745,56 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: valid_arch_inv'_def valid_page_inv'_def) apply (simp add: ARM_H.isPageFlushLabel_def throwError_R' split: invocation_label.split_asm arch_invocation_label.split_asm) + \ \PageTableCap\ apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def Let_def split_def isCap_simps vs_entry_align_def - cong: if_cong list.case_cong invocation_label.case_cong arch_invocation_label.case_cong prod.case_cong - split del: if_split) + cong: if_cong list.case_cong invocation_label.case_cong + arch_invocation_label.case_cong prod.case_cong + split del: if_split) apply (rename_tac word option) apply (rule hoare_pre) apply ((wp whenE_throwError_wp isFinalCapability_inv getPDE_wp - | wpc | - simp add: valid_arch_inv'_def valid_pti'_def unlessE_whenE| - rule_tac x="fst p" in hoare_imp_eq_substR - )+) - apply (rule_tac Q'="\b c. ko_at' ARM_H.pde.InvalidPDE (b + (hd args >> 20 << 2)) c \ - cte_wp_at' - (is_arch_update' - (capability.ArchObjectCap (arch_capability.PageTableCap word (Some (snd p, hd args >> 20 << 20))))) - slot c \ - c \' capability.ArchObjectCap (arch_capability.PageTableCap word (Some (snd p, hd args >> 20 << 20))) \ - is_aligned (addrFromPPtr word) ptBits \ - valid_pde_mapping_offset' (b + (hd args >> 20 << 2) && mask pdBits) - " in hoare_post_imp_R) - apply ((wp whenE_throwError_wp isFinalCapability_inv getPDE_wp - | wpc | - simp add: valid_arch_inv'_def valid_pti'_def unlessE_whenE| - rule_tac x="fst p" in hoare_imp_eq_substR - | rule hoare_drop_impE_R)+) - apply (clarsimp simp:ko_wp_at'_def obj_at'_real_def) - apply (clarsimp simp: projectKO_opt_pde vs_entry_align_def - pageBits_def ptBits_def pdeBits_def pteBits_def - split:Structures_H.kernel_object.splits - arch_kernel_object.splits) - apply ((wp whenE_throwError_wp isFinalCapability_inv - | wpc |simp add: valid_arch_inv'_def valid_pti'_def if_apply_def2 | - rule hoare_drop_imp)+)[15] - apply (clarsimp simp: linorder_not_le isCap_simps - cte_wp_at_ctes_of diminished_arch_update') - apply (simp add: valid_cap'_def capAligned_def) - apply (rule conjI) - apply (clarsimp simp: is_arch_update'_def isCap_simps - dest!: diminished_capMaster) - apply (clarsimp simp: neq_Nil_conv vs_entry_align_def invs_valid_objs' - ptBits_def pageBits_def is_aligned_addrFromPPtr_n) + | wpc | simp add: valid_arch_inv'_def valid_pti'_def unlessE_whenE + | rule_tac x="fst p" in hoare_imp_eq_substR)+) + apply (rule_tac Q'= +"\b c. ko_at' ARM_H.pde.InvalidPDE (b + (hd args >> 20 << 2)) c \ + cte_wp_at' + (is_arch_update' + (capability.ArchObjectCap + (arch_capability.PageTableCap word (Some (snd p, hd args >> 20 << 20))))) + slot c \ + c \' capability.ArchObjectCap + (arch_capability.PageTableCap word (Some (snd p, hd args >> 20 << 20))) \ + is_aligned (addrFromPPtr word) ptBits \ + valid_pde_mapping_offset' (b + (hd args >> 20 << 2) && mask pdBits) + " in hoare_post_imp_R) + apply ((wp whenE_throwError_wp isFinalCapability_inv getPDE_wp + | wpc | simp add: valid_arch_inv'_def valid_pti'_def unlessE_whenE + | rule_tac x="fst p" in hoare_imp_eq_substR + | rule hoare_drop_impE_R)+) + apply (clarsimp simp: ko_wp_at'_def obj_at'_real_def) + apply (clarsimp simp: projectKO_opt_pde vs_entry_align_def + pageBits_def ptBits_def pdeBits_def pteBits_def + split: Structures_H.kernel_object.splits arch_kernel_object.splits) + apply ((wp whenE_throwError_wp isFinalCapability_inv + | wpc | simp add: valid_arch_inv'_def valid_pti'_def if_apply_def2 + | rule hoare_drop_imp)+)[15] + apply (clarsimp simp: linorder_not_le isCap_simps cte_wp_at_ctes_of) + apply (frule eq_arch_update') + apply (case_tac option; clarsimp) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (clarsimp simp: is_arch_update'_def isCap_simps valid_cap'_def capAligned_def) apply (thin_tac "Ball S P" for S P)+ apply (drule ctes_of_valid', fastforce)+ - apply (clarsimp simp: diminished_valid' [symmetric]) - apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def is_aligned_addrFromPPtr_n - invs_valid_objs' vs_entry_align_def and_not_mask[symmetric] pteBits_def) + apply (clarsimp simp: valid_cap'_def ptBits_def is_aligned_addrFromPPtr_n invs_valid_objs' + and_not_mask[symmetric] pteBits_def) apply (erule order_le_less_trans[rotated]) apply (rule word_and_le2) - apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def isCap_simps Let_def) - apply(cases "ARM_H.isPDFlushLabel (invocation_type label)", simp_all) - apply(cases args; simp) - apply(wp) - defer - apply(wp) - apply(case_tac list, simp_all) - defer - apply(wp) - apply(simp add:split_def, wp) - apply(case_tac xb, simp_all)[] - apply (wp whenE_throwError_wp)+ - apply(simp add:valid_arch_inv'_def)+ - apply wp+ - apply(simp, wp) + apply (simp add: valid_cap'_def capAligned_def) + apply (simp add: decodeARMMMUInvocation_def ARM_H.decodeInvocation_def isCap_simps Let_def) + apply (cases "ARM_H.isPDFlushLabel (invocation_type label)"; simp) + apply (cases args; wpsimp simp: valid_arch_inv'_def) + apply wp done crunch nosch[wp]: setMRs "\s. P (ksSchedulerAction s)" diff --git a/proof/refine/ARM/CSpace_I.thy b/proof/refine/ARM/CSpace_I.thy index e32d94020d..1d8be84e68 100644 --- a/proof/refine/ARM/CSpace_I.thy +++ b/proof/refine/ARM/CSpace_I.thy @@ -46,11 +46,6 @@ lemma maskCapRights_allRights [simp]: ARM_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma diminished_refl'[simp]: - "diminished' cap cap" - unfolding diminished'_def - by (rule exI[where x=allRights], simp) - lemma getCTE_inv [wp]: "\P\ getCTE addr \\rv. P\" by (simp add: getCTE_def) wp @@ -2026,9 +2021,5 @@ crunch idle[wp]: get_object "valid_idle" end -lemma diminished_capMaster: - "diminished' cap cap' \ capMasterCap cap' = capMasterCap cap" - by (clarsimp simp: diminished'_def) - end (* of theory *) diff --git a/proof/refine/ARM/CSpace_R.thy b/proof/refine/ARM/CSpace_R.thy index 2d85458004..a394fc6f7b 100644 --- a/proof/refine/ARM/CSpace_R.thy +++ b/proof/refine/ARM/CSpace_R.thy @@ -6039,22 +6039,6 @@ lemma updateCap_same_master: apply (clarsimp simp: cte_wp_at_ctes_of) done -lemma diminished_cte_refs': - "diminished' cap cap' \ cte_refs' cap n = cte_refs' cap' n" - by (clarsimp simp: diminished'_def) - -lemma diminished_Untyped' : - "diminished' (UntypedCap d r n x) cap = (cap = UntypedCap d r n x)" - apply (rule iffI) - apply (case_tac cap) - apply (clarsimp simp:isCap_simps maskCapRights_def diminished'_def split:if_split_asm)+ - (* 6 subgoals *) - apply (rename_tac arch_capability R) - apply (case_tac arch_capability) - apply (clarsimp simp: isCap_simps ARM_H.maskCapRights_def maskCapRights_def - diminished'_def Let_def)+ -done - lemma updateCapFreeIndex_valid_mdb_ctes: assumes preserve:"\m m'. mdb_inv_preserve m m' \ mdb_inv_preserve (Q m) (Q m')" and coin :"\m cte. \m src = Some cte\ \ (\cte'. (Q m) src = Some cte' \ cteCap cte = cteCap cte')" diff --git a/proof/refine/ARM/LevityCatch.thy b/proof/refine/ARM/LevityCatch.thy index 1607c2a1c6..983a89c75d 100644 --- a/proof/refine/ARM/LevityCatch.thy +++ b/proof/refine/ARM/LevityCatch.thy @@ -29,8 +29,6 @@ lemmas makeObject_simps = makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte makeObject_asidpool end -definition - "diminished' cap cap' \ \R. cap = maskCapRights R cap'" lemma projectKO_inv : "\P\ projectKO ko \\rv. P\" by (simp add: projectKO_def fail_def valid_def return_def diff --git a/proof/refine/ARM/Syscall_R.thy b/proof/refine/ARM/Syscall_R.thy index ecb668857f..76af57124e 100644 --- a/proof/refine/ARM/Syscall_R.thy +++ b/proof/refine/ARM/Syscall_R.thy @@ -170,7 +170,7 @@ lemma decode_invocation_corres: \ corres (ser \ inv_relation) (invs and valid_sched and valid_list - and valid_cap cap and cte_at slot and cte_wp_at (diminished cap) slot + and valid_cap cap and cte_at slot and cte_wp_at ((=) cap) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s) and (\s. length args < 2 ^ word_bits)) (invs' and valid_cap' cap' and cte_at' slot' @@ -187,7 +187,7 @@ lemma decode_invocation_corres: \ \Untyped\ apply (simp add: isCap_defs Let_def o_def split del: if_split) apply (rule corres_guard_imp, rule dec_untyped_inv_corres) - apply ((clarsimp simp:cte_wp_at_caps_of_state diminished_def)+)[3] + apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3] \ \(Async)Endpoint\ apply (simp add: isCap_defs returnOk_def) apply (simp add: isCap_defs) @@ -233,8 +233,6 @@ lemma decode_invocation_corres: apply (clarsimp simp add: isCap_defs Let_def o_def) apply (rule corres_guard_imp [OF dec_arch_inv_corres]) apply (simp_all add: list_all2_map2 list_all2_map1)+ - apply (clarsimp simp: is_arch_diminished_def cte_wp_at_caps_of_state - is_cap_simps) done declare mapME_Nil [simp] @@ -604,22 +602,6 @@ lemma decode_inv_inv'[wp]: clarsimp split: capability.split_asm simp: isCap_defs)+ done -lemma diminished_IRQHandler' [simp]: - "diminished' (IRQHandlerCap h) cap = (cap = IRQHandlerCap h)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - -lemma diminished_IRQControlCap' [simp]: - "diminished' IRQControlCap cap = (cap = IRQControlCap)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - (* FIXME: move to TCB *) lemma dec_dom_inv_wf[wp]: "\invs' and (\s. \x \ set excaps. s \' fst x)\ @@ -638,36 +620,29 @@ lemma dec_dom_inv_wf[wp]: apply (simp add:numDomains_def maxDomain_def) done -lemma diminished_ReplyCap': - "diminished' (capability.ReplyCap t False r) cap - \ \gr. cap = capability.ReplyCap t False gr" - apply (clarsimp simp: diminished'_def maskCapRights_def Let_def split del: if_split) - apply (cases cap, simp_all add: isCap_simps)[1] - apply (simp add: ARM_H.maskCapRights_def isPageCap_def split: arch_capability.splits) - done - lemma decode_inv_wf'[wp]: "\valid_cap' cap and invs' and sch_act_simple - and cte_wp_at' (diminished' cap \ cteCap) slot and real_cte_at' slot + and cte_wp_at' ((=) cap \ cteCap) slot and real_cte_at' slot and (\s. \r\zobj_refs' cap. ex_nonz_cap_to' r s) and (\s. \r\cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\zobj_refs' (fst cap). ex_nonz_cap_to' r s) - and (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and (\s. \x \ set excaps. s \' fst x) and (\s. \x \ set excaps. real_cte_at' (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to' isCNodeCap (snd x) s) - and (\s. \x \ set excaps. cte_wp_at' (badge_derived' (fst x) o cteCap) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at' (badge_derived' (fst x) \ cteCap) (snd x) s) and (\s. vs_valid_duplicates' (ksPSpace s))\ decodeInvocation label args cap_index slot cap excaps \valid_invocation'\,-" - apply (case_tac cap, simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def - split del: if_split - cong: if_cong) + apply (case_tac cap, + simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def + split del: if_split + cong: if_cong) apply ((rule hoare_pre, - ((wp decodeTCBInv_wf | simp add: o_def)+)[1], - clarsimp simp: valid_cap'_def cte_wp_at_ctes_of diminished_ReplyCap' - | (rule exI, rule exI, erule (1) conjI))+) + ((wpsimp wp: decodeTCBInv_wf simp: o_def)+)[1], + clarsimp simp: valid_cap'_def cte_wp_at_ctes_of) + | intro exI conjI | simp)+ done lemma ct_active_imp_simple'[elim!]: @@ -1099,29 +1074,19 @@ lemma lec_ex_nonz_cap_to' [wp]: done (* FIXME: move *) -lemma getSlotCap_diminished' [wp]: +lemma getSlotCap_eq [wp]: "\\\ getSlotCap slot - \\cap. cte_wp_at' (diminished' cap \ cteCap) slot\" - apply (simp add: getSlotCap_def) - apply (wp getCTE_wp') - apply (clarsimp simp: cte_wp_at_ctes_of) - done + \\cap. cte_wp_at' ((=) cap \ cteCap) slot\" + by (wpsimp wp: getCTE_wp' simp: getSlotCap_def cte_wp_at_ctes_of) -lemma lcs_diminished' [wp]: - "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' (diminished' (fst rv) o cteCap) (snd rv)\,-" - unfolding lookupCapAndSlot_def - apply (rule hoare_pre) - apply (wp | simp add: split_def)+ - done +lemma lcs_eq [wp]: + "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' ((=) (fst rv) \ cteCap) (snd rv)\,-" + by (wpsimp simp: lookupCapAndSlot_def) lemma lec_dimished'[wp]: - "\\\ - lookupExtraCaps t buffer info - \\rv s. (\x\set rv. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s)\,-" - apply (simp add: lookupExtraCaps_def split del: if_split) - apply (rule hoare_pre) - apply (wp mapME_set|simp)+ - done + "\\\ lookupExtraCaps t buffer info + \\rv s. (\x\set rv. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s)\,-" + by (wpsimp wp: mapME_set simp: lookupExtraCaps_def) lemma lookupExtras_real_ctes[wp]: "\valid_objs'\ lookupExtraCaps t xs info \\rv s. \x \ set rv. real_cte_at' (snd x) s\,-" @@ -1319,10 +1284,10 @@ lemma hinv_corres: apply (clarsimp) apply (wp setThreadState_nonqueued_state_update setThreadState_st_tcb setThreadState_rct)[1] - apply (wp lec_caps_to get_cap_diminished lsft_ex_cte_cap_to - | simp add: split_def liftE_bindE[symmetric] - ct_in_state'_def ball_conj_distrib - | rule hoare_vcg_E_elim)+ + apply (wp lec_caps_to lsft_ex_cte_cap_to + | simp add: split_def liftE_bindE[symmetric] + ct_in_state'_def ball_conj_distrib + | rule hoare_vcg_E_elim)+ apply (clarsimp simp: tcb_at_invs invs_valid_objs valid_tcb_state_def ct_in_state_def simple_from_active invs_mdb) diff --git a/proof/refine/ARM/Untyped_R.thy b/proof/refine/ARM/Untyped_R.thy index b55ec8cb9e..8d0ee38b17 100644 --- a/proof/refine/ARM/Untyped_R.thy +++ b/proof/refine/ARM/Untyped_R.thy @@ -660,23 +660,20 @@ lemma ensureNoChildren_sp: declare isPDCap_PD [simp] -declare diminished_Untyped' [simp] - lemma dui_sp_helper': "\P\ if Q then returnOk root_cap else doE slot \ lookupTargetSlot root_cap cref dpth; liftE (getSlotCap slot) - odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' (diminished' rv o cteCap) slot s)) \ P s\, -" + odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' ((=) rv o cteCap) slot s)) \ P s\, -" apply (cases Q, simp_all add: lookupTargetSlot_def) apply (wp, simp) apply (simp add: getSlotCap_def split_def) apply wp apply (rule hoare_strengthen_post [OF getCTE_sp[where P=P]]) - apply (clarsimp simp: cte_wp_at_ctes_of diminished'_def) + apply (clarsimp simp: cte_wp_at_ctes_of) apply (elim allE, drule(1) mp) - apply (erule allE, subst(asm) maskCapRights_allRights) - apply simp + apply clarsimp apply wpsimp apply simp done @@ -797,7 +794,6 @@ lemma decodeUntyped_wf[wp]: apply (case_tac cte) apply clarsimp apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])+ - apply (drule diminished_valid') apply simp apply (clarsimp simp: toEnum_of_nat [OF less_Suc_unat_less_bound] ucast_id) apply (subgoal_tac "args ! 4 \ 2 ^ capCNodeBits nodeCap") @@ -867,7 +863,7 @@ lemma decodeUntyped_wf[wp]: apply (clarsimp simp:ex_cte_cap_wp_to'_def) apply (rule_tac x = nodeSlot in exI) apply (case_tac cte) - apply (clarsimp simp:cte_wp_at_ctes_of diminished_cte_refs'[symmetric] isCap_simps image_def) + apply (clarsimp simp:cte_wp_at_ctes_of isCap_simps image_def) apply (rule_tac x = x in bexI,simp) apply simp apply (erule order_trans) diff --git a/proof/refine/ARM/VSpace_R.thy b/proof/refine/ARM/VSpace_R.thy index e2ed1a2ff5..532194657c 100644 --- a/proof/refine/ARM/VSpace_R.thy +++ b/proof/refine/ARM/VSpace_R.thy @@ -1173,7 +1173,7 @@ lemma storeHWASID_valid_arch' [wp]: armKSHWASIDTable (ksArchState s) hw_asid = None)\ storeHWASID asid hw_asid \\_. valid_arch_state'\" - supply image_cong_simp [cong del] + supply image_cong_simp [cong del] apply (simp add: storeHWASID_def) apply wp prefer 2 @@ -2277,8 +2277,7 @@ proof - apply (rule updateCap_same_master) apply (clarsimp simp: is_page_cap_def update_map_data_def) apply (wp get_cap_wp getSlotCap_wp)+ - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def) - apply (drule (2) diminished_is_update')+ + apply (clarsimp simp: cte_wp_at_caps_of_state) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def update_map_data_def is_cap_simps) apply auto[1] apply (auto simp: cte_wp_at_ctes_of)[1] @@ -2303,8 +2302,7 @@ proof - apply (simp add: cte_wp_at_ctes_of) apply wp apply (clarsimp simp: valid_unmap_def cte_wp_at_caps_of_state) - apply (clarsimp simp: is_arch_diminished_def is_cap_simps split: cap.splits arch_cap.splits) - apply (drule (2) diminished_is_update')+ + apply (clarsimp simp: is_cap_simps split: cap.splits arch_cap.splits) apply (clarsimp simp: cap_rights_update_def is_page_cap_def cap_master_cap_simps update_map_data_def acap_rights_update_def) apply (clarsimp simp add: valid_cap_def mask_def) @@ -2459,12 +2457,10 @@ lemma perform_page_table_corres: apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift mapM_x_wp' | simp split del: if_split)+ apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state - is_arch_diminished_def cap_master_cap_simps update_map_data_def is_cap_simps cap_rights_update_def acap_rights_update_def dest!: cap_master_cap_eqDs) - apply (frule (2) diminished_is_update') 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] @@ -3564,18 +3560,6 @@ lemma isPDCap_PD : by (simp add: isPDCap_def) -lemma diminished_valid': - "diminished' cap cap' \ valid_cap' cap = valid_cap' cap'" - apply (clarsimp simp add: diminished'_def) - apply (rule ext) - apply (simp add: maskCapRights_def Let_def split del: if_split) - apply (cases cap'; simp add: isCap_simps valid_cap'_def capAligned_def split del: if_split) - by (simp add: ARM_H.maskCapRights_def isPageCap_def Let_def split del: if_split split: arch_capability.splits) - -lemma diminished_isPDCap: - "diminished' cap cap' \ isPDCap cap' = isPDCap cap" - by (blast dest: diminished_capMaster capMaster_isPDCap) - end lemma cteCaps_of_ctes_of_lift: diff --git a/proof/refine/ARM_HYP/Arch_R.thy b/proof/refine/ARM_HYP/Arch_R.thy index f39fe27455..d82a92bdd2 100644 --- a/proof/refine/ARM_HYP/Arch_R.thy +++ b/proof/refine/ARM_HYP/Arch_R.thy @@ -560,8 +560,7 @@ lemma dec_arch_inv_page_flush_corres: (invs and valid_cap (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option)) and cte_wp_at - (is_arch_diminished - (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option))) + ((=) (cap.ArchObjectCap (arch_cap.PageCap d word seta vmpage_size option))) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and @@ -893,7 +892,7 @@ shows corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap arch_cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap arch_cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap arch_cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap arch_cap') and (\s. \x\set excaps'. s \' fst x \ cte_at' (snd x) s) and @@ -1181,17 +1180,10 @@ shows apply (clarsimp) apply (rule no_fail_pre, rule no_fail_getCTE) apply (erule conjunct2) - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def - cap_rights_update_def acap_rights_update_def) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) + apply (clarsimp simp: cte_wp_at_caps_of_state cap_rights_update_def acap_rights_update_def) apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) - apply (clarsimp simp: cte_wp_at_ctes_of is_arch_diminished_def - cap_rights_update_def acap_rights_update_def + apply (clarsimp simp: cte_wp_at_ctes_of cap_rights_update_def acap_rights_update_def cte_wp_at_caps_of_state) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (drule pspace_relation_ctes_ofI[OF _ caps_of_state_cteD, rotated], erule invs_pspace_aligned', clarsimp+) apply (simp add: isCap_simps) @@ -1620,10 +1612,9 @@ lemma findPDForASID_valid_offset'[wp]: apply (erule less_kernelBase_valid_pde_offset'') done -lemma diminished_arch_update': - "diminished' (ArchObjectCap cp) (cteCap cte) \ is_arch_update' (ArchObjectCap cp) cte" - by (clarsimp simp: is_arch_update'_def isCap_simps - diminished'_def) +lemma eq_arch_update': + "ArchObjectCap cp = cteCap cte \ is_arch_update' (ArchObjectCap cp) cte" + by (clarsimp simp: is_arch_update'_def isCap_simps) lemma lookupPTSlot_page_table_at': "\valid_objs'\ lookupPTSlot pd vptr @@ -1794,11 +1785,10 @@ lemma arch_decodeARMPageFlush_wf: valid_cap' (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size option)) and cte_wp_at' - (diminished' - (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size option)) \ + ((=) (capability.ArchObjectCap (arch_capability.PageCap d word vmrights vmpage_size option)) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple and (\s. vs_valid_duplicates' (ksPSpace s))\ decodeARMPageFlush label args (arch_capability.PageCap d word vmrights vmpage_size option) @@ -1812,15 +1802,11 @@ lemma zobj_refs_maksCapRights[simp]: "zobj_refs' (maskCapRights R cap) = zobj_refs' cap" by (cases cap; clarsimp simp: maskCapRights_def ARM_HYP_H.maskCapRights_def Let_def isCap_simps) -lemma diminished_zobj_refs': - "diminished' cap cap' \ zobj_refs' cap' = zobj_refs' cap" - by (cases cap'; clarsimp simp: diminished'_def) - lemma arch_decodeInvocation_wf[wp]: notes ensureSafeMapping_inv[wp del] shows "\invs' and valid_cap' (ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (ArchObjectCap arch_cap) o cteCap) slot and - (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) and + cte_wp_at' ((=) (ArchObjectCap arch_cap) o cteCap) slot and + (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and sch_act_simple and (\s. vs_valid_duplicates' (ksPSpace s))\ Arch.decodeInvocation label args cap_index slot arch_cap excaps \valid_arch_inv'\,-" @@ -1833,7 +1819,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: word_neq_0_conv valid_cap'_def valid_arch_inv'_def valid_apinv'_def) apply (rule conjI) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: diminished_isPDCap) + apply (simp, drule_tac t="cteCap c" in sym, simp) apply (subst (asm) conj_assoc [symmetric]) apply (subst (asm) assocs_empty_dom_comp [symmetric]) apply (drule dom_hd_assocsD) @@ -1843,6 +1829,7 @@ lemma arch_decodeInvocation_wf[wp]: apply assumption apply (simp add: asid_low_bits_def asid_bits_def) apply assumption + \ \ASIDControlCap\ apply (simp add: decodeARMMMUInvocation_def ARM_HYP_H.decodeInvocation_def Let_def split_def isCap_simps cong: if_cong invocation_label.case_cong arch_invocation_label.case_cong @@ -1884,15 +1871,16 @@ lemma arch_decodeInvocation_wf[wp]: apply (case_tac cteb) apply clarsimp apply (drule ctes_of_valid_cap', fastforce) - apply (simp add: diminished_valid') - apply clarsimp + apply assumption apply (simp add: ex_cte_cap_to'_def cte_wp_at_ctes_of) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (drule_tac t="cteCap cte" in sym, clarsimp) apply (rule_tac x=ba in exI) - apply (simp add: diminished_cte_refs') + apply simp + \ \PageCap\ apply (simp add: decodeARMMMUInvocation_def ARM_HYP_H.decodeInvocation_def - Let_def split_def isCap_simps - cong: if_cong split del: if_split) - + Let_def split_def isCap_simps + cong: if_cong split del: if_split) apply (cases "invocation_type label = ArchInvocationLabel ARMPageMap") apply (rename_tac word vmrights vmpage_size option) apply (simp add: split_def split del: if_split @@ -1907,11 +1895,10 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: neq_Nil_conv invs_valid_objs' linorder_not_le cte_wp_at_ctes_of) apply (drule ctes_of_valid', fastforce)+ - apply (case_tac option; clarsimp) - - apply (clarsimp simp: diminished_valid' [symmetric] valid_cap'_def ptBits_def pageBits_def + apply (case_tac option; clarsimp, drule_tac t="cteCap cte" in sym, simp) + apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def is_arch_update'_def isCap_simps capAligned_def vmsz_aligned'_def - dest!: diminished_capMaster cong: conj_cong) + cong: conj_cong) apply (rule conjI) apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size, simp_all)[1] apply (simp add: vmsz_aligned_def) @@ -1920,9 +1907,9 @@ lemma arch_decodeInvocation_wf[wp]: apply (erule order_le_less_trans[rotated]) apply (erule is_aligned_no_overflow'[simplified field_simps]) apply (clarsimp simp: page_directory_at'_def lookup_pd_slot_eq)+ - apply (clarsimp simp: diminished_valid' [symmetric] valid_cap'_def ptBits_def pageBits_def + apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def is_arch_update'_def isCap_simps capAligned_def vmsz_aligned'_def - dest!: diminished_capMaster cong: conj_cong) + cong: conj_cong) apply (rule conjI) apply (erule is_aligned_addrFromPPtr_n, case_tac vmpage_size, simp_all)[1] @@ -1935,7 +1922,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: valid_arch_inv'_def valid_page_inv'_def) apply (thin_tac "Ball S P" for S P) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: is_arch_update'_def isCap_simps dest!: diminished_capMaster) + apply (clarsimp simp: is_arch_update'_def isCap_simps) apply (cases "ARM_HYP_H.isPageFlushLabel (invocation_type label)") apply (clarsimp simp: ARM_HYP_H.isPageFlushLabel_def split: invocation_label.splits arch_invocation_label.splits) apply (rule arch_decodeARMPageFlush_wf, @@ -1946,6 +1933,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: valid_arch_inv'_def valid_page_inv'_def) apply (simp add: ARM_HYP_H.isPageFlushLabel_def throwError_R' split: invocation_label.split_asm arch_invocation_label.split_asm) + \ \PageTableCap\ apply (simp add: decodeARMMMUInvocation_def ARM_HYP_H.decodeInvocation_def Let_def split_def isCap_simps vs_entry_align_def cong: if_cong list.case_cong invocation_label.case_cong arch_invocation_label.case_cong prod.case_cong @@ -1974,21 +1962,19 @@ lemma arch_decodeInvocation_wf[wp]: apply ((wp whenE_throwError_wp isFinalCapability_inv | wpc | simp add: valid_arch_inv'_def valid_pti'_def if_apply_def2 | rule hoare_drop_imp)+)[19] + apply (clarsimp simp: linorder_not_le isCap_simps cte_wp_at_ctes_of) + apply (frule eq_arch_update') + apply (case_tac option; clarsimp) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (clarsimp simp: is_arch_update'_def isCap_simps valid_cap'_def capAligned_def) - apply (clarsimp simp: linorder_not_le isCap_simps cte_wp_at_ctes_of diminished_arch_update') - apply (simp add: valid_cap'_def capAligned_def) - apply (rule conjI) - apply (clarsimp simp: is_arch_update'_def isCap_simps - dest!: diminished_capMaster) - apply (clarsimp simp: neq_Nil_conv vs_entry_align_def invs_valid_objs' - ptBits_def pageBits_def is_aligned_addrFromPPtr_n) apply (thin_tac "Ball S P" for S P)+ apply (drule ctes_of_valid', fastforce)+ - apply (clarsimp simp: diminished_valid' [symmetric]) apply (clarsimp simp: valid_cap'_def ptBits_def is_aligned_addrFromPPtr_n invs_valid_objs' vs_entry_align_def and_not_mask[symmetric] vspace_bits_defs) apply (erule order_le_less_trans[rotated]) apply (rule word_and_le2) + \ \PageDirectoryCap\ apply (simp add: decodeARMMMUInvocation_def ARM_HYP_H.decodeInvocation_def isCap_simps Let_def) supply hoare_True_E_R [simp del] @@ -1999,6 +1985,7 @@ lemma arch_decodeInvocation_wf[wp]: apply wp supply if_split [split del] + \ \VCPUCap\ apply (simp add: ARM_HYP_H.decodeInvocation_def decodeARMVCPUInvocation_def Let_def) apply (wpsimp wp: whenE_throwError_wp getVCPU_wp simp: decodeVCPUSetTCB_def decodeVCPUInjectIRQ_def Let_def @@ -2010,11 +1997,11 @@ lemma arch_decodeInvocation_wf[wp]: apply (frule_tac p=cref in ctes_of_valid', fastforce) apply (subgoal_tac "s \' ThreadCap tcb") prefer 2 - apply (drule diminished_valid')+ apply clarsimp + apply (drule_tac t="cteCap cte'" in sym, simp) apply (rule conjI) apply (clarsimp simp: valid_cap'_def) - apply (drule diminished_zobj_refs')+ + apply (drule_tac t="cteCap cte" in sym, simp) by fastforce crunch nosch[wp]: setMRs "\s. P (ksSchedulerAction s)" diff --git a/proof/refine/ARM_HYP/CSpace_I.thy b/proof/refine/ARM_HYP/CSpace_I.thy index 3ba36db6a1..ff4338b3c1 100644 --- a/proof/refine/ARM_HYP/CSpace_I.thy +++ b/proof/refine/ARM_HYP/CSpace_I.thy @@ -47,11 +47,6 @@ lemma maskCapRights_allRights [simp]: ARM_HYP_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma diminished_refl'[simp]: - "diminished' cap cap" - unfolding diminished'_def - by (rule exI[where x=allRights], simp) - lemma getCTE_inv [wp]: "\P\ getCTE addr \\rv. P\" by (simp add: getCTE_def) wp @@ -2070,9 +2065,5 @@ crunch idle[wp]: get_object "valid_idle" end -lemma diminished_capMaster: - "diminished' cap cap' \ capMasterCap cap' = capMasterCap cap" - by (clarsimp simp: diminished'_def) - end (* of theory *) diff --git a/proof/refine/ARM_HYP/CSpace_R.thy b/proof/refine/ARM_HYP/CSpace_R.thy index a407e4bfb8..d44491e43f 100644 --- a/proof/refine/ARM_HYP/CSpace_R.thy +++ b/proof/refine/ARM_HYP/CSpace_R.thy @@ -6118,22 +6118,6 @@ lemma updateCap_same_master: apply (clarsimp simp: cte_wp_at_ctes_of) done -lemma diminished_cte_refs': - "diminished' cap cap' \ cte_refs' cap n = cte_refs' cap' n" - by (clarsimp simp: diminished'_def) - -lemma diminished_Untyped' : - "diminished' (UntypedCap d r n x) cap = (cap = UntypedCap d r n x)" - apply (rule iffI) - apply (case_tac cap) - apply (clarsimp simp:isCap_simps maskCapRights_def diminished'_def split:if_split_asm)+ - (* 6 subgoals *) - apply (rename_tac arch_capability R) - apply (case_tac arch_capability) - apply (clarsimp simp: isCap_simps ARM_HYP_H.maskCapRights_def maskCapRights_def - diminished'_def Let_def)+ -done - lemma updateCapFreeIndex_valid_mdb_ctes: assumes preserve:"\m m'. mdb_inv_preserve m m' \ mdb_inv_preserve (Q m) (Q m')" and coin :"\m cte. \m src = Some cte\ \ (\cte'. (Q m) src = Some cte' \ cteCap cte = cteCap cte')" diff --git a/proof/refine/ARM_HYP/LevityCatch.thy b/proof/refine/ARM_HYP/LevityCatch.thy index 910ce34537..37b5cdf43a 100644 --- a/proof/refine/ARM_HYP/LevityCatch.thy +++ b/proof/refine/ARM_HYP/LevityCatch.thy @@ -29,8 +29,6 @@ lemmas makeObject_simps = makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte makeObject_asidpool makeObject_vcpu end -definition - "diminished' cap cap' \ \R. cap = maskCapRights R cap'" lemma projectKO_inv : "\P\ projectKO ko \\rv. P\" by (simp add: projectKO_def fail_def valid_def return_def diff --git a/proof/refine/ARM_HYP/Syscall_R.thy b/proof/refine/ARM_HYP/Syscall_R.thy index 44db4bcf1d..1bcaff3aeb 100644 --- a/proof/refine/ARM_HYP/Syscall_R.thy +++ b/proof/refine/ARM_HYP/Syscall_R.thy @@ -170,7 +170,7 @@ lemma decode_invocation_corres: \ corres (ser \ inv_relation) (invs and valid_sched and valid_list - and valid_cap cap and cte_at slot and cte_wp_at (diminished cap) slot + and valid_cap cap and cte_at slot and cte_wp_at ((=) cap) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s) and (\s. length args < 2 ^ word_bits)) (invs' and valid_cap' cap' and cte_at' slot' @@ -187,7 +187,7 @@ lemma decode_invocation_corres: \ \Untyped\ apply (simp add: isCap_defs Let_def o_def split del: if_split) apply (rule corres_guard_imp, rule dec_untyped_inv_corres) - apply ((clarsimp simp:cte_wp_at_caps_of_state diminished_def)+)[3] + apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3] \ \(Async)Endpoint\ apply (simp add: isCap_defs returnOk_def) apply (simp add: isCap_defs) @@ -233,8 +233,6 @@ lemma decode_invocation_corres: apply (clarsimp simp add: isCap_defs Let_def o_def) apply (rule corres_guard_imp [OF dec_arch_inv_corres]) apply (simp_all add: list_all2_map2 list_all2_map1)+ - apply (clarsimp simp: is_arch_diminished_def cte_wp_at_caps_of_state - is_cap_simps) done declare mapME_Nil [simp] @@ -614,22 +612,6 @@ lemma decode_inv_inv'[wp]: clarsimp split: capability.split_asm simp: isCap_defs)+ done -lemma diminished_IRQHandler' [simp]: - "diminished' (IRQHandlerCap h) cap = (cap = IRQHandlerCap h)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - -lemma diminished_IRQControlCap' [simp]: - "diminished' IRQControlCap cap = (cap = IRQControlCap)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - (* FIXME: move to TCB *) lemma dec_dom_inv_wf[wp]: "\invs' and (\s. \x \ set excaps. s \' fst x)\ @@ -648,22 +630,14 @@ lemma dec_dom_inv_wf[wp]: apply (simp add:numDomains_def maxDomain_def) done -lemma diminished_ReplyCap': - "diminished' (capability.ReplyCap t False r) cap - \ \gr. cap = capability.ReplyCap t False gr" - apply (clarsimp simp: diminished'_def maskCapRights_def Let_def split del: if_split) - apply (cases cap, simp_all add: isCap_simps)[1] - apply (simp add: ARM_HYP_H.maskCapRights_def isPageCap_def split: arch_capability.splits) - done - lemma decode_inv_wf'[wp]: "\valid_cap' cap and invs' and sch_act_simple - and cte_wp_at' (diminished' cap \ cteCap) slot and real_cte_at' slot + and cte_wp_at' ((=) cap \ cteCap) slot and real_cte_at' slot and (\s. \r\zobj_refs' cap. ex_nonz_cap_to' r s) and (\s. \r\cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\zobj_refs' (fst cap). ex_nonz_cap_to' r s) - and (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and (\s. \x \ set excaps. s \' fst x) and (\s. \x \ set excaps. real_cte_at' (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to' isCNodeCap (snd x) s) @@ -675,9 +649,9 @@ lemma decode_inv_wf'[wp]: split del: if_split cong: if_cong) apply ((rule hoare_pre, - ((wp decodeTCBInv_wf | simp add: o_def)+)[1], - clarsimp simp: valid_cap'_def cte_wp_at_ctes_of diminished_ReplyCap' - | (rule exI, rule exI, erule (1) conjI))+) + ((wpsimp wp: decodeTCBInv_wf simp: o_def)+)[1], + clarsimp simp: valid_cap'_def cte_wp_at_ctes_of) + | intro exI conjI | simp)+ done lemma ct_active_imp_simple'[elim!]: @@ -1116,29 +1090,20 @@ lemma lec_ex_nonz_cap_to' [wp]: done (* FIXME: move *) -lemma getSlotCap_diminished' [wp]: +lemma getSlotCap_eq [wp]: "\\\ getSlotCap slot - \\cap. cte_wp_at' (diminished' cap \ cteCap) slot\" - apply (simp add: getSlotCap_def) - apply (wp getCTE_wp') - apply (clarsimp simp: cte_wp_at_ctes_of) - done + \\cap. cte_wp_at' ((=) cap \ cteCap) slot\" + by (wpsimp wp: getCTE_wp' simp: getSlotCap_def cte_wp_at_ctes_of) -lemma lcs_diminished' [wp]: - "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' (diminished' (fst rv) o cteCap) (snd rv)\,-" - unfolding lookupCapAndSlot_def - apply (rule hoare_pre) - apply (wp | simp add: split_def)+ - done +lemma lcs_eq [wp]: + "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' ((=) (fst rv) o cteCap) (snd rv)\,-" + by (wpsimp simp: lookupCapAndSlot_def) lemma lec_dimished'[wp]: "\\\ lookupExtraCaps t buffer info - \\rv s. (\x\set rv. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s)\,-" - apply (simp add: lookupExtraCaps_def split del: if_split) - apply (rule hoare_pre) - apply (wp mapME_set|simp)+ - done + \\rv s. (\x\set rv. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s)\,-" + by (wpsimp wp: mapME_set simp: lookupExtraCaps_def) lemma lookupExtras_real_ctes[wp]: "\valid_objs'\ lookupExtraCaps t xs info \\rv s. \x \ set rv. real_cte_at' (snd x) s\,-" @@ -1336,10 +1301,10 @@ lemma hinv_corres: apply (clarsimp) apply (wp setThreadState_nonqueued_state_update setThreadState_st_tcb setThreadState_rct)[1] - apply (wp lec_caps_to get_cap_diminished lsft_ex_cte_cap_to - | simp add: split_def liftE_bindE[symmetric] - ct_in_state'_def ball_conj_distrib - | rule hoare_vcg_E_elim)+ + apply (wp lec_caps_to lsft_ex_cte_cap_to + | simp add: split_def liftE_bindE[symmetric] + ct_in_state'_def ball_conj_distrib + | rule hoare_vcg_E_elim)+ apply (clarsimp simp: tcb_at_invs invs_valid_objs valid_tcb_state_def ct_in_state_def simple_from_active invs_mdb) diff --git a/proof/refine/ARM_HYP/Untyped_R.thy b/proof/refine/ARM_HYP/Untyped_R.thy index e18a08f05a..9acd3e8105 100644 --- a/proof/refine/ARM_HYP/Untyped_R.thy +++ b/proof/refine/ARM_HYP/Untyped_R.thy @@ -673,22 +673,18 @@ lemma ensureNoChildren_sp: declare isPDCap_PD [simp] -declare diminished_Untyped' [simp] - lemma dui_sp_helper': "\P\ if Q then returnOk root_cap else doE slot \ lookupTargetSlot root_cap cref dpth; liftE (getSlotCap slot) - odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' (diminished' rv o cteCap) slot s)) \ P s\, -" - apply (cases Q, simp_all add: lookupTargetSlot_def) + odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' ((=) rv o cteCap) slot s)) \ P s\, -" + apply (cases Q; simp add: lookupTargetSlot_def) apply (wp, simp) - apply (simp add: getSlotCap_def split_def) - apply wp + apply (wpsimp simp: getSlotCap_def split_def) apply (rule hoare_strengthen_post [OF getCTE_sp[where P=P]]) - apply (clarsimp simp: cte_wp_at_ctes_of diminished'_def) + apply (clarsimp simp: cte_wp_at_ctes_of) apply (elim allE, drule(1) mp) - apply (erule allE, subst(asm) maskCapRights_allRights) apply simp apply wpsimp apply simp @@ -810,7 +806,6 @@ lemma decodeUntyped_wf[wp]: apply (case_tac cte) apply clarsimp apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])+ - apply (drule diminished_valid') apply simp apply (clarsimp simp: toEnum_of_nat [OF less_Suc_unat_less_bound] ucast_id) apply (subgoal_tac "args ! 4 \ 2 ^ capCNodeBits nodeCap") @@ -880,7 +875,7 @@ lemma decodeUntyped_wf[wp]: apply (clarsimp simp:ex_cte_cap_wp_to'_def) apply (rule_tac x = nodeSlot in exI) apply (case_tac cte) - apply (clarsimp simp:cte_wp_at_ctes_of diminished_cte_refs'[symmetric] isCap_simps image_def) + apply (clarsimp simp:cte_wp_at_ctes_of isCap_simps image_def) apply (rule_tac x = x in bexI,simp) apply simp apply (erule order_trans) diff --git a/proof/refine/ARM_HYP/VSpace_R.thy b/proof/refine/ARM_HYP/VSpace_R.thy index 84eb843d94..97151d183e 100644 --- a/proof/refine/ARM_HYP/VSpace_R.thy +++ b/proof/refine/ARM_HYP/VSpace_R.thy @@ -2932,8 +2932,7 @@ proof - apply (rule updateCap_same_master) apply (clarsimp simp: is_page_cap_def update_map_data_def) apply (wp get_cap_wp getSlotCap_wp)+ - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def) - apply (drule (2) diminished_is_update')+ + apply (clarsimp simp: cte_wp_at_caps_of_state) apply (clarsimp simp: cap_rights_update_def acap_rights_update_def update_map_data_def is_cap_simps) apply auto[1] apply (auto simp: cte_wp_at_ctes_of)[1] @@ -2957,9 +2956,8 @@ proof - apply wp apply (simp add: cte_wp_at_ctes_of) apply wp - apply (clarsimp simp: valid_unmap_def cte_wp_at_caps_of_state is_arch_diminished_def is_cap_simps + apply (clarsimp simp: valid_unmap_def cte_wp_at_caps_of_state is_cap_simps split: cap.splits arch_cap.splits) - apply (drule (2) diminished_is_update')+ apply (clarsimp simp: cap_rights_update_def is_page_cap_def cap_master_cap_simps update_map_data_def acap_rights_update_def valid_cap_def mask_def) apply auto[1] @@ -3112,12 +3110,10 @@ lemma perform_page_table_corres: apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift mapM_x_wp' | simp split del: if_split)+ apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state - is_arch_diminished_def cap_master_cap_simps update_map_data_def is_cap_simps cap_rights_update_def acap_rights_update_def dest!: cap_master_cap_eqDs) - apply (frule (2) diminished_is_update') 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] @@ -5080,18 +5076,6 @@ lemma isPDCap_PD : by (simp add: isPDCap_def) -lemma diminished_valid': - "diminished' cap cap' \ valid_cap' cap = valid_cap' cap'" - apply (clarsimp simp add: diminished'_def) - apply (rule ext) - apply (simp add: maskCapRights_def Let_def split del: if_split) - apply (cases cap'; simp add: isCap_simps valid_cap'_def capAligned_def split del: if_split) - by (simp add: ARM_HYP_H.maskCapRights_def isPageCap_def Let_def split del: if_split split: arch_capability.splits) - -lemma diminished_isPDCap: - "diminished' cap cap' \ isPDCap cap' = isPDCap cap" - by (blast dest: diminished_capMaster capMaster_isPDCap) - end end diff --git a/proof/refine/RISCV64/Arch_R.thy b/proof/refine/RISCV64/Arch_R.thy index 945a635014..32f52029cb 100644 --- a/proof/refine/RISCV64/Arch_R.thy +++ b/proof/refine/RISCV64/Arch_R.thy @@ -517,7 +517,7 @@ lemma decode_page_inv_corres: list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap cap') and (\s. \x\set excaps'. valid_cap' (fst x) s \ cte_wp_at' (\_. True) (snd x) s)) @@ -587,7 +587,7 @@ lemma decode_page_inv_corres: apply (wpsimp simp: if_apply_def2 wp: validE_validE_R[OF find_vspace_for_asid_wp, simplified])+ apply (clarsimp simp: invs_psp_aligned invs_distinct invs_vspace_objs invs_valid_asid_table - cte_wp_at_caps_of_state is_arch_diminished_def is_cap_simps) + cte_wp_at_caps_of_state is_cap_simps) apply (rule conjI; clarsimp?) apply (clarsimp simp: valid_cap_def wellformed_mapdata_def) apply (rule conjI) @@ -651,7 +651,7 @@ lemma decode_page_table_inv_corres: list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap cap') and (\s. \x\set excaps'. valid_cap' (fst x) s \ cte_wp_at' (\_. True) (snd x) s)) @@ -743,11 +743,10 @@ lemma decode_page_table_inv_corres: apply (clarsimp) apply (rule no_fail_pre, rule no_fail_getCTE) apply (erule conjunct2) - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def invs_vspace_objs + apply (clarsimp simp: cte_wp_at_caps_of_state invs_vspace_objs invs_valid_asid_table invs_psp_aligned invs_distinct) apply (clarsimp simp: valid_cap_def wellformed_mapdata_def) - apply (clarsimp simp: cte_wp_at_ctes_of is_arch_diminished_def - cap_rights_update_def acap_rights_update_def + apply (clarsimp simp: cte_wp_at_ctes_of cap_rights_update_def acap_rights_update_def cte_wp_at_caps_of_state) apply (drule pspace_relation_ctes_ofI[OF _ caps_of_state_cteD, rotated], erule invs_pspace_aligned', clarsimp+) @@ -767,7 +766,7 @@ shows corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap arch_cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap arch_cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap arch_cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap arch_cap') and (\s. \x\set excaps'. s \' fst x \ cte_at' (snd x) s)) @@ -1077,16 +1076,15 @@ lemma inv_ASIDPool: "inv ASIDPool = (\v. case v of ASIDPool a \ is_arch_update' (ArchObjectCap cp) cte" - by (clarsimp simp: is_arch_update'_def isCap_simps - diminished'_def) +lemma eq_arch_update': + "ArchObjectCap cp = cteCap cte \ is_arch_update' (ArchObjectCap cp) cte" + by (clarsimp simp: is_arch_update'_def isCap_simps) lemma decode_page_inv_wf[wp]: "cap = (arch_capability.FrameCap word vmrights vmpage_size d option) \ \invs' and valid_cap' (capability.ArchObjectCap cap ) and - cte_wp_at' (diminished' (capability.ArchObjectCap cap) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + cte_wp_at' ((=) (capability.ArchObjectCap cap) \ cteCap) slot and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple\ decodeRISCVFrameInvocation label args slot cap excaps \valid_arch_inv'\, -" @@ -1098,19 +1096,11 @@ lemma decode_page_inv_wf[wp]: | wp (once) hoare_drop_imps)+ apply ((rule conjI; clarsimp)+; (clarsimp simp: cte_wp_at_ctes_of, + (drule_tac t="cteCap _" in sym)+, (drule ctes_of_valid', fastforce)+, - clarsimp simp: diminished_valid' [symmetric] valid_cap'_def ptBits_def pageBits_def + clarsimp simp: valid_cap'_def ptBits_def pageBits_def is_arch_update'_def isCap_simps capAligned_def wellformed_mapdata'_def - vmsz_aligned_user_region not_le - dest!: diminished_capMaster)) - done - -lemma diminished'_PT: - "(diminished' (ArchObjectCap (PageTableCap r m)) cap) = - (cap = ArchObjectCap (PageTableCap r m))" - apply (cases cap; clarsimp simp: diminished'_def maskCapRights_def isCap_simps) - apply (rename_tac acap, case_tac acap; simp add: RISCV64_H.maskCapRights_def isCap_simps) - apply auto + vmsz_aligned_user_region not_le)) done lemma below_pptrUserTop_in_user_region: @@ -1122,23 +1112,25 @@ lemma below_pptrUserTop_in_user_region: lemma decode_page_table_inv_wf[wp]: "arch_cap = PageTableCap word option \ \invs' and valid_cap' (capability.ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (capability.ArchObjectCap arch_cap) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + cte_wp_at' ((=) (capability.ArchObjectCap arch_cap) \ cteCap) slot and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple\ decodeRISCVPageTableInvocation label args slot arch_cap excaps \valid_arch_inv'\, - " - supply if_cong[cong] if_split [split del] diminished'_PT[simp] + supply if_cong[cong] if_split [split del] apply (clarsimp simp: decodeRISCVPageTableInvocation_def Let_def isCap_simps) apply (wpsimp simp: decodeRISCVPageTableInvocationMap_def valid_arch_inv'_def valid_pti'_def maybeVSpaceForASID_def o_def if_apply_def2 wp: getPTE_wp hoare_vcg_all_lift hoare_vcg_const_imp_lift lookupPTSlot_inv isFinalCapability_inv | wp (once) hoare_drop_imps)+ - apply (clarsimp simp: not_le isCap_simps cte_wp_at_ctes_of diminished_arch_update') + apply (clarsimp simp: not_le isCap_simps cte_wp_at_ctes_of eq_arch_update') + apply (drule_tac t="cteCap cte" in sym) apply (simp add: valid_cap'_def capAligned_def) apply (clarsimp simp: is_arch_update'_def isCap_simps split: if_split) apply (rule conjI; clarsimp) + apply (drule_tac t="cteCap ctea" in sym) apply (drule ctes_of_valid', fastforce)+ apply (clarsimp simp: valid_cap'_def) apply (simp add: wellformed_mapdata'_def below_pptrUserTop_in_user_region neg_mask_user_region) @@ -1150,14 +1142,10 @@ lemma capMaster_isPageTableCap: by (simp add: capMasterCap_def isArchCap_def isPageTableCap_def split: capability.splits arch_capability.splits) -lemma diminished_isPageTableCap: - "diminished' cap cap' \ isArchCap isPageTableCap cap' = isArchCap isPageTableCap cap" - by (drule diminished_capMaster) (erule capMaster_isPageTableCap) - lemma arch_decodeInvocation_wf[wp]: shows "\invs' and valid_cap' (ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (ArchObjectCap arch_cap) o cteCap) slot and - (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) and + cte_wp_at' ((=) (ArchObjectCap arch_cap) o cteCap) slot and + (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and (\s. \x \ set excaps. \r \ cte_refs' (fst x) (irq_node' s). ex_cte_cap_to' r s) and (\s. \x \ set excaps. s \' fst x) and sch_act_simple\ @@ -1203,12 +1191,12 @@ lemma arch_decodeInvocation_wf[wp]: \ \ASIDPool cap\ apply (simp add: decodeRISCVMMUInvocation_def RISCV64_H.decodeInvocation_def Let_def split_def isCap_simps decodeRISCVASIDPoolInvocation_def - cong: if_cong split del: if_split) + cong: if_cong split del: if_split) apply (wpsimp simp: valid_arch_inv'_def valid_apinv'_def wp: getASID_wp cong: if_cong) apply (clarsimp simp: word_neq_0_conv valid_cap'_def valid_arch_inv'_def valid_apinv'_def) apply (rule conjI) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: diminished_isPageTableCap isCap_simps) + apply (simp, drule_tac t="cteCap c" in sym, simp add: isCap_simps) apply (subst (asm) conj_assoc [symmetric]) apply (subst (asm) assocs_empty_dom_comp [symmetric]) apply (drule dom_hd_assocsD) diff --git a/proof/refine/RISCV64/CSpace_I.thy b/proof/refine/RISCV64/CSpace_I.thy index 0bc8652e28..6264ee16f0 100644 --- a/proof/refine/RISCV64/CSpace_I.thy +++ b/proof/refine/RISCV64/CSpace_I.thy @@ -46,11 +46,6 @@ lemma maskCapRights_allRights [simp]: RISCV64_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma diminished_refl'[simp]: - "diminished' cap cap" - unfolding diminished'_def - by (rule exI[where x=allRights], simp) - lemma getCTE_inv [wp]: "\P\ getCTE addr \\rv. P\" by (simp add: getCTE_def) wp @@ -2036,9 +2031,4 @@ declare mresults_fail[simp] end -lemma diminished_capMaster: - "diminished' cap cap' \ capMasterCap cap' = capMasterCap cap" - by (clarsimp simp: diminished'_def) - - end (* of theory *) diff --git a/proof/refine/RISCV64/CSpace_R.thy b/proof/refine/RISCV64/CSpace_R.thy index 4292519423..c9767f9d49 100644 --- a/proof/refine/RISCV64/CSpace_R.thy +++ b/proof/refine/RISCV64/CSpace_R.thy @@ -6061,22 +6061,6 @@ lemma updateCap_same_master: apply (clarsimp simp: cte_wp_at_ctes_of) done -lemma diminished_cte_refs': - "diminished' cap cap' \ cte_refs' cap n = cte_refs' cap' n" - by (clarsimp simp: diminished'_def) - -lemma diminished_Untyped' : - "diminished' (UntypedCap d r n x) cap = (cap = UntypedCap d r n x)" - apply (rule iffI) - apply (case_tac cap) - apply (clarsimp simp:isCap_simps maskCapRights_def diminished'_def split:if_split_asm)+ - (* 6 subgoals *) - apply (rename_tac arch_capability R) - apply (case_tac arch_capability) - apply (clarsimp simp: isCap_simps RISCV64_H.maskCapRights_def maskCapRights_def - diminished'_def Let_def)+ -done - lemma updateCapFreeIndex_valid_mdb_ctes: assumes preserve:"\m m'. mdb_inv_preserve m m' \ mdb_inv_preserve (Q m) (Q m')" and coin :"\m cte. \m src = Some cte\ \ (\cte'. (Q m) src = Some cte' \ cteCap cte = cteCap cte')" diff --git a/proof/refine/RISCV64/LevityCatch.thy b/proof/refine/RISCV64/LevityCatch.thy index 2db293c362..befdbbd2f8 100644 --- a/proof/refine/RISCV64/LevityCatch.thy +++ b/proof/refine/RISCV64/LevityCatch.thy @@ -18,9 +18,6 @@ begin no_notation bind_drop (infixl ">>" 60) -definition diminished' :: "capability \ capability \ bool" where - "diminished' cap cap' \ \R. cap = maskCapRights R cap'" - lemma magnitudeCheck_assert: "magnitudeCheck x y n = assert (case y of None \ True | Some z \ 1 << n \ z - x)" by (fastforce simp: magnitudeCheck_def assert_def when_def diff --git a/proof/refine/RISCV64/Syscall_R.thy b/proof/refine/RISCV64/Syscall_R.thy index be1f4a058e..3fe8dc430e 100644 --- a/proof/refine/RISCV64/Syscall_R.thy +++ b/proof/refine/RISCV64/Syscall_R.thy @@ -170,7 +170,7 @@ lemma decode_invocation_corres: \ corres (ser \ inv_relation) (invs and valid_sched and valid_list - and valid_cap cap and cte_at slot and cte_wp_at (diminished cap) slot + and valid_cap cap and cte_at slot and cte_wp_at ((=) cap) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s) and (\s. length args < 2 ^ word_bits)) (invs' and valid_cap' cap' and cte_at' slot' @@ -186,7 +186,7 @@ lemma decode_invocation_corres: \ \Untyped\ apply (simp add: isCap_defs Let_def o_def split del: if_split) apply (rule corres_guard_imp, rule dec_untyped_inv_corres) - apply ((clarsimp simp:cte_wp_at_caps_of_state diminished_def)+)[3] + apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3] \ \(Async)Endpoint\ apply (simp add: isCap_defs returnOk_def) apply (simp add: isCap_defs) @@ -232,8 +232,6 @@ lemma decode_invocation_corres: apply (clarsimp simp add: isCap_defs Let_def o_def) apply (rule corres_guard_imp [OF dec_arch_inv_corres]) apply (simp_all add: list_all2_map2 list_all2_map1)+ - apply (clarsimp simp: is_arch_diminished_def cte_wp_at_caps_of_state - is_cap_simps) done declare mapME_Nil [simp] @@ -609,22 +607,6 @@ lemma arch_cap_exhausted: crunch inv[wp]: decodeInvocation P (simp: crunch_simps wp: crunch_wps arch_cap_exhausted mapME_x_inv_wp getASID_wp ignore: getObject) -lemma diminished_IRQHandler' [simp]: - "diminished' (IRQHandlerCap h) cap = (cap = IRQHandlerCap h)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - -lemma diminished_IRQControlCap' [simp]: - "diminished' IRQControlCap cap = (cap = IRQControlCap)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - (* FIXME: move to TCB *) lemma dec_dom_inv_wf[wp]: "\invs' and (\s. \x \ set excaps. s \' fst x)\ @@ -643,22 +625,14 @@ lemma dec_dom_inv_wf[wp]: apply (simp add:numDomains_def maxDomain_def) done -lemma diminished_ReplyCap': - "diminished' (capability.ReplyCap t False r) cap - \ \gr. cap = capability.ReplyCap t False gr" - apply (clarsimp simp: diminished'_def maskCapRights_def Let_def split del: if_split) - apply (cases cap, simp_all add: isCap_simps)[1] - apply (simp add: RISCV64_H.maskCapRights_def isFrameCap_def split: arch_capability.splits) - done - lemma decode_inv_wf'[wp]: "\valid_cap' cap and invs' and sch_act_simple - and cte_wp_at' (diminished' cap \ cteCap) slot and real_cte_at' slot + and cte_wp_at' ((=) cap \ cteCap) slot and real_cte_at' slot and (\s. \r\zobj_refs' cap. ex_nonz_cap_to' r s) and (\s. \r\cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\zobj_refs' (fst cap). ex_nonz_cap_to' r s) - and (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and (\s. \x \ set excaps. s \' fst x) and (\s. \x \ set excaps. real_cte_at' (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to' isCNodeCap (snd x) s) @@ -668,10 +642,11 @@ lemma decode_inv_wf'[wp]: apply (case_tac cap, simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def split del: if_split cong: if_cong) - apply ((rule hoare_pre, + apply (rule hoare_pre, ((wp decodeTCBInv_wf | simp add: o_def)+)[1], - clarsimp simp: valid_cap'_def cte_wp_at_ctes_of diminished_ReplyCap' - | (rule exI, rule exI, erule (1) conjI))+) + clarsimp simp: valid_cap'_def cte_wp_at_ctes_of + | (rule exI, rule exI, erule (1) conjI) + | drule_tac t="cteCap cte" in sym, simp)+ done lemma ct_active_imp_simple'[elim!]: @@ -1102,29 +1077,20 @@ lemma lec_ex_nonz_cap_to' [wp]: done (* FIXME: move *) -lemma getSlotCap_diminished' [wp]: +lemma getSlotCap_eq [wp]: "\\\ getSlotCap slot - \\cap. cte_wp_at' (diminished' cap \ cteCap) slot\" - apply (simp add: getSlotCap_def) - apply (wp getCTE_wp') - apply (clarsimp simp: cte_wp_at_ctes_of) - done + \\cap. cte_wp_at' ((=) cap \ cteCap) slot\" + by (wpsimp wp: getCTE_wp' simp: getSlotCap_def cte_wp_at_ctes_of) -lemma lcs_diminished' [wp]: - "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' (diminished' (fst rv) o cteCap) (snd rv)\,-" - unfolding lookupCapAndSlot_def - apply (rule hoare_pre) - apply (wp | simp add: split_def)+ - done +lemma lcs_eq [wp]: + "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' ((=) (fst rv) o cteCap) (snd rv)\,-" + by (wpsimp simp: lookupCapAndSlot_def) -lemma lec_dimished'[wp]: +lemma lec_eq[wp]: "\\\ lookupExtraCaps t buffer info - \\rv s. (\x\set rv. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s)\,-" - apply (simp add: lookupExtraCaps_def split del: if_split) - apply (rule hoare_pre) - apply (wp mapME_set|simp)+ - done + \\rv s. (\x\set rv. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s)\,-" + by (wpsimp wp: mapME_set simp: lookupExtraCaps_def) lemma lookupExtras_real_ctes[wp]: "\valid_objs'\ lookupExtraCaps t xs info \\rv s. \x \ set rv. real_cte_at' (snd x) s\,-" @@ -1287,10 +1253,10 @@ lemma hinv_corres: apply (clarsimp) apply (wp setThreadState_nonqueued_state_update setThreadState_st_tcb setThreadState_rct)[1] - apply (wp lec_caps_to get_cap_diminished lsft_ex_cte_cap_to - | simp add: split_def liftE_bindE[symmetric] - ct_in_state'_def ball_conj_distrib - | rule hoare_vcg_E_elim)+ + apply (wp lec_caps_to lsft_ex_cte_cap_to + | simp add: split_def liftE_bindE[symmetric] + ct_in_state'_def ball_conj_distrib + | rule hoare_vcg_E_elim)+ apply (clarsimp simp: tcb_at_invs invs_valid_objs valid_tcb_state_def ct_in_state_def simple_from_active invs_mdb diff --git a/proof/refine/RISCV64/Untyped_R.thy b/proof/refine/RISCV64/Untyped_R.thy index 770b0d5a53..0a8117e91b 100644 --- a/proof/refine/RISCV64/Untyped_R.thy +++ b/proof/refine/RISCV64/Untyped_R.thy @@ -641,22 +641,19 @@ lemma ensureNoChildren_sp: "\P\ ensureNoChildren sl \\rv s. P s \ descendants_of' sl (ctes_of s) = {}\,-" by (wp ensureNoChildren_wp, simp) -declare diminished_Untyped' [simp] - lemma dui_sp_helper': "\P\ if Q then returnOk root_cap else doE slot \ lookupTargetSlot root_cap cref dpth; liftE (getSlotCap slot) - odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' (diminished' rv o cteCap) slot s)) \ P s\, -" + odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' ((=) rv o cteCap) slot s)) \ P s\, -" apply (cases Q, simp_all add: lookupTargetSlot_def) apply (wp, simp) apply (simp add: getSlotCap_def split_def) apply wp apply (rule hoare_strengthen_post [OF getCTE_sp[where P=P]]) - apply (clarsimp simp: cte_wp_at_ctes_of diminished'_def) + apply (clarsimp simp: cte_wp_at_ctes_of) apply (elim allE, drule(1) mp) - apply (erule allE, subst(asm) maskCapRights_allRights) apply simp apply wpsimp apply simp @@ -778,7 +775,6 @@ lemma decodeUntyped_wf[wp]: apply (case_tac cte) apply clarsimp apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])+ - apply (drule diminished_valid') apply simp apply (clarsimp simp: toEnum_of_nat [OF less_Suc_unat_less_bound] ucast_id) apply (subgoal_tac "args ! 4 \ 2 ^ capCNodeBits nodeCap") @@ -848,7 +844,7 @@ lemma decodeUntyped_wf[wp]: apply (clarsimp simp:ex_cte_cap_wp_to'_def) apply (rule_tac x = nodeSlot in exI) apply (case_tac cte) - apply (clarsimp simp: cte_wp_at_ctes_of diminished_cte_refs'[symmetric] isCap_simps image_def + apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps image_def shiftl_t2n) apply (rule_tac x = x in bexI,simp) apply (simp add: mask_def) diff --git a/proof/refine/RISCV64/VSpace_R.thy b/proof/refine/RISCV64/VSpace_R.thy index 2bdd499c90..6344902329 100644 --- a/proof/refine/RISCV64/VSpace_R.thy +++ b/proof/refine/RISCV64/VSpace_R.thy @@ -633,7 +633,7 @@ lemma perform_page_corres: apply (rule unmap_page_corres; simp) apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift')+ apply (clarsimp simp: invs_valid_objs invs_psp_aligned invs_distinct) - apply (clarsimp simp: cte_wp_at_caps_of_state wellformed_pte_def is_arch_diminished_def + apply (clarsimp simp: cte_wp_at_caps_of_state wellformed_pte_def cap_master_cap_simps is_cap_simps update_map_data_def mdata_map_def wellformed_mapdata_def valid_arch_cap_def) apply (clarsimp simp: valid_page_inv'_def cte_wp_at_ctes_of) @@ -758,7 +758,7 @@ lemma perform_page_table_corres: apply (wpsimp wp: mapM_x_wp' hoare_vcg_all_lift hoare_vcg_imp_lift' simp: wellformed_pte_def)+ apply (clarsimp simp: valid_pti_def valid_arch_cap_def cte_wp_at_caps_of_state - invs_valid_objs invs_psp_aligned invs_distinct is_arch_diminished_def + invs_valid_objs invs_psp_aligned invs_distinct cap_master_cap_simps is_cap_simps update_map_data_def wellformed_mapdata_def) apply (clarsimp simp: valid_pti'_def cte_wp_at_ctes_of) @@ -1373,10 +1373,6 @@ lemma perform_aci_invs [wp]: wellformed_mapdata'_def) done -lemma diminished_valid': - "diminished' cap cap' \ valid_cap' cap = valid_cap' cap'" - by (rule ext) (clarsimp simp add: diminished'_def) - end lemma cteCaps_of_ctes_of_lift: diff --git a/proof/refine/X64/Arch_R.thy b/proof/refine/X64/Arch_R.thy index f9e2aca609..0dd9669c06 100644 --- a/proof/refine/X64/Arch_R.thy +++ b/proof/refine/X64/Arch_R.thy @@ -574,7 +574,7 @@ lemma decode_page_inv_corres: list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap cap') and (\s. \x\set excaps'. valid_cap' (fst x) s \ cte_wp_at' (\_. True) (snd x) s)) @@ -668,7 +668,7 @@ lemma decode_page_table_inv_corres: list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap cap') and (\s. \x\set excaps'. valid_cap' (fst x) s \ cte_wp_at' (\_. True) (snd x) s)) @@ -747,17 +747,10 @@ lemma decode_page_table_inv_corres: apply (clarsimp) apply (rule no_fail_pre, rule no_fail_getCTE) apply (erule conjunct2) - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def - cap_rights_update_def acap_rights_update_def) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) + apply (clarsimp simp: cte_wp_at_caps_of_state cap_rights_update_def acap_rights_update_def) apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) - apply (clarsimp simp: cte_wp_at_ctes_of is_arch_diminished_def - cap_rights_update_def acap_rights_update_def + apply (clarsimp simp: cte_wp_at_ctes_of cap_rights_update_def acap_rights_update_def cte_wp_at_caps_of_state) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (drule pspace_relation_ctes_ofI[OF _ caps_of_state_cteD, rotated], erule invs_pspace_aligned', clarsimp+) apply (simp add: isCap_simps) @@ -770,7 +763,7 @@ lemma decode_page_directory_inv_corres: list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap cap') and (\s. \x\set excaps'. valid_cap' (fst x) s \ cte_wp_at' (\_. True) (snd x) s)) @@ -849,17 +842,10 @@ lemma decode_page_directory_inv_corres: apply (clarsimp) apply (rule no_fail_pre, rule no_fail_getCTE) apply (erule conjunct2) - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def - cap_rights_update_def acap_rights_update_def) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) + apply (clarsimp simp: cte_wp_at_caps_of_state cap_rights_update_def acap_rights_update_def) apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) - apply (clarsimp simp: cte_wp_at_ctes_of is_arch_diminished_def - cap_rights_update_def acap_rights_update_def + apply (clarsimp simp: cte_wp_at_ctes_of cap_rights_update_def acap_rights_update_def cte_wp_at_caps_of_state) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (drule pspace_relation_ctes_ofI[OF _ caps_of_state_cteD, rotated], erule invs_pspace_aligned', clarsimp+) apply (simp add: isCap_simps) @@ -872,7 +858,7 @@ lemma decode_pdpt_inv_corres: list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_wp_at (\_. True) (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap cap') and (\s. \x\set excaps'. valid_cap' (fst x) s \ cte_wp_at' (\_. True) (snd x) s)) @@ -939,17 +925,9 @@ lemma decode_pdpt_inv_corres: apply (clarsimp) apply (rule no_fail_pre, rule no_fail_getCTE) apply (erule conjunct2) - apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_diminished_def - cap_rights_update_def acap_rights_update_def) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) - apply (clarsimp simp: cte_wp_at_ctes_of is_arch_diminished_def - cap_rights_update_def acap_rights_update_def + apply (clarsimp simp: cte_wp_at_caps_of_state cap_rights_update_def acap_rights_update_def) + apply (clarsimp simp: cte_wp_at_ctes_of cap_rights_update_def acap_rights_update_def cte_wp_at_caps_of_state) - apply (frule diminished_is_update[rotated]) - apply (frule (2) caps_of_state_valid) - apply (clarsimp simp add: cap_rights_update_def acap_rights_update_def) apply (drule pspace_relation_ctes_ofI[OF _ caps_of_state_cteD, rotated], erule invs_pspace_aligned', clarsimp+) apply (simp add: isCap_simps) @@ -1142,7 +1120,7 @@ shows corres (ser \ archinv_relation) (invs and valid_cap (cap.ArchObjectCap arch_cap) and - cte_wp_at (is_arch_diminished (cap.ArchObjectCap arch_cap)) slot and + cte_wp_at ((=) (cap.ArchObjectCap arch_cap)) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s)) (invs' and valid_cap' (capability.ArchObjectCap arch_cap') and (\s. \x\set excaps'. s \' fst x \ cte_at' (snd x) s)) @@ -1655,10 +1633,9 @@ lemma inv_ASIDPool: "inv ASIDPool = (\v. case v of ASIDPool a \ is_arch_update' (ArchObjectCap cp) cte" - by (clarsimp simp: is_arch_update'_def isCap_simps - diminished'_def) +lemma eq_arch_update': + "ArchObjectCap cp = cteCap cte \ is_arch_update' (ArchObjectCap cp) cte" + by (clarsimp simp: is_arch_update'_def isCap_simps) lemma lookup_pdpt_slot_no_fail_corres[simp]: "lookupPDPTSlotFromPDPT pt vptr @@ -1681,8 +1658,8 @@ lemma lookup_pt_slot_no_fail_corres[simp]: lemma decode_page_inv_wf[wp]: "cap = (arch_capability.PageCap word vmrights mt vmpage_size d option) \ \invs' and valid_cap' (capability.ArchObjectCap cap ) and - cte_wp_at' (diminished' (capability.ArchObjectCap cap) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + cte_wp_at' ((=) (capability.ArchObjectCap cap) \ cteCap) slot and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple\ decodeX64FrameInvocation label args slot cap excaps \valid_arch_inv'\, -" @@ -1697,11 +1674,9 @@ lemma decode_page_inv_wf[wp]: apply (clarsimp simp: neq_Nil_conv invs_valid_objs' linorder_not_le cte_wp_at_ctes_of) apply (drule ctes_of_valid', fastforce)+ - apply (clarsimp simp: diminished_valid' [symmetric]) + apply (drule_tac t="cteCap cte" in sym) apply (clarsimp simp: valid_cap'_def ptBits_def pageBits_def) - apply (clarsimp simp: is_arch_update'_def isCap_simps capAligned_def - vmsz_aligned_def - dest!: diminished_capMaster) + apply (clarsimp simp: is_arch_update'_def isCap_simps capAligned_def vmsz_aligned_def) apply (rule conjI) apply (clarsimp simp: valid_cap_simps) apply (rule conjI) @@ -1719,7 +1694,7 @@ lemma decode_page_inv_wf[wp]: apply (clarsimp simp: valid_arch_inv'_def valid_page_inv'_def) apply (thin_tac "Ball S P" for S P) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: is_arch_update'_def isCap_simps dest!: diminished_capMaster) + apply (clarsimp simp: is_arch_update'_def isCap_simps) apply (cases "invocation_type label = ArchInvocationLabel X64PageGetAddress") apply (simp split del: if_split) apply (rule hoare_pre, wp) @@ -1730,28 +1705,24 @@ lemma decode_page_inv_wf[wp]: lemma decode_page_table_inv_wf[wp]: "arch_cap = PageTableCap word option \ \invs' and valid_cap' (capability.ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (capability.ArchObjectCap arch_cap) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + cte_wp_at' ((=) (capability.ArchObjectCap arch_cap) \ cteCap) slot and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple\ decodeX64PageTableInvocation label args slot arch_cap excaps \valid_arch_inv'\, - " apply (simp add: decodeX64PageTableInvocation_def Let_def isCap_simps split del: if_split cong: if_cong) apply (rule hoare_pre) apply ((wp whenE_throwError_wp isFinalCapability_inv getPDE_wp - | wpc - | simp add: valid_arch_inv'_def valid_pti'_def if_apply_def2 - | wp (once) hoare_drop_imps)+) - apply (clarsimp simp: linorder_not_le isCap_simps - cte_wp_at_ctes_of diminished_arch_update') - apply (simp add: valid_cap'_def capAligned_def) - apply (rule conjI) - apply (clarsimp simp: is_arch_update'_def isCap_simps - dest!: diminished_capMaster) - apply (clarsimp simp: neq_Nil_conv invs_valid_objs' - ptBits_def pageBits_def is_aligned_addrFromPPtr_n) + | wpc + | simp add: valid_arch_inv'_def valid_pti'_def if_apply_def2 + | wp (once) hoare_drop_imps)+) + apply (clarsimp simp: linorder_not_le isCap_simps cte_wp_at_ctes_of) + apply (frule eq_arch_update') + apply (case_tac option; clarsimp) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (clarsimp simp: is_arch_update'_def isCap_simps valid_cap'_def capAligned_def) apply (thin_tac "Ball S P" for S P)+ apply (drule ctes_of_valid', fastforce)+ - apply (clarsimp simp: diminished_valid' [symmetric]) apply (clarsimp simp: valid_cap'_def bit_simps is_aligned_addrFromPPtr_n invs_valid_objs' and_not_mask[symmetric]) apply (clarsimp simp: mask_def X64.pptrBase_def X64.pptrUserTop_def user_vtop_def) @@ -1762,28 +1733,24 @@ lemma decode_page_table_inv_wf[wp]: lemma decode_page_directory_inv_wf[wp]: "arch_cap = PageDirectoryCap word option \ \invs' and valid_cap' (capability.ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (capability.ArchObjectCap arch_cap) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + cte_wp_at' ((=) (capability.ArchObjectCap arch_cap) \ cteCap) slot and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple\ decodeX64PageDirectoryInvocation label args slot arch_cap excaps \valid_arch_inv'\, - " apply (simp add: decodeX64PageDirectoryInvocation_def Let_def isCap_simps split del: if_split cong: if_cong) apply (rule hoare_pre) apply ((wp whenE_throwError_wp isFinalCapability_inv getPDPTE_wp - | wpc - | simp add: valid_arch_inv'_def valid_pdi'_def if_apply_def2 - | wp (once) hoare_drop_imps)+) - apply (clarsimp simp: linorder_not_le isCap_simps - cte_wp_at_ctes_of diminished_arch_update') - apply (simp add: valid_cap'_def capAligned_def) - apply (rule conjI) - apply (clarsimp simp: is_arch_update'_def isCap_simps - dest!: diminished_capMaster) - apply (clarsimp simp: neq_Nil_conv invs_valid_objs' - pdBits_def pageBits_def is_aligned_addrFromPPtr_n) + | wpc + | simp add: valid_arch_inv'_def valid_pdi'_def if_apply_def2 + | wp (once) hoare_drop_imps)+) + apply (clarsimp simp: linorder_not_le isCap_simps cte_wp_at_ctes_of) + apply (frule eq_arch_update') + apply (case_tac option; clarsimp) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (clarsimp simp: is_arch_update'_def isCap_simps valid_cap'_def capAligned_def) apply (thin_tac "Ball S P" for S P)+ apply (drule ctes_of_valid', fastforce)+ - apply (clarsimp simp: diminished_valid' [symmetric]) apply (clarsimp simp: valid_cap'_def bit_simps is_aligned_addrFromPPtr_n invs_valid_objs' and_not_mask[symmetric]) apply (clarsimp simp: mask_def X64.pptrBase_def X64.pptrUserTop_def user_vtop_def) @@ -1794,28 +1761,24 @@ lemma decode_page_directory_inv_wf[wp]: lemma decode_pdpt_inv_wf[wp]: "arch_cap = PDPointerTableCap word option \ \invs' and valid_cap' (capability.ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (capability.ArchObjectCap arch_cap) \ cteCap) slot and - (\s. \x\set excaps. cte_wp_at' (diminished' (fst x) \ cteCap) (snd x) s) and + cte_wp_at' ((=) (capability.ArchObjectCap arch_cap) \ cteCap) slot and + (\s. \x\set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and sch_act_simple\ decodeX64PDPointerTableInvocation label args slot arch_cap excaps \valid_arch_inv'\, - " apply (simp add: decodeX64PDPointerTableInvocation_def Let_def isCap_simps split del: if_split cong: if_cong) apply (rule hoare_pre) apply ((wp whenE_throwError_wp isFinalCapability_inv getPML4E_wp - | wpc - | simp add: valid_arch_inv'_def valid_pdpti'_def if_apply_def2 - | wp (once) hoare_drop_imps)+) - apply (clarsimp simp: linorder_not_le isCap_simps - cte_wp_at_ctes_of diminished_arch_update') - apply (simp add: valid_cap'_def capAligned_def) - apply (rule conjI) - apply (clarsimp simp: is_arch_update'_def isCap_simps - dest!: diminished_capMaster) - apply (clarsimp simp: neq_Nil_conv invs_valid_objs' - pdBits_def pageBits_def is_aligned_addrFromPPtr_n) + | wpc + | simp add: valid_arch_inv'_def valid_pdpti'_def if_apply_def2 + | wp (once) hoare_drop_imps)+) + apply (clarsimp simp: linorder_not_le isCap_simps cte_wp_at_ctes_of) + apply (frule eq_arch_update') + apply (case_tac option; clarsimp) + apply (drule_tac t="cteCap ctea" in sym, simp) + apply (clarsimp simp: is_arch_update'_def isCap_simps valid_cap'_def capAligned_def) apply (thin_tac "Ball S P" for S P)+ apply (drule ctes_of_valid', fastforce)+ - apply (clarsimp simp: diminished_valid' [symmetric]) apply (clarsimp simp: valid_cap'_def bit_simps is_aligned_addrFromPPtr_n invs_valid_objs' and_not_mask[symmetric]) apply (clarsimp simp: mask_def X64.pptrBase_def X64.pptrUserTop_def user_vtop_def) @@ -1851,23 +1814,12 @@ lemma decode_port_control_inv_wf: | wp (once) hoare_drop_imps)+ by (auto simp: invs_valid_objs') -lemma diminished_IOPortControl': - "(diminished' (ArchObjectCap IOPortControlCap) cap') = (cap' = ArchObjectCap IOPortControlCap)" - apply (rule iffI) - apply (case_tac cap') - apply (clarsimp simp:isCap_simps maskCapRights_def diminished'_def split:if_split_asm)+ - (* 6 subgoals *) - apply (rename_tac arch_capability R) - apply (case_tac arch_capability) - by ((assumption | clarsimp simp: isCap_simps X64_H.maskCapRights_def maskCapRights_def - diminished'_def Let_def)+) - lemma arch_decodeInvocation_wf[wp]: notes ensureSafeMapping_inv[wp del] shows "\invs' and valid_cap' (ArchObjectCap arch_cap) and - cte_wp_at' (diminished' (ArchObjectCap arch_cap) o cteCap) slot and - (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) and + cte_wp_at' ((=) (ArchObjectCap arch_cap) o cteCap) slot and + (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and (\s. \x \ set excaps. \r \ cte_refs' (fst x) (irq_node' s). ex_cte_cap_to' r s) and (\s. \x \ set excaps. s \' fst x) and sch_act_simple\ @@ -1885,7 +1837,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (clarsimp simp: word_neq_0_conv valid_cap'_def valid_arch_inv'_def valid_apinv'_def) apply (rule conjI) apply (erule cte_wp_at_weakenE') - apply (clarsimp simp: diminished_isPML4Cap') + apply (simp, drule_tac t="cteCap c" in sym, simp) apply (subst (asm) conj_assoc [symmetric]) apply (subst (asm) assocs_empty_dom_comp [symmetric]) apply (drule dom_hd_assocsD) @@ -1942,7 +1894,7 @@ lemma arch_decodeInvocation_wf[wp]: cong: if_cong split del: if_split) apply (wp decode_port_control_inv_wf, simp) - apply (clarsimp simp: cte_wp_at_ctes_of diminished_IOPortControl') + apply (clarsimp simp: cte_wp_at_ctes_of) \ \PageCap\ apply (simp add: decodeX64MMUInvocation_def isCap_simps X64_H.decodeInvocation_def Let_def isIOCap_def diff --git a/proof/refine/X64/CSpace_I.thy b/proof/refine/X64/CSpace_I.thy index f33c2ab3b9..6f47ce9455 100644 --- a/proof/refine/X64/CSpace_I.thy +++ b/proof/refine/X64/CSpace_I.thy @@ -50,11 +50,6 @@ lemma maskCapRights_allRights [simp]: X64_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma diminished_refl'[simp]: - "diminished' cap cap" - unfolding diminished'_def - by (rule exI[where x=allRights], simp) - lemma getCTE_inv [wp]: "\P\ getCTE addr \\rv. P\" by (simp add: getCTE_def) wp @@ -2126,9 +2121,5 @@ crunch idle[wp]: get_object "valid_idle" end -lemma diminished_capMaster: - "diminished' cap cap' \ capMasterCap cap' = capMasterCap cap" - by (clarsimp simp: diminished'_def) - end (* of theory *) diff --git a/proof/refine/X64/CSpace_R.thy b/proof/refine/X64/CSpace_R.thy index e6137aa8b2..d4cd80fcb2 100644 --- a/proof/refine/X64/CSpace_R.thy +++ b/proof/refine/X64/CSpace_R.thy @@ -6371,22 +6371,6 @@ lemma updateCap_same_master: apply (clarsimp simp: cte_wp_at_ctes_of) done -lemma diminished_cte_refs': - "diminished' cap cap' \ cte_refs' cap n = cte_refs' cap' n" - by (clarsimp simp: diminished'_def) - -lemma diminished_Untyped' : - "diminished' (UntypedCap d r n x) cap = (cap = UntypedCap d r n x)" - apply (rule iffI) - apply (case_tac cap) - apply (clarsimp simp:isCap_simps maskCapRights_def diminished'_def split:if_split_asm)+ - (* 6 subgoals *) - apply (rename_tac arch_capability R) - apply (case_tac arch_capability) - apply (clarsimp simp: isCap_simps X64_H.maskCapRights_def maskCapRights_def - diminished'_def Let_def)+ -done - lemma updateCapFreeIndex_valid_mdb_ctes: assumes preserve:"\m m'. mdb_inv_preserve m m' \ mdb_inv_preserve (Q m) (Q m')" and coin :"\m cte. \m src = Some cte\ \ (\cte'. (Q m) src = Some cte' \ cteCap cte = cteCap cte')" diff --git a/proof/refine/X64/LevityCatch.thy b/proof/refine/X64/LevityCatch.thy index 7ff9a56d0c..fbb4070ca0 100644 --- a/proof/refine/X64/LevityCatch.thy +++ b/proof/refine/X64/LevityCatch.thy @@ -29,8 +29,6 @@ lemmas makeObject_simps = makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte makeObject_asidpool makeObject_pdpte makeObject_pml4e end -definition - "diminished' cap cap' \ \R. cap = maskCapRights R cap'" lemma projectKO_inv : "\P\ projectKO ko \\rv. P\" by (simp add: projectKO_def fail_def valid_def return_def diff --git a/proof/refine/X64/Syscall_R.thy b/proof/refine/X64/Syscall_R.thy index b6e88077dc..3733030c6f 100644 --- a/proof/refine/X64/Syscall_R.thy +++ b/proof/refine/X64/Syscall_R.thy @@ -170,7 +170,7 @@ lemma decode_invocation_corres: \ corres (ser \ inv_relation) (invs and valid_sched and valid_list - and valid_cap cap and cte_at slot and cte_wp_at (diminished cap) slot + and valid_cap cap and cte_at slot and cte_wp_at ((=) cap) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s) and (\s. length args < 2 ^ word_bits)) (invs' and valid_cap' cap' and cte_at' slot' @@ -186,7 +186,7 @@ lemma decode_invocation_corres: \ \Untyped\ apply (simp add: isCap_defs Let_def o_def split del: if_split) apply (rule corres_guard_imp, rule dec_untyped_inv_corres) - apply ((clarsimp simp:cte_wp_at_caps_of_state diminished_def)+)[3] + apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3] \ \(Async)Endpoint\ apply (simp add: isCap_defs returnOk_def) apply (simp add: isCap_defs) @@ -232,8 +232,6 @@ lemma decode_invocation_corres: apply (clarsimp simp add: isCap_defs Let_def o_def) apply (rule corres_guard_imp [OF dec_arch_inv_corres]) apply (simp_all add: list_all2_map2 list_all2_map1)+ - apply (clarsimp simp: is_arch_diminished_def cte_wp_at_caps_of_state - is_cap_simps) done declare mapME_Nil [simp] @@ -614,22 +612,6 @@ lemma decode_inv_inv'[wp]: clarsimp split: capability.split_asm simp: isCap_defs)+ done -lemma diminished_IRQHandler' [simp]: - "diminished' (IRQHandlerCap h) cap = (cap = IRQHandlerCap h)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - -lemma diminished_IRQControlCap' [simp]: - "diminished' IRQControlCap cap = (cap = IRQControlCap)" - apply (rule iffI) - apply (drule diminished_capMaster) - apply clarsimp - apply (simp add: diminished'_def maskCapRights_def isCap_simps Let_def) - done - (* FIXME: move to TCB *) lemma dec_dom_inv_wf[wp]: "\invs' and (\s. \x \ set excaps. s \' fst x)\ @@ -648,35 +630,28 @@ lemma dec_dom_inv_wf[wp]: apply (simp add:numDomains_def maxDomain_def) done -lemma diminished_ReplyCap': - "diminished' (capability.ReplyCap t False r) cap - \ \gr. cap = capability.ReplyCap t False gr" - apply (clarsimp simp: diminished'_def maskCapRights_def Let_def split del: if_split) - apply (cases cap, simp_all add: isCap_simps)[1] - apply (simp add: X64_H.maskCapRights_def isPageCap_def split: arch_capability.splits) - done - lemma decode_inv_wf'[wp]: "\valid_cap' cap and invs' and sch_act_simple - and cte_wp_at' (diminished' cap \ cteCap) slot and real_cte_at' slot + and cte_wp_at' ((=) cap \ cteCap) slot and real_cte_at' slot and (\s. \r\zobj_refs' cap. ex_nonz_cap_to' r s) and (\s. \r\cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\zobj_refs' (fst cap). ex_nonz_cap_to' r s) - and (\s. \x \ set excaps. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s) + and (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s) and (\s. \x \ set excaps. s \' fst x) and (\s. \x \ set excaps. real_cte_at' (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to' isCNodeCap (snd x) s) and (\s. \x \ set excaps. cte_wp_at' (badge_derived' (fst x) o cteCap) (snd x) s)\ decodeInvocation label args cap_index slot cap excaps \valid_invocation'\,-" - apply (case_tac cap, simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def - split del: if_split - cong: if_cong) + apply (case_tac cap, + simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def + split del: if_split + cong: if_cong) apply ((rule hoare_pre, - ((wp decodeTCBInv_wf | simp add: o_def)+)[1], - clarsimp simp: valid_cap'_def cte_wp_at_ctes_of diminished_ReplyCap' - | (rule exI, rule exI, erule (1) conjI))+) + ((wpsimp wp: decodeTCBInv_wf simp: o_def)+)[1], + clarsimp simp: valid_cap'_def cte_wp_at_ctes_of) + | intro exI | simp)+ done lemma ct_active_imp_simple'[elim!]: @@ -1110,29 +1085,20 @@ lemma lec_ex_nonz_cap_to' [wp]: done (* FIXME: move *) -lemma getSlotCap_diminished' [wp]: +lemma getSlotCap_eq [wp]: "\\\ getSlotCap slot - \\cap. cte_wp_at' (diminished' cap \ cteCap) slot\" - apply (simp add: getSlotCap_def) - apply (wp getCTE_wp') - apply (clarsimp simp: cte_wp_at_ctes_of) - done + \\cap. cte_wp_at' ((=) cap \ cteCap) slot\" + by (wpsimp wp: getCTE_wp' simp: getSlotCap_def cte_wp_at_ctes_of) -lemma lcs_diminished' [wp]: - "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' (diminished' (fst rv) o cteCap) (snd rv)\,-" - unfolding lookupCapAndSlot_def - apply (rule hoare_pre) - apply (wp | simp add: split_def)+ - done +lemma lcs_eq [wp]: + "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' ((=) (fst rv) \ cteCap) (snd rv)\,-" + by (wpsimp simp: lookupCapAndSlot_def) lemma lec_dimished'[wp]: "\\\ lookupExtraCaps t buffer info - \\rv s. (\x\set rv. cte_wp_at' (diminished' (fst x) o cteCap) (snd x) s)\,-" - apply (simp add: lookupExtraCaps_def split del: if_split) - apply (rule hoare_pre) - apply (wp mapME_set|simp)+ - done + \\rv s. (\x\set rv. cte_wp_at' ((=) (fst x) o cteCap) (snd x) s)\,-" + by (wpsimp wp: mapME_set simp: lookupExtraCaps_def) lemma lookupExtras_real_ctes[wp]: "\valid_objs'\ lookupExtraCaps t xs info \\rv s. \x \ set rv. real_cte_at' (snd x) s\,-" @@ -1297,10 +1263,10 @@ lemma hinv_corres: apply (clarsimp) apply (wp setThreadState_nonqueued_state_update setThreadState_st_tcb setThreadState_rct)[1] - apply (wp lec_caps_to get_cap_diminished lsft_ex_cte_cap_to - | simp add: split_def liftE_bindE[symmetric] - ct_in_state'_def ball_conj_distrib - | rule hoare_vcg_E_elim)+ + apply (wp lec_caps_to lsft_ex_cte_cap_to + | simp add: split_def liftE_bindE[symmetric] + ct_in_state'_def ball_conj_distrib + | rule hoare_vcg_E_elim)+ apply (clarsimp simp: tcb_at_invs invs_valid_objs valid_tcb_state_def ct_in_state_def simple_from_active invs_mdb) diff --git a/proof/refine/X64/Untyped_R.thy b/proof/refine/X64/Untyped_R.thy index 415cb25d06..4e0cc26ca5 100644 --- a/proof/refine/X64/Untyped_R.thy +++ b/proof/refine/X64/Untyped_R.thy @@ -704,22 +704,19 @@ lemma ensureNoChildren_sp: declare isPML4Cap'_PML4 [simp] -declare diminished_Untyped' [simp] - lemma dui_sp_helper': "\P\ if Q then returnOk root_cap else doE slot \ lookupTargetSlot root_cap cref dpth; liftE (getSlotCap slot) - odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' (diminished' rv o cteCap) slot s)) \ P s\, -" + odE \\rv s. (rv = root_cap \ (\slot. cte_wp_at' ((=) rv o cteCap) slot s)) \ P s\, -" apply (cases Q, simp_all add: lookupTargetSlot_def) apply (wp, simp) apply (simp add: getSlotCap_def split_def) apply wp apply (rule hoare_strengthen_post [OF getCTE_sp[where P=P]]) - apply (clarsimp simp: cte_wp_at_ctes_of diminished'_def) + apply (clarsimp simp: cte_wp_at_ctes_of) apply (elim allE, drule(1) mp) - apply (erule allE, subst(asm) maskCapRights_allRights) apply simp apply wpsimp apply simp @@ -842,7 +839,6 @@ lemma decodeUntyped_wf[wp]: apply (case_tac cte) apply clarsimp apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])+ - apply (drule diminished_valid') apply simp apply (clarsimp simp: toEnum_of_nat [OF less_Suc_unat_less_bound] ucast_id) apply (subgoal_tac "args ! 4 \ 2 ^ capCNodeBits nodeCap") @@ -912,7 +908,7 @@ lemma decodeUntyped_wf[wp]: apply (clarsimp simp:ex_cte_cap_wp_to'_def) apply (rule_tac x = nodeSlot in exI) apply (case_tac cte) - apply (clarsimp simp:cte_wp_at_ctes_of diminished_cte_refs'[symmetric] isCap_simps image_def) + apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps image_def) apply (rule_tac x = x in bexI,simp) apply simp apply (erule order_trans) diff --git a/proof/refine/X64/VSpace_R.thy b/proof/refine/X64/VSpace_R.thy index 0dca764487..bab30789d0 100644 --- a/proof/refine/X64/VSpace_R.thy +++ b/proof/refine/X64/VSpace_R.thy @@ -1149,8 +1149,7 @@ proof - apply (simp add: cte_wp_at_ctes_of) apply wp apply (clarsimp simp: valid_unmap_def cte_wp_at_caps_of_state) - apply (clarsimp simp: is_arch_diminished_def is_cap_simps split: cap.splits arch_cap.splits) - apply (drule (2) diminished_is_update')+ + apply (clarsimp simp: is_cap_simps split: cap.splits arch_cap.splits) apply (clarsimp simp: cap_rights_update_def is_page_cap_def cap_master_cap_simps update_map_data_def acap_rights_update_def) apply (clarsimp simp add: wellformed_mapdata_def valid_cap_def mask_def) @@ -1354,12 +1353,10 @@ lemma perform_page_table_corres: apply ((wp hoare_vcg_all_lift hoare_vcg_const_imp_lift mapM_x_wp' | simp split del: if_split)+) apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state - is_arch_diminished_def cap_master_cap_simps update_map_data_def is_cap_simps cap_rights_update_def acap_rights_update_def dest!: cap_master_cap_eqDs) - apply (frule (2) diminished_is_update') apply (auto simp: valid_cap_def mask_def cap_master_cap_def cap_rights_update_def acap_rights_update_def wellformed_mapdata_def @@ -1486,12 +1483,10 @@ lemma perform_page_directory_corres: apply ((wp hoare_vcg_all_lift hoare_vcg_const_imp_lift mapM_x_wp' | simp split del: if_split)+) apply (clarsimp simp: valid_pdi_def cte_wp_at_caps_of_state - is_arch_diminished_def cap_master_cap_simps update_map_data_def is_cap_simps cap_rights_update_def acap_rights_update_def dest!: cap_master_cap_eqDs) - apply (frule (2) diminished_is_update') apply (auto simp: valid_cap_def mask_def cap_master_cap_def cap_rights_update_def acap_rights_update_def wellformed_mapdata_def vmsz_aligned_def @@ -1615,12 +1610,10 @@ lemma perform_pdpt_corres: apply ((wp hoare_vcg_all_lift hoare_vcg_const_imp_lift mapM_x_wp' | simp split del: if_split)+) apply (clarsimp simp: valid_pdpti_def cte_wp_at_caps_of_state - is_arch_diminished_def cap_master_cap_simps update_map_data_def is_cap_simps cap_rights_update_def acap_rights_update_def dest!: cap_master_cap_eqDs) - apply (frule (2) diminished_is_update') apply (auto simp: valid_cap_def mask_def cap_master_cap_def cap_rights_update_def acap_rights_update_def wellformed_mapdata_def vmsz_aligned_def @@ -2871,14 +2864,6 @@ lemma isPML4Cap'_PML4 : by (simp add: isPML4Cap'_def) -lemma diminished_valid': - "diminished' cap cap' \ valid_cap' cap = valid_cap' cap'" - by (rule ext) (clarsimp simp add: diminished'_def) - -lemma diminished_isPML4Cap': - "diminished' cap cap' \ isPML4Cap' cap' = isPML4Cap' cap" - by (blast dest: diminished_capMaster capMaster_isPML4Cap') - end lemma cteCaps_of_ctes_of_lift: diff --git a/spec/capDL/Endpoint_D.thy b/spec/capDL/Endpoint_D.thy index 996e9a9f43..170df2287a 100644 --- a/spec/capDL/Endpoint_D.thy +++ b/spec/capDL/Endpoint_D.thy @@ -120,7 +120,6 @@ where transfer_caps_loop ep receiver caps dest od else if dest \ None then doE - \ \Possibly diminish rights (if diminish flag was set on endpoint)\ new_cap \ returnOk (update_cap_rights (cap_rights cap - {Write}) cap) \ returnOk cap; @@ -155,8 +154,6 @@ where * - Caps may not send, but still allow later caps to * use the receive slot (Unwrapped endpoints); * - * - Caps may send with the rights diminished; - * * - Cap sending may stop half way (cap lookup faults); * * - The new cap may either be a sibling or child of source cap, diff --git a/spec/haskell/src/SEL4/Kernel/Thread.lhs b/spec/haskell/src/SEL4/Kernel/Thread.lhs index 69c81c7a83..041b281508 100644 --- a/spec/haskell/src/SEL4/Kernel/Thread.lhs +++ b/spec/haskell/src/SEL4/Kernel/Thread.lhs @@ -177,7 +177,7 @@ If the sent message is a fault IPC, the stored fault is transferred. > Just _ -> do > doFaultTransfer badge sender receiver receiveBuffer -Replies sent by the "Reply" and "ReplyRecv" system calls can either be normal IPC replies, or fault replies. In the former case, the transfer is the same as for an IPC send, but there is never a fault, capability grants are always allowed, the badge is always 0, and capabilities are never received with diminished rights (diminished rights are now removed). +Replies sent by the "Reply" and "ReplyRecv" system calls can either be normal IPC replies, or fault replies. In the former case, the transfer is the same as for an IPC send, but there is never a fault, capability grants are always allowed, and the badge is always 0. > doReplyTransfer :: PPtr TCB -> PPtr TCB -> PPtr CTE -> Bool -> Kernel () > doReplyTransfer sender receiver slot grant = do