diff --git a/lib/Clear_Named_Theorems.thy b/lib/Clear_Named_Theorems.thy new file mode 100644 index 0000000000..6b36680487 --- /dev/null +++ b/lib/Clear_Named_Theorems.thy @@ -0,0 +1,35 @@ +(* + * Copyright 2026, Proofcraft Pty Ltd + * + * SPDX-License-Identifier: BSD-2-Clause + *) + +(* Clearing an existing named_theorems within the current context, allowing the same named_theorems + to be re-used multiple times as an accumulator. *) + +theory Clear_Named_Theorems +imports Main +keywords "clear_named_theorems" :: thy_decl +begin + +ML \ +local + +(* We need to lift from a Context.generic transformer to a local_theory transformer. + Context.proof_map looks like it should do this, but using it with Named_Theorems.clear does not + have any effect. It is unclear why that's the case. + Going via Local_Theory.declaration does work, even if we have to give it a "morphism" that + doesn't actually contain a morphism. *) +fun alt_proof_map f = + Local_Theory.declaration {syntax = false, pervasive = false, pos = \<^here>} (fn _ => f); + +val _ = + Outer_Syntax.local_theory \<^command_keyword>\clear_named_theorems\ + "clear named collection of theorems" + ((Parse.name_position) >> + (fn (b,pos) => fn ctxt => + alt_proof_map (Named_Theorems.clear (Named_Theorems.check ctxt (b, pos))) ctxt)); + +in end\ + +end \ No newline at end of file diff --git a/lib/NICTATools.thy b/lib/NICTATools.thy index 5fc6acaf50..ad3380108b 100644 --- a/lib/NICTATools.thy +++ b/lib/NICTATools.thy @@ -22,6 +22,7 @@ imports Locale_Abbrev Value_Type Named_Eta + Clear_Named_Theorems begin section "Detect unused meta-forall" diff --git a/lib/ROOT b/lib/ROOT index 4e2213b195..74326f3e82 100644 --- a/lib/ROOT +++ b/lib/ROOT @@ -72,6 +72,7 @@ session Lib (lib) = Word_Lib + Heap_List None_Top_Bot Sorted_Addrs + Clear_Named_Theorems (* should move to Monads: *) NonDetMonadLemmaBucket @@ -131,6 +132,7 @@ session LibTest (lib) in test = Refine + Rules_Tac_Test MonadicRewrite_Test Requalify_Test + Clear_Named_Theorems_Test (* use virtual memory function as an example, only makes sense on ARM: *) theories [condition = "L4V_ARCH_IS_ARM"] CorresK_Test diff --git a/lib/test/Clear_Named_Theorems_Test.thy b/lib/test/Clear_Named_Theorems_Test.thy new file mode 100644 index 0000000000..d54d4ce0f0 --- /dev/null +++ b/lib/test/Clear_Named_Theorems_Test.thy @@ -0,0 +1,67 @@ +(* + * Copyright 2026, Proofcraft Pty Ltd + * + * SPDX-License-Identifier: BSD-2-Clause + *) + +theory Clear_Named_Theorems_Test +imports Lib.Clear_Named_Theorems +begin + +section \Interacting with named theorems in global theory context\ + +named_theorems glob_thms + +thm glob_thms (* empty *) + +declare TrueI[glob_thms] +thm glob_thms (* True *) + +clear_named_theorems glob_thms + +thm glob_thms (* empty again *) + + +section \Interacting with named theorems inside locale context\ + +locale Arch + +context Arch begin + +named_theorems Arch_assms + +declare TrueI[Arch_assms] +thm Arch_assms (* True *) + +clear_named_theorems Arch_assms +thm Arch_assms (* empty again *) + +end (* Arch *) + +text \Remember that named theorems are locale-aware, so attempts to directly access them from a + different context don't do what one might expect:\ + +context Arch begin + +declare TrueI[Arch_assms] + +end (* Arch *) + +thm Arch.Arch_assms (* empty! *) +clear_named_theorems Arch.Arch_assms (* no effect! *) + +context Arch begin + +thm Arch_assms (* True *) + +text \In cases where we need direct access to the set of theorems accumulated in a named theorems + from outside its locale, the current set of theorems must be captured under a non-dynamic name:\ + +lemmas Arch_assms_final = Arch_assms +thm Arch_assms_final (* True *) + +end (* Arch *) + +thm Arch.Arch_assms_final (* True *) + +end diff --git a/proof/access-control/AARCH64/ArchRetype_AC.thy b/proof/access-control/AARCH64/ArchRetype_AC.thy index a7f72c6e3d..9147579e76 100644 --- a/proof/access-control/AARCH64/ArchRetype_AC.thy +++ b/proof/access-control/AARCH64/ArchRetype_AC.thy @@ -16,6 +16,8 @@ lemma invs_mdb_cte': context retype_region_proofs begin interpretation Arch . +interpretation retype_region_proofs_arch .. + lemma state_vrefs_eq: "\ valid_vspace_objs s; valid_arch_state s \ \ state_vrefs s' = state_vrefs s" diff --git a/proof/access-control/RISCV64/ArchRetype_AC.thy b/proof/access-control/RISCV64/ArchRetype_AC.thy index f085985b01..b06e33a1d9 100644 --- a/proof/access-control/RISCV64/ArchRetype_AC.thy +++ b/proof/access-control/RISCV64/ArchRetype_AC.thy @@ -25,6 +25,8 @@ end context retype_region_proofs begin interpretation Arch . +interpretation retype_region_proofs_arch .. + lemma state_vrefs_eq: "\ valid_vspace_objs s; valid_arch_state s \ \ state_vrefs s' = state_vrefs s" diff --git a/proof/invariant-abstract/AARCH64/ArchAInvsPre.thy b/proof/invariant-abstract/AARCH64/ArchAInvsPre.thy index 83ae5d2b58..4b696f68e1 100644 --- a/proof/invariant-abstract/AARCH64/ArchAInvsPre.thy +++ b/proof/invariant-abstract/AARCH64/ArchAInvsPre.thy @@ -79,7 +79,7 @@ lemma device_frame_in_device_region: \ device_state (machine_state s) p \ None" by (auto simp add: pspace_respects_device_region_def dom_def device_mem_def) -named_theorems AInvsPre_assms +clear_named_theorems Arch_assms (* accumulate assumptions for AInvsPre locale *) lemma get_vspace_of_thread_asid_or_global_pt: "(\asid. vspace_for_asid asid s = Some (get_vspace_of_thread (kheap s) (arch_state s) t)) @@ -99,7 +99,7 @@ lemma get_page_info_gpd_kmaps: table_base_pt_slot_offset[where level=max_pt_level, simplified]) done -lemma ptable_rights_imp_frame[AInvsPre_assms]: +lemma ptable_rights_imp_frame[Arch_assms]: assumes "valid_state s" shows "\ ptable_rights t s vptr \ {}; ptable_lift t s vptr = Some (addrFromPPtr p) \ \ in_user_frame p s \ in_device_frame p s" @@ -132,12 +132,13 @@ lemma ptable_rights_imp_frame[AInvsPre_assms]: apply simp done +lemmas AInvsPre_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation AInvsPre?: AInvsPre proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact AInvsPre_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.AInvsPre_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy b/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy index ba501f0e45..a13a0eae5d 100644 --- a/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchBCorres2_AI.thy @@ -12,10 +12,10 @@ begin context Arch begin arch_global_naming -named_theorems BCorres2_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for BCorres2_AI locale *) crunch invoke_cnode - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state (simp: swp_def ignore: clearMemory without_preemption filterM) crunch create_cap,init_arch_objects,retype_region,delete_objects @@ -33,7 +33,7 @@ crunch set_mcpriority, set_priority, set_flags, arch_post_set_flags for (bcorres) bcorres[wp]: truncate_state crunch arch_get_sanitise_register_info, arch_post_modify_registers - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state lemma invoke_tcb_bcorres[wp]: fixes a @@ -56,19 +56,20 @@ lemma invoke_irq_handler_bcorres[wp]: "bcorres (invoke_irq_handler a) (invoke_ir by (cases a; (wpsimp | rule conjI)+) crunch maybe_handle_interrupt - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state (simp: crunch_simps wp: crunch_wps) -lemma handle_arch_fault_reply_bcorres[wp,BCorres2_AI_assms]: +lemma handle_arch_fault_reply_bcorres[wp,Arch_assms]: "bcorres ( handle_arch_fault_reply a b c d) (handle_arch_fault_reply a b c d)" by (cases a; simp add: handle_arch_fault_reply_def; wp) +lemmas BCorres2_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation BCorres2_AI?: BCorres2_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact BCorres2_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.BCorres2_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/AARCH64/ArchCNodeInv_AI.thy b/proof/invariant-abstract/AARCH64/ArchCNodeInv_AI.thy index 3592f38e1c..c5d0417172 100644 --- a/proof/invariant-abstract/AARCH64/ArchCNodeInv_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchCNodeInv_AI.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_AI locale *) lemma valid_cnode_capI: "\cap_table_at n w s; valid_objs s; pspace_aligned s; n > 0; length g \ 64\ @@ -27,7 +27,7 @@ lemma valid_cnode_capI: apply (simp add: word_bits_def cte_level_bits_def) done -lemma derive_cap_objrefs [CNodeInv_AI_assms]: +lemma derive_cap_objrefs [Arch_assms]: "\\s. P (obj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (obj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] @@ -35,7 +35,7 @@ lemma derive_cap_objrefs [CNodeInv_AI_assms]: apply (case_tac arch_cap, simp_all add: arch_derive_cap_def) by (wp | wpc |simp add: o_def)+ -lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: +lemma derive_cap_zobjrefs [Arch_assms]: "\\s. P (zobj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (zobj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] @@ -43,21 +43,21 @@ lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: apply (case_tac arch_cap, simp_all add: arch_derive_cap_def) by (wp | wpc |simp add: o_def)+ -lemma update_cap_objrefs [CNodeInv_AI_assms]: +lemma update_cap_objrefs [Arch_assms]: "\ update_cap_data P dt cap \ NullCap \ \ obj_refs (update_cap_data P dt cap) = obj_refs cap" by (case_tac cap, simp_all add: update_cap_data_closedform arch_update_cap_data_def Let_def is_cap_simps split: if_split_asm arch_cap.splits) -lemma update_cap_zobjrefs [CNodeInv_AI_assms]: +lemma update_cap_zobjrefs [Arch_assms]: "\ update_cap_data P dt cap \ cap.NullCap \ \ zobj_refs (update_cap_data P dt cap) = zobj_refs cap" by (case_tac cap, simp_all add: update_cap_data_closedform arch_update_cap_data_def Let_def is_cap_simps split: if_split_asm arch_cap.splits) -lemma copy_mask [simp, CNodeInv_AI_assms]: +lemma copy_mask [simp, Arch_assms]: "copy_of (mask_cap R c) = copy_of c" apply (rule ext) apply (auto simp: copy_of_def is_cap_simps mask_cap_def @@ -66,7 +66,7 @@ lemma copy_mask [simp, CNodeInv_AI_assms]: split: cap.splits arch_cap.splits bool.splits) done -lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: +lemma update_cap_data_mask_Null [simp, Arch_assms]: "(update_cap_data P x (mask_cap m c) = NullCap) = (update_cap_data P x c = NullCap)" unfolding update_cap_data_def mask_cap_def apply (cases c) @@ -75,7 +75,7 @@ lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: apply (case_tac arch_cap; clarsimp simp: arch_update_cap_data_def acap_rights_update_def split: if_splits) done -lemma cap_master_update_cap_data [CNodeInv_AI_assms]: +lemma cap_master_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap \ \ cap_master_cap (update_cap_data P x c) = cap_master_cap c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -98,11 +98,11 @@ lemma same_object_as_def2: split: cap.splits arch_cap.splits) done -lemma same_object_as_cap_master [CNodeInv_AI_assms]: +lemma same_object_as_cap_master [Arch_assms]: "same_object_as cap cap' \ cap_master_cap cap = cap_master_cap cap'" by (simp add: same_object_as_def2) -lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: +lemma weak_derived_cap_is_device[Arch_assms]: "\weak_derived c' c\ \ cap_is_device c = cap_is_device c'" apply (auto simp: weak_derived_def copy_of_def is_cap_simps same_object_as_def2 @@ -110,7 +110,7 @@ lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: dest!: master_cap_eq_is_device_cap_eq) done -lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid (update_cap_data P x c) = cap_asid c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -119,7 +119,7 @@ lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: +lemma cap_vptr_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_vptr (update_cap_data P x c) = cap_vptr c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -128,7 +128,7 @@ lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_base_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid_base (update_cap_data P x c) = cap_asid_base c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -137,7 +137,7 @@ lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma same_object_as_update_cap_data [CNodeInv_AI_assms]: +lemma same_object_as_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap; same_object_as c' c \ \ same_object_as c' (update_cap_data P x c)" apply (clarsimp simp: same_object_as_def is_cap_simps @@ -158,7 +158,7 @@ lemma is_master_reply_update_cap_data[simp]: by (simp add:is_master_reply_cap_def update_cap_data_def arch_update_cap_data_def the_cnode_cap_def is_arch_cap_def badge_update_def split:cap.split) -lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: +lemma weak_derived_update_cap_data [Arch_assms]: "\update_cap_data P x c \ NullCap; weak_derived c c'\ \ weak_derived (update_cap_data P x c) c'" apply (simp add: weak_derived_def copy_of_def @@ -182,7 +182,7 @@ lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: +lemma cap_badge_update_cap_data [Arch_assms]: "update_cap_data False x c \ NullCap \ (bdg, cap_badge c) \ capBadge_ordering False \ (bdg, cap_badge (update_cap_data False x c)) \ capBadge_ordering False" apply clarsimp @@ -194,25 +194,25 @@ lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: done -lemma cap_vptr_rights_update[simp, CNodeInv_AI_assms]: +lemma cap_vptr_rights_update[simp, Arch_assms]: "cap_vptr (cap_rights_update f c) = cap_vptr c" by (simp add: cap_vptr_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_vptr_mask[simp, CNodeInv_AI_assms]: +lemma cap_vptr_mask[simp, Arch_assms]: "cap_vptr (mask_cap m c) = cap_vptr c" by (simp add: mask_cap_def) -lemma cap_asid_base_rights [simp, CNodeInv_AI_assms]: +lemma cap_asid_base_rights [simp, Arch_assms]: "cap_asid_base (cap_rights_update R c) = cap_asid_base c" by (auto simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_asid_base_mask[simp, CNodeInv_AI_assms]: +lemma cap_asid_base_mask[simp, Arch_assms]: "cap_asid_base (mask_cap m c) = cap_asid_base c" by (simp add: mask_cap_def) -lemma weak_derived_mask [CNodeInv_AI_assms]: +lemma weak_derived_mask [Arch_assms]: "\ weak_derived c c'; cap_aligned c \ \ weak_derived (mask_cap m c) c'" unfolding weak_derived_def apply simp @@ -227,16 +227,16 @@ lemma weak_derived_mask [CNodeInv_AI_assms]: done -lemma vs_cap_ref_update_cap_data[simp, CNodeInv_AI_assms]: +lemma vs_cap_ref_update_cap_data[simp, Arch_assms]: "vs_cap_ref (update_cap_data P d cap) = vs_cap_ref cap" by (auto simp: vs_cap_ref_def update_cap_data_closedform arch_update_cap_data_def Let_def is_cap_simps split: arch_cap.splits cap.split if_splits) -lemmas [CNodeInv_AI_assms] = invs_irq_state_independent +lemmas [Arch_assms] = invs_irq_state_independent -lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: +lemma cte_at_nat_to_cref_zbits [Arch_assms]: "\ s \ Zombie oref zb n; m < n \ \ cte_at (oref, nat_to_cref (zombie_cte_bits zb) m) s" apply (subst(asm) valid_cap_def) @@ -250,7 +250,7 @@ lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: done -lemma copy_of_cap_range [CNodeInv_AI_assms]: +lemma copy_of_cap_range [Arch_assms]: "copy_of cap cap' \ cap_range cap = cap_range cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -262,7 +262,7 @@ lemma copy_of_cap_range [CNodeInv_AI_assms]: done -lemma copy_of_zobj_refs [CNodeInv_AI_assms]: +lemma copy_of_zobj_refs [Arch_assms]: "copy_of cap cap' \ zobj_refs cap = zobj_refs cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -274,7 +274,7 @@ lemma copy_of_zobj_refs [CNodeInv_AI_assms]: done -lemma vs_cap_ref_master [CNodeInv_AI_assms]: +lemma vs_cap_ref_master [Arch_assms]: "\ cap_master_cap cap = cap_master_cap cap'; cap_asid cap = cap_asid cap'; cap_asid_base cap = cap_asid_base cap'; @@ -286,13 +286,13 @@ lemma vs_cap_ref_master [CNodeInv_AI_assms]: apply (clarsimp simp: cap_asid_def split: arch_cap.split_asm option.split_asm) done -lemma weak_derived_vs_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_vs_cap_ref [Arch_assms]: "weak_derived c c' \ vs_cap_ref c = vs_cap_ref c'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm elim: vs_cap_ref_master[OF sym]) -lemma weak_derived_table_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_table_cap_ref [Arch_assms]: "weak_derived c c' \ table_cap_ref c = table_cap_ref c'" apply (clarsimp simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm) @@ -346,7 +346,7 @@ lemma weak_derived_Page1[simp]: dest!: same_object_as_cap_master cap_master_cap_eqDs split: option.splits) -lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: +lemma swap_of_caps_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -403,7 +403,7 @@ lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: done -lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: +lemma cap_swap_asid_map[wp, Arch_assms]: "\valid_asid_map and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -413,7 +413,7 @@ lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: done -lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: +lemma cap_swap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -425,14 +425,14 @@ lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: simp: cte_wp_at_caps_of_state weak_derived_cap_range) done -lemma cap_swap_vms[wp, CNodeInv_AI_assms]: +lemma cap_swap_vms[wp, Arch_assms]: "\valid_machine_state\ cap_swap c a c' b \\rv. valid_machine_state\" apply (simp add: valid_machine_state_def in_user_frame_def) apply (wp cap_swap_typ_at hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_disj_lift) done -lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: +lemma unat_of_bl_nat_to_cref[Arch_assms]: "\ n < 2 ^ len; len < word_bits \ \ unat (of_bl (nat_to_cref len n) :: machine_word) = n" apply (simp add: nat_to_cref_def word_bits_conv of_drop_to_bl @@ -451,7 +451,7 @@ lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: apply simp done -lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: +lemma zombie_is_cap_toE_pre[Arch_assms]: "\ s \ Zombie ptr zbits n; invs s; m < n \ \ (ptr, nat_to_cref (zombie_cte_bits zbits) m) \ cte_refs (Zombie ptr zbits n) irqn" apply (clarsimp simp add: valid_cap_def cap_aligned_def) @@ -466,7 +466,7 @@ crunch prepare_thread_delete for st_tcb_at_halted[wp]: "st_tcb_at halted t" (wp: dissociate_vcpu_tcb_pred_tcb_at) -lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: +lemma finalise_cap_makes_halted_proof[Arch_assms]: "\invs and valid_cap cap and (\s. ex = is_final_cap' cap s) and cte_wp_at ((=) cap) slot\ finalise_cap cap ex @@ -488,12 +488,12 @@ lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof crunch finalise_cap - for emptyable[wp,CNodeInv_AI_assms]: "\s. emptyable sl s" + for emptyable[wp,Arch_assms]: "\s. emptyable sl s" (simp: crunch_simps rule: emptyable_lift wp: crunch_wps suspend_emptyable unbind_notification_invs unbind_maybe_notification_invs arch_finalise_cap_pred_tcb_at) -lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: +lemma finalise_cap_not_reply_master_unlifted [Arch_assms]: "(rv, s') \ fst (finalise_cap cap sl s) \ \ is_master_reply_cap (fst rv)" by (case_tac cap, auto simp: is_cap_simps in_monad liftM_def @@ -501,7 +501,7 @@ lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: split: if_split_asm arch_cap.split_asm bool.split_asm option.split_asm pt_type.splits) -lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: +lemma nat_to_cref_0_replicate [Arch_assms]: "\n. n < word_bits \ nat_to_cref n 0 = replicate n False" apply (subgoal_tac "nat_to_cref n (unat (of_bl (replicate n False))) = replicate n False") apply simp @@ -510,25 +510,26 @@ lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: apply simp done -lemma prepare_thread_delete_thread_cap [CNodeInv_AI_assms]: +lemma prepare_thread_delete_thread_cap [Arch_assms]: "\\s. caps_of_state s x = Some (cap.ThreadCap p)\ prepare_thread_delete t \\rv s. caps_of_state s x = Some (cap.ThreadCap p)\" by (wpsimp simp: prepare_thread_delete_def) -lemma cap_swap_valid_arch_state[wp, CNodeInv_AI_assms]: +lemma cap_swap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ cap_swap c a c' b \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_swap_typ_ats cap_swap_aobj_at) +lemmas CNodeInv_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI?: CNodeInv_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.CNodeInv_AI_assms)?) qed @@ -783,27 +784,27 @@ next done qed - -lemmas rec_del_invs'[CNodeInv_AI_assms] = rec_del_invs'' [where Q=\, +lemmas rec_del_invs'[Arch_assms] = rec_del_invs'' [where Q=\, simplified hoare_TrueI pred_conj_def simp_thms, OF TrueI TrueI TrueI TrueI, simplified] +lemmas CNodeInv_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_2?: CNodeInv_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.CNodeInv_AI_2_assms)?) qed context Arch begin arch_global_naming -lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: +lemma finalise_cap_rvk_prog [Arch_assms]: "finalise_cap cap f \\s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\" by (cases cap; wpsimp wp: suspend_rvk_prog deleting_irq_handler_rvk_prog) -lemma rec_del_rvk_prog [CNodeInv_AI_assms]: +lemma rec_del_rvk_prog [Arch_assms]: "st \ \\s. revoke_progress_ord m (option_map cap_to_rpo \ caps_of_state s) \ (case args of ReduceZombieCall cap sl ex \ cte_wp_at (\c. c = cap) sl s \ is_final_cap' cap s @@ -887,13 +888,14 @@ next done qed +lemmas CNodeInv_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_3?: CNodeInv_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.CNodeInv_AI_3_assms)?) qed @@ -905,31 +907,32 @@ declare cap_revoke.simps[simp del] context Arch begin arch_global_naming crunch finalise_slot - for typ_at[wp, CNodeInv_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM set_object clearMemory) -lemma weak_derived_appropriate [CNodeInv_AI_assms]: +lemma weak_derived_appropriate [Arch_assms]: "weak_derived cap cap' \ appropriate_cte_cap cap = appropriate_cte_cap cap'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 appropriate_cte_master split: if_split_asm dest!: arg_cong[where f=appropriate_cte_cap]) +lemmas CNodeInv_AI_4_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_4?: CNodeInv_AI_4 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.CNodeInv_AI_4_assms)?) qed context Arch begin arch_global_naming -lemma cap_move_invs[wp, CNodeInv_AI_assms]: +lemma cap_move_invs[wp, Arch_assms]: "\invs and valid_cap cap and cte_wp_at ((=) cap.NullCap) ptr' and tcb_cap_valid cap ptr' and cte_wp_at (weak_derived cap) ptr @@ -976,13 +979,14 @@ lemma arch_derive_is_arch: "\\\ arch_derive_cap c \\rv s. rv \ NullCap \ is_arch_cap rv\,-" by (wpsimp simp: is_arch_cap_def arch_derive_cap_def) +lemmas CNodeInv_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_5?: CNodeInv_AI_5 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.CNodeInv_AI_5_assms)?) qed diff --git a/proof/invariant-abstract/AARCH64/ArchCSpace_AI.thy b/proof/invariant-abstract/AARCH64/ArchCSpace_AI.thy index 74a8af5f96..f103133792 100644 --- a/proof/invariant-abstract/AARCH64/ArchCSpace_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchCSpace_AI.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_AI locale *) lemma unique_table_refs_upd_eqD: "\ms a = Some b; obj_refs b = obj_refs b'; table_cap_ref b = table_cap_ref b'\ @@ -39,7 +39,7 @@ lemma cte_at_length_limit: done (* FIXME: move? *) -lemma getActiveIRQ_wp [CSpace_AI_assms]: +lemma getActiveIRQ_wp [Arch_assms]: "irq_state_independent_A P \ valid P (do_machine_op (getActiveIRQ in_kernel)) (\_. P)" apply (simp add: getActiveIRQ_def do_machine_op_def split_def exec_gets @@ -49,7 +49,7 @@ lemma getActiveIRQ_wp [CSpace_AI_assms]: apply (clarsimp simp: irq_state_independent_A_def in_monad return_def split: if_splits) done -lemma weak_derived_valid_cap [CSpace_AI_assms]: +lemma weak_derived_valid_cap [Arch_assms]: "\ s \ c; wellformed_cap c'; weak_derived c' c\ \ s \ c'" apply (case_tac "c = c'", simp) apply (clarsimp simp: weak_derived_def) @@ -60,7 +60,7 @@ lemma weak_derived_valid_cap [CSpace_AI_assms]: split: cap.splits arch_cap.splits option.splits) done -lemma copy_obj_refs [CSpace_AI_assms]: +lemma copy_obj_refs [Arch_assms]: "copy_of cap cap' \ obj_refs cap' = obj_refs cap" apply (cases cap) apply (auto simp: copy_of_def same_object_as_def is_cap_simps @@ -68,26 +68,26 @@ lemma copy_obj_refs [CSpace_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma weak_derived_cap_class[simp, CSpace_AI_assms]: +lemma weak_derived_cap_class[simp, Arch_assms]: "weak_derived cap src_cap \ cap_class cap = cap_class src_cap" apply (simp add:weak_derived_def) apply (auto simp:copy_of_def same_object_as_def is_cap_simps cap_asid_base_def split:if_splits cap.splits arch_cap.splits) done -lemma weak_derived_obj_refs [CSpace_AI_assms]: +lemma weak_derived_obj_refs [Arch_assms]: "weak_derived dcap cap \ obj_refs dcap = obj_refs cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma weak_derived_obj_ref_of [CSpace_AI_assms]: +lemma weak_derived_obj_ref_of [Arch_assms]: "weak_derived dcap cap \ obj_ref_of dcap = obj_ref_of cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma set_free_index_invs [CSpace_AI_assms]: +lemma set_free_index_invs [Arch_assms]: "\\s. (free_index_of cap \ idx \ is_untyped_cap cap \ idx \ 2^cap_bits cap) \ invs s \ cte_wp_at ((=) cap ) cref s\ set_cap (free_index_update (\_. idx) cap) cref @@ -132,7 +132,7 @@ lemma set_free_index_invs [CSpace_AI_assms]: apply (simp add: not_kernel_window_def) done -lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: +lemma set_untyped_cap_as_full_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at ((=) src_cap) src\ set_untyped_cap_as_full src_cap cap src \\ya. valid_arch_caps\" @@ -144,7 +144,7 @@ lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: is_cap_simps cte_wp_at_caps_of_state) done -lemma set_untyped_cap_as_full[wp, CSpace_AI_assms]: +lemma set_untyped_cap_as_full[wp, Arch_assms]: "\\s. no_cap_to_obj_with_diff_ref a b s \ cte_wp_at ((=) src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. no_cap_to_obj_with_diff_ref a b s\" @@ -243,7 +243,7 @@ lemma is_derived_is_pt: apply (clarsimp simp: is_derived_def split: if_split_asm) by (clarsimp simp: cap_master_cap_def split: cap.splits arch_cap.splits)+ -lemma cap_insert_valid_arch_caps [CSpace_AI_assms]: +lemma cap_insert_valid_arch_caps [Arch_assms]: "\valid_arch_caps and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_caps\" @@ -306,7 +306,7 @@ global_interpretation cap_insert_crunches?: cap_insert_crunches . context Arch begin arch_global_naming -lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma cap_insert_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range cap \ cap_range c) src\ cap_insert cap src dest @@ -319,7 +319,7 @@ lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: done -lemma mask_cap_valid[simp, CSpace_AI_assms]: +lemma mask_cap_valid[simp, Arch_assms]: "s \ c \ s \ mask_cap R c" apply (cases c, simp_all add: valid_cap_def mask_cap_def cap_rights_update_def @@ -329,21 +329,21 @@ lemma mask_cap_valid[simp, CSpace_AI_assms]: apply (rename_tac arch_cap) by (case_tac arch_cap, simp_all) -lemma mask_cap_objrefs[simp, CSpace_AI_assms]: +lemma mask_cap_objrefs[simp, Arch_assms]: "obj_refs (mask_cap rs cap) = obj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma mask_cap_zobjrefs[simp, CSpace_AI_assms]: +lemma mask_cap_zobjrefs[simp, Arch_assms]: "zobj_refs (mask_cap rs cap) = zobj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma derive_cap_valid_cap [CSpace_AI_assms]: +lemma derive_cap_valid_cap [Arch_assms]: "\valid_cap cap\ derive_cap slot cap \valid_cap\,-" apply (simp add: derive_cap_def) apply (rule hoare_pre) @@ -352,7 +352,7 @@ lemma derive_cap_valid_cap [CSpace_AI_assms]: done -lemma valid_cap_update_rights[simp, CSpace_AI_assms]: +lemma valid_cap_update_rights[simp, Arch_assms]: "valid_cap cap s \ valid_cap (cap_rights_update cr cap) s" apply (case_tac cap, simp_all add: cap_rights_update_def valid_cap_def cap_aligned_def @@ -370,7 +370,7 @@ lemma valid_cap_SMCCap[simp, intro!]: "valid_cap (ArchObjectCap (SMCCap badge)) s" by (simp add: valid_cap_def) -lemma update_cap_data_validI [CSpace_AI_assms]: +lemma update_cap_data_validI [Arch_assms]: "s \ cap \ s \ update_cap_data p d cap" apply (cases cap) apply (simp_all add: is_cap_defs update_cap_data_def Let_def split_def) @@ -383,7 +383,7 @@ lemma update_cap_data_validI [CSpace_AI_assms]: done -lemma tcb_cnode_index_def2 [CSpace_AI_assms]: +lemma tcb_cnode_index_def2 [Arch_assms]: "tcb_cnode_index n = nat_to_cref 3 n" apply (simp add: tcb_cnode_index_def nat_to_cref_def) apply (rule nth_equalityI) @@ -392,7 +392,7 @@ lemma tcb_cnode_index_def2 [CSpace_AI_assms]: done -lemma ex_nonz_tcb_cte_caps [CSpace_AI_assms]: +lemma ex_nonz_tcb_cte_caps [Arch_assms]: "\ex_nonz_cap_to t s; tcb_at t s; valid_objs s; ref \ dom tcb_cap_cases\ \ ex_cte_cap_wp_to (appropriate_cte_cap cp) (t, ref) s" apply (clarsimp simp: ex_nonz_cap_to_def ex_cte_cap_wp_to_def @@ -420,7 +420,7 @@ lemma no_cap_to_obj_with_diff_ref_triv: done -lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: +lemma setup_reply_master_arch_caps[wp, Arch_assms]: "\valid_arch_caps and tcb_at t and valid_objs and pspace_aligned\ setup_reply_master t \\rv. valid_arch_caps\" @@ -435,7 +435,7 @@ lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: done -lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma setup_reply_master_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and tcb_at t and pspace_in_kernel_window\ setup_reply_master t \\rv. cap_refs_in_kernel_window\" @@ -447,14 +447,14 @@ lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: (* FIXME: prove same_region_as_def2 instead or change def *) -lemma same_region_as_Untyped2 [CSpace_AI_assms]: +lemma same_region_as_Untyped2 [Arch_assms]: "\ is_untyped_cap pcap; same_region_as pcap cap \ \ (is_physical cap \ cap_range cap \ {} \ cap_range cap \ cap_range pcap)" by (fastforce simp: is_cap_simps cap_range_def is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma same_region_as_cap_class [CSpace_AI_assms]: +lemma same_region_as_cap_class [Arch_assms]: shows "same_region_as a b \ cap_class a = cap_class b" apply (case_tac a) apply ((fastforce simp: cap_range_def arch_is_physical_def is_cap_simps is_physical_def @@ -484,22 +484,23 @@ lemma cap_insert_simple_arch_caps_no_ap: apply (intro conjI impI allI) by (auto simp:is_simple_cap_def[simplified is_simple_cap_arch_def] is_cap_simps) -lemma cap_insert_derived_valid_arch_state[CSpace_AI_assms]: +lemma cap_insert_derived_valid_arch_state[Arch_assms]: "\valid_arch_state and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_insert_tcb cap_insert_aobj_at) -lemma setup_reply_master_arch[CSpace_AI_assms]: +lemma setup_reply_master_arch[Arch_assms]: "setup_reply_master t \ valid_arch_state \" by (wpsimp simp: setup_reply_master_def wp: get_cap_wp) +lemmas CSpace_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CSpace_AI?: CSpace_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CSpace_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.CSpace_AI_assms)?) qed diff --git a/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy index d99ca7d816..a2814bc0d1 100644 --- a/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchDetSchedAux_AI.thy @@ -11,18 +11,18 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedAux_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedAux_AI locale *) crunch init_arch_objects for exst[wp]: "\s. P (exst s)" and valid_queues[wp]: valid_queues and valid_sched_action[wp]: valid_sched_action and valid_sched[wp]: valid_sched - and etcbs_of[wp, DetSchedAux_AI_assms]: "\s. P (etcbs_of s)" - and ready_queues[wp, DetSchedAux_AI_assms]: "\s. P (ready_queues s)" - and idle_thread[wp, DetSchedAux_AI_assms]: "\s. P (idle_thread s)" - and schedact[wp, DetSchedAux_AI_assms]: "\s. P (scheduler_action s)" - and cur_domain[wp, DetSchedAux_AI_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and schedact[wp, Arch_assms]: "\s. P (scheduler_action s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" (wp: mapM_x_wp') lemma tcb_sched_action_valid_idle_etcb: @@ -31,7 +31,7 @@ lemma tcb_sched_action_valid_idle_etcb: (wpsimp simp: tcb_sched_action_def set_tcb_queue_def) crunch init_arch_objects - for valid_blocked[wp, DetSchedAux_AI_assms]: valid_blocked + for valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift crunch_wps) lemma perform_asid_control_etcb_at: @@ -73,12 +73,13 @@ lemma perform_asid_control_invocation_valid_sched: apply simp done +lemmas DetSchedAux_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedAux_AI?: DetSchedAux_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedAux_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.DetSchedAux_AI_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy index 7ff442dcf2..4883451875 100644 --- a/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchDetSchedDomainTime_AI.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedDomainTime_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedDomainTime_AI locale *) crunch vcpu_update, vcpu_save_reg, vgic_update, vcpu_enable, vcpu_disable, vcpu_restore, @@ -21,7 +21,7 @@ crunch (wp: crunch_wps simp: crunch_simps) crunch arch_finalise_cap - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: hoare_drop_imps mapM_wp subset_refl simp: crunch_simps) crunch @@ -32,24 +32,25 @@ crunch arch_post_modify_registers, arch_post_cap_deletion, handle_vm_fault, arch_invoke_irq_handler, arch_prepare_next_domain, arch_prepare_set_domain, arch_post_set_flags, handle_spurious_irq, handle_reserved_irq, arch_mask_irq_signal - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (simp: crunch_simps isFpuEnable_def wp: mapM_wp' transfer_caps_loop_pres crunch_wps) crunch handle_spurious_irq - for scheduler_action[wp, DetSchedDomainTime_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" + +lemmas DetSchedDomainTime_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.DetSchedDomainTime_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_perform_invocation - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps check_cap_inv simp: if_apply_def2) lemma vgic_maintenance_valid_domain_time: @@ -102,7 +103,7 @@ lemma timer_tick_valid_domain_time: crunch do_machine_op for domain_time_sched[wp]: "\s. P (domain_time s) (scheduler_action s)" -lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: +lemma handle_interrupt_valid_domain_time [Arch_assms]: "\\s :: det_ext state. 0 < domain_time s \ handle_interrupt i \\rv s. domain_time s = 0 \ scheduler_action s = choose_new_thread \" (is "\ ?dtnot0 \ _ \ _ \") @@ -124,12 +125,13 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: apply wpsimp+ done +lemmas DetSchedDomainTime_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedDomainTime_AI_2?: DetSchedDomainTime_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.DetSchedDomainTime_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy index 35685ffb25..7d334b2b43 100644 --- a/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchDetSchedSchedule_AI.thy @@ -11,10 +11,10 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedSchedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedSchedule_AI locale *) crunch prepare_thread_delete - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" (wp: crunch_wps) crunch set_vcpu, vcpu_disable, vcpu_restore, vcpu_save, vcpu_switch, switch_to_idle_thread, set_vm_root @@ -96,13 +96,13 @@ lemma set_vcpu_valid_sched_action'[wp]: crunch switch_to_idle_thread, switch_to_thread, vcpu_restore, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain - for valid_queues [wp, DetSchedSchedule_AI_assms]: valid_queues + for valid_queues [wp, Arch_assms]: valid_queues (simp: crunch_simps wp: crunch_wps ignore: tcb_sched_action) crunch switch_to_idle_thread, switch_to_thread, vcpu_disable, vcpu_restore, vcpu_save, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers - for weak_valid_sched_action [wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action + for weak_valid_sched_action [wp, Arch_assms]: weak_valid_sched_action (simp: crunch_simps wp: crunch_wps) crunch set_vm_root @@ -115,7 +115,7 @@ lemma vcpu_switch_valid_sched_action[wp]: unfolding valid_sched_action_def is_activatable_def st_tcb_at_kh_simp by (rule hoare_lift_Pf[where f=cur_thread]; wpsimp wp: hoare_vcg_imp_lift switch_in_cur_domain_lift) -lemma switch_to_idle_thread_ct_not_in_q[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_in_q[wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\_. ct_not_in_q\" unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def apply (wpsimp | wps)+ @@ -128,7 +128,7 @@ crunch set_vm_root, vcpu_switch thread (cur_domain s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_sched_action [wp, Arch_assms]: "\valid_sched_action and valid_idle\ switch_to_idle_thread \\_. valid_sched_action\" @@ -143,13 +143,13 @@ crunch set_vm_root (scheduler_action s) (cur_domain s) (etcbs_of s)" (wp: crunch_wps simp: crunch_simps ignore: set_asid_pool) -lemma switch_to_idle_thread_ct_in_cur_domain[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_in_cur_domain[wp, Arch_assms]: "\\\ switch_to_idle_thread \\_. ct_in_cur_domain\" unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_disj_lift | simp add: ct_in_cur_domain_def | wps)+ crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (simp: crunch_simps wp: crunch_wps) lemma do_machine_op_activatable[wp]: @@ -173,22 +173,22 @@ lemma set_asid_pool_is_activatable[wp]: crunch vcpu_disable, vcpu_restore, vcpu_save, vcpu_switch, set_vm_root for etcbs_of[wp]: "\s. P (etcbs_of s)" and is_activatable[wp]: "is_activatable t" - and valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + and valid_sched[wp, Arch_assms]: valid_sched (wp: crunch_wps valid_sched_lift simp: crunch_simps ignore: set_asid_pool) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for is_activatable[wp, DetSchedSchedule_AI_assms]: "is_activatable t" + for is_activatable[wp, Arch_assms]: "is_activatable t" (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for valid_sched_action [wp, DetSchedSchedule_AI_assms]: valid_sched_action + for valid_sched_action [wp, Arch_assms]: valid_sched_action (simp: crunch_simps ignore: set_asid_pool wp: crunch_wps valid_sched_action_lift[where f="set_asid_pool ptr pool" for ptr pool]) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain, arch_post_set_flags, arch_prepare_set_domain - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps wp: crunch_wps) lemma arch_thread_set_ct_in_cur_domain_2[wp]: @@ -197,7 +197,7 @@ lemma arch_thread_set_ct_in_cur_domain_2[wp]: by wpsimp crunch arch_switch_to_thread - for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" + for ct_in_cur_domain_2[wp, Arch_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" (simp: crunch_simps wp: assert_inv crunch_wps ignore: set_vcpu) crunch set_asid_pool @@ -210,13 +210,13 @@ lemma set_asid_pool_ct_in_q[wp]: by (wpsimp wp: hoare_vcg_imp_lift' | wps)+ crunch vcpu_switch, arch_prepare_next_domain - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" - and valid_blocked[wp, DetSchedSchedule_AI_assms]: valid_blocked + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift crunch_wps) crunch arch_prepare_set_domain - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and valid_idle[wp, Arch_assms]: valid_idle lemma as_user_ct_in_q[wp]: "as_user t f \ct_in_q\" @@ -231,7 +231,7 @@ lemma vcpu_switch_ct_in_q[wp]: apply wp done -lemma arch_prepare_next_domain_ct_in_q[wp, DetSchedSchedule_AI_assms]: +lemma arch_prepare_next_domain_ct_in_q[wp, Arch_assms]: "arch_prepare_next_domain \ct_in_q\" unfolding ct_in_q_def by (wp_pre, wps, wpsimp+) @@ -250,22 +250,22 @@ crunch lazy_fpu_restore and ct_in_q[wp]: ct_in_q (wp: crunch_wps) -lemma arch_switch_to_thread_valid_blocked[wp, DetSchedSchedule_AI_assms]: +lemma arch_switch_to_thread_valid_blocked[wp, Arch_assms]: "\valid_blocked and ct_in_q\ arch_switch_to_thread thread \\_. valid_blocked and ct_in_q\" by (wpsimp simp: arch_switch_to_thread_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" crunch arch_switch_to_idle_thread - for valid_idle[wp, DetSchedSchedule_AI_assms]: "valid_idle" + for valid_idle[wp, Arch_assms]: "valid_idle" (wp: crunch_wps simp: crunch_simps) crunch arch_prepare_next_domain, arch_prepare_set_domain - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" (simp: Let_def) -lemma switch_to_idle_thread_ct_not_queued[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_queued[wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\rv s. not_queued (cur_thread s) s\" @@ -293,7 +293,7 @@ crunch set_vm_root, vcpu_switch (scheduler_action s) thread" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ switch_to_idle_thread \\rv. valid_blocked\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def | wp | wpc)+ apply clarsimp @@ -302,7 +302,7 @@ lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: done crunch arch_switch_to_thread - for exst[wp, DetSchedSchedule_AI_assms]: "\s. P (exst s :: det_ext)" + for exst[wp, Arch_assms]: "\s. P (exst s :: det_ext)" crunch arch_switch_to_idle_thread for cur_thread[wp]: "\s. P (cur_thread s)" @@ -312,14 +312,14 @@ lemma astit_st_tcb_at[wp]: apply (simp add: arch_switch_to_idle_thread_def) by (wpsimp) -lemma stit_activatable'[DetSchedSchedule_AI_assms]: +lemma stit_activatable'[Arch_assms]: "\valid_idle\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def ct_in_state_def do_machine_op_def split_def) apply wpsimp apply (clarsimp simp: valid_idle_def ct_in_state_def pred_tcb_at_def obj_at_def) done -lemma switch_to_idle_thread_cur_thread_idle_thread[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_cur_thread_idle_thread[wp, Arch_assms]: "\\\ switch_to_idle_thread \\_ s. cur_thread s = idle_thread s\" by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+ @@ -344,22 +344,22 @@ lemma set_asid_pool_valid_sched[wp]: crunch arch_finalise_cap, prepare_thread_delete - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action) crunch arch_finalise_cap, prepare_thread_delete - for simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action + for simple_sched_action[wp, Arch_assms]: simple_sched_action (wp: hoare_drop_imps mapM_x_wp mapM_wp subset_refl simp: unless_def if_fun_split) crunch arch_finalise_cap, prepare_thread_delete, arch_invoke_irq_handler, arch_mask_irq_signal - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" (ignore: set_object wp: crunch_wps subset_refl simp: if_fun_split) -lemma activate_thread_valid_sched [DetSchedSchedule_AI_assms]: +lemma activate_thread_valid_sched [Arch_assms]: "\valid_sched\ activate_thread \\_. valid_sched\" apply (simp add: activate_thread_def) apply (wp set_thread_state_runnable_valid_sched gts_wp | wpc | simp add: arch_activate_idle_thread_def)+ @@ -391,7 +391,7 @@ crunch perform_vcpu_invocation, perform_smc_invocation for valid_sched[wp]: valid_sched (wp: crunch_wps simp: crunch_simps ignore: set_thread_state) -lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: +lemma arch_perform_invocation_valid_sched [wp, Arch_assms]: "\invs and valid_sched and ct_active and valid_arch_inv a\ arch_perform_invocation a \\_.valid_sched\" @@ -402,24 +402,24 @@ lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: crunch handle_arch_fault_reply, handle_vm_fault - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps) crunch handle_vm_fault, handle_arch_fault_reply - for not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" + for not_queued[wp, Arch_assms]: "not_queued t" (simp: crunch_simps) crunch handle_arch_fault_reply, handle_vm_fault - for sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" + for sched_act_not[wp, Arch_assms]: "scheduler_act_not t" (simp: crunch_simps) -lemma hvmf_st_tcb_at [wp, DetSchedSchedule_AI_assms]: +lemma hvmf_st_tcb_at [wp, Arch_assms]: "\st_tcb_at P t' \ handle_vm_fault t w \\rv. st_tcb_at P t' \" unfolding handle_vm_fault_def by (cases w; wpsimp) -lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: +lemma handle_vm_fault_st_tcb_cur_thread [wp, Arch_assms]: "\ \s. st_tcb_at P (cur_thread s) s \ handle_vm_fault t f \\_ s. st_tcb_at P (cur_thread s) s \" unfolding handle_vm_fault_def apply (fold ct_in_state_def) @@ -427,37 +427,37 @@ lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: done crunch arch_invoke_irq_control - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" crunch arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for valid_list[wp, DetSchedSchedule_AI_assms]: "valid_list" + for valid_list[wp, Arch_assms]: "valid_list" crunch handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info, arch_post_modify_registers - for cur_tcb[wp, DetSchedSchedule_AI_assms]: cur_tcb + for cur_tcb[wp, Arch_assms]: cur_tcb (simp: crunch_simps dmo_inv) crunch arch_get_sanitise_register_info, arch_post_modify_registers - for not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t'" + for not_cur_thread[wp, Arch_assms]: "not_cur_thread t'" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" -lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]: +lemma arch_post_modify_registers_not_idle_thread[Arch_assms]: "\\s::det_ext state. t \ idle_thread s\ arch_post_modify_registers c t \\_ s. t \ idle_thread s\" by (wpsimp simp: arch_post_modify_registers_def) crunch arch_post_cap_deletion - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q - and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action - and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t" - and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" - and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" - and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and ct_not_in_q[wp, Arch_assms]: ct_not_in_q + and simple_sched_action[wp, Arch_assms]: simple_sched_action + and not_cur_thread[wp, Arch_assms]: "not_cur_thread t" + and not_queued[wp, Arch_assms]: "not_queued t" + and sched_act_not[wp, Arch_assms]: "scheduler_act_not t" + and weak_valid_sched_action[wp, Arch_assms]: weak_valid_sched_action + and valid_idle[wp, Arch_assms]: valid_idle crunch delete_asid_pool for delete_asid_pool[wp]: "\(s:: det_ext state). P (idle_thread s)" @@ -465,27 +465,28 @@ crunch delete_asid_pool crunch arch_finalise_cap - for arch_finalise_cap[wp, DetSchedSchedule_AI_assms]: "\(s:: det_ext state). P (idle_thread s)" + for arch_finalise_cap[wp, Arch_assms]: "\(s:: det_ext state). P (idle_thread s)" (wp: crunch_wps simp: if_fun_split) crunch arch_switch_to_thread, handle_spurious_irq - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for valid_sched[wp, Arch_assms]: valid_sched + and valid_idle[wp, Arch_assms]: valid_idle + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" crunch prepare_thread_delete, arch_post_cap_deletion, arch_finalise_cap - for cur_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_thread s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for cur_thread[wp, Arch_assms]: "\s. P (cur_thread s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) +lemmas DetSchedSchedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.DetSchedSchedule_AI_assms)?) qed context Arch begin arch_global_naming @@ -553,12 +554,15 @@ lemma handle_reserved_irq_valid_sched: apply (simp add: irq_vppi_event_index_def) done +lemmas [Arch_assms] = handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched + +lemmas DetSchedSchedule_AI_handle_hypervisor_fault_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI_handle_hypervisor_fault?: DetSchedSchedule_AI_handle_hypervisor_fault proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.DetSchedSchedule_AI_handle_hypervisor_fault_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchDeterministic_AI.thy b/proof/invariant-abstract/AARCH64/ArchDeterministic_AI.thy index a8626e668c..17c0db8549 100644 --- a/proof/invariant-abstract/AARCH64/ArchDeterministic_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchDeterministic_AI.thy @@ -13,14 +13,14 @@ declare dxo_wp_weak[wp del] context Arch begin arch_global_naming -named_theorems Deterministic_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Deterministic_AI locale *) crunch vcpu_save, vcpu_enable, vcpu_disable, vcpu_restore, arch_get_sanitise_register_info, arch_post_modify_registers - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -lemma vcpu_switch_valid_list[wp, Deterministic_AI_assms]: +lemma vcpu_switch_valid_list[wp, Arch_assms]: "vcpu_switch v \valid_list\" unfolding vcpu_switch_def by wpsimp @@ -28,22 +28,23 @@ lemma vcpu_switch_valid_list[wp, Deterministic_AI_assms]: crunch cap_swap_for_delete,set_cap,finalise_cap,arch_get_sanitise_register_info, arch_post_modify_registers, arch_post_set_flags - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -declare get_cap_inv[Deterministic_AI_assms] +declare get_cap_inv[Arch_assms] + +lemmas Deterministic_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Deterministic_AI_1?: Deterministic_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Deterministic_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_invoke_irq_handler - for valid_list[wp,Deterministic_AI_assms]: valid_list + for valid_list[wp,Arch_assms]: valid_list crunch invoke_untyped for valid_list[wp]: valid_list @@ -72,15 +73,15 @@ crunch perform_invocation (wp: crunch_wps simp: crunch_simps ignore: without_preemption as_user) crunch handle_invocation - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps syscall_valid simp: crunch_simps ignore: without_preemption syscall) crunch handle_recv, handle_yield, handle_call - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: crunch_simps) -lemma handle_vm_fault_valid_list[wp, Deterministic_AI_assms]: +lemma handle_vm_fault_valid_list[wp, Arch_assms]: "handle_vm_fault thread fault \valid_list\" unfolding handle_vm_fault_def by (cases fault; wpsimp) @@ -88,7 +89,7 @@ crunch vgic_maintenance, vppi_event for valid_list[wp]: valid_list (wp: hoare_drop_imps) -lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: +lemma handle_interrupt_valid_list[wp, Arch_assms]: "\valid_list\ handle_interrupt irq \\_.valid_list\" unfolding handle_interrupt_def ackInterrupt_def apply (rule hoare_pre) @@ -97,18 +98,19 @@ lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: | wp (once) hoare_drop_imps)+ crunch handle_send, handle_reply, handle_spurious_irq - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list crunch handle_hypervisor_fault - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (simp: isFpuEnable_def) +lemmas Deterministic_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Deterministic_AI_2?: Deterministic_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Deterministic_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy b/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy index 3b53e82ced..3972ffabf7 100644 --- a/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchDetype_AI.thy @@ -11,16 +11,16 @@ begin context Arch begin arch_global_naming -named_theorems Detype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_AI locale *) -lemma valid_globals_irq_node[Detype_AI_assms]: +lemma valid_globals_irq_node[Arch_assms]: "\ valid_global_refs s; cte_wp_at ((=) cap) ptr s \ \ interrupt_irq_node s irq \ cap_range cap" apply (erule(1) valid_global_refsD) apply (simp add: global_refs_def) done -lemma caps_of_state_ko[Detype_AI_assms]: +lemma caps_of_state_ko[Arch_assms]: "valid_cap cap s \ is_untyped_cap cap \ cap_range cap = {} \ @@ -34,7 +34,7 @@ lemma caps_of_state_ko[Detype_AI_assms]: split: option.splits if_splits)+ done -lemma mapM_x_storeWord[Detype_AI_assms]: +lemma mapM_x_storeWord[Arch_assms]: (* FIXME: taken from Retype_C.thy and adapted wrt. the missing intvl syntax. *) assumes al: "is_aligned ptr word_size_bits" shows "mapM_x (\x. storeWord (ptr + of_nat x * word_size) 0) [0..x. if x \ S then {} else state_hyp_refs_of s x)" by (rule ext, simp add: state_hyp_refs_of_def detype_def) +lemmas Detype_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Detype_AI?: Detype_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Detype_AI_assms)?) + by (intro_locales; (unfold_locales; fact AARCH64.Detype_AI_assms)?) qed context detype_locale_arch begin diff --git a/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy b/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy index 4e02070429..d779414225 100644 --- a/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchEmptyFail_AI.thy @@ -11,29 +11,30 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_AI locale *) crunch_ignore (empty_fail) (add: pt_lookup_from_level) crunch load_word_offs, get_mrs - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] -declare loadWord_empty_fail[EmptyFail_AI_assms] +declare loadWord_empty_fail[Arch_assms] + +lemmas EmptyFail_AI_load_word_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_load_word?: EmptyFail_AI_load_word proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.EmptyFail_AI_load_word_assms)?) qed context Arch begin arch_global_naming crunch handle_fault - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: kernel_object.splits option.splits arch_cap.splits cap.splits endpoint.splits bool.splits list.splits thread_state.splits split_def catch_def sum.splits Let_def) @@ -123,12 +124,13 @@ lemma arch_decode_invocation_empty_fail[wp]: decode_vspace_invocation_def decode_vs_inv_flush_def Let_def decode_sgi_signal_invocation_def decode_smc_invocation_def)\) (* 15s *) +lemmas EmptyFail_AI_derive_cap_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_derive_cap?: EmptyFail_AI_derive_cap proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.EmptyFail_AI_derive_cap_assms)?) qed context Arch begin arch_global_naming @@ -148,29 +150,33 @@ crunch vcpu_update, vcpu_save_reg_range, vgic_update_lr, save_virt_timer crunch maskInterrupt, empty_slot, finalise_cap, preemption_point, vcpu_save, cap_swap_for_delete, decode_invocation - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: Let_def catch_def split_def OR_choiceE_def mk_ef_def option.splits endpoint.splits notification.splits thread_state.splits sum.splits cap.splits arch_cap.splits kernel_object.splits vmpage_size.splits pte.splits bool.splits list.splits) +lemmas EmptyFail_AI_rec_del_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_rec_del?: EmptyFail_AI_rec_del proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.EmptyFail_AI_rec_del_assms)?) qed context Arch begin arch_global_naming + crunch cap_delete, choose_thread, arch_prepare_next_domain - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_schedule_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_schedule?: EmptyFail_AI_schedule proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.EmptyFail_AI_schedule_assms)?) qed context Arch begin arch_global_naming @@ -187,7 +193,7 @@ lemma deactivateInterrupt_empty_fail[wp]: by wpsimp crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: cap.splits arch_cap.splits split_def invocation_label.splits Let_def kernel_object.splits arch_kernel_obj.splits option.splits pte.splits bool.splits apiobject_type.splits aobject_type.splits notification.splits @@ -195,12 +201,13 @@ crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt page_table_invocation.splits page_invocation.splits asid_control_invocation.splits asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits) +lemmas EmptyFail_AI_call_kernel_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_call_kernel?: EmptyFail_AI_call_kernel proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.EmptyFail_AI_call_kernel_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchFinalise_AI.thy b/proof/invariant-abstract/AARCH64/ArchFinalise_AI.thy index 1dcf363104..b86ee1dd9c 100644 --- a/proof/invariant-abstract/AARCH64/ArchFinalise_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchFinalise_AI.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Finalise_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_AI locale *) lemma valid_global_refs_asid_table_udapte [iff]: "valid_global_refs (s\arch_state := arm_asid_table_update f (arch_state s)\) = @@ -210,17 +210,17 @@ lemma unmap_page_tcb_cap_valid: done -lemma (* replaceable_cdt_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_cdt_update *)[simp,Arch_assms]: "replaceable (cdt_update f s) = replaceable s" by (fastforce simp: replaceable_def tcb_cap_valid_def reachable_frame_cap_def reachable_target_def) -lemma (* replaceable_revokable_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_revokable_update *)[simp,Arch_assms]: "replaceable (is_original_cap_update f s) = replaceable s" by (fastforce simp: replaceable_def is_final_cap'_def2 tcb_cap_valid_def reachable_frame_cap_def reachable_target_def) -lemma (* replaceable_more_update *) [simp,Finalise_AI_assms]: +lemma (* replaceable_more_update *) [simp,Arch_assms]: "replaceable (trans_state f s) sl cap cap' = replaceable s sl cap cap'" by (simp add: replaceable_def reachable_frame_cap_def reachable_target_def) @@ -232,9 +232,9 @@ lemma reachable_frame_cap_trans_state[simp]: "reachable_frame_cap cap (trans_state f s) = reachable_frame_cap cap s" by (simp add: reachable_frame_cap_def) -lemmas [Finalise_AI_assms] = obj_refs_obj_ref_of (* used under name obj_ref_ofI *) +lemmas [Arch_assms] = obj_refs_obj_ref_of (* used under name obj_ref_ofI *) -lemma (* empty_slot_invs *) [Finalise_AI_assms]: +lemma (* empty_slot_invs *) [Arch_assms]: "\\s. invs s \ cte_wp_at (replaceable s sl cap.NullCap) sl s \ emptyable sl s \ (info \ NullCap \ post_cap_delete_pre info ((caps_of_state s) (sl \ NullCap)))\ @@ -314,7 +314,7 @@ lemma (* empty_slot_invs *) [Finalise_AI_assms]: apply (simp add: is_final_cap'_def2 cte_wp_at_caps_of_state) by fastforce -lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: +lemma dom_tcb_cap_cases_lt_ARCH [Arch_assms]: "dom tcb_cap_cases = {xs. length xs = 3 \ unat (of_bl xs :: machine_word) < 5}" apply (rule set_eqI, rule iffI) apply clarsimp @@ -324,7 +324,7 @@ lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: apply (clarsimp simp: nat_to_cref_unat_of_bl') done -lemma (* unbind_notification_final *) [wp,Finalise_AI_assms]: +lemma (* unbind_notification_final *) [wp,Arch_assms]: "\is_final_cap' cap\ unbind_notification t \ \rv. is_final_cap' cap\" unfolding unbind_notification_def apply (wp final_cap_lift thread_set_caps_of_state_trivial hoare_drop_imps @@ -335,7 +335,7 @@ crunch prepare_thread_delete for caps_of_state[wp]: "\s. P (caps_of_state s)" (wp: crunch_wps ignore: do_machine_op) -declare prepare_thread_delete_caps_of_state [Finalise_AI_assms] +declare prepare_thread_delete_caps_of_state [Arch_assms] lemma dissociate_vcpu_tcb_final_cap[wp]: "\is_final_cap' cap\ dissociate_vcpu_tcb v t \\rv. is_final_cap' cap\" @@ -354,7 +354,7 @@ lemma length_and_unat_of_bl_length: "(length xs = x \ unat (of_bl xs :: 'a::len word) < 2 ^ x) = (length xs = x)" by (auto simp: unat_of_bl_length) -lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: +lemma (* finalise_cap_cases1 *)[Arch_assms]: "\\s. final \ is_final_cap' cap s \ cte_wp_at ((=) cap) slot s\ finalise_cap cap final @@ -389,12 +389,12 @@ crunch dissociate_vcpu_tcb ignore: do_machine_op set_object) crunch arch_finalise_cap - for typ_at[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp,Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps unless_def assertE_def ignore: maskInterrupt set_object) crunch prepare_thread_delete - for typ_at[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp,Arch_assms]: "\s. P (typ_at T p s)" crunch dissociate_vcpu_tcb for tcb_at[wp]: "\s. tcb_at p s" @@ -404,7 +404,7 @@ crunch prepare_thread_delete for tcb_at[wp]: "\s. tcb_at p s" (wp: crunch_wps) -lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: +lemma (* finalise_cap_new_valid_cap *)[wp,Arch_assms]: "\valid_cap cap\ finalise_cap cap x \\rv. valid_cap (fst rv)\" apply (cases cap; simp) apply (wp suspend_valid_cap prepare_thread_delete_typ_at @@ -724,7 +724,7 @@ crunch vcpu_finalise for invs[wp]: invs (ignore: dissociate_vcpu_tcb) -lemma arch_finalise_cap_invs' [wp,Finalise_AI_assms]: +lemma arch_finalise_cap_invs' [wp,Arch_assms]: "\invs and valid_cap (ArchObjectCap cap)\ arch_finalise_cap cap final \\rv. invs\" @@ -778,14 +778,14 @@ lemma arch_finalise_cap_vcpu: apply (wpsimp wp: wps simp: simps reachable_frame_cap_def | strengthen strg)+ done -lemma obj_at_not_live_valid_arch_cap_strg [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r \ \ typ_at (AArch AVCPU) r s) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: live_def valid_cap_def valid_arch_cap_ref_def obj_at_def a_type_arch_live valid_cap_simps hyp_live_def arch_live_def split: arch_cap.split_asm if_splits) -lemma obj_at_not_live_valid_arch_cap_strg' [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg' [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r \ cap \ VCPUCap r) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: live_def valid_cap_def valid_arch_cap_ref_def obj_at_def @@ -1040,7 +1040,7 @@ lemma arch_finalise_cap_replaceable: apply (clarsimp simp: valid_cap_def wellformed_mapdata_def cap_aligned_def obj_at_def) done -lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_slot_not_irq_node *)[Arch_assms]: "\if_unsafe_then_cap and valid_global_refs and cte_wp_at (\cp. cap_irqs cp \ {}) sl\ deleting_irq_handler irq @@ -1061,7 +1061,7 @@ lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: apply (clarsimp simp: appropriate_cte_cap_def split: cap.split_asm) done -lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Arch_assms]: "\ cte_wp_at ((=) cap) p s; is_final_cap' cap s; obj_refs cap' = obj_refs cap \ \ no_cap_to_obj_with_diff_ref cap' {p} s" @@ -1083,7 +1083,7 @@ lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: gen_obj_refs_Int) done -lemma (* suspend_no_cap_to_obj_ref *)[wp,Finalise_AI_assms]: +lemma (* suspend_no_cap_to_obj_ref *)[wp,Arch_assms]: "\no_cap_to_obj_with_diff_ref cap S\ suspend t \\rv. no_cap_to_obj_with_diff_ref cap S\" @@ -1209,7 +1209,7 @@ crunch suspend, unbind_notification for valid_cur_fpu[wp]: valid_cur_fpu (wp: crunch_wps simp: crunch_simps) -lemma finalise_cap_replaceable [Finalise_AI_assms]: +lemma finalise_cap_replaceable [Arch_assms]: "\\s. s \ cap \ x = is_final_cap' cap s \ valid_mdb s \ valid_cur_fpu s \ cte_wp_at ((=) cap) sl s \ valid_objs s \ sym_refs (state_refs_of s) \ (cap_irqs cap \ {} \ if_unsafe_then_cap s \ valid_global_refs s) @@ -1260,7 +1260,7 @@ lemma finalise_cap_replaceable [Finalise_AI_assms]: | wpc | simp add: valid_cap_simps)+)) -lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_cte_preserved *)[Arch_assms]: assumes x: "\cap. P cap \ \ can_fast_finalise cap" shows "\cte_wp_at P p\ deleting_irq_handler irq \\rv. cte_wp_at P p\" apply (simp add: deleting_irq_handler_def) @@ -1268,30 +1268,31 @@ lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: done crunch dissociate_vcpu_tcb - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) crunch prepare_thread_delete - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) crunch arch_finalise_cap - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) -declare arch_post_cap_deletion_cur_thread[Finalise_AI_assms] +declare arch_post_cap_deletion_cur_thread[Arch_assms] crunch arch_post_cap_deletion - for cur_domain[Finalise_AI_assms, wp]: "\s. P (cur_domain s)" + for cur_domain[Arch_assms, wp]: "\s. P (cur_domain s)" (wp: crunch_wps dxo_wp_weak) +lemmas Finalise_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_1?: Finalise_AI_1 proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + by (intro_locales; (unfold_locales; fact AARCH64.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -1315,7 +1316,7 @@ lemma fast_finalise_replaceable[wp]: apply (clarsimp simp: cap_irqs_def cap_irq_opt_def split: cap.split_asm) done -lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: +lemma (* cap_delete_one_invs *) [Arch_assms,wp]: "\invs and emptyable ptr\ cap_delete_one ptr \\rv. invs\" apply (simp add: cap_delete_one_def unless_def is_final_cap_def) apply (rule hoare_pre) @@ -1324,12 +1325,13 @@ lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: apply (drule cte_wp_at_valid_objs_valid_cap, fastforce+) done +lemmas Finalise_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_2?: Finalise_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.Finalise_AI_2_assms)?) qed context Arch begin arch_global_naming @@ -1341,7 +1343,7 @@ crunch (wp: crunch_wps subset_refl) crunch prepare_thread_delete - for irq_node[Finalise_AI_assms,wp]: "\s. P (interrupt_irq_node s)" + for irq_node[Arch_assms,wp]: "\s. P (interrupt_irq_node s)" (wp: crunch_wps simp: crunch_simps) crunch arch_finalise_cap @@ -1489,7 +1491,7 @@ crunch prepare_thread_delete for invs[wp]: invs (ignore: set_object do_machine_op wp: dmo_invs_lift) -lemma (* finalise_cap_invs *)[Finalise_AI_assms]: +lemma (* finalise_cap_invs *)[Arch_assms]: shows "\invs and cte_wp_at ((=) cap) slot\ finalise_cap cap x \\rv. invs\" apply (cases cap, simp_all split del: if_split) apply (wp cancel_all_ipc_invs cancel_all_signals_invs unbind_notification_invs @@ -1506,14 +1508,14 @@ lemma (* finalise_cap_invs *)[Finalise_AI_assms]: apply (auto dest: cte_wp_at_valid_objs_valid_cap) done -lemma (* finalise_cap_irq_node *)[Finalise_AI_assms]: +lemma (* finalise_cap_irq_node *)[Arch_assms]: "\\s. P (interrupt_irq_node s)\ finalise_cap a b \\_ s. P (interrupt_irq_node s)\" by (case_tac a, wpsimp+) -lemmas (*arch_finalise_cte_irq_node *) [wp,Finalise_AI_assms] +lemmas (*arch_finalise_cte_irq_node *) [wp,Arch_assms] = hoare_use_eq_irq_node [OF arch_finalise_cap_irq_node arch_finalise_cap_cte_wp_at] -lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: +lemma (* deleting_irq_handler_st_tcb_at *) [Arch_assms]: "\st_tcb_at P t and K (\st. simple st \ P st)\ deleting_irq_handler irq \\rv. st_tcb_at P t\" @@ -1522,11 +1524,11 @@ lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: apply simp done -lemma irq_node_global_refs_ARCH [Finalise_AI_assms]: +lemma irq_node_global_refs_ARCH [Arch_assms]: "interrupt_irq_node s irq \ global_refs s" by (simp add: global_refs_def) -lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: +lemma (* get_irq_slot_fast_finalisable *)[wp,Arch_assms]: "\invs\ get_irq_slot irq \cte_wp_at can_fast_finalise\" apply (simp add: get_irq_slot_def) apply wp @@ -1548,12 +1550,12 @@ lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: apply (clarsimp simp: cap_range_def) done -lemma (* replaceable_or_arch_update_same *) [Finalise_AI_assms]: +lemma (* replaceable_or_arch_update_same *) [Arch_assms]: "replaceable_or_arch_update s slot cap cap" by (clarsimp simp: replaceable_or_arch_update_def replaceable_def is_arch_update_def is_cap_simps) -lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: +lemma (* replace_cap_invs_arch_update *)[Arch_assms]: "\\s. cte_wp_at (replaceable_or_arch_update s p cap) p s \ invs s \ cap \ cap.NullCap @@ -1578,7 +1580,7 @@ lemma dmo_pred_tcb_at[wp]: apply (clarsimp simp: pred_tcb_at_def obj_at_def) done -lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: +lemma dmo_tcb_cap_valid_ARCH [Arch_assms]: "do_machine_op mop \\s. P (tcb_cap_valid cap ptr s)\" apply (simp add: tcb_cap_valid_def no_cap_to_obj_with_diff_ref_def) apply (wp_pre, wps, rule hoare_vcg_prop) @@ -1596,7 +1598,7 @@ lemma dmo_reachable_target[wp]: apply simp done -lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: +lemma (* dmo_replaceable_or_arch_update *) [Arch_assms,wp]: "\\s. replaceable_or_arch_update s slot cap cap'\ do_machine_op mo \\r s. replaceable_or_arch_update s slot cap cap'\" @@ -1607,6 +1609,8 @@ lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: apply simp done +lemmas Finalise_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end arch_requalify_consts replaceable_or_arch_update @@ -1614,9 +1618,8 @@ arch_requalify_consts replaceable_or_arch_update interpretation Finalise_AI_3?: Finalise_AI_3 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + by (intro_locales; (unfold_locales; fact AARCH64.Finalise_AI_3_assms)?) qed context Arch begin arch_global_naming @@ -1633,8 +1636,7 @@ end interpretation Finalise_AI_4?: Finalise_AI_4 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -1672,9 +1674,9 @@ lemma arch_finalise_cap_valid_cap[wp]: unfolding arch_finalise_cap_def by (wpsimp split: arch_cap.split option.split bool.split) -lemmas clearMemory_invs[wp,Finalise_AI_assms] = clearMemory_invs +lemmas clearMemory_invs[wp,Arch_assms] = clearMemory_invs -lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: +lemma valid_idle_has_null_cap_ARCH[Arch_assms]: "\ if_unsafe_then_cap s; valid_global_refs s; valid_idle s; valid_irq_node s; caps_of_state s (idle_thread s, v) = Some cap \ \ cap = NullCap" @@ -1690,7 +1692,7 @@ lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: apply (drule_tac x=word in spec, simp) done -lemma (* zombie_cap_two_nonidles *)[Finalise_AI_assms]: +lemma (* zombie_cap_two_nonidles *)[Arch_assms]: "\ caps_of_state s ptr = Some (Zombie ptr' zbits n); invs s \ \ fst ptr \ idle_thread s \ ptr' \ idle_thread s" apply (frule valid_global_refsD2, clarsimp+) @@ -1706,13 +1708,14 @@ lemma arch_derive_cap_notIRQ[wp]: "\\\ arch_derive_cap cap \\rv s. rv \ cap.IRQControlCap\,-" by (cases cap; wpsimp simp: arch_derive_cap_def o_def) +lemmas Finalise_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_5?: Finalise_AI_5 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.Finalise_AI_5_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchInterruptAcc_AI.thy b/proof/invariant-abstract/AARCH64/ArchInterruptAcc_AI.thy index e066edf8c0..72fc6cb8e7 100644 --- a/proof/invariant-abstract/AARCH64/ArchInterruptAcc_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchInterruptAcc_AI.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems InterruptAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InterruptAcc_AI locale *) -lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: +lemma dmo_maskInterrupt_invs [Arch_assms]: "\all_invs_but_valid_irq_states_for irq and (\s. state = interrupt_states s irq)\ do_machine_op (maskInterrupt (state = IRQInactive) irq) \\rv. invs\" @@ -30,12 +30,13 @@ lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: crunch handle_spurious_irq for invs: invs +lemmas InterruptAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation InterruptAcc_AI?: InterruptAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact InterruptAcc_AI_assms) + case 1 show ?case by (unfold_locales; fact AARCH64.InterruptAcc_AI_assms) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy b/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy index 372c9084f3..b77a021ef6 100644 --- a/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchInterrupt_AI.thy @@ -29,16 +29,16 @@ primrec arch_irq_control_inv_valid_real :: defs arch_irq_control_inv_valid_def: "arch_irq_control_inv_valid \ arch_irq_control_inv_valid_real" -named_theorems Interrupt_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_AI locale *) -lemma (* decode_irq_control_invocation_inv *)[Interrupt_AI_assms]: +lemma (* decode_irq_control_invocation_inv *)[Arch_assms]: "\P\ decode_irq_control_invocation label args slot caps \\rv. P\" apply (simp add: decode_irq_control_invocation_def Let_def arch_check_irq_def range_check_def arch_decode_irq_control_invocation_def whenE_def, safe) apply (wp | simp)+ done -lemma decode_irq_control_valid [Interrupt_AI_assms]: +lemma decode_irq_control_valid [Arch_assms]: "\\s. invs s \ (\cap \ set caps. s \ cap) \ (\cap \ set caps. is_cnode_cap cap \ (\r \ cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -55,7 +55,7 @@ lemma decode_irq_control_valid [Interrupt_AI_assms]: apply (fastforce split: if_split simp: maxIRQ_def) done -lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: +lemma get_irq_slot_different_ARCH[Arch_assms]: "\\s. valid_global_refs s \ ex_cte_cap_wp_to is_cnode_cap ptr s\ get_irq_slot irq \\rv s. rv \ ptr\" @@ -67,7 +67,7 @@ lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: apply (clarsimp simp: global_refs_def is_cap_simps cap_range_def) done -lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: +lemma is_derived_use_interrupt_ARCH[Arch_assms]: "(is_ntfn_cap cap \ interrupt_derived cap cap') \ (is_derived m p cap cap')" apply (clarsimp simp: is_cap_simps) apply (clarsimp simp: interrupt_derived_def is_derived_def) @@ -75,19 +75,19 @@ lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: apply (simp add: is_cap_simps is_pt_cap_def vs_cap_ref_def) done -lemma maskInterrupt_invs_ARCH[Interrupt_AI_assms]: +lemma maskInterrupt_invs_ARCH[Arch_assms]: "\invs and (\s. \b \ interrupt_states s irq \ IRQInactive)\ do_machine_op (maskInterrupt b irq) \\rv. invs\" by (rule maskInterrupt_invs) -lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Interrupt_AI_assms]: +lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Arch_assms]: "no_cap_to_obj_with_diff_ref (IRQHandlerCap irq) S = \" by (rule ext, simp add: no_cap_to_obj_with_diff_ref_def cte_wp_at_caps_of_state obj_ref_none_no_asid) -lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: +lemma (* set_irq_state_valid_cap *)[Arch_assms]: "\valid_cap cap\ set_irq_state IRQSignal irq \\rv. valid_cap cap\" apply (clarsimp simp: set_irq_state_def) apply (wp do_machine_op_valid_cap) @@ -97,7 +97,7 @@ lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: done crunch set_irq_state - for valid_global_refs[Interrupt_AI_assms]: "valid_global_refs" + for valid_global_refs[Arch_assms]: "valid_global_refs" lemma deactivateInterrupt_invs: "\invs and (\s. interrupt_states s irq \ IRQInactive) and K config_ARM_GIC_V3\ @@ -107,7 +107,7 @@ lemma deactivateInterrupt_invs: by (cases config_ARM_GIC_V3; simp) (wpsimp wp: maskInterrupt_invs) -lemma invoke_irq_handler_invs'[Interrupt_AI_assms]: +lemma invoke_irq_handler_invs'[Arch_assms]: assumes dmo_ex_inv[wp]: "\f. \invs and ex_inv\ do_machine_op f \\rv::unit. ex_inv\" assumes cap_insert_ex_inv[wp]: "\cap src dest. \ex_inv and invs and K (src \ dest)\ @@ -178,7 +178,7 @@ lemma valid_cap_SGISignalCap[simp, intro!]: unfolding valid_cap_def by (clarsimp simp: cap_aligned_def word_bits_def) -lemma (* invoke_irq_control_invs *) [Interrupt_AI_assms]: +lemma (* invoke_irq_control_invs *) [Arch_assms]: "\invs and irq_control_inv_valid i\ invoke_irq_control i \\rv. invs\" apply (cases i; simp) apply (wp cap_insert_simple_invs @@ -206,7 +206,7 @@ lemma (* invoke_irq_control_invs *) [Interrupt_AI_assms]: crunch resetTimer for device_state_inv[wp]: "\ms. P (device_state ms)" -lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: +lemma resetTimer_invs_ARCH[Arch_assms]: "\invs\ do_machine_op resetTimer \\_. invs\" apply (wp dmo_invs) apply safe @@ -219,11 +219,11 @@ lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: apply(erule use_valid, wp no_irq_resetTimer no_irq, assumption) done -lemma empty_fail_ackInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_ackInterrupt_ARCH[Arch_assms]: "empty_fail (ackInterrupt irq)" by (wp | simp add: ackInterrupt_def)+ -lemma empty_fail_maskInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_maskInterrupt_ARCH[Arch_assms]: "empty_fail (maskInterrupt f irq)" by (wp | simp add: maskInterrupt_def)+ @@ -282,7 +282,7 @@ crunch timer_tick for invs[wp]: invs (wp: thread_set_invs_trivial[OF ball_tcb_cap_casesI]) -lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]: +lemma (* handle_interrupt_invs *) [Arch_assms]: "\invs\ handle_interrupt irq \\_. invs\" apply (simp add: handle_interrupt_def) apply (rule conjI; rule impI) @@ -299,7 +299,7 @@ lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]: | rule conjI)+ done -lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: +lemma sts_arch_irq_control_inv_valid[wp, Arch_assms]: "\arch_irq_control_inv_valid i\ set_thread_state t st \\rv. arch_irq_control_inv_valid i\" @@ -309,12 +309,13 @@ lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: crunch arch_invoke_irq_handler for typ_at[wp]: "\s. P (typ_at T p s)" +lemmas Interrupt_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Interrupt_AI?: Interrupt_AI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: Interrupt_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: AARCH64.Interrupt_AI_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy b/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy index 2e36f068b3..a7f13c86ba 100644 --- a/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchInvariants_AI.thy @@ -44,6 +44,10 @@ end_qualify context Arch begin arch_global_naming +(* used to accumulate theorems for satisfying Arch interface assumptions; + remember to clear before starting a new accumulation *) +named_theorems Arch_assms + definition arch_tcb_to_iarch_tcb :: "arch_tcb \ iarch_tcb" where "arch_tcb_to_iarch_tcb arch_tcb \ \ itcb_vcpu = tcb_vcpu arch_tcb, itcb_cur_fpu = tcb_cur_fpu arch_tcb \" diff --git a/proof/invariant-abstract/AARCH64/ArchIpcCancel_AI.thy b/proof/invariant-abstract/AARCH64/ArchIpcCancel_AI.thy index 1a33884511..a1349f2953 100644 --- a/proof/invariant-abstract/AARCH64/ArchIpcCancel_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchIpcCancel_AI.thy @@ -10,19 +10,20 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_AI locale *) crunch arch_post_cap_deletion - for typ_at[wp, IpcCancel_AI_assms]: "\s. P (typ_at T p s)" - and idle_thread[wp, IpcCancel_AI_assms]: "\s. P (idle_thread s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + +lemmas IpcCancel_AI_assms = Arch_assms (* extract accumulated assumptions *) end interpretation IpcCancel_AI?: IpcCancel_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact IpcCancel_AI_assms)?) + by (intro_locales; (unfold_locales; fact AARCH64.IpcCancel_AI_assms)?) qed diff --git a/proof/invariant-abstract/AARCH64/ArchIpc_AI.thy b/proof/invariant-abstract/AARCH64/ArchIpc_AI.thy index 19718b0643..130a71b593 100644 --- a/proof/invariant-abstract/AARCH64/ArchIpc_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchIpc_AI.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_AI_1_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_1 locale *) lemma cap_asid_PageCap_None[simp]: "cap_asid (ArchObjectCap (FrameCap r R pgsz dev None)) = None" @@ -38,7 +38,7 @@ lemma arch_derive_cap_is_derived: | rule conjI)+) done -lemma derive_cap_is_derived [Ipc_AI_1_assms]: +lemma derive_cap_is_derived [Arch_assms]: "\\s. c'\ cap.NullCap \ cte_wp_at (\cap. cap_master_cap cap = cap_master_cap c' \ (cap_badge cap, cap_badge c') \ capBadge_ordering False \ cap_asid cap = cap_asid c' @@ -64,23 +64,24 @@ lemma derive_cap_is_derived [Ipc_AI_1_assms]: apply(clarsimp simp: valid_cap_def) done -lemma arch_cap_badge_rights_update[Ipc_AI_1_assms, simp]: +lemma arch_cap_badge_rights_update[Arch_assms, simp]: "arch_cap_badge (acap_rights_update rights acap) = arch_cap_badge acap" by (cases acap; simp add: acap_rights_update_def) +lemmas Ipc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_1_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Ipc_AI_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_2 locale *) -lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights [simp, Arch_assms]: "is_derived m p (cap_rights_update R c) = is_derived m p c" apply (rule ext) apply (simp add: cap_rights_update_def is_derived_def is_cap_simps) @@ -92,12 +93,12 @@ lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: split: arch_cap.split cap.split bool.splits) -lemma data_to_message_info_valid [Ipc_AI_2_assms]: +lemma data_to_message_info_valid [Arch_assms]: "valid_message_info (data_to_message_info w)" by (simp add: valid_message_info_def data_to_message_info_def word_and_le1 msg_max_length_def msg_max_extra_caps_def Let_def not_less mask_def) -lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: +lemma get_extra_cptrs_length[wp, Arch_assms]: "\\s . valid_message_info mi\ get_extra_cptrs buf mi \\rv s. length rv \ msg_max_extra_caps\" @@ -112,17 +113,17 @@ lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: intro: length_upt) done -lemma cap_asid_rights_update [simp, Ipc_AI_2_assms]: +lemma cap_asid_rights_update [simp, Arch_assms]: "cap_asid (cap_rights_update R c) = cap_asid c" by (simp add: cap_rights_update_def acap_rights_update_def cap_asid_def split: cap.splits arch_cap.splits) -lemma cap_rights_update_vs_cap_ref[simp, Ipc_AI_2_assms]: +lemma cap_rights_update_vs_cap_ref[simp, Arch_assms]: "vs_cap_ref (cap_rights_update rs cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def vs_cap_ref_arch_def cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) -lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights2[simp, Arch_assms]: "is_derived m p c (cap_rights_update R c') = is_derived m p c c'" apply (case_tac c'; simp add: cap_rights_update_def) apply (clarsimp simp: is_derived_def is_cap_simps cap_master_cap_def vs_cap_ref_def @@ -131,12 +132,12 @@ lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: apply (case_tac acap1) by (auto simp: acap_rights_update_def) -lemma cap_range_update [simp, Ipc_AI_2_assms]: +lemma cap_range_update [simp, Arch_assms]: "cap_range (cap_rights_update R cap) = cap_range cap" by (simp add: cap_range_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits) -lemma derive_cap_idle[wp, Ipc_AI_2_assms]: +lemma derive_cap_idle[wp, Arch_assms]: "\\s. global_refs s \ cap_range cap = {}\ derive_cap slot cap \\c s. global_refs s \ cap_range c = {}\, -" @@ -148,7 +149,7 @@ lemma derive_cap_idle[wp, Ipc_AI_2_assms]: apply (case_tac arch_cap, simp_all) done -lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: +lemma arch_derive_cap_objrefs_iszombie [Arch_assms]: "\\s . P (set_option (aobj_ref cap)) False s\ arch_derive_cap cap \\rv s. rv \ NullCap \ P (obj_refs rv) (is_zombie rv) s\,-" @@ -156,7 +157,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: apply(rule hoare_pre, wpsimp+)+ done -lemma obj_refs_remove_rights[simp, Ipc_AI_2_assms]: +lemma obj_refs_remove_rights[simp, Arch_assms]: "obj_refs (remove_rights rs cap) = obj_refs cap" by (auto simp add: remove_rights_def cap_rights_update_def acap_rights_update_def @@ -168,7 +169,7 @@ lemma storeWord_um_inv: \\_ s. is_aligned a 3 \ x \ {a,a+1,a+2,a+3,a+4,a+5,a+6,a+7} \ underlying_memory s x = um x\" by (wpsimp simp: upto.simps storeWord_def is_aligned_mask) -lemma store_word_offs_vms[wp, Ipc_AI_2_assms]: +lemma store_word_offs_vms[wp, Arch_assms]: "\valid_machine_state\ store_word_offs ptr offs v \\_. valid_machine_state\" proof - have aligned_offset_ignore: @@ -207,12 +208,12 @@ proof - done qed -lemma is_zombie_update_cap_data[simp, Ipc_AI_2_assms]: +lemma is_zombie_update_cap_data[simp, Arch_assms]: "is_zombie (update_cap_data P data cap) = is_zombie cap" by (simp add: update_cap_data_closedform arch_update_cap_data_def is_zombie_def split: cap.splits) -lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: +lemma valid_msg_length_strengthen [Arch_assms]: "valid_message_info mi \ unat (mi_length mi) \ msg_max_length" apply (clarsimp simp: valid_message_info_def) apply (subgoal_tac "unat (mi_length mi) \ unat (of_nat msg_max_length :: machine_word)") @@ -220,7 +221,7 @@ lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: apply (clarsimp simp: un_ui_le word_le_def) done -lemma copy_mrs_in_user_frame[wp, Ipc_AI_2_assms]: +lemma copy_mrs_in_user_frame[wp, Arch_assms]: "\in_user_frame p\ copy_mrs t buf t' buf' n \\rv. in_user_frame p\" by (simp add: in_user_frame_def) (wp hoare_vcg_ex_lift) @@ -228,7 +229,7 @@ lemma as_user_getRestart_inv[wp]: "as_user t getRestartPC \P\" by (simp add: getRestartPC_def, rule user_getreg_inv) -lemma make_arch_fault_msg_inv[wp, Ipc_AI_2_assms]: +lemma make_arch_fault_msg_inv[wp, Arch_assms]: "make_arch_fault_msg ft t \P\" by (cases ft; wpsimp) @@ -236,14 +237,14 @@ lemma make_fault_msg_inv[wp]: "make_fault_msg ft t \P\" by (cases ft; wpsimp wp: as_user_inv getRestartPC_inv mapM_wp' split_del: if_split) -lemma do_fault_transfer_invs[wp, Ipc_AI_2_assms]: +lemma do_fault_transfer_invs[wp, Arch_assms]: "\invs and tcb_at receiver\ do_fault_transfer badge sender receiver recv_buf \\rv. invs\" by (simp add: do_fault_transfer_def split_def | wp | clarsimp split: option.split)+ -lemma lookup_ipc_buffer_in_user_frame[wp, Ipc_AI_2_assms]: +lemma lookup_ipc_buffer_in_user_frame[wp, Arch_assms]: "\valid_objs and tcb_at t\ lookup_ipc_buffer b t \case_option (\_. True) in_user_frame\" apply (simp add: lookup_ipc_buffer_def) @@ -340,9 +341,9 @@ lemma transfer_caps_non_null_cte_wp_at: done crunch do_fault_transfer - for cte_wp_at[wp,Ipc_AI_2_assms]: "cte_wp_at P p" + for cte_wp_at[wp,Arch_assms]: "cte_wp_at P p" -lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: +lemma do_normal_transfer_non_null_cte_wp_at [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at (P and ((\) cap.NullCap)) ptr\ do_normal_transfer st send_buffer ep b gr rt recv_buffer @@ -353,7 +354,7 @@ lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: | clarsimp simp:imp)+ done -lemma is_derived_ReplyCap [simp, Ipc_AI_2_assms]: +lemma is_derived_ReplyCap [simp, Arch_assms]: "\m p R. is_derived m p (cap.ReplyCap t False R) = (\c. is_master_reply_cap c \ obj_ref_of c = t)" apply (subst fun_eq_iff) apply clarsimp @@ -374,7 +375,7 @@ lemma do_normal_transfer_tcb_caps: | simp add:imp)+ done -lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: +lemma do_ipc_transfer_tcb_caps [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at P (t, ref) and tcb_at t\ @@ -386,7 +387,7 @@ lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: | wpc | simp add:imp)+ done -lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: +lemma setup_caller_cap_valid_global_objs[wp, Arch_assms]: "\valid_global_objs\ setup_caller_cap send recv grant \\rv. valid_global_objs\" apply (simp add: valid_global_objs_def) unfolding setup_caller_cap_def @@ -394,9 +395,9 @@ lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: done crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for inv[Ipc_AI_2_assms]: P + for inv[Arch_assms]: P -lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_vspace_objs[wp, Arch_assms]: "\valid_vspace_objs\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_vspace_objs\" @@ -429,11 +430,11 @@ lemma setup_caller_cap_aobj_at: unfolding setup_caller_cap_def by (wpsimp wp: cap_insert_aobj_at sts.aobj_at) -lemma setup_caller_cap_valid_arch[Ipc_AI_2_assms, wp]: +lemma setup_caller_cap_valid_arch[Arch_assms, wp]: "setup_caller_cap st rt grant \valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps[rotated -1] setup_caller_cap_tcb_at setup_caller_cap_aobj_at) -lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_arch[Arch_assms]: "\slots caps ep buffer n mi. \valid_arch_state and valid_objs and valid_mdb and K (distinct slots) and (\s. \x \ set slots. real_cte_at x s \ cte_wp_at (\cap. cap = cap.NullCap) x s) @@ -442,27 +443,28 @@ lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps transfer_caps_loop_typ_ats transfer_caps_loop_aobj_at) +lemmas Ipc_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_2_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Ipc_AI_2_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_3 locale *) lemma dmo_addressTranslateS1_pspace_respects_device_region[wp]: "do_machine_op (addressTranslateS1 addr) \ pspace_respects_device_region \" by (wpsimp wp: pspace_respects_device_region_dmo) crunch do_ipc_transfer - for pspace_respects_device_region[wp, Ipc_AI_3_assms]: "pspace_respects_device_region" + for pspace_respects_device_region[wp, Arch_assms]: "pspace_respects_device_region" (wp: crunch_wps ignore: const_on_failure simp: crunch_simps) -lemma do_ipc_transfer_respects_device_region[Ipc_AI_3_assms]: +lemma do_ipc_transfer_respects_device_region[Arch_assms]: "\cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\ do_ipc_transfer t ep bg grt r \\rv. cap_refs_respects_device_region\" @@ -480,7 +482,7 @@ lemma set_mrs_state_hyp_refs_of[wp]: by (wp set_mrs_thread_set_dmo thread_set_hyp_refs_trivial | simp)+ crunch do_ipc_transfer - for state_hyp_refs_of[wp, Ipc_AI_3_assms]: "\ s. P (state_hyp_refs_of s)" + for state_hyp_refs_of[wp, Arch_assms]: "\ s. P (state_hyp_refs_of s)" (wp: crunch_wps simp: zipWithM_x_mapM) lemma arch_derive_cap_untyped: @@ -501,18 +503,19 @@ lemma valid_arch_mdb_cap_swap: ((caps_of_state s)(a \ c', b \ c))" by (auto simp: valid_arch_mdb_def) -lemma do_ipc_transfer_valid_arch[Ipc_AI_3_assms]: +lemma do_ipc_transfer_valid_arch[Arch_assms]: "\valid_arch_state and valid_objs and valid_mdb \ do_ipc_transfer s ep bg grt r \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps dit_tcb_at do_ipc_transfer_aobj_at) +lemmas Ipc_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_3_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Ipc_AI_3_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy b/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy index 57e18b2b1f..b78b6d599a 100644 --- a/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchRetype_AI.thy @@ -15,19 +15,19 @@ begin context Arch begin arch_global_naming -named_theorems Retype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_AI locale *) -lemma arch_kobj_size_cong[Retype_AI_assms]: +lemma arch_kobj_size_cong[Arch_assms]: "\a = a1; c=c1\ \ arch_kobj_size (default_arch_object a b c) = arch_kobj_size (default_arch_object a1 b1 c1)" by (simp add: default_arch_object_def split: aobject_type.splits) -lemma clearMemoryVM_return[simp, Retype_AI_assms]: +lemma clearMemoryVM_return[simp, Arch_assms]: "clearMemoryVM a b = return ()" by (simp add: clearMemoryVM_def) -lemma slot_bits_def2 [Retype_AI_assms]: "slot_bits = cte_level_bits" +lemma slot_bits_def2 [Arch_assms]: "slot_bits = cte_level_bits" by (simp add: slot_bits_def cte_level_bits_def) definition @@ -35,7 +35,7 @@ definition ArchObject SmallPageObj, ArchObject LargePageObj, ArchObject HugePageObj, ArchObject PageTableObj, ArchObject VSpaceObj}" -lemma no_gs_types_simps [simp, Retype_AI_assms]: +lemma no_gs_types_simps [simp, Arch_assms]: "Untyped \ no_gs_types" "TCBObject \ no_gs_types" "EndpointObject \ no_gs_types" @@ -43,7 +43,7 @@ lemma no_gs_types_simps [simp, Retype_AI_assms]: "ArchObject ASIDPoolObj \ no_gs_types" by (simp_all add: no_gs_types_def) -lemma retype_region_ret_folded [Retype_AI_assms]: +lemma retype_region_ret_folded [Arch_assms]: "\\\ retype_region y n bits ty dev \\r s. r = retype_addrs y ty n bits\" unfolding retype_region_def @@ -112,7 +112,7 @@ crunch reserve_region crunch reserve_region for invs[wp]: "invs" -lemma dmo_eq_kernel_restricted [wp, Retype_AI_assms]: +lemma dmo_eq_kernel_restricted [wp, Arch_assms]: "\\s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\ do_machine_op m \\rv s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\" @@ -156,25 +156,26 @@ lemma init_arch_objects_invs_from_restricted: done -lemma obj_bits_api_neq_0 [Retype_AI_assms]: +lemma obj_bits_api_neq_0 [Arch_assms]: "ty \ Untyped \ 0 < obj_bits_api ty us" unfolding obj_bits_api_def by (clarsimp simp: slot_bits_def default_arch_object_def bit_simps split: apiobject_type.splits aobject_type.splits) +lemmas Retype_AI_slot_bits_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_slot_bits?: Retype_AI_slot_bits proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact AARCH64.Retype_AI_slot_bits_assms) qed context Arch begin arch_global_naming -lemma valid_untyped_helper [Retype_AI_assms]: +lemma valid_untyped_helper [Arch_assms]: assumes valid_c : "s \ c" and cte_at : "cte_wp_at ((=) c) q s" and tyunt: "ty \ Structures_A.apiobject_type.Untyped" @@ -249,13 +250,14 @@ lemma valid_default_arch_tcb: "\s. valid_arch_tcb default_arch_tcb s" by (simp add: default_arch_tcb_def valid_arch_tcb_def) +lemmas Retype_AI_valid_untyped_helper_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_valid_untyped_helper?: Retype_AI_valid_untyped_helper proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact AARCH64.Retype_AI_valid_untyped_helper_assms) qed @@ -264,12 +266,7 @@ locale retype_region_proofs_arch + Arch for s :: "'state_ext :: state_ext state" and ty us ptr sz n ps s' dev - - -context retype_region_proofs begin - -(* FIXME arch_split: is there any way to optimise this interpretation out? we can't nest contexts *) -interpretation Arch . +begin lemma valid_cap: assumes cap: @@ -484,18 +481,13 @@ lemma vs_lookup_target': apply (fastforce dest: ptes_of) done -lemma wellformed_default_obj[Retype_AI_assms]: +lemma wellformed_default_obj[Arch_assms]: "\ ptr' \ set (retype_addrs ptr ty n us); kheap s ptr' = Some (ArchObj ao); arch_valid_obj ao s\ \ arch_valid_obj ao s'" by (cases ao; clarsimp elim!: obj_at_pres simp: valid_vcpu_def split: arch_kernel_obj.splits option.splits)+ -end - - -context retype_region_proofs_arch begin - lemma hyp_refs_eq: "state_hyp_refs_of s' = state_hyp_refs_of s" unfolding s'_def ps_def @@ -874,18 +866,18 @@ end context Arch begin arch_global_naming -named_theorems Retype_AI_assms' - -lemma invs_post_retype_invs [Retype_AI_assms']: +lemma invs_post_retype_invs [Arch_assms]: "invs s \ post_retype_invs ty refs s" by (clarsimp simp: post_retype_invs_def) lemmas equal_kernel_mappings_trans_state = more_update.equal_kernel_mappings_update -lemmas retype_region_proofs_assms [Retype_AI_assms'] +lemmas retype_region_proofs_assms [Arch_assms] = retype_region_proofs.post_retype_invs_axioms +lemmas Retype_AI_assms' = Arch_assms (* extract accumulated assumptions *) + end @@ -895,10 +887,9 @@ global_interpretation Retype_AI?: Retype_AI and post_retype_invs = post_retype_invs and region_in_kernel_window = region_in_kernel_window proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Retype_AI_assms)?) - (simp add: Retype_AI_axioms_def Retype_AI_assms') + by (intro_locales; (unfold_locales; fact AARCH64.Retype_AI_assms')?) + (simp add: Retype_AI_axioms_def AARCH64.Retype_AI_assms') qed diff --git a/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy b/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy index 8bcb382779..c7bff5a292 100644 --- a/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchSchedule_AI.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_AI locale *) -lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]: +lemma dmo_mapM_storeWord_0_invs[wp,Arch_assms]: "do_machine_op (mapM (\p. storeWord p 0) S) \invs\" apply (simp add: dom_mapM) apply (rule mapM_UNIV_wp) @@ -109,18 +109,18 @@ crunch set_vm_root, vcpu_switch for ex_nonz_cap_to[wp]: "ex_nonz_cap_to t" (wp: crunch_wps simp: crunch_simps) -lemma arch_stt_invs [wp,Schedule_AI_assms]: +lemma arch_stt_invs [wp,Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_switch_to_thread t \\_. invs\" unfolding arch_switch_to_thread_def apply wpsimp apply (clarsimp simp: tcb_at_def) by (rule sym_refs_VCPU_hyp_live; fastforce) -lemma arch_stt_tcb [wp,Schedule_AI_assms]: +lemma arch_stt_tcb [wp,Arch_assms]: "arch_switch_to_thread t' \tcb_at t'\" by (wpsimp simp: arch_switch_to_thread_def wp: tcb_at_typ_at) -lemma arch_stt_st_tcb_at[Schedule_AI_assms]: +lemma arch_stt_st_tcb_at[Arch_assms]: "arch_switch_to_thread t \st_tcb_at Q t\" by (wpsimp simp: arch_switch_to_thread_def) @@ -136,7 +136,7 @@ crunch and ct[wp]: "\s. P (cur_thread s)" (wp: mapM_x_wp mapM_wp subset_refl) -lemma arch_stit_invs[wp, Schedule_AI_assms]: +lemma arch_stit_invs[wp, Arch_assms]: "arch_switch_to_idle_thread \invs\" by (wpsimp simp: arch_switch_to_idle_thread_def) @@ -149,19 +149,19 @@ crunch set_vm_root and it[wp]: "\s. P (idle_thread s)" (simp: crunch_simps wp: hoare_drop_imps) -lemma arch_stit_activatable[wp, Schedule_AI_assms]: +lemma arch_stit_activatable[wp, Arch_assms]: "arch_switch_to_idle_thread \ct_in_state activatable\" apply (clarsimp simp: arch_switch_to_idle_thread_def) apply (wpsimp simp: ct_in_state_def wp: ct_in_state_thread_state_lift) done -lemma stit_invs [wp,Schedule_AI_assms]: +lemma stit_invs [wp,Arch_assms]: "switch_to_idle_thread \invs\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wpsimp|strengthen idle_strg)+ done -lemma stit_activatable[Schedule_AI_assms]: +lemma stit_activatable[Arch_assms]: "\invs\ switch_to_idle_thread \\_. ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wpsimp simp: ct_in_state_def) @@ -173,7 +173,7 @@ crunch set_vm_root, vcpu_switch for scheduler_action[wp]: "\s. P (scheduler_action s)" (wp: crunch_wps simp: crunch_simps) -lemma arch_stt_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stt_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_thread t' \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_thread_def) @@ -183,24 +183,25 @@ lemma vcpu_invalidate_active_invs[wp]: by (wpsimp simp: cur_vcpu_at_def | strengthen invs_current_vcpu_update')+ crunch arch_prepare_next_domain - for ct[wp, Schedule_AI_assms]: "\s. P (cur_thread s)" - and activatable[wp, Schedule_AI_assms]: "ct_in_state activatable" - and st_tcb_at[wp, Schedule_AI_assms]: "\s. P (st_tcb_at Q t s)" - and valid_idle[wp, Schedule_AI_assms]: valid_idle - and invs[wp, Schedule_AI_assms]: invs + for ct[wp, Arch_assms]: "\s. P (cur_thread s)" + and activatable[wp, Arch_assms]: "ct_in_state activatable" + and st_tcb_at[wp, Arch_assms]: "\s. P (st_tcb_at Q t s)" + and valid_idle[wp, Arch_assms]: valid_idle + and invs[wp, Arch_assms]: invs (wp: crunch_wps ct_in_state_thread_state_lift) -lemma arch_stit_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stit_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_idle_thread \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_idle_thread_def) +lemmas Schedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Schedule_AI?: Schedule_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Schedule_AI_assms)?) + by (intro_locales; (unfold_locales; fact AARCH64.Schedule_AI_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchSyscall_AI.thy b/proof/invariant-abstract/AARCH64/ArchSyscall_AI.thy index a4a268f847..4816b34d8f 100644 --- a/proof/invariant-abstract/AARCH64/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchSyscall_AI.thy @@ -16,44 +16,44 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_AI locale *) -declare arch_get_sanitise_register_info_invs[Syscall_AI_assms] - arch_get_sanitise_register_info_ex_nonz_cap_to[Syscall_AI_assms] - make_fault_msg_inv[Syscall_AI_assms] +declare arch_get_sanitise_register_info_invs[Arch_assms] + arch_get_sanitise_register_info_ex_nonz_cap_to[Arch_assms] + make_fault_msg_inv[Arch_assms] crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for pred_tcb_at[wp,Syscall_AI_assms]: "pred_tcb_at proj P t" + for pred_tcb_at[wp,Arch_assms]: "pred_tcb_at proj P t" crunch handle_arch_fault_reply - for invs[wp,Syscall_AI_assms]: "invs" + for invs[wp,Arch_assms]: "invs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cap_to[wp,Syscall_AI_assms]: "ex_nonz_cap_to c" + for cap_to[wp,Arch_assms]: "ex_nonz_cap_to c" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for it[wp,Syscall_AI_assms]: "\s. P (idle_thread s)" + for it[wp,Arch_assms]: "\s. P (idle_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for caps[wp,Syscall_AI_assms]: "\s. P (caps_of_state s)" + for caps[wp,Arch_assms]: "\s. P (caps_of_state s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cur_thread[wp,Syscall_AI_assms]: "\s. P (cur_thread s)" + for cur_thread[wp,Arch_assms]: "\s. P (cur_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for valid_objs[wp,Syscall_AI_assms]: "valid_objs" + for valid_objs[wp,Arch_assms]: "valid_objs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cte_wp_at[wp,Syscall_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" crunch invoke_irq_control - for typ_at[wp, Syscall_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" -lemma obj_refs_cap_rights_update[simp, Syscall_AI_assms]: +lemma obj_refs_cap_rights_update[simp, Arch_assms]: "obj_refs (cap_rights_update rs cap) = obj_refs cap" by (simp add: cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) (* FIXME: move to TCB *) -lemma table_cap_ref_mask_cap [Syscall_AI_assms]: +lemma table_cap_ref_mask_cap [Arch_assms]: "table_cap_ref (mask_cap R cap) = table_cap_ref cap" 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 eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: +lemma eq_no_cap_to_obj_with_diff_ref [Arch_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) @@ -73,35 +73,36 @@ lemma do_machine_op_getFAR_inv[wp]: "do_machine_op getFAR \P\" by (rule dmo_inv) wp -lemma hv_invs[wp, Syscall_AI_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" +lemma hv_invs[wp, Arch_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" unfolding handle_vm_fault_def by (cases flt; wpsimp wp: dmo_invs_lift) -lemma handle_vm_fault_valid_fault[wp, Syscall_AI_assms]: +lemma handle_vm_fault_valid_fault[wp, Arch_assms]: "\\\ handle_vm_fault thread ft -,\\rv s. valid_fault rv\" unfolding handle_vm_fault_def by (cases ft; wpsimp simp: valid_fault_def) -lemma hvmf_active [Syscall_AI_assms]: +lemma hvmf_active [Arch_assms]: "\st_tcb_at active t\ handle_vm_fault t w \\rv. st_tcb_at active t\" unfolding handle_vm_fault_def by (cases w; wpsimp) -lemma hvmf_ex_cap[wp, Syscall_AI_assms]: +lemma hvmf_ex_cap[wp, Arch_assms]: "\ex_nonz_cap_to p\ handle_vm_fault t b \\rv. ex_nonz_cap_to p\" unfolding handle_vm_fault_def by (cases b; wpsimp) -lemma hh_invs[wp, Syscall_AI_assms]: +lemma hh_invs[wp, Arch_assms]: "\invs and ct_active and st_tcb_at active thread and ex_nonz_cap_to thread\ handle_hypervisor_fault thread fault \\rv. invs\" supply if_split[split del] by (cases fault) (wpsimp simp: valid_fault_def isFpuEnable_def wp: dmo_invs_lift hoare_drop_imps) +lemmas Syscall_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Syscall_AI?: Syscall_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Syscall_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Syscall_AI_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchTcbAcc_AI.thy b/proof/invariant-abstract/AARCH64/ArchTcbAcc_AI.thy index 0e3ef7ea65..01744988e9 100644 --- a/proof/invariant-abstract/AARCH64/ArchTcbAcc_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchTcbAcc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_AI locale *) lemmas cap_master_cap_simps = cap_master_cap_def[simplified cap_master_arch_cap_def, split_simps cap.split arch_cap.split] @@ -51,7 +51,7 @@ lemma cap_master_cap_tcb_cap_valid_arch: split: option.splits cap.splits arch_cap.splits Structures_A.thread_state.splits) -lemma storeWord_invs[wp, TcbAcc_AI_assms]: +lemma storeWord_invs[wp, Arch_assms]: "\in_user_frame p and invs\ do_machine_op (storeWord p w) \\rv. invs\" proof - have aligned_offset_ignore: @@ -79,12 +79,12 @@ proof - done qed -lemma valid_ipc_buffer_cap_0[simp, TcbAcc_AI_assms]: +lemma valid_ipc_buffer_cap_0[simp, Arch_assms]: "valid_ipc_buffer_cap cap a \ valid_ipc_buffer_cap cap 0" by (auto simp add: valid_ipc_buffer_cap_def case_bool_If split: cap.split arch_cap.split) -lemma thread_set_hyp_refs_trivial [TcbAcc_AI_assms]: +lemma thread_set_hyp_refs_trivial [Arch_assms]: assumes x: "\tcb. tcb_state (f tcb) = tcb_state tcb" assumes y: "\tcb. tcb_arch_ref (f tcb) = tcb_arch_ref tcb" shows "\\s. P (state_hyp_refs_of s)\ thread_set f t \\rv s. P (state_hyp_refs_of s)\" @@ -105,7 +105,7 @@ lemma mab_wb [simp]: unfolding msg_align_bits word_bits_conv by simp -lemma get_cap_valid_ipc [TcbAcc_AI_assms]: +lemma get_cap_valid_ipc [Arch_assms]: "\valid_objs and obj_at (\ko. \tcb. ko = TCB tcb \ tcb_ipc_buffer tcb = v) t\ get_cap (t, tcb_cnode_index 4) \\rv s. valid_ipc_buffer_cap rv v\" @@ -120,7 +120,7 @@ lemma get_cap_valid_ipc [TcbAcc_AI_assms]: -lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: +lemma pred_tcb_cap_wp_at [Arch_assms]: "\pred_tcb_at proj P t s; valid_objs s; ref \ dom tcb_cap_cases; \cap. (pred_tcb_at proj P t s \ tcb_cap_valid cap (t, ref) s) \ Q cap\ \ @@ -134,7 +134,7 @@ lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: apply fastforce+ done -lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: +lemma as_user_hyp_refs_of[wp, Arch_assms]: "\\s. P (state_hyp_refs_of s)\ as_user t m \\rv s. P (state_hyp_refs_of s)\" @@ -144,11 +144,11 @@ lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: lemmas sts_typ_ats = sts_typ_ats abs_atyp_at_lifts [OF set_thread_state_typ_at] -lemma arch_tcb_context_set_eq_AARCH64[TcbAcc_AI_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" +lemma arch_tcb_context_set_eq_AARCH64[Arch_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp -lemma arch_tcb_context_get_eq_AARCH64[TcbAcc_AI_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" +lemma arch_tcb_context_get_eq_AARCH64[Arch_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp @@ -156,17 +156,18 @@ lemma tcb_context_update_aux: "arch_tcb_context_set (P (arch_tcb_context_get atc = tcb_context_update (\ctx. P ctx) atcb" by (simp add: arch_tcb_context_set_def arch_tcb_context_get_def) -lemma thread_set_valid_arch_state[TcbAcc_AI_assms]: +lemma thread_set_valid_arch_state[Arch_assms]: "(\tcb. \(getF, v) \ ran tcb_cap_cases. getF (f tcb) = getF tcb) \ thread_set f t \ valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps thread_set_tcb thread_set.aobj_at) +lemmas TcbAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation TcbAcc_AI?: TcbAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact TcbAcc_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.TcbAcc_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/AARCH64/ArchTcb_AI.thy b/proof/invariant-abstract/AARCH64/ArchTcb_AI.thy index f62c6f6a06..f3cd4230fa 100644 --- a/proof/invariant-abstract/AARCH64/ArchTcb_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchTcb_AI.thy @@ -11,17 +11,17 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_AI locale *) -lemma activate_idle_invs[Tcb_AI_assms]: +lemma activate_idle_invs[Arch_assms]: "\invs and ct_idle\ arch_activate_idle_thread thread \\rv. invs and ct_idle\" by (simp add: arch_activate_idle_thread_def) -declare getRegister_empty_fail [Tcb_AI_assms] +declare getRegister_empty_fail [Arch_assms] lemma same_object_also_valid: (* arch specific *) "\ same_object_as cap cap'; s \ cap'; wellformed_cap cap; @@ -35,14 +35,14 @@ lemma same_object_also_valid: (* arch specific *) split: cap.split_asm arch_cap.split_asm option.splits)+) done -lemma same_object_obj_refs[Tcb_AI_assms]: +lemma same_object_obj_refs[Arch_assms]: "\ same_object_as cap cap' \ \ obj_refs cap = obj_refs cap'" apply (cases cap, simp_all add: same_object_as_def) apply (clarsimp simp: is_cap_simps bits_of_def split: cap.split_asm)+ by (cases "the_arch_cap cap"; cases "the_arch_cap cap'"; simp) -lemma arch_cap_badge_none_master[Tcb_AI_assms, simp]: +lemma arch_cap_badge_none_master[Arch_assms, simp]: "(arch_cap_badge (cap_master_arch_cap acap) = None) = (arch_cap_badge acap = None)" by (cases acap; simp add: cap_master_arch_cap_def) @@ -55,11 +55,11 @@ where (\ arch_cap_fun_lift is_SMCCap False cap)" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for tcb_at[wp, Tcb_AI_assms]: "tcb_at a" - and invs[wp, Tcb_AI_assms]: "invs" - and ex_nonz_cap_to[wp, Tcb_AI_assms]: "ex_nonz_cap_to a" + for tcb_at[wp, Arch_assms]: "tcb_at a" + and invs[wp, Arch_assms]: "invs" + and ex_nonz_cap_to[wp, Arch_assms]: "ex_nonz_cap_to a" -lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: +lemma finalise_cap_not_cte_wp_at[Arch_assms]: assumes x: "P cap.NullCap" shows "\\s. \cp \ ran (caps_of_state s). P cp\ finalise_cap cap fin @@ -76,12 +76,12 @@ lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: done crunch arch_post_set_flags, arch_prepare_set_domain - for typ_at[wp, Tcb_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" crunch arch_prepare_set_domain - for invs[wp, Tcb_AI_assms]: "invs" + for invs[wp, Arch_assms]: "invs" -lemma arch_post_set_flags_invs[wp, Tcb_AI_assms]: +lemma arch_post_set_flags_invs[wp, Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_post_set_flags t flags \\_. invs\" unfolding arch_post_set_flags_def by wpsimp @@ -93,18 +93,19 @@ crunch arch_prepare_set_domain and pspace_distinct[wp]: pspace_distinct (wp: crunch_wps) -lemma table_cap_ref_max_free_index_upd[simp,Tcb_AI_assms]: +lemma table_cap_ref_max_free_index_upd[simp,Arch_assms]: "table_cap_ref (max_free_index_update cap) = table_cap_ref cap" by (simp add:free_index_update_def table_cap_ref_def split:cap.splits) +lemmas Tcb_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI_1?: Tcb_AI_1 where state_ext_t = state_ext_t and is_cnode_or_valid_arch = is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Tcb_AI_assms)?) qed context Arch begin arch_global_naming @@ -189,8 +190,7 @@ global_interpretation Tcb_AI_1?: Tcb_AI_1 where state_ext_t = state_ext_t and is_cnode_or_valid_arch = is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Tcb_AI_assms)?) qed context Arch begin arch_global_naming @@ -209,7 +209,7 @@ lemma use_no_cap_to_obj_asid_strg: (* arch specific *) by (fastforce simp: table_cap_ref_def vspace_asid_def valid_cap_simps obj_at_def split: cap.splits arch_cap.splits option.splits prod.splits) -lemma cap_delete_no_cap_to_obj_asid[wp, Tcb_AI_assms]: +lemma cap_delete_no_cap_to_obj_asid[wp, Arch_assms]: "\no_cap_to_obj_dr_emp cap\ cap_delete slot \\rv. no_cap_to_obj_dr_emp cap\" @@ -243,7 +243,7 @@ lemma option_case_eq_None: "((case m of None \ None | Some (a,b) \ Some a) = None) = (m = None)" by (clarsimp split: option.splits) -lemma tc_invs[Tcb_AI_assms]: +lemma tc_invs[Arch_assms]: "\invs and tcb_at a and (case_option \ (valid_cap o fst) e) and (case_option \ (valid_cap o fst) f) @@ -319,7 +319,7 @@ lemma check_valid_ipc_buffer_inv: (* arch_specific *) apply (wp | simp add: if_apply_def2 split del: if_split | wpcw)+ done -lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: +lemma check_valid_ipc_buffer_wp[Arch_assms]: "\\(s::'state_ext::state_ext state). is_arch_cap cap \ is_cnode_or_valid_arch cap \ valid_ipc_buffer_cap cap vptr \ is_aligned vptr msg_align_bits @@ -334,7 +334,7 @@ lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: valid_ipc_buffer_cap_def) done -lemma derive_no_cap_asid[wp,Tcb_AI_assms]: +lemma derive_no_cap_asid[wp,Arch_assms]: "\(no_cap_to_obj_with_diff_ref cap S)::'state_ext::state_ext state\bool\ derive_cap slot cap \\rv. no_cap_to_obj_with_diff_ref rv S\,-" @@ -348,7 +348,7 @@ lemma derive_no_cap_asid[wp,Tcb_AI_assms]: done -lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: +lemma decode_set_ipc_inv[wp,Arch_assms]: "\P::'state_ext::state_ext state \ bool\ decode_set_ipc_buffer args cap slot excaps \\rv. P\" apply (simp add: decode_set_ipc_buffer_def whenE_def split_def @@ -357,7 +357,7 @@ lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: apply simp done -lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_update_cap_data[Arch_assms]: "no_cap_to_obj_with_diff_ref c S s \ no_cap_to_obj_with_diff_ref (update_cap_data P x c) S s" apply (case_tac "update_cap_data P x c = NullCap") @@ -371,7 +371,7 @@ lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: split: cap.split arch_cap.splits) done -lemma update_cap_valid[Tcb_AI_assms]: +lemma update_cap_valid[Arch_assms]: "valid_cap cap (s::'state_ext::state_ext state) \ valid_cap (case capdata of None \ cap_rights_update rs cap @@ -403,13 +403,14 @@ crunch invoke_tcb wp: hoare_drop_imps mapM_x_wp' check_cap_inv simp: crunch_simps) +lemmas Tcb_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI?: Tcb_AI where is_cnode_or_valid_arch = AARCH64.is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact AARCH64.Tcb_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy b/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy index e2ebef3dd7..aa152630a0 100644 --- a/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/AARCH64/ArchUntyped_AI.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_AI locale *) -lemma of_bl_nat_to_cref[Untyped_AI_assms]: +lemma of_bl_nat_to_cref[Arch_assms]: "\ x < 2 ^ bits; bits < word_bits \ \ (of_bl (nat_to_cref bits x) :: word64) = of_nat x" apply (clarsimp intro!: less_mask_eq @@ -22,7 +22,7 @@ lemma of_bl_nat_to_cref[Untyped_AI_assms]: by (metis add_lessD1 le_unat_uoi nat_le_iff_add nat_le_linear) -lemma cnode_cap_ex_cte[Untyped_AI_assms]: +lemma cnode_cap_ex_cte[Arch_assms]: "\ is_cnode_cap cap; cte_wp_at (\c. \m. cap = mask_cap m c) p s; (s::'state_ext::state_ext state) \ cap; valid_objs s; pspace_aligned s \ \ ex_cte_cap_wp_to is_cnode_cap (obj_ref_of cap, nat_to_cref (bits_of cap) x) s" @@ -37,7 +37,7 @@ lemma cnode_cap_ex_cte[Untyped_AI_assms]: -lemma inj_on_nat_to_cref[Untyped_AI_assms]: +lemma inj_on_nat_to_cref[Arch_assms]: "bits < word_bits \ inj_on (nat_to_cref bits) {..< 2 ^ bits}" apply (rule inj_onI) apply (drule arg_cong[where f="\x. replicate (64 - bits) False @ x"]) @@ -55,7 +55,7 @@ lemma inj_on_nat_to_cref[Untyped_AI_assms]: done -lemma data_to_obj_type_sp[Untyped_AI_assms]: +lemma data_to_obj_type_sp[Arch_assms]: "\P\ data_to_obj_type x \\ts (s::'state_ext::state_ext state). ts \ ArchObject ASIDPoolObj \ P s\, -" unfolding data_to_obj_type_def apply (rule hoare_pre) @@ -64,7 +64,7 @@ lemma data_to_obj_type_sp[Untyped_AI_assms]: apply (simp add: arch_data_to_obj_type_def split: if_split_asm) done -lemma dui_inv_wf[wp, Untyped_AI_assms]: +lemma dui_inv_wf[wp, Arch_assms]: "\invs and cte_wp_at ((=) (cap.UntypedCap dev w sz idx)) slot and (\s. \cap \ set cs. is_cnode_cap cap \ (\r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -149,7 +149,7 @@ qed lemma asid_bits_ge_0: "(0::word32) < 2 ^ asid_bits" by (simp add: asid_bits_def) -lemma retype_ret_valid_caps_captable[Untyped_AI_assms]: +lemma retype_ret_valid_caps_captable[Arch_assms]: "\pspace_no_overlap_range_cover ptr sz (s::'state_ext::state_ext state) \ 0 < us \ range_cover ptr sz (obj_bits_api CapTableObject us) n \ ptr \ 0 \ @@ -162,7 +162,7 @@ by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def | rule is_aligned_add_multI[OF _ le_refl], (simp add:range_cover_def word_bits_def obj_bits_api_def slot_bits_def)+)+)[1] -lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]: +lemma retype_ret_valid_caps_aobj[Arch_assms]: "\ptr sz (s::'state_ext::state_ext state) x6 us n. \pspace_no_overlap_range_cover ptr sz s \ x6 \ ASIDPoolObj \ range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \ ptr \ 0\ @@ -190,21 +190,21 @@ lemma cap_refs_in_kernel_windowD2: apply fastforce done -lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: +lemma init_arch_objects_descendants_range[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). descendants_range x cref s \ init_arch_objects ty dev ptr n us y \\rv s. descendants_range x cref s\" unfolding init_arch_objects_def descendants_range_def by (wp mapM_x_wp' | wps)+ simp -lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: +lemma init_arch_objects_caps_overlap_reserved[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). caps_overlap_reserved S s\ init_arch_objects ty dev ptr n us y \\rv s. caps_overlap_reserved S s\" unfolding init_arch_objects_def caps_overlap_reserved_def by (wp mapM_x_wp' | wps)+ simp -lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: +lemma set_untyped_cap_invs_simple[Arch_assms]: "\\s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \ pspace_no_overlap_range_cover ptr sz s \ invs s \ cte_wp_at (\c. is_untyped_cap c \ cap_bits c = sz \ obj_ref_of c = ptr \ cap_is_device c = dev) cref s \ idx \ 2^ sz\ set_cap (cap.UntypedCap dev ptr sz idx) cref @@ -245,7 +245,7 @@ lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: lemmas pbfs_less_wb' = pageBitsForSize_bounded -lemma delete_objects_rewrite[Untyped_AI_assms]: +lemma delete_objects_rewrite[Arch_assms]: "\ word_size_bits \ sz; sz\ word_bits;ptr && ~~ mask sz = ptr\ \ delete_objects ptr sz = do y \ modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz}); modify (detype {ptr && ~~ mask sz..ptr + 2 ^ sz - 1}) @@ -274,7 +274,7 @@ lemma reachable_pg_cap_exst_update[simp]: "reachable_frame_cap x (trans_state f (s::'state_ext::state_ext state)) = reachable_frame_cap x s" by (simp add: reachable_frame_cap_def obj_at_def) -lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_caps[wp, Arch_assms]: "\valid_arch_caps and valid_cap (default_cap tp oref sz dev) and (\(s::'state_ext::state_ext state). \r\obj_refs (default_cap tp oref sz dev). @@ -309,7 +309,7 @@ lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: done -lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: +lemma create_cap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range (default_cap tp oref sz dev) \ cap_range c) p\ create_cap tp sz p dev (cref, oref) \\rv. cap_refs_in_kernel_window\" apply (simp add: create_cap_def) @@ -319,7 +319,7 @@ lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: apply blast done -lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: +lemma init_arch_objects_nonempty_table[Arch_assms, wp]: "\(\s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \ valid_global_objs s \ valid_arch_state s \ pspace_aligned s) and K (\ref\set refs. is_aligned ref (obj_bits_api tp us))\ @@ -327,13 +327,13 @@ lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: \\rv s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)\" unfolding init_arch_objects_def by (wpsimp wp: mapM_x_wp') -lemma nonempty_table_caps_of[Untyped_AI_assms]: +lemma nonempty_table_caps_of[Arch_assms]: "nonempty_table S ko \ caps_of ko = {}" by (auto simp: caps_of_def cap_of_def nonempty_table_def a_type_def split: Structures_A.kernel_object.split if_split_asm) -lemma nonempty_default[simp, Untyped_AI_assms]: +lemma nonempty_default[simp, Arch_assms]: "tp \ Untyped \ \ nonempty_table S (default_object tp dev us d)" apply (case_tac tp, simp_all add: default_object_def nonempty_table_def a_type_def) apply (rename_tac aobject_type) @@ -346,7 +346,7 @@ crunch init_arch_objects lemmas init_arch_objects_ex_cte_cap_wp_to = init_arch_objects_excap -lemma obj_is_device_vui_eq[Untyped_AI_assms]: +lemma obj_is_device_vui_eq[Arch_assms]: "valid_untyped_inv ui s \ case ui of Retype slot reset ptr_base ptr tp us slots dev \ obj_is_device tp dev = dev" @@ -358,26 +358,27 @@ lemma obj_is_device_vui_eq[Untyped_AI_assms]: apply (auto simp: arch_is_frame_type_def) done -lemma create_cap_valid_arch_state[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (\_. True) cref\ create_cap tp sz p dev (cref,oref) \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps create_cap_tcb create_cap_aobj_at) -lemma set_cap_non_arch_valid_arch_state[Untyped_AI_assms]: +lemma set_cap_non_arch_valid_arch_state[Arch_assms]: "\\s. valid_arch_state s \ cte_wp_at (\_. \is_arch_cap cap) ptr s\ set_cap cap ptr \\rv. valid_arch_state \" by wpsimp +lemmas Untyped_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Untyped_AI? : Untyped_AI where nonempty_table = AARCH64.nonempty_table proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; (fact Untyped_AI_assms)?) + by (unfold_locales; (fact AARCH64.Untyped_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchAInvsPre.thy b/proof/invariant-abstract/ARM/ArchAInvsPre.thy index 1f52533a82..e7a2e2751e 100644 --- a/proof/invariant-abstract/ARM/ArchAInvsPre.thy +++ b/proof/invariant-abstract/ARM/ArchAInvsPre.thy @@ -174,11 +174,11 @@ lemma device_frame_in_device_region: by (auto simp add: pspace_respects_device_region_def dom_def device_mem_def) -named_theorems AInvsPre_assms +clear_named_theorems Arch_assms (* accumulate assumptions for AInvsPre locale *) -lemma (* ptable_rights_imp_frame *)[AInvsPre_assms]: +lemma (* ptable_rights_imp_frame *)[Arch_assms]: assumes "valid_state s" shows "ptable_rights t s x \ {} \ ptable_lift t s x = Some (addrFromPPtr y) \ @@ -216,12 +216,14 @@ lemma (* ptable_rights_imp_frame *)[AInvsPre_assms]: apply (case_tac sz, simp_all add: word_bits_conv)[1] apply (clarsimp simp: field_simps simp: data_at_def) done + +lemmas AInvsPre_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation AInvsPre?: AInvsPre proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, fact AInvsPre_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, fact ARM.AInvsPre_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchBCorres2_AI.thy b/proof/invariant-abstract/ARM/ArchBCorres2_AI.thy index 5ca3cbc453..025f14a55f 100644 --- a/proof/invariant-abstract/ARM/ArchBCorres2_AI.thy +++ b/proof/invariant-abstract/ARM/ArchBCorres2_AI.thy @@ -11,10 +11,10 @@ begin context Arch begin arch_global_naming -named_theorems BCorres2_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for BCorres2_AI locale *) crunch invoke_cnode - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state (simp: swp_def ignore: clearMemory without_preemption filterM) crunch create_cap,init_arch_objects,retype_region,delete_objects @@ -31,7 +31,7 @@ crunch invoke_untyped crunch set_mcpriority, set_priority, arch_get_sanitise_register_info, arch_post_modify_registers, set_flags, arch_post_set_flags, maybe_handle_interrupt - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state lemma invoke_tcb_bcorres[wp]: fixes a @@ -64,20 +64,21 @@ lemma invoke_irq_control_bcorres[wp]: "bcorres (invoke_irq_control a) (invoke_ir lemma invoke_irq_handler_bcorres[wp]: "bcorres (invoke_irq_handler a) (invoke_irq_handler a)" by (cases a; (wpsimp | rule conjI)+) -lemma make_arch_fault_msg_bcorres[wp,BCorres2_AI_assms]: +lemma make_arch_fault_msg_bcorres[wp,Arch_assms]: "bcorres (make_arch_fault_msg a b) (make_arch_fault_msg a b)" by (cases a; simp ; wp) -lemma handle_arch_fault_reply_bcorres[wp,BCorres2_AI_assms]: +lemma handle_arch_fault_reply_bcorres[wp,Arch_assms]: "bcorres ( handle_arch_fault_reply a b c d) (handle_arch_fault_reply a b c d)" by (cases a; simp add: handle_arch_fault_reply_def; wp) +lemmas BCorres2_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation BCorres2_AI?: BCorres2_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact BCorres2_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.BCorres2_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy b/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy index c7ab404e4a..f79e7c56a3 100644 --- a/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy +++ b/proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_AI locale *) lemma set_cap_in_device_frame[wp]: "\in_device_frame buffer\ set_cap cap ref \\_. in_device_frame buffer\" @@ -31,15 +31,15 @@ lemma valid_cnode_capI: done (* unused *) -lemma derive_cap_objrefs [CNodeInv_AI_assms]: +lemma derive_cap_objrefs [Arch_assms]: "\\s. P (obj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (obj_refs rv)\,-" by (wpsimp simp: arch_derive_cap_def derive_cap_def) auto -lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: +lemma derive_cap_zobjrefs [Arch_assms]: "\\s. P (zobj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (zobj_refs rv)\,-" by (wpsimp simp: arch_derive_cap_def derive_cap_def) auto -lemma update_cap_objrefs [CNodeInv_AI_assms]: +lemma update_cap_objrefs [Arch_assms]: "\ update_cap_data P dt cap \ NullCap \ \ obj_refs (update_cap_data P dt cap) = obj_refs cap" by (case_tac cap, @@ -47,7 +47,7 @@ lemma update_cap_objrefs [CNodeInv_AI_assms]: split: if_split_asm) -lemma update_cap_zobjrefs [CNodeInv_AI_assms]: +lemma update_cap_zobjrefs [Arch_assms]: "\ update_cap_data P dt cap \ cap.NullCap \ \ zobj_refs (update_cap_data P dt cap) = zobj_refs cap" apply (case_tac cap, @@ -56,7 +56,7 @@ lemma update_cap_zobjrefs [CNodeInv_AI_assms]: done -lemma copy_mask [simp, CNodeInv_AI_assms]: +lemma copy_mask [simp, Arch_assms]: "copy_of (mask_cap R c) = copy_of c" apply (rule ext) apply (auto simp: copy_of_def is_cap_simps mask_cap_def @@ -65,14 +65,14 @@ lemma copy_mask [simp, CNodeInv_AI_assms]: split: cap.splits arch_cap.splits bool.splits) done -lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: +lemma update_cap_data_mask_Null [simp, Arch_assms]: "(update_cap_data P x (mask_cap m c) = NullCap) = (update_cap_data P x c = NullCap)" unfolding update_cap_data_def mask_cap_def apply (cases c) by (auto simp add: the_cnode_cap_def Let_def is_cap_simps cap_rights_update_def badge_update_def arch_update_cap_data_def split:bool.splits) -lemma cap_master_update_cap_data [CNodeInv_AI_assms]: +lemma cap_master_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap \ \ cap_master_cap (update_cap_data P x c) = cap_master_cap c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -95,11 +95,11 @@ lemma same_object_as_def2: by (auto simp: cap_master_cap_def bits_of_def split: arch_cap.splits cap.splits) -lemma same_object_as_cap_master [CNodeInv_AI_assms]: +lemma same_object_as_cap_master [Arch_assms]: "same_object_as cap cap' \ cap_master_cap cap = cap_master_cap cap'" by (simp add: same_object_as_def2) -lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: +lemma weak_derived_cap_is_device[Arch_assms]: "\weak_derived c' c\ \ cap_is_device c = cap_is_device c'" apply (auto simp: weak_derived_def copy_of_def is_cap_simps same_object_as_def2 @@ -107,7 +107,7 @@ lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: dest!: master_cap_eq_is_device_cap_eq) done -lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid (update_cap_data P x c) = cap_asid c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -116,7 +116,7 @@ lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: +lemma cap_vptr_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_vptr (update_cap_data P x c) = cap_vptr c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -125,7 +125,7 @@ lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_base_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid_base (update_cap_data P x c) = cap_asid_base c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -134,7 +134,7 @@ lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma same_object_as_update_cap_data [CNodeInv_AI_assms]: +lemma same_object_as_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap; same_object_as c' c \ \ same_object_as c' (update_cap_data P x c)" apply (clarsimp simp: same_object_as_def is_cap_simps @@ -153,7 +153,7 @@ lemma is_master_reply_update_cap_data[simp]: by (simp add:is_master_reply_cap_def update_cap_data_def arch_update_cap_data_def the_cnode_cap_def is_arch_cap_def badge_update_def split:cap.split) -lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: +lemma weak_derived_update_cap_data [Arch_assms]: "\update_cap_data P x c \ NullCap; weak_derived c c'\ \ weak_derived (update_cap_data P x c) c'" apply (simp add: weak_derived_def copy_of_def @@ -175,7 +175,7 @@ lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: Let_def split_def the_cnode_cap_def bits_of_def split: if_split_asm cap.splits)+ done -lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: +lemma cap_badge_update_cap_data [Arch_assms]: "update_cap_data False x c \ NullCap \ (bdg, cap_badge c) \ capBadge_ordering False \ (bdg, cap_badge (update_cap_data False x c)) \ capBadge_ordering False" apply clarsimp @@ -187,25 +187,25 @@ lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: done -lemma cap_vptr_rights_update[simp, CNodeInv_AI_assms]: +lemma cap_vptr_rights_update[simp, Arch_assms]: "cap_vptr (cap_rights_update f c) = cap_vptr c" by (simp add: cap_vptr_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_vptr_mask[simp, CNodeInv_AI_assms]: +lemma cap_vptr_mask[simp, Arch_assms]: "cap_vptr (mask_cap m c) = cap_vptr c" by (simp add: mask_cap_def) -lemma cap_asid_base_rights [simp, CNodeInv_AI_assms]: +lemma cap_asid_base_rights [simp, Arch_assms]: "cap_asid_base (cap_rights_update R c) = cap_asid_base c" by (auto simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_asid_base_mask[simp, CNodeInv_AI_assms]: +lemma cap_asid_base_mask[simp, Arch_assms]: "cap_asid_base (mask_cap m c) = cap_asid_base c" by (simp add: mask_cap_def) -lemma weak_derived_mask [CNodeInv_AI_assms]: +lemma weak_derived_mask [Arch_assms]: "\ weak_derived c c'; cap_aligned c \ \ weak_derived (mask_cap m c) c'" unfolding weak_derived_def apply simp @@ -220,14 +220,14 @@ lemma weak_derived_mask [CNodeInv_AI_assms]: done -lemma vs_cap_ref_update_cap_data[simp, CNodeInv_AI_assms]: +lemma vs_cap_ref_update_cap_data[simp, Arch_assms]: "vs_cap_ref (update_cap_data P d cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def update_cap_data_closedform arch_update_cap_data_def split: cap.split) -lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]: +lemma invs_irq_state_independent[intro!, simp, Arch_assms]: "invs (s\machine_state := machine_state s\irq_state := f (irq_state (machine_state s))\\) = invs s" by (clarsimp simp: irq_state_independent_A_def invs_def @@ -243,7 +243,7 @@ lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]: swp_def valid_irq_states_def) -lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: +lemma cte_at_nat_to_cref_zbits [Arch_assms]: "\ s \ Zombie oref zb n; m < n \ \ cte_at (oref, nat_to_cref (zombie_cte_bits zb) m) s" apply (subst(asm) valid_cap_def) @@ -257,7 +257,7 @@ lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: done -lemma copy_of_cap_range [CNodeInv_AI_assms]: +lemma copy_of_cap_range [Arch_assms]: "copy_of cap cap' \ cap_range cap = cap_range cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -269,7 +269,7 @@ lemma copy_of_cap_range [CNodeInv_AI_assms]: done -lemma copy_of_zobj_refs [CNodeInv_AI_assms]: +lemma copy_of_zobj_refs [Arch_assms]: "copy_of cap cap' \ zobj_refs cap = zobj_refs cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -281,7 +281,7 @@ lemma copy_of_zobj_refs [CNodeInv_AI_assms]: done -lemma vs_cap_ref_master [CNodeInv_AI_assms]: +lemma vs_cap_ref_master [Arch_assms]: "\ cap_master_cap cap = cap_master_cap cap'; cap_asid cap = cap_asid cap'; cap_asid_base cap = cap_asid_base cap'; @@ -293,13 +293,13 @@ lemma vs_cap_ref_master [CNodeInv_AI_assms]: apply (clarsimp simp: cap_asid_def split: arch_cap.split_asm option.split_asm) done -lemma weak_derived_vs_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_vs_cap_ref [Arch_assms]: "weak_derived c c' \ vs_cap_ref c = vs_cap_ref c'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm elim: vs_cap_ref_master[OF sym]) -lemma weak_derived_table_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_table_cap_ref [Arch_assms]: "weak_derived c c' \ table_cap_ref c = table_cap_ref c'" apply (clarsimp simp: weak_derived_def copy_of_def same_object_as_def2 @@ -348,7 +348,7 @@ lemmas weak_derived_ASIDPool [simp] = weak_derived_ASIDPool1 weak_derived_ASIDPool2 -lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: +lemma swap_of_caps_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -395,7 +395,7 @@ lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: done -lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: +lemma cap_swap_asid_map[wp, Arch_assms]: "\valid_asid_map and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -407,7 +407,7 @@ lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: done -lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: +lemma cap_swap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -420,7 +420,7 @@ lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: done -lemma cap_swap_vms[wp, CNodeInv_AI_assms]: +lemma cap_swap_vms[wp, Arch_assms]: "\valid_machine_state\ cap_swap c a c' b \\rv. valid_machine_state\" apply (simp add: valid_machine_state_def in_user_frame_def) apply (wp cap_swap_typ_at @@ -428,7 +428,7 @@ lemma cap_swap_vms[wp, CNodeInv_AI_assms]: done -lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: +lemma unat_of_bl_nat_to_cref[Arch_assms]: "\ n < 2 ^ len; len < word_bits \ \ unat (of_bl (nat_to_cref len n) :: word32) = n" apply (simp add: nat_to_cref_def word_bits_conv of_drop_to_bl @@ -447,7 +447,7 @@ lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: apply simp done -lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: +lemma zombie_is_cap_toE_pre[Arch_assms]: "\ s \ Zombie ptr zbits n; invs s; m < n \ \ (ptr, nat_to_cref (zombie_cte_bits zbits) m) \ cte_refs (Zombie ptr zbits n) irqn" apply (clarsimp simp add: valid_cap_def cap_aligned_def) @@ -461,7 +461,7 @@ lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: crunch prepare_thread_delete for st_tcb_at_halted[wp]: "st_tcb_at halted t" -lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: +lemma finalise_cap_makes_halted_proof[Arch_assms]: "\invs and valid_cap cap and (\s. ex = is_final_cap' cap s) and cte_wp_at ((=) cap) slot\ finalise_cap cap ex @@ -488,12 +488,12 @@ lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof crunch finalise_cap - for emptyable[wp, CNodeInv_AI_assms]: "emptyable sl" + for emptyable[wp, Arch_assms]: "emptyable sl" (simp: crunch_simps rule: emptyable_lift wp: crunch_wps suspend_emptyable unbind_notification_invs unbind_maybe_notification_invs) -lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: +lemma finalise_cap_not_reply_master_unlifted [Arch_assms]: "(rv, s') \ fst (finalise_cap cap sl s) \ \ is_master_reply_cap (fst rv)" by (case_tac cap, auto simp: is_cap_simps in_monad liftM_def @@ -501,7 +501,7 @@ lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: split: if_split_asm arch_cap.split_asm bool.split_asm option.split_asm) -lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: +lemma nat_to_cref_0_replicate [Arch_assms]: "\n. n < word_bits \ nat_to_cref n 0 = replicate n False" apply (subgoal_tac "nat_to_cref n (unat (of_bl (replicate n False))) = replicate n False") apply simp @@ -510,25 +510,26 @@ lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: apply simp done -lemma prepare_thread_delete_thread_cap [CNodeInv_AI_assms]: +lemma prepare_thread_delete_thread_cap [Arch_assms]: "\\s. caps_of_state s x = Some (cap.ThreadCap p)\ prepare_thread_delete t \\rv s. caps_of_state s x = Some (cap.ThreadCap p)\" by (wpsimp simp: prepare_thread_delete_def) -lemma cap_swap_valid_arch_state[wp, CNodeInv_AI_assms]: +lemma cap_swap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ cap_swap c a c' b \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_swap_typ_ats cap_swap_aobj_at) +lemmas CNodeInv_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI?: CNodeInv_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.CNodeInv_AI_assms)?) qed @@ -784,22 +785,23 @@ next qed -lemmas rec_del_invs'[CNodeInv_AI_assms] = rec_del_invs'' [where Q=\, +lemmas rec_del_invs'[Arch_assms] = rec_del_invs'' [where Q=\, simplified hoare_TrueI pred_conj_def simp_thms, OF TrueI TrueI TrueI TrueI, simplified] +lemmas CNodeInv_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_2?: CNodeInv_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.CNodeInv_AI_2_assms)?) qed context Arch begin arch_global_naming -lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: +lemma finalise_cap_rvk_prog [Arch_assms]: "\\s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\ finalise_cap a b \\_ s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\" @@ -809,7 +811,7 @@ lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: done -lemma rec_del_rvk_prog [CNodeInv_AI_assms]: +lemma rec_del_rvk_prog [Arch_assms]: "st \ \\s. revoke_progress_ord m (option_map cap_to_rpo \ caps_of_state s) \ (case args of ReduceZombieCall cap sl ex \ cte_wp_at (\c. c = cap) sl s \ is_final_cap' cap s @@ -893,13 +895,14 @@ next done qed +lemmas CNodeInv_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_3?: CNodeInv_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.CNodeInv_AI_3_assms)?) qed @@ -911,30 +914,31 @@ declare cap_revoke.simps[simp del] context Arch begin arch_global_naming crunch finalise_slot - for typ_at[wp, CNodeInv_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM set_object clearMemory) -lemma weak_derived_appropriate [CNodeInv_AI_assms]: +lemma weak_derived_appropriate [Arch_assms]: "weak_derived cap cap' \ appropriate_cte_cap cap = appropriate_cte_cap cap'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 appropriate_cte_master split: if_split_asm dest!: arg_cong[where f=appropriate_cte_cap]) +lemmas CNodeInv_AI_4_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_4?: CNodeInv_AI_4 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.CNodeInv_AI_4_assms)?) qed context Arch begin arch_global_naming -lemma cap_move_invs[wp, CNodeInv_AI_assms]: +lemma cap_move_invs[wp, Arch_assms]: "\invs and valid_cap cap and cte_wp_at ((=) cap.NullCap) ptr' and tcb_cap_valid cap ptr' and cte_wp_at (weak_derived cap) ptr @@ -980,12 +984,13 @@ lemma arch_derive_is_arch: "\\\ arch_derive_cap c \\rv s. rv \ NullCap \ is_arch_cap rv\,-" by (wpsimp simp: is_arch_cap_def arch_derive_cap_def) +lemmas CNodeInv_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_5?: CNodeInv_AI_5 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.CNodeInv_AI_5_assms)?) qed diff --git a/proof/invariant-abstract/ARM/ArchCSpace_AI.thy b/proof/invariant-abstract/ARM/ArchCSpace_AI.thy index 26926fb3e2..ac0b6a498a 100644 --- a/proof/invariant-abstract/ARM/ArchCSpace_AI.thy +++ b/proof/invariant-abstract/ARM/ArchCSpace_AI.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_AI locale *) lemma cte_at_length_limit: "\ cte_at p s; valid_objs s \ \ length (snd p) < word_bits - cte_level_bits" @@ -30,7 +30,7 @@ lemma cte_at_length_limit: done (* FIXME: move? *) -lemma getActiveIRQ_wp [CSpace_AI_assms]: +lemma getActiveIRQ_wp [Arch_assms]: "irq_state_independent_A P \ valid P (do_machine_op (getActiveIRQ in_kernel)) (\_. P)" apply (simp add: getActiveIRQ_def do_machine_op_def split_def exec_gets @@ -40,7 +40,7 @@ lemma getActiveIRQ_wp [CSpace_AI_assms]: apply (clarsimp simp: irq_state_independent_A_def in_monad return_def split: if_splits) done -lemma weak_derived_valid_cap [CSpace_AI_assms]: +lemma weak_derived_valid_cap [Arch_assms]: "\ s \ c; wellformed_cap c'; weak_derived c' c\ \ s \ c'" apply (case_tac "c = c'", simp) apply (clarsimp simp: weak_derived_def) @@ -51,7 +51,7 @@ lemma weak_derived_valid_cap [CSpace_AI_assms]: split: cap.splits arch_cap.splits option.splits) done -lemma copy_obj_refs [CSpace_AI_assms]: +lemma copy_obj_refs [Arch_assms]: "copy_of cap cap' \ obj_refs cap' = obj_refs cap" apply (cases cap) apply (auto simp: copy_of_def same_object_as_def is_cap_simps @@ -59,26 +59,26 @@ lemma copy_obj_refs [CSpace_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma weak_derived_cap_class[simp, CSpace_AI_assms]: +lemma weak_derived_cap_class[simp, Arch_assms]: "weak_derived cap src_cap \ cap_class cap = cap_class src_cap" apply (simp add:weak_derived_def) apply (auto simp:copy_of_def same_object_as_def is_cap_simps cap_asid_base_def split:if_splits cap.splits arch_cap.splits) done -lemma weak_derived_obj_refs [CSpace_AI_assms]: +lemma weak_derived_obj_refs [Arch_assms]: "weak_derived dcap cap \ obj_refs dcap = obj_refs cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma weak_derived_obj_ref_of [CSpace_AI_assms]: +lemma weak_derived_obj_ref_of [Arch_assms]: "weak_derived dcap cap \ obj_ref_of dcap = obj_ref_of cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma set_free_index_invs [CSpace_AI_assms]: +lemma set_free_index_invs [Arch_assms]: "\\s. (free_index_of cap \ idx \ is_untyped_cap cap \ idx \ 2^cap_bits cap) \ invs s \ cte_wp_at ((=) cap ) cref s\ set_cap (free_index_update (\_. idx) cap) cref @@ -132,7 +132,7 @@ lemma unique_table_refs_upd_eqD: apply (rule all_cong[where Q=\, simplified]) by auto -lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: +lemma set_untyped_cap_as_full_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at ((=) src_cap) src\ set_untyped_cap_as_full src_cap cap src \\ya. valid_arch_caps\" @@ -150,7 +150,7 @@ lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: apply clarsimp done -lemma set_untyped_cap_as_full[wp, CSpace_AI_assms]: +lemma set_untyped_cap_as_full[wp, Arch_assms]: "\\s. no_cap_to_obj_with_diff_ref a b s \ cte_wp_at ((=) src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. no_cap_to_obj_with_diff_ref a b s\" @@ -246,7 +246,7 @@ lemma is_derived_is_pt_pd: split: cap.splits arch_cap.splits)+ done -lemma cap_insert_valid_arch_caps [CSpace_AI_assms]: +lemma cap_insert_valid_arch_caps [Arch_assms]: "\valid_arch_caps and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_caps\" @@ -344,7 +344,7 @@ global_interpretation cap_insert_crunches?: cap_insert_crunches . context Arch begin arch_global_naming -lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma cap_insert_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range cap \ cap_range c) src\ cap_insert cap src dest @@ -357,7 +357,7 @@ lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: done -lemma mask_cap_valid[simp, CSpace_AI_assms]: +lemma mask_cap_valid[simp, Arch_assms]: "s \ c \ s \ mask_cap R c" apply (cases c, simp_all add: valid_cap_def mask_cap_def cap_rights_update_def @@ -367,21 +367,21 @@ lemma mask_cap_valid[simp, CSpace_AI_assms]: apply (rename_tac arch_cap) by (case_tac arch_cap, simp_all) -lemma mask_cap_objrefs[simp, CSpace_AI_assms]: +lemma mask_cap_objrefs[simp, Arch_assms]: "obj_refs (mask_cap rs cap) = obj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma mask_cap_zobjrefs[simp, CSpace_AI_assms]: +lemma mask_cap_zobjrefs[simp, Arch_assms]: "zobj_refs (mask_cap rs cap) = zobj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma derive_cap_valid_cap [CSpace_AI_assms]: +lemma derive_cap_valid_cap [Arch_assms]: "\valid_cap cap\ derive_cap slot cap \valid_cap\,-" apply (simp add: derive_cap_def) apply (rule hoare_pre) @@ -390,7 +390,7 @@ lemma derive_cap_valid_cap [CSpace_AI_assms]: done -lemma valid_cap_update_rights[simp, CSpace_AI_assms]: +lemma valid_cap_update_rights[simp, Arch_assms]: "valid_cap cap s \ valid_cap (cap_rights_update cr cap) s" apply (case_tac cap, simp_all add: cap_rights_update_def valid_cap_def cap_aligned_def @@ -401,7 +401,7 @@ lemma valid_cap_update_rights[simp, CSpace_AI_assms]: done -lemma update_cap_data_validI [CSpace_AI_assms]: +lemma update_cap_data_validI [Arch_assms]: "s \ cap \ s \ update_cap_data p d cap" apply (cases cap) apply (simp_all add: is_cap_defs update_cap_data_def Let_def split_def) @@ -414,7 +414,7 @@ lemma update_cap_data_validI [CSpace_AI_assms]: done -lemma tcb_cnode_index_def2 [CSpace_AI_assms]: +lemma tcb_cnode_index_def2 [Arch_assms]: "tcb_cnode_index n = nat_to_cref 3 n" apply (simp add: tcb_cnode_index_def nat_to_cref_def) apply (rule nth_equalityI) @@ -424,7 +424,7 @@ lemma tcb_cnode_index_def2 [CSpace_AI_assms]: done -lemma ex_nonz_tcb_cte_caps [CSpace_AI_assms]: +lemma ex_nonz_tcb_cte_caps [Arch_assms]: "\ex_nonz_cap_to t s; tcb_at t s; valid_objs s; ref \ dom tcb_cap_cases\ \ ex_cte_cap_wp_to (appropriate_cte_cap cp) (t, ref) s" apply (clarsimp simp: ex_nonz_cap_to_def ex_cte_cap_wp_to_def @@ -453,7 +453,7 @@ lemma no_cap_to_obj_with_diff_ref_triv: done -lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: +lemma setup_reply_master_arch_caps[wp, Arch_assms]: "\valid_arch_caps and tcb_at t and valid_objs and pspace_aligned\ setup_reply_master t \\rv. valid_arch_caps\" @@ -468,7 +468,7 @@ lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: done -lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma setup_reply_master_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and tcb_at t and pspace_in_kernel_window\ setup_reply_master t \\rv. cap_refs_in_kernel_window\" @@ -480,13 +480,13 @@ lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: (* FIXME: prove same_region_as_def2 instead or change def *) -lemma same_region_as_Untyped2 [CSpace_AI_assms]: +lemma same_region_as_Untyped2 [Arch_assms]: "\ is_untyped_cap pcap; same_region_as pcap cap \ \ (is_physical cap \ cap_range cap \ {} \ cap_range cap \ cap_range pcap)" by (fastforce simp: is_cap_simps cap_range_def is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma same_region_as_cap_class [CSpace_AI_assms]: +lemma same_region_as_cap_class [Arch_assms]: shows "same_region_as a b \ cap_class a = cap_class b" apply (case_tac a) apply (fastforce simp: cap_range_def arch_is_physical_def is_cap_simps @@ -515,22 +515,23 @@ lemma cap_insert_simple_arch_caps_no_ap: apply (intro conjI impI allI) by (auto simp:is_simple_cap_def[simplified is_simple_cap_arch_def] is_cap_simps) -lemma cap_insert_derived_valid_arch_state[CSpace_AI_assms]: +lemma cap_insert_derived_valid_arch_state[Arch_assms]: "\valid_arch_state and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_insert_tcb cap_insert_aobj_at) -lemma setup_reply_master_arch[CSpace_AI_assms]: +lemma setup_reply_master_arch[Arch_assms]: "setup_reply_master t \ valid_arch_state \" by (wpsimp simp: setup_reply_master_def wp: get_cap_wp) +lemmas CSpace_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CSpace_AI?: CSpace_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CSpace_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.CSpace_AI_assms)?) qed diff --git a/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy index 1335cff66d..34ddfc4c8f 100644 --- a/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy +++ b/proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedAux_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedAux_AI locale *) lemma set_pd_etcbs[wp]: "set_pd p pd \\s. P (etcbs_of s)\" @@ -21,11 +21,11 @@ lemma set_pd_etcbs[wp]: crunch init_arch_objects for exst[wp]: "\s. P (exst s)" - and etcbs_of[wp, DetSchedAux_AI_assms]: "\s. P (etcbs_of s)" - and ready_queues[wp, DetSchedAux_AI_assms]: "\s. P (ready_queues s)" - and idle_thread[wp, DetSchedAux_AI_assms]: "\s. P (idle_thread s)" - and schedact[wp, DetSchedAux_AI_assms]: "\s. P (scheduler_action s)" - and cur_domain[wp, DetSchedAux_AI_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and schedact[wp, Arch_assms]: "\s. P (scheduler_action s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" (wp: crunch_wps) crunch init_arch_objects @@ -40,7 +40,7 @@ lemma tcb_sched_action_valid_idle_etcb: (wpsimp simp: tcb_sched_action_def set_tcb_queue_def) crunch init_arch_objects - for valid_blocked[wp, DetSchedAux_AI_assms]: valid_blocked + for valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift crunch_wps) lemma perform_asid_control_etcb_at: @@ -84,12 +84,13 @@ lemma perform_asid_control_invocation_valid_sched: apply simp done +lemmas DetSchedAux_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedAux_AI?: DetSchedAux_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedAux_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.DetSchedAux_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchDetSchedDomainTime_AI.thy b/proof/invariant-abstract/ARM/ArchDetSchedDomainTime_AI.thy index 84c0e45d34..6d68761a37 100644 --- a/proof/invariant-abstract/ARM/ArchDetSchedDomainTime_AI.thy +++ b/proof/invariant-abstract/ARM/ArchDetSchedDomainTime_AI.thy @@ -10,10 +10,10 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedDomainTime_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedDomainTime_AI locale *) crunch arch_finalise_cap - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: hoare_drop_imps mapM_wp subset_refl simp: crunch_simps) crunch @@ -23,30 +23,31 @@ crunch prepare_thread_delete, handle_hypervisor_fault, init_arch_objects, arch_post_modify_registers, arch_post_cap_deletion, arch_invoke_irq_handler, arch_prepare_next_domain, arch_prepare_set_domain, arch_post_set_flags - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps) crunch arch_finalise_cap - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: hoare_drop_imps mapM_wp subset_refl simp: crunch_simps) -declare init_arch_objects_exst[DetSchedDomainTime_AI_assms] +declare init_arch_objects_exst[Arch_assms] + +lemmas DetSchedDomainTime_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.DetSchedDomainTime_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_mask_irq_signal - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" crunch arch_perform_invocation - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps check_cap_inv) lemma timer_tick_valid_domain_time: @@ -70,7 +71,7 @@ lemma timer_tick_valid_domain_time: crunch do_machine_op for domain_time_sched[wp]: "\s. P (domain_time s) (scheduler_action s)" -lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: +lemma handle_interrupt_valid_domain_time [Arch_assms]: "\\s :: det_ext state. 0 < domain_time s \ handle_interrupt i \\rv s. domain_time s = 0 \ scheduler_action s = choose_new_thread \" (is "\ ?dtnot0 \ _ \ _ \") @@ -87,18 +88,19 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: done crunch handle_reserved_irq, handle_spurious_irq - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps mapM_wp subset_refl simp: crunch_simps) crunch handle_spurious_irq - for scheduler_action[wp, DetSchedDomainTime_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" + +lemmas DetSchedDomainTime_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI_2?: DetSchedDomainTime_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.DetSchedDomainTime_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchDetSchedSchedule_AI.thy b/proof/invariant-abstract/ARM/ArchDetSchedSchedule_AI.thy index bd31c06634..96ec259ff6 100644 --- a/proof/invariant-abstract/ARM/ArchDetSchedSchedule_AI.thy +++ b/proof/invariant-abstract/ARM/ArchDetSchedSchedule_AI.thy @@ -10,24 +10,24 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedSchedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedSchedule_AI locale *) crunch arch_mask_irq_signal - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched crunch prepare_thread_delete - for prepare_thread_delete_idle_thread[wp, DetSchedSchedule_AI_assms]: "\(s:: det_ext state). P (idle_thread s)" + for prepare_thread_delete_idle_thread[wp, Arch_assms]: "\(s:: det_ext state). P (idle_thread s)" crunch switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain - for valid_queues[wp, DetSchedSchedule_AI_assms]: valid_queues + for valid_queues[wp, Arch_assms]: valid_queues (simp: crunch_simps ignore: set_tcb_queue tcb_sched_action clearExMonitor) crunch switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers - for weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: "weak_valid_sched_action" + for weak_valid_sched_action[wp, Arch_assms]: "weak_valid_sched_action" (simp: crunch_simps ignore: clearExMonitor) crunch set_vm_root @@ -36,7 +36,7 @@ crunch set_vm_root and ct_not_in_q'[wp]: "\s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) t" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_not_in_q [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_in_q [wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\_. ct_not_in_q\" apply (simp add: switch_to_idle_thread_def) apply wp @@ -51,7 +51,7 @@ crunch set_vm_root (etcbs_of s) (kheap s) thread (cur_domain s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_sched_action [wp, Arch_assms]: "\valid_sched_action and valid_idle\ switch_to_idle_thread \\_. valid_sched_action\" @@ -68,7 +68,7 @@ crunch set_vm_root (scheduler_action s) (cur_domain s) (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_in_cur_domain [wp, Arch_assms]: "\\\ switch_to_idle_thread \\_. ct_in_cur_domain\" by (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def split_def @@ -76,21 +76,21 @@ lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]: | simp add: ct_in_cur_domain_def)+ crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (simp: crunch_simps ignore: clearExMonitor) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for is_activatable[wp, DetSchedSchedule_AI_assms]: "is_activatable t" + for is_activatable[wp, Arch_assms]: "is_activatable t" (simp: crunch_simps ignore: clearExMonitor) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for valid_sched_action[wp, DetSchedSchedule_AI_assms]: valid_sched_action + for valid_sched_action[wp, Arch_assms]: valid_sched_action (simp: crunch_simps ignore: clearExMonitor) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain, arch_post_set_flags, arch_prepare_set_domain - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps ignore: clearExMonitor) crunch set_vm_root @@ -98,7 +98,7 @@ crunch set_vm_root (wp: crunch_wps whenE_wp simp: crunch_simps) crunch arch_switch_to_thread - for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" + for ct_in_cur_domain_2[wp, Arch_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" (simp: crunch_simps) crunch set_vm_root @@ -110,36 +110,36 @@ crunch set_vm_root (simp: crunch_simps) crunch switch_to_thread - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" (wp: crunch_wps) crunch arch_switch_to_idle_thread - for valid_idle[wp, DetSchedSchedule_AI_assms]: "valid_idle" + for valid_idle[wp, Arch_assms]: "valid_idle" (wp: crunch_wps simp: crunch_simps) crunch arch_switch_to_idle_thread, arch_prepare_next_domain - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" crunch arch_prepare_next_domain, arch_prepare_set_domain - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" (simp: Let_def) crunch arch_prepare_next_domain - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" - and ct_in_q[wp, DetSchedSchedule_AI_assms]: ct_in_q - and valid_blocked[wp, DetSchedSchedule_AI_assms]: valid_blocked + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and ct_in_q[wp, Arch_assms]: ct_in_q + and valid_blocked[wp, Arch_assms]: valid_blocked crunch arch_prepare_set_domain - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and valid_idle[wp, Arch_assms]: valid_idle lemma set_vm_root_valid_blocked_ct_in_q [wp]: "\valid_blocked and ct_in_q\ set_vm_root p \\_. valid_blocked and ct_in_q\" by (wp | wpc | auto)+ -lemma arch_switch_to_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma arch_switch_to_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ arch_switch_to_thread thread \\_. valid_blocked and ct_in_q\" apply (simp add: arch_switch_to_thread_def) apply (rule bind_wp)+ @@ -147,7 +147,7 @@ lemma arch_switch_to_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: apply wp done -lemma switch_to_idle_thread_ct_not_queued [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_queued [wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\rv s. not_queued (cur_thread s) s\" @@ -163,7 +163,7 @@ crunch set_vm_root (scheduler_action s) thread" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ switch_to_idle_thread \\rv. valid_blocked\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def | wp | wpc)+ apply clarsimp @@ -172,7 +172,7 @@ lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: done crunch arch_switch_to_thread - for exst[wp, DetSchedSchedule_AI_assms]: "\s. P (exst s :: det_ext)" + for exst[wp, Arch_assms]: "\s. P (exst s :: det_ext)" (ignore: clearExMonitor) crunch arch_switch_to_idle_thread @@ -183,14 +183,14 @@ lemma astit_st_tcb_at[wp]: apply (simp add: arch_switch_to_idle_thread_def) by (wpsimp) -lemma stit_activatable' [DetSchedSchedule_AI_assms]: +lemma stit_activatable' [Arch_assms]: "\valid_idle\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def ct_in_state_def do_machine_op_def split_def) apply wpsimp apply (clarsimp simp: valid_idle_def ct_in_state_def pred_tcb_at_def obj_at_def) done -lemma switch_to_idle_thread_cur_thread_idle_thread [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_cur_thread_idle_thread [wp, Arch_assms]: "\\\ switch_to_idle_thread \\_ s. cur_thread s = idle_thread s\" by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+ @@ -222,21 +222,21 @@ lemma set_asid_pool_valid_sched[wp]: crunch arch_finalise_cap, prepare_thread_delete - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action) crunch arch_finalise_cap, prepare_thread_delete - for simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action + for simple_sched_action[wp, Arch_assms]: simple_sched_action (wp: hoare_drop_imps mapM_x_wp mapM_wp subset_refl simp: unless_def if_fun_split) crunch arch_finalise_cap, prepare_thread_delete, arch_invoke_irq_handler - for valid_sched [wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched [wp, Arch_assms]: valid_sched (ignore: set_object wp: crunch_wps subset_refl simp: if_fun_split) -lemma activate_thread_valid_sched [DetSchedSchedule_AI_assms]: +lemma activate_thread_valid_sched [Arch_assms]: "\valid_sched\ activate_thread \\_. valid_sched\" apply (simp add: activate_thread_def) apply (wp set_thread_state_runnable_valid_sched gts_wp | wpc | simp add: arch_activate_idle_thread_def)+ @@ -249,7 +249,7 @@ crunch for valid_sched[wp]: valid_sched (wp: mapM_x_wp' mapM_wp') -lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: +lemma arch_perform_invocation_valid_sched [wp, Arch_assms]: "\invs and valid_sched and ct_active and valid_arch_inv a\ arch_perform_invocation a \\_.valid_sched\" @@ -260,24 +260,24 @@ lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: crunch handle_arch_fault_reply, handle_vm_fault - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (ignore: getFAR getDFSR getIFSR) crunch handle_vm_fault, handle_arch_fault_reply - for not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" + for not_queued[wp, Arch_assms]: "not_queued t" (ignore: getFAR getDFSR getIFSR) crunch handle_arch_fault_reply, handle_vm_fault - for sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" + for sched_act_not[wp, Arch_assms]: "scheduler_act_not t" (ignore: getFAR getDFSR getIFSR) -lemma hvmf_st_tcb_at [wp, DetSchedSchedule_AI_assms]: +lemma hvmf_st_tcb_at [wp, Arch_assms]: "\st_tcb_at P t' \ handle_vm_fault t w \\rv. st_tcb_at P t' \" by (cases w, simp_all) ((wp | simp)+) -lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: +lemma handle_vm_fault_st_tcb_cur_thread [wp, Arch_assms]: "\ \s. st_tcb_at P (cur_thread s) s \ handle_vm_fault t f \\_ s. st_tcb_at P (cur_thread s) s \" apply (fold ct_in_state_def) apply (rule ct_in_state_thread_state_lift) @@ -286,34 +286,34 @@ lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: done crunch arch_invoke_irq_control - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" crunch arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for valid_list[wp, DetSchedSchedule_AI_assms]: "valid_list" + for valid_list[wp, Arch_assms]: "valid_list" crunch handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info, arch_post_modify_registers - for cur_tcb[wp, DetSchedSchedule_AI_assms]: cur_tcb + for cur_tcb[wp, Arch_assms]: cur_tcb crunch arch_get_sanitise_register_info, arch_post_modify_registers - for not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t'" + for not_cur_thread[wp, Arch_assms]: "not_cur_thread t'" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" -lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]: +lemma arch_post_modify_registers_not_idle_thread[Arch_assms]: "\\s::det_ext state. t \ idle_thread s\ arch_post_modify_registers c t \\_ s. t \ idle_thread s\" by (wpsimp simp: arch_post_modify_registers_def) crunch arch_post_cap_deletion - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q - and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action - and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t" - and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" - and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" - and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action + for valid_sched[wp, Arch_assms]: valid_sched + and ct_not_in_q[wp, Arch_assms]: ct_not_in_q + and simple_sched_action[wp, Arch_assms]: simple_sched_action + and not_cur_thread[wp, Arch_assms]: "not_cur_thread t" + and not_queued[wp, Arch_assms]: "not_queued t" + and sched_act_not[wp, Arch_assms]: "scheduler_act_not t" + and weak_valid_sched_action[wp, Arch_assms]: weak_valid_sched_action crunch flush_space, invalidate_asid_entry, get_asid_pool for idle_thread[wp]: "\s. P (idle_thread s)" @@ -329,10 +329,10 @@ crunch crunch finalise_cap - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" (wp: crunch_wps simp: crunch_simps) -lemmas[DetSchedSchedule_AI_assms] = arch_post_cap_deletion_valid_idle +lemmas[Arch_assms] = arch_post_cap_deletion_valid_idle crunch cap_swap_for_delete, cap_move, cancel_badged_sends for idle_thread[wp]: "\s::'a::state_ext state. P (idle_thread s)" @@ -341,25 +341,26 @@ crunch cap_swap_for_delete, cap_move, cancel_badged_sends ignore: without_preemption filterM rec_del check_cap_at cap_revoke) crunch arch_switch_to_thread - for etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" + for etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" crunch handle_spurious_irq - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and valid_idle[wp, Arch_assms]: valid_idle crunch prepare_thread_delete, arch_post_cap_deletion, arch_finalise_cap - for cur_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_thread s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for cur_thread[wp, Arch_assms]: "\s. P (cur_thread s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) +lemmas DetSchedSchedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.DetSchedSchedule_AI_assms)?) qed context Arch begin arch_global_naming @@ -375,12 +376,15 @@ lemma handle_reserved_irq_valid_sched: handle_reserved_irq irq \\rv. valid_sched\" unfolding handle_reserved_irq_def by (wpsimp simp: non_kernel_IRQs_def) +lemmas [Arch_assms] = handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched + +lemmas DetSchedSchedule_AI_handle_hypervisor_fault_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI_handle_hypervisor_fault?: DetSchedSchedule_AI_handle_hypervisor_fault proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched)?) + case 1 show ?case by (unfold_locales; (fact ARM.DetSchedSchedule_AI_handle_hypervisor_fault_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchDeterministic_AI.thy b/proof/invariant-abstract/ARM/ArchDeterministic_AI.thy index 5072a5de33..b8e4975f64 100644 --- a/proof/invariant-abstract/ARM/ArchDeterministic_AI.thy +++ b/proof/invariant-abstract/ARM/ArchDeterministic_AI.thy @@ -10,27 +10,28 @@ begin context Arch begin arch_global_naming -named_theorems Deterministic_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Deterministic_AI locale *) crunch cap_swap_for_delete,set_cap,finalise_cap,arch_get_sanitise_register_info, arch_post_modify_registers, arch_post_set_flags - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -declare get_cap_inv[Deterministic_AI_assms] +declare get_cap_inv[Arch_assms] + +lemmas Deterministic_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Deterministic_AI_1?: Deterministic_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.Deterministic_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_invoke_irq_handler - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list crunch invalidate_tlb_by_asid for valid_list[wp]: valid_list @@ -63,21 +64,21 @@ crunch perform_invocation (wp: crunch_wps simp: crunch_simps ignore: without_preemption) crunch handle_invocation - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps syscall_valid simp: crunch_simps ignore: without_preemption syscall) crunch handle_recv, handle_yield, handle_call - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: crunch_simps) -lemma handle_vm_fault_valid_list[wp, Deterministic_AI_assms]: +lemma handle_vm_fault_valid_list[wp, Arch_assms]: "\valid_list\ handle_vm_fault thread fault \\_.valid_list\" apply (cases fault,simp_all) apply (wp|simp)+ done -lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: +lemma handle_interrupt_valid_list[wp, Arch_assms]: "\valid_list\ handle_interrupt irq \\_.valid_list\" unfolding handle_interrupt_def ackInterrupt_def apply (rule hoare_pre) @@ -86,16 +87,18 @@ lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: | wp (once) hoare_drop_imps)+ crunch handle_send, handle_reply, handle_spurious_irq - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list crunch handle_hypervisor_fault - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list + +lemmas Deterministic_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end + global_interpretation Deterministic_AI_2?: Deterministic_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.Deterministic_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchDetype_AI.thy b/proof/invariant-abstract/ARM/ArchDetype_AI.thy index f89a7b1b0f..2132d59ed5 100644 --- a/proof/invariant-abstract/ARM/ArchDetype_AI.thy +++ b/proof/invariant-abstract/ARM/ArchDetype_AI.thy @@ -10,16 +10,16 @@ begin context Arch begin arch_global_naming -named_theorems Detype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_AI locale *) -lemma valid_globals_irq_node[Detype_AI_assms]: +lemma valid_globals_irq_node[Arch_assms]: "\ valid_global_refs s; cte_wp_at ((=) cap) ptr s \ \ interrupt_irq_node s irq \ cap_range cap" apply (erule(1) valid_global_refsD) apply (simp add: global_refs_def) done -lemma caps_of_state_ko[Detype_AI_assms]: +lemma caps_of_state_ko[Arch_assms]: "valid_cap cap s \ is_untyped_cap cap \ cap_range cap = {} \ @@ -34,7 +34,7 @@ lemma caps_of_state_ko[Detype_AI_assms]: done -lemma mapM_x_storeWord[Detype_AI_assms]: +lemma mapM_x_storeWord[Arch_assms]: (* FIXME: taken from Retype_C.thy and adapted wrt. the missing intvl syntax. *) assumes al: "is_aligned ptr word_size_bits" shows "mapM_x (\x. storeWord (ptr + of_nat x * word_size) 0) [0..x. if x \ S then {} else state_hyp_refs_of s x)" by (rule ext, simp add: state_hyp_refs_of_def detype_def) +lemmas Detype_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Detype_AI?: Detype_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Detype_AI_assms)?) + by (intro_locales; (unfold_locales; fact ARM.Detype_AI_assms)?) qed context detype_locale_arch begin diff --git a/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy b/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy index 2155c9397b..671492331d 100644 --- a/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy +++ b/proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_AI locale *) crunch_ignore (empty_fail) (add: invalidateLocalTLB_ASID_impl invalidateLocalTLB_VAASID_impl cleanByVA_impl @@ -23,20 +23,21 @@ crunch_ignore (empty_fail) crunch loadWord, load_word_offs, storeWord, getRestartPC, get_mrs - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_load_word_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_load_word?: EmptyFail_AI_load_word proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.EmptyFail_AI_load_word_assms)?) qed context Arch begin arch_global_naming crunch handle_fault - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: kernel_object.splits option.splits arch_cap.splits cap.splits endpoint.splits bool.splits list.splits thread_state.splits split_def catch_def sum.splits Let_def) @@ -106,12 +107,13 @@ lemma arch_decode_invocation_empty_fail[wp]: including no_pre by ((simp add: arch_decode_invocation_def Let_def split: arch_cap.splits cap.splits option.splits | (wp+) | intro conjI impI allI)+) +lemmas EmptyFail_AI_derive_cap_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_derive_cap?: EmptyFail_AI_derive_cap proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.EmptyFail_AI_derive_cap_assms)?) qed context Arch begin arch_global_naming @@ -119,32 +121,36 @@ context Arch begin arch_global_naming crunch maskInterrupt, empty_slot, setHardwareASID, set_current_pd, finalise_cap, preemption_point, cap_swap_for_delete, decode_invocation - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: Let_def catch_def split_def OR_choiceE_def mk_ef_def option.splits endpoint.splits notification.splits thread_state.splits sum.splits cap.splits arch_cap.splits kernel_object.splits vmpage_size.splits pde.splits bool.splits list.splits) crunch setRegister, setNextPC - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_rec_del_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_rec_del?: EmptyFail_AI_rec_del proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.EmptyFail_AI_rec_del_assms)?) qed context Arch begin arch_global_naming + crunch cap_delete, choose_thread, arch_prepare_next_domain - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_schedule_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_schedule?: EmptyFail_AI_schedule proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.EmptyFail_AI_schedule_assms)?) qed context Arch begin arch_global_naming @@ -155,7 +161,7 @@ lemma deactivateInterrupt_empty_fail[wp]: by wpsimp crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: cap.splits arch_cap.splits split_def invocation_label.splits Let_def kernel_object.splits arch_kernel_obj.splits option.splits pde.splits pte.splits bool.splits apiobject_type.splits aobject_type.splits notification.splits @@ -164,12 +170,14 @@ crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits flush_type.splits page_directory_invocation.splits ignore: resetTimer_impl ackInterrupt_impl handleSpuriousIRQ_impl) + +lemmas EmptyFail_AI_call_kernel_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_call_kernel?: EmptyFail_AI_call_kernel proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.EmptyFail_AI_call_kernel_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchFinalise_AI.thy b/proof/invariant-abstract/ARM/ArchFinalise_AI.thy index 0ce50757e9..02d09b2e56 100644 --- a/proof/invariant-abstract/ARM/ArchFinalise_AI.thy +++ b/proof/invariant-abstract/ARM/ArchFinalise_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin -named_theorems Finalise_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_AI locale *) -lemma (* obj_at_not_live_valid_arch_cap_strg *) [Finalise_AI_assms]: +lemma (* obj_at_not_live_valid_arch_cap_strg *) [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: valid_cap_def obj_at_def @@ -20,7 +20,7 @@ lemma (* obj_at_not_live_valid_arch_cap_strg *) [Finalise_AI_assms]: split: arch_cap.split_asm if_splits) crunch prepare_thread_delete - for caps_of_state[wp,Finalise_AI_assms]: "\s. P (caps_of_state s)" + for caps_of_state[wp,Arch_assms]: "\s. P (caps_of_state s)" arch_global_naming @@ -232,22 +232,22 @@ lemma unmap_page_tcb_cap_valid: apply (wp unmap_page_tcb_at hoare_vcg_ex_lift hoare_vcg_all_lift)+ done -lemma (* replaceable_cdt_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_cdt_update *)[simp,Arch_assms]: "replaceable (cdt_update f s) = replaceable s" by (fastforce simp: replaceable_def tcb_cap_valid_def) -lemma (* replaceable_revokable_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_revokable_update *)[simp,Arch_assms]: "replaceable (is_original_cap_update f s) = replaceable s" by (fastforce simp: replaceable_def is_final_cap'_def2 tcb_cap_valid_def) -lemma (* replaceable_more_update *) [simp,Finalise_AI_assms]: +lemma (* replaceable_more_update *) [simp,Arch_assms]: "replaceable (trans_state f s) sl cap cap' = replaceable s sl cap cap'" by (simp add: replaceable_def) -lemma (* obj_ref_ofI *) [Finalise_AI_assms]: "obj_refs cap = {x} \ obj_ref_of cap = x" +lemma (* obj_ref_ofI *) [Arch_assms]: "obj_refs cap = {x} \ obj_ref_of cap = x" by (case_tac cap, simp_all) (rename_tac arch_cap, case_tac arch_cap, simp_all) -lemma (* empty_slot_invs *) [Finalise_AI_assms]: +lemma (* empty_slot_invs *) [Arch_assms]: "\\s. invs s \ cte_wp_at (replaceable s sl cap.NullCap) sl s \ emptyable sl s \ (info \ NullCap \ post_cap_delete_pre info ((caps_of_state s) (sl \ NullCap)))\ @@ -323,7 +323,7 @@ lemma (* empty_slot_invs *) [Finalise_AI_assms]: apply (simp add: is_final_cap'_def2 cte_wp_at_caps_of_state) done -lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: +lemma dom_tcb_cap_cases_lt_ARCH [Arch_assms]: "dom tcb_cap_cases = {xs. length xs = 3 \ unat (of_bl xs :: machine_word) < 5}" apply (rule set_eqI, rule iffI) apply clarsimp @@ -333,7 +333,7 @@ lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: apply (clarsimp simp: nat_to_cref_unat_of_bl') done -lemma (* unbind_notification_final *) [wp,Finalise_AI_assms]: +lemma (* unbind_notification_final *) [wp,Arch_assms]: "\is_final_cap' cap\ unbind_notification t \ \rv. is_final_cap' cap\" unfolding unbind_notification_def apply (wp final_cap_lift thread_set_caps_of_state_trivial hoare_drop_imps @@ -343,7 +343,7 @@ lemma (* unbind_notification_final *) [wp,Finalise_AI_assms]: crunch prepare_thread_delete for is_final_cap'[wp]: "is_final_cap' cap" -lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: +lemma (* finalise_cap_cases1 *)[Arch_assms]: "\\s. final \ is_final_cap' cap s \ cte_wp_at ((=) cap) slot s\ finalise_cap cap final @@ -374,14 +374,14 @@ lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: done crunch arch_finalise_cap,prepare_thread_delete - for typ_at_arch[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at_arch[wp,Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps unless_def assertE_def ignore: maskInterrupt ) crunch prepare_thread_delete for tcb_at[wp]: "\s. tcb_at p s" -lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: +lemma (* finalise_cap_new_valid_cap *)[wp,Arch_assms]: "\valid_cap cap\ finalise_cap cap x \\rv. valid_cap (fst rv)\" apply (cases cap, simp_all) apply (wp suspend_valid_cap @@ -395,7 +395,7 @@ lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: split del: if_split|clarsimp|wpc)+ done -lemma (* arch_finalise_cap_invs *)[wp,Finalise_AI_assms]: +lemma (* arch_finalise_cap_invs *)[wp,Arch_assms]: "\invs and valid_cap (ArchObjectCap cap)\ arch_finalise_cap cap final \\rv. invs\" @@ -406,7 +406,7 @@ lemma (* arch_finalise_cap_invs *)[wp,Finalise_AI_assms]: apply (auto simp: mask_def vmsz_aligned_def) done -lemma obj_at_not_live_valid_arch_cap_strg [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: valid_cap_def obj_at_def @@ -454,7 +454,7 @@ lemma arch_finalise_cap_replaceable[wp]: split: cap.splits arch_cap.splits vmpage_size.splits)[1] done -lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_slot_not_irq_node *)[Arch_assms]: "\if_unsafe_then_cap and valid_global_refs and cte_wp_at (\cp. cap_irqs cp \ {}) sl\ deleting_irq_handler irq @@ -475,7 +475,7 @@ lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: apply (clarsimp simp: appropriate_cte_cap_def split: cap.split_asm) done -lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Arch_assms]: "\ cte_wp_at ((=) cap) p s; is_final_cap' cap s; obj_refs cap' = obj_refs cap \ \ no_cap_to_obj_with_diff_ref cap' {p} s" @@ -497,7 +497,7 @@ lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: gen_obj_refs_Int) done -lemma (* suspend_no_cap_to_obj_ref *)[wp,Finalise_AI_assms]: +lemma (* suspend_no_cap_to_obj_ref *)[wp,Arch_assms]: "\no_cap_to_obj_with_diff_ref cap S\ suspend t \\rv. no_cap_to_obj_with_diff_ref cap S\" @@ -520,7 +520,7 @@ lemma prepare_thread_delete_unlive[wp]: apply (clarsimp simp: obj_at_def, case_tac ko; clarsimp simp: live_def hyp_live_def arch_tcb_live_def) done -lemma finalise_cap_replaceable [Finalise_AI_assms]: +lemma finalise_cap_replaceable [Arch_assms]: "\\s. s \ cap \ x = is_final_cap' cap s \ valid_mdb s \ cte_wp_at ((=) cap) sl s \ valid_objs s \ sym_refs (state_refs_of s) \ (cap_irqs cap \ {} \ if_unsafe_then_cap s \ valid_global_refs s) @@ -569,7 +569,7 @@ lemma finalise_cap_replaceable [Finalise_AI_assms]: | wpc | simp add: valid_cap_simps is_nondevice_page_cap_simps)+)) -lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_cte_preserved *)[Arch_assms]: assumes x: "\cap. P cap \ \ can_fast_finalise cap" shows "\cte_wp_at P p\ deleting_irq_handler irq \\rv. cte_wp_at P p\" apply (simp add: deleting_irq_handler_def) @@ -578,25 +578,26 @@ lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: crunch arch_finalise_cap - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) crunch prepare_thread_delete - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) -declare arch_post_cap_deletion_cur_thread[Finalise_AI_assms] +declare arch_post_cap_deletion_cur_thread[Arch_assms] crunch arch_post_cap_deletion - for cur_domain[Finalise_AI_assms, wp]: "\s. P (cur_domain s)" + for cur_domain[Arch_assms, wp]: "\s. P (cur_domain s)" (wp: crunch_wps dxo_wp_weak) +lemmas Finalise_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_1?: Finalise_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -620,7 +621,7 @@ lemma fast_finalise_replaceable[wp]: apply (clarsimp simp: cap_irqs_def cap_irq_opt_def split: cap.split_asm) done -lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: +lemma (* cap_delete_one_invs *) [Arch_assms,wp]: "\invs and emptyable ptr\ cap_delete_one ptr \\rv. invs\" apply (simp add: cap_delete_one_def unless_def is_final_cap_def) apply (rule hoare_pre) @@ -629,12 +630,13 @@ lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: apply (drule cte_wp_at_valid_objs_valid_cap, fastforce+) done +lemmas Finalise_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_2?: Finalise_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Finalise_AI_2_assms)?) qed context Arch begin arch_global_naming @@ -644,7 +646,7 @@ crunch arch_finalise_cap (wp: crunch_wps simp: crunch_simps) crunch prepare_thread_delete - for irq_node[wp,Finalise_AI_assms]: "\s. P (interrupt_irq_node s)" + for irq_node[wp,Arch_assms]: "\s. P (interrupt_irq_node s)" crunch arch_finalise_cap for pred_tcb_at[wp]: "pred_tcb_at proj P t" @@ -1228,7 +1230,7 @@ lemma mapM_x_swp_store_invalid_pde_invs: crunch prepare_thread_delete for invs[wp]: invs -lemma (* finalise_cap_invs *)[Finalise_AI_assms]: +lemma (* finalise_cap_invs *)[Arch_assms]: shows "\invs and cte_wp_at ((=) cap) slot\ finalise_cap cap x \\rv. invs\" apply (cases cap, simp_all split del: if_split) apply (wp cancel_all_ipc_invs cancel_all_signals_invs unbind_notification_invs @@ -1245,16 +1247,16 @@ lemma (* finalise_cap_invs *)[Finalise_AI_assms]: apply (auto dest: cte_wp_at_valid_objs_valid_cap) done -lemma (* finalise_cap_irq_node *)[Finalise_AI_assms]: +lemma (* finalise_cap_irq_node *)[Arch_assms]: "\\s. P (interrupt_irq_node s)\ finalise_cap a b \\_ s. P (interrupt_irq_node s)\" apply (case_tac a,simp_all) apply (wp | clarsimp)+ done -lemmas (*arch_finalise_cte_irq_node *) [wp,Finalise_AI_assms] +lemmas (*arch_finalise_cte_irq_node *) [wp,Arch_assms] = hoare_use_eq_irq_node [OF arch_finalise_cap_irq_node arch_finalise_cap_cte_wp_at] -lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: +lemma (* deleting_irq_handler_st_tcb_at *) [Arch_assms]: "\st_tcb_at P t and K (\st. simple st \ P st)\ deleting_irq_handler irq \\rv. st_tcb_at P t\" @@ -1263,11 +1265,11 @@ lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: apply simp done -lemma irq_node_global_refs_ARCH [Finalise_AI_assms]: +lemma irq_node_global_refs_ARCH [Arch_assms]: "interrupt_irq_node s irq \ global_refs s" by (simp add: global_refs_def) -lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: +lemma (* get_irq_slot_fast_finalisable *)[wp,Arch_assms]: "\invs\ get_irq_slot irq \cte_wp_at can_fast_finalise\" apply (simp add: get_irq_slot_def) apply wp @@ -1289,12 +1291,12 @@ lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: apply (clarsimp simp: cap_range_def) done -lemma (* replaceable_or_arch_update_same *) [Finalise_AI_assms]: +lemma (* replaceable_or_arch_update_same *) [Arch_assms]: "replaceable_or_arch_update s slot cap cap" by (clarsimp simp: replaceable_or_arch_update_def replaceable_def is_arch_update_def is_cap_simps) -lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: +lemma (* replace_cap_invs_arch_update *)[Arch_assms]: "\\s. cte_wp_at (replaceable_or_arch_update s p cap) p s \ invs s \ cap \ cap.NullCap @@ -1312,7 +1314,7 @@ lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: apply simp done -lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: +lemma dmo_tcb_cap_valid_ARCH [Arch_assms]: "\\s. P (tcb_cap_valid cap ptr s)\ do_machine_op mop \\_ s. P (tcb_cap_valid cap ptr s)\" apply (simp add: tcb_cap_valid_def no_cap_to_obj_with_diff_ref_def) apply (rule hoare_pre) @@ -1321,7 +1323,7 @@ lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: apply simp done -lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: +lemma (* dmo_replaceable_or_arch_update *) [Arch_assms,wp]: "\\s. replaceable_or_arch_update s slot cap cap'\ do_machine_op mo \\r s. replaceable_or_arch_update s slot cap cap'\" @@ -1333,6 +1335,8 @@ lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: apply auto done +lemmas Finalise_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end arch_requalify_consts replaceable_or_arch_update @@ -1340,8 +1344,7 @@ arch_requalify_consts replaceable_or_arch_update interpretation Finalise_AI_3?: Finalise_AI_3 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Finalise_AI_3_assms)?) qed context Arch begin arch_global_naming @@ -1358,8 +1361,7 @@ end interpretation Finalise_AI_4?: Finalise_AI_4 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -1652,10 +1654,10 @@ crunch unmap_page_table, invalidate_tlb_by_asid, for valid_cap[wp]: "valid_cap c" (wp: mapM_wp_inv mapM_x_wp' simp: crunch_simps) -lemmas clearMemory_invs [wp,Finalise_AI_assms] +lemmas clearMemory_invs [wp,Arch_assms] = clearMemory_invs -lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: +lemma valid_idle_has_null_cap_ARCH[Arch_assms]: "\ if_unsafe_then_cap s; valid_global_refs s; valid_idle s; valid_irq_node s\ \ caps_of_state s (idle_thread s, v) = Some cap \ cap = NullCap" @@ -1671,7 +1673,7 @@ lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: apply (drule_tac x=word in spec, simp) done -lemma (* zombie_cap_two_nonidles *)[Finalise_AI_assms]: +lemma (* zombie_cap_two_nonidles *)[Arch_assms]: "\ caps_of_state s ptr = Some (Zombie ptr' zbits n); invs s \ \ fst ptr \ idle_thread s \ ptr' \ idle_thread s" apply (frule valid_global_refsD2, clarsimp+) @@ -1687,13 +1689,14 @@ lemma arch_derive_cap_notIRQ[wp]: "\\\ arch_derive_cap cap \\rv s. rv \ cap.IRQControlCap\,-" by (cases cap; wpsimp simp: arch_derive_cap_def o_def) +lemmas Finalise_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_5?: Finalise_AI_5 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Finalise_AI_5_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchInterruptAcc_AI.thy b/proof/invariant-abstract/ARM/ArchInterruptAcc_AI.thy index 2611c46441..d3613a195a 100644 --- a/proof/invariant-abstract/ARM/ArchInterruptAcc_AI.thy +++ b/proof/invariant-abstract/ARM/ArchInterruptAcc_AI.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems InterruptAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InterruptAcc_AI locale *) -lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: +lemma dmo_maskInterrupt_invs [Arch_assms]: "\all_invs_but_valid_irq_states_for irq and (\s. state = interrupt_states s irq)\ do_machine_op (maskInterrupt (state = IRQInactive) irq) \\rv. invs\" @@ -32,12 +32,13 @@ lemma handle_spurious_irq_invs: apply (clarsimp simp add: machine_op_lift_def machine_rest_lift_def in_monad select_f_def) done +lemmas InterruptAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation InterruptAcc_AI?: InterruptAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact InterruptAcc_AI_assms) + case 1 show ?case by (unfold_locales; fact ARM.InterruptAcc_AI_assms) qed end diff --git a/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy b/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy index 3405c11eb8..dc0f2973bd 100644 --- a/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy +++ b/proof/invariant-abstract/ARM/ArchInterrupt_AI.thy @@ -28,16 +28,16 @@ primrec arch_irq_control_inv_valid_real :: defs arch_irq_control_inv_valid_def: "arch_irq_control_inv_valid \ arch_irq_control_inv_valid_real" -named_theorems Interrupt_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_AI locale *) -lemma (* decode_irq_control_invocation_inv *)[Interrupt_AI_assms]: +lemma (* decode_irq_control_invocation_inv *)[Arch_assms]: "\P\ decode_irq_control_invocation label args slot caps \\rv. P\" apply (simp add: decode_irq_control_invocation_def Let_def arch_check_irq_def range_check_def arch_decode_irq_control_invocation_def whenE_def, safe) apply (wp | simp)+ done -lemma decode_irq_control_valid [Interrupt_AI_assms]: +lemma decode_irq_control_valid [Arch_assms]: "\\s. invs s \ (\cap \ set caps. s \ cap) \ (\cap \ set caps. is_cnode_cap cap \ (\r \ cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -54,7 +54,7 @@ lemma decode_irq_control_valid [Interrupt_AI_assms]: apply (cases caps ; fastforce simp: cte_wp_at_eq_simp) done -lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: +lemma get_irq_slot_different_ARCH[Arch_assms]: "\\s. valid_global_refs s \ ex_cte_cap_wp_to is_cnode_cap ptr s\ get_irq_slot irq \\rv s. rv \ ptr\" @@ -66,7 +66,7 @@ lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: apply (clarsimp simp: global_refs_def is_cap_simps cap_range_def) done -lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: +lemma is_derived_use_interrupt_ARCH[Arch_assms]: "(is_ntfn_cap cap \ interrupt_derived cap cap') \ (is_derived m p cap cap')" apply (clarsimp simp: is_cap_simps) apply (clarsimp simp: interrupt_derived_def is_derived_def) @@ -74,7 +74,7 @@ lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: apply (simp add: is_cap_simps is_pt_cap_def vs_cap_ref_def) done -lemma maskInterrupt_invs_ARCH[Interrupt_AI_assms]: +lemma maskInterrupt_invs_ARCH[Arch_assms]: "\invs and (\s. \b \ interrupt_states s irq \ IRQInactive)\ do_machine_op (maskInterrupt b irq) \\rv. invs\" @@ -84,13 +84,13 @@ lemma maskInterrupt_invs_ARCH[Interrupt_AI_assms]: valid_irq_states_but_def valid_irq_masks_but_def valid_machine_state_def cur_tcb_def valid_irq_states_def valid_irq_masks_def) done -lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Interrupt_AI_assms]: +lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Arch_assms]: "no_cap_to_obj_with_diff_ref (IRQHandlerCap irq) S = \" by (rule ext, simp add: no_cap_to_obj_with_diff_ref_def cte_wp_at_caps_of_state obj_ref_none_no_asid) -lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: +lemma (* set_irq_state_valid_cap *)[Arch_assms]: "\valid_cap cap\ set_irq_state IRQSignal irq \\rv. valid_cap cap\" apply (clarsimp simp: set_irq_state_def) apply (wp do_machine_op_valid_cap) @@ -100,7 +100,7 @@ lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: done crunch set_irq_state - for valid_global_refs[Interrupt_AI_assms]: "valid_global_refs" + for valid_global_refs[Arch_assms]: "valid_global_refs" crunch arch_invoke_irq_handler for typ_at[wp]: "\s. P (typ_at T p s)" @@ -113,7 +113,7 @@ lemma deactivateInterrupt_invs: by (cases config_ARM_GIC_V3; simp) (wpsimp wp: maskInterrupt_invs_ARCH) -lemma invoke_irq_handler_invs'[Interrupt_AI_assms]: +lemma invoke_irq_handler_invs'[Arch_assms]: assumes dmo_ex_inv[wp]: "\f. \invs and ex_inv\ do_machine_op f \\rv::unit. ex_inv\" assumes cap_insert_ex_inv[wp]: "\cap src dest. \ex_inv and invs and K (src \ dest)\ @@ -184,7 +184,7 @@ lemma valid_cap_SGISignalCap[simp, intro!]: unfolding valid_cap_def by (clarsimp simp: cap_aligned_def word_bits_def) -lemma invoke_irq_control_invs[Interrupt_AI_assms]: +lemma invoke_irq_control_invs[Arch_assms]: "\invs and irq_control_inv_valid i\ invoke_irq_control i \\rv. invs\" apply (cases i; simp) apply (wp cap_insert_simple_invs @@ -214,7 +214,7 @@ lemma invoke_irq_control_invs[Interrupt_AI_assms]: crunch resetTimer for device_state_inv[wp]: "\ms. P (device_state ms)" -lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: +lemma resetTimer_invs_ARCH[Arch_assms]: "\invs\ do_machine_op resetTimer \\_. invs\" apply (wp dmo_invs) apply safe @@ -227,11 +227,11 @@ lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: apply(erule use_valid, wp no_irq_resetTimer no_irq, assumption) done -lemma empty_fail_ackInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_ackInterrupt_ARCH[Arch_assms]: "empty_fail (ackInterrupt irq)" by (wp | simp add: ackInterrupt_def)+ -lemma empty_fail_maskInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_maskInterrupt_ARCH[Arch_assms]: "empty_fail (maskInterrupt f irq)" by (wp | simp add: maskInterrupt_def)+ @@ -239,7 +239,7 @@ crunch timer_tick for invs[wp]: invs (wp: thread_set_invs_trivial[OF ball_tcb_cap_casesI]) -lemma handle_interrupt_invs[Interrupt_AI_assms]: +lemma handle_interrupt_invs[Arch_assms]: "\invs\ handle_interrupt irq \\_. invs\" apply (simp add: handle_interrupt_def) apply (rule conjI; rule impI) @@ -255,7 +255,7 @@ lemma handle_interrupt_invs[Interrupt_AI_assms]: | simp add: get_irq_state_def handle_reserved_irq_def)+ done -lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: +lemma sts_arch_irq_control_inv_valid[wp, Arch_assms]: "\arch_irq_control_inv_valid i\ set_thread_state t st \\rv. arch_irq_control_inv_valid i\" @@ -265,12 +265,13 @@ lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: apply (wp ex_cte_cap_to_pres | simp add: cap_table_at_typ)+ done +lemmas Interrupt_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Interrupt_AI?: Interrupt_AI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: Interrupt_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: ARM.Interrupt_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchInvariants_AI.thy b/proof/invariant-abstract/ARM/ArchInvariants_AI.thy index e504354f65..7f5e30e69c 100644 --- a/proof/invariant-abstract/ARM/ArchInvariants_AI.thy +++ b/proof/invariant-abstract/ARM/ArchInvariants_AI.thy @@ -36,6 +36,10 @@ end_qualify context Arch begin arch_global_naming +(* used to accumulate theorems for satisfying Arch interface assumptions; + remember to clear before starting a new accumulation *) +named_theorems Arch_assms + definition arch_tcb_to_iarch_tcb :: "arch_tcb \ iarch_tcb" where diff --git a/proof/invariant-abstract/ARM/ArchIpcCancel_AI.thy b/proof/invariant-abstract/ARM/ArchIpcCancel_AI.thy index 1a33884511..b7fe663aa7 100644 --- a/proof/invariant-abstract/ARM/ArchIpcCancel_AI.thy +++ b/proof/invariant-abstract/ARM/ArchIpcCancel_AI.thy @@ -10,19 +10,20 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_AI locale *) crunch arch_post_cap_deletion - for typ_at[wp, IpcCancel_AI_assms]: "\s. P (typ_at T p s)" - and idle_thread[wp, IpcCancel_AI_assms]: "\s. P (idle_thread s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + +lemmas IpcCancel_AI_assms = Arch_assms (* extract accumulated assumptions *) end interpretation IpcCancel_AI?: IpcCancel_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact IpcCancel_AI_assms)?) + by (intro_locales; (unfold_locales; fact ARM.IpcCancel_AI_assms)?) qed diff --git a/proof/invariant-abstract/ARM/ArchIpc_AI.thy b/proof/invariant-abstract/ARM/ArchIpc_AI.thy index 99e9f13b20..930ace3330 100644 --- a/proof/invariant-abstract/ARM/ArchIpc_AI.thy +++ b/proof/invariant-abstract/ARM/ArchIpc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_AI_1_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_1 locale *) lemma cap_asid_PageCap_None [simp]: "cap_asid (ArchObjectCap (PageCap dev r R pgsz None)) = None" @@ -36,7 +36,7 @@ lemma arch_derive_cap_is_derived: | rule conjI)+) done -lemma derive_cap_is_derived [Ipc_AI_1_assms]: +lemma derive_cap_is_derived [Arch_assms]: "\\s. c'\ cap.NullCap \ cte_wp_at (\cap. cap_master_cap cap = cap_master_cap c' \ (cap_badge cap, cap_badge c') \ capBadge_ordering False \ cap_asid cap = cap_asid c' @@ -62,23 +62,24 @@ lemma derive_cap_is_derived [Ipc_AI_1_assms]: apply(clarsimp simp: valid_cap_def) done -lemma arch_cap_badge_rights_update[Ipc_AI_1_assms, simp]: +lemma arch_cap_badge_rights_update[Arch_assms, simp]: "arch_cap_badge (acap_rights_update rights acap) = arch_cap_badge acap" by simp +lemmas Ipc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_1_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.Ipc_AI_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_2 locale *) -lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights [simp, Arch_assms]: "is_derived m p (cap_rights_update R c) = is_derived m p c" apply (rule ext) apply (simp add: cap_rights_update_def is_derived_def is_cap_simps) @@ -90,12 +91,12 @@ lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: split: arch_cap.split cap.split bool.splits) -lemma data_to_message_info_valid [Ipc_AI_2_assms]: +lemma data_to_message_info_valid [Arch_assms]: "valid_message_info (data_to_message_info w)" by (simp add: valid_message_info_def data_to_message_info_def word_and_le1 msg_max_length_def msg_max_extra_caps_def Let_def not_less mask_def) -lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: +lemma get_extra_cptrs_length[wp, Arch_assms]: "\\s . valid_message_info mi\ get_extra_cptrs buf mi \\rv s. length rv \ msg_max_extra_caps\" @@ -110,19 +111,19 @@ lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: intro: length_upt) done -lemma cap_asid_rights_update [simp, Ipc_AI_2_assms]: +lemma cap_asid_rights_update [simp, Arch_assms]: "cap_asid (cap_rights_update R c) = cap_asid c" apply (simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) apply (clarsimp simp: cap_asid_def) done -lemma cap_rights_update_vs_cap_ref[simp, Ipc_AI_2_assms]: +lemma cap_rights_update_vs_cap_ref[simp, Arch_assms]: "vs_cap_ref (cap_rights_update rs cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split bool.splits) -lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights2[simp, Arch_assms]: "is_derived m p c (cap_rights_update R c') = is_derived m p c c'" apply (case_tac c') apply (simp_all add: cap_rights_update_def) @@ -132,12 +133,12 @@ lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: apply (case_tac acap1) by (auto simp: acap_rights_update_def) -lemma cap_range_update [simp, Ipc_AI_2_assms]: +lemma cap_range_update [simp, Arch_assms]: "cap_range (cap_rights_update R cap) = cap_range cap" by (auto simp add: cap_range_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma derive_cap_idle[wp, Ipc_AI_2_assms]: +lemma derive_cap_idle[wp, Arch_assms]: "\\s. global_refs s \ cap_range cap = {}\ derive_cap slot cap \\c s. global_refs s \ cap_range c = {}\, -" @@ -149,7 +150,7 @@ lemma derive_cap_idle[wp, Ipc_AI_2_assms]: apply (case_tac arch_cap, simp_all) done -lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: +lemma arch_derive_cap_objrefs_iszombie [Arch_assms]: "\\s . P (set_option (aobj_ref cap)) False s\ arch_derive_cap cap \\rv s. rv \ NullCap \ P (obj_refs rv) (is_zombie rv) s\,-" @@ -157,7 +158,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: apply(rule hoare_pre, wpc?, wp+, simp)+ done -lemma obj_refs_remove_rights[simp, Ipc_AI_2_assms]: +lemma obj_refs_remove_rights[simp, Arch_assms]: "obj_refs (remove_rights rs cap) = obj_refs cap" by (auto simp add: remove_rights_def cap_rights_update_def acap_rights_update_def @@ -172,7 +173,7 @@ lemma storeWord_um_inv: apply simp done -lemma store_word_offs_vms[wp, Ipc_AI_2_assms]: +lemma store_word_offs_vms[wp, Arch_assms]: "\valid_machine_state\ store_word_offs ptr offs v \\_. valid_machine_state\" proof - have aligned_offset_ignore: @@ -211,12 +212,12 @@ proof - done qed -lemma is_zombie_update_cap_data[simp, Ipc_AI_2_assms]: +lemma is_zombie_update_cap_data[simp, Arch_assms]: "is_zombie (update_cap_data P data cap) = is_zombie cap" by (simp add: update_cap_data_closedform is_zombie_def arch_update_cap_data_def split: cap.splits) -lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: +lemma valid_msg_length_strengthen [Arch_assms]: "valid_message_info mi \ unat (mi_length mi) \ msg_max_length" apply (clarsimp simp: valid_message_info_def) apply (subgoal_tac "unat (mi_length mi) \ unat (of_nat msg_max_length :: word32)") @@ -224,7 +225,7 @@ lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: apply (clarsimp simp: un_ui_le word_le_def) done -lemma copy_mrs_in_user_frame[wp, Ipc_AI_2_assms]: +lemma copy_mrs_in_user_frame[wp, Arch_assms]: "\in_user_frame p\ copy_mrs t buf t' buf' n \\rv. in_user_frame p\" by (simp add: in_user_frame_def) (wp hoare_vcg_ex_lift) @@ -232,7 +233,7 @@ lemma as_user_getRestart_inv[wp]: "as_user t getRestartPC \P\" by (simp add: getRestartPC_def, rule user_getreg_inv) -lemma make_arch_fault_msg_inv[wp, Ipc_AI_2_assms]: +lemma make_arch_fault_msg_inv[wp, Arch_assms]: "make_arch_fault_msg ft t \P\" by (cases ft; wpsimp) @@ -240,14 +241,14 @@ lemma make_fault_msg_inv[wp]: "make_fault_msg ft t \P\" by (cases ft; wpsimp wp: as_user_inv getRestartPC_inv mapM_wp' split_del: if_split) -lemma do_fault_transfer_invs[wp, Ipc_AI_2_assms]: +lemma do_fault_transfer_invs[wp, Arch_assms]: "\invs and tcb_at receiver\ do_fault_transfer badge sender receiver recv_buf \\rv. invs\" by (simp add: do_fault_transfer_def split_def | wp | clarsimp split: option.split)+ -lemma lookup_ipc_buffer_in_user_frame[wp, Ipc_AI_2_assms]: +lemma lookup_ipc_buffer_in_user_frame[wp, Arch_assms]: "\valid_objs and tcb_at t\ lookup_ipc_buffer b t \case_option (\_. True) in_user_frame\" apply (simp add: lookup_ipc_buffer_def) @@ -350,9 +351,9 @@ lemma transfer_caps_non_null_cte_wp_at: done crunch do_fault_transfer - for cte_wp_at[wp,Ipc_AI_2_assms]: "cte_wp_at P p" + for cte_wp_at[wp,Arch_assms]: "cte_wp_at P p" -lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: +lemma do_normal_transfer_non_null_cte_wp_at [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at (P and ((\) cap.NullCap)) ptr\ do_normal_transfer st send_buffer ep b gr rt recv_buffer @@ -363,7 +364,7 @@ lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: | clarsimp simp:imp)+ done -lemma is_derived_ReplyCap [simp, Ipc_AI_2_assms]: +lemma is_derived_ReplyCap [simp, Arch_assms]: "\m p R. is_derived m p (cap.ReplyCap t False R) = (\c. is_master_reply_cap c \ obj_ref_of c = t)" apply (subst fun_eq_iff) apply clarsimp @@ -384,7 +385,7 @@ lemma do_normal_transfer_tcb_caps: | simp add:imp)+ done -lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: +lemma do_ipc_transfer_tcb_caps [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at P (t, ref) and tcb_at t\ @@ -406,7 +407,7 @@ lemma cap_insert_valid_vso_at[wp]: apply (clarsimp simp: valid_vso_at_def) by (wpsimp wp: sts_obj_at_impossible sts_typ_ats hoare_vcg_ex_lift) -lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: +lemma setup_caller_cap_valid_global_objs[wp, Arch_assms]: "\valid_global_objs\ setup_caller_cap send recv grant \\rv. valid_global_objs\" apply (wp valid_global_objs_lift valid_ao_at_lift) unfolding setup_caller_cap_def @@ -414,9 +415,9 @@ lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: done crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for inv[Ipc_AI_2_assms]: P + for inv[Arch_assms]: P -lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_vspace_objs[wp, Arch_assms]: "\valid_vspace_objs\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_vspace_objs\" @@ -437,11 +438,11 @@ lemma setup_caller_cap_aobj_at: unfolding setup_caller_cap_def by (wpsimp wp: cap_insert_aobj_at sts.aobj_at) -lemma setup_caller_cap_valid_arch[Ipc_AI_2_assms, wp]: +lemma setup_caller_cap_valid_arch[Arch_assms, wp]: "setup_caller_cap st rt grant \valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps[rotated -1] setup_caller_cap_tcb_at setup_caller_cap_aobj_at) -lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_arch[Arch_assms]: "\slots caps ep buffer n mi. \valid_arch_state and valid_objs and valid_mdb and K (distinct slots) and (\s. \x \ set slots. real_cte_at x s \ cte_wp_at (\cap. cap = cap.NullCap) x s) @@ -450,23 +451,24 @@ lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps transfer_caps_loop_typ_ats transfer_caps_loop_aobj_at) +lemmas Ipc_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_2_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.Ipc_AI_2_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_3 locale *) crunch do_ipc_transfer - for pspace_respects_device_region[wp, Ipc_AI_3_assms]: "pspace_respects_device_region" + for pspace_respects_device_region[wp, Arch_assms]: "pspace_respects_device_region" (wp: crunch_wps ignore: const_on_failure simp: crunch_simps) -lemma do_ipc_transfer_respects_device_region[Ipc_AI_3_assms]: +lemma do_ipc_transfer_respects_device_region[Arch_assms]: "\cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\ do_ipc_transfer t ep bg grt r \\rv. cap_refs_respects_device_region\" @@ -484,7 +486,7 @@ lemma set_mrs_state_hyp_refs_of[wp]: by (wp set_mrs_thread_set_dmo thread_set_hyp_refs_trivial | simp)+ crunch do_ipc_transfer - for state_hyp_refs_of[wp, Ipc_AI_3_assms]: "\ s. P (state_hyp_refs_of s)" + for state_hyp_refs_of[wp, Arch_assms]: "\ s. P (state_hyp_refs_of s)" (wp: crunch_wps simp: zipWithM_x_mapM) lemma arch_derive_cap_untyped: @@ -503,18 +505,19 @@ lemma valid_arch_mdb_cap_swap: ((caps_of_state s)(a \ c', b \ c))" by auto -lemma do_ipc_transfer_valid_arch[Ipc_AI_3_assms]: +lemma do_ipc_transfer_valid_arch[Arch_assms]: "\valid_arch_state and valid_objs and valid_mdb \ do_ipc_transfer s ep bg grt r \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps dit_tcb_at do_ipc_transfer_aobj_at) +lemmas Ipc_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales;(fact Ipc_AI_3_assms)?) + case 1 show ?case by (unfold_locales;(fact ARM.Ipc_AI_3_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchRetype_AI.thy b/proof/invariant-abstract/ARM/ArchRetype_AI.thy index f3d99d398c..746daef5b2 100644 --- a/proof/invariant-abstract/ARM/ArchRetype_AI.thy +++ b/proof/invariant-abstract/ARM/ArchRetype_AI.thy @@ -15,18 +15,18 @@ begin context Arch begin arch_global_naming -named_theorems Retype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_AI locale *) -lemma arch_kobj_size_cong[Retype_AI_assms]: +lemma arch_kobj_size_cong[Arch_assms]: "\a = a1; c=c1\ \ arch_kobj_size (default_arch_object a b c) = arch_kobj_size (default_arch_object a1 b1 c1)" by (simp add: default_arch_object_def split: aobject_type.splits) -lemma clearMemoryVM_return[simp, Retype_AI_assms]: +lemma clearMemoryVM_return[simp, Arch_assms]: "clearMemoryVM a b = return ()" by (simp add: clearMemoryVM_def) -lemma slot_bits_def2 [Retype_AI_assms]: "slot_bits = cte_level_bits" +lemma slot_bits_def2 [Arch_assms]: "slot_bits = cte_level_bits" by (simp add: slot_bits_def cte_level_bits_def) definition @@ -34,7 +34,7 @@ definition ArchObject SmallPageObj, ArchObject LargePageObj, ArchObject SectionObj, ArchObject SuperSectionObj}" -lemma no_gs_types_simps [simp, Retype_AI_assms]: +lemma no_gs_types_simps [simp, Arch_assms]: "Untyped \ no_gs_types" "TCBObject \ no_gs_types" "EndpointObject \ no_gs_types" @@ -44,7 +44,7 @@ lemma no_gs_types_simps [simp, Retype_AI_assms]: "ArchObject ASIDPoolObj \ no_gs_types" by (simp_all add: no_gs_types_def) -lemma retype_region_ret_folded [Retype_AI_assms]: +lemma retype_region_ret_folded [Arch_assms]: "\\\ retype_region y n bits ty dev \\r s. r = retype_addrs y ty n bits\" unfolding retype_region_def @@ -538,7 +538,7 @@ lemma mapM_copy_global_invs_mappings_restricted: done -lemma dmo_eq_kernel_restricted [wp, Retype_AI_assms]: +lemma dmo_eq_kernel_restricted [wp, Arch_assms]: "\\s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\ do_machine_op m \\rv s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\" @@ -601,7 +601,7 @@ lemma init_arch_objects_invs_from_restricted: done -lemma obj_bits_api_neq_0 [Retype_AI_assms]: +lemma obj_bits_api_neq_0 [Arch_assms]: "ty \ Untyped \ 0 < obj_bits_api ty us" unfolding obj_bits_api_def by (clarsimp simp: slot_bits_def default_arch_object_def pageBits_def @@ -635,20 +635,20 @@ lemma vs_lookup_pages_sub2: apply (rule table) done +lemmas Retype_AI_slot_bits_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_slot_bits?: Retype_AI_slot_bits proof goal_cases - interpret Arch . - case 1 show ?case - by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact ARM.Retype_AI_slot_bits_assms) qed context Arch begin arch_global_naming -lemma valid_untyped_helper [Retype_AI_assms]: +lemma valid_untyped_helper [Arch_assms]: assumes valid_c : "s \ c" and cte_at : "cte_wp_at ((=) c) q s" and tyunt: "ty \ Untyped" @@ -722,13 +722,14 @@ lemma valid_default_arch_tcb: "\s. valid_arch_tcb default_arch_tcb s" by (simp add: default_arch_tcb_def valid_arch_tcb_def) +lemmas Retype_AI_valid_untyped_helper_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_valid_untyped_helper?: Retype_AI_valid_untyped_helper proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact ARM.Retype_AI_valid_untyped_helper_assms) qed @@ -737,11 +738,7 @@ locale retype_region_proofs_arch + Arch for s :: "'state_ext :: state_ext state" and ty us ptr sz n ps s' dev - - -context retype_region_proofs begin - -interpretation Arch . +begin lemma valid_cap: assumes cap: @@ -834,11 +831,6 @@ lemma hyp_refs_eq: default_arch_tcb_def) done -end - - -context retype_region_proofs_arch begin - lemma valid_vspace_obj_pres: "valid_vspace_obj ao s \ valid_vspace_obj ao s'" apply (cases ao; simp add: valid_vspace_obj_def obj_at_pres) @@ -1227,9 +1219,7 @@ end context Arch begin arch_global_naming -named_theorems Retype_AI_assms' - -lemma invs_post_retype_invs [Retype_AI_assms']: +lemma invs_post_retype_invs [Arch_assms]: "invs s \ post_retype_invs ty refs s" apply (clarsimp simp: post_retype_invs_def invs_def valid_state_def) apply (clarsimp simp: equal_kernel_mappings_def obj_at_def @@ -1239,9 +1229,11 @@ lemma invs_post_retype_invs [Retype_AI_assms']: lemmas equal_kernel_mappings_trans_state = more_update.equal_kernel_mappings_update -lemmas retype_region_proofs_assms [Retype_AI_assms'] +lemmas retype_region_proofs_assms [Arch_assms] = retype_region_proofs.post_retype_invs_axioms +lemmas Retype_AI_assms' = Arch_assms (* extract accumulated assumptions *) + end @@ -1251,10 +1243,9 @@ global_interpretation Retype_AI?: Retype_AI and post_retype_invs = post_retype_invs and region_in_kernel_window = region_in_kernel_window proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Retype_AI_assms)?) - (simp add: Retype_AI_axioms_def Retype_AI_assms') + by (intro_locales; (unfold_locales; fact ARM.Retype_AI_assms')?) + (simp add: Retype_AI_axioms_def ARM.Retype_AI_assms') qed diff --git a/proof/invariant-abstract/ARM/ArchSchedule_AI.thy b/proof/invariant-abstract/ARM/ArchSchedule_AI.thy index 1f9fdaa0a0..af086aba15 100644 --- a/proof/invariant-abstract/ARM/ArchSchedule_AI.thy +++ b/proof/invariant-abstract/ARM/ArchSchedule_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_AI locale *) -lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]: +lemma dmo_mapM_storeWord_0_invs[wp,Arch_assms]: "valid invs (do_machine_op (mapM (\p. storeWord p 0) S)) (\_. invs)" apply (simp add: dom_mapM ef_storeWord) apply (rule mapM_UNIV_wp) @@ -38,23 +38,23 @@ lemma clearExMonitor_invs [wp]: machine_rest_lift_def in_monad select_f_def) done -lemma arch_stt_invs [wp,Schedule_AI_assms]: +lemma arch_stt_invs [wp,Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_switch_to_thread t \\_. invs\" apply (simp add: arch_switch_to_thread_def) apply wpsimp done -lemma arch_stt_tcb [wp,Schedule_AI_assms]: +lemma arch_stt_tcb [wp,Arch_assms]: "\tcb_at t'\ arch_switch_to_thread t' \\_. tcb_at t'\" apply (simp add: arch_switch_to_thread_def) apply (wp) done -lemma arch_stt_st_tcb_at[Schedule_AI_assms]: +lemma arch_stt_st_tcb_at[Arch_assms]: "arch_switch_to_thread t \st_tcb_at Q t\" by (wpsimp simp: arch_switch_to_thread_def) -lemma arch_stit_invs[wp, Schedule_AI_assms]: +lemma arch_stit_invs[wp, Arch_assms]: "\invs\ arch_switch_to_idle_thread \\r. invs\" by (wpsimp wp: svr_invs simp: arch_switch_to_idle_thread_def) @@ -75,19 +75,19 @@ crunch set_vm_root and scheduler_action[wp]: "\s. P (scheduler_action s)" (wp: crunch_wps simp: crunch_simps) -lemma arch_stit_activatable[wp, Schedule_AI_assms]: +lemma arch_stit_activatable[wp, Arch_assms]: "\ct_in_state activatable\ arch_switch_to_idle_thread \\rv . ct_in_state activatable\" apply (clarsimp simp: arch_switch_to_idle_thread_def) apply (wpsimp simp: ct_in_state_def wp: ct_in_state_thread_state_lift) done -lemma stit_invs [wp,Schedule_AI_assms]: +lemma stit_invs [wp,Arch_assms]: "switch_to_idle_thread \invs\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wpsimp|strengthen idle_strg)+ done -lemma stit_activatable[Schedule_AI_assms]: +lemma stit_activatable[Arch_assms]: "\invs\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wp | simp add: ct_in_state_def)+ @@ -95,29 +95,30 @@ lemma stit_activatable[Schedule_AI_assms]: elim!: pred_tcb_weaken_strongerE) done -lemma arch_stt_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stt_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_thread t' \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_thread_def) crunch arch_prepare_next_domain - for ct[wp, Schedule_AI_assms]: "\s. P (cur_thread s)" - and activatable[wp, Schedule_AI_assms]: "ct_in_state activatable" - and st_tcb_at[wp, Schedule_AI_assms]: "\s. P (st_tcb_at Q t s)" - and valid_idle[wp, Schedule_AI_assms]: valid_idle - and invs[wp, Schedule_AI_assms]: invs + for ct[wp, Arch_assms]: "\s. P (cur_thread s)" + and activatable[wp, Arch_assms]: "ct_in_state activatable" + and st_tcb_at[wp, Arch_assms]: "\s. P (st_tcb_at Q t s)" + and valid_idle[wp, Arch_assms]: valid_idle + and invs[wp, Arch_assms]: invs (wp: crunch_wps ct_in_state_thread_state_lift) -lemma arch_stit_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stit_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_idle_thread \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_idle_thread_def) +lemmas Schedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Schedule_AI?: Schedule_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; unfold_locales; (fact Schedule_AI_assms)?) + by (intro_locales; unfold_locales; (fact ARM.Schedule_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchSyscall_AI.thy b/proof/invariant-abstract/ARM/ArchSyscall_AI.thy index 6c2e5f43c6..747c57bb63 100644 --- a/proof/invariant-abstract/ARM/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/ARM/ArchSyscall_AI.thy @@ -15,44 +15,44 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_AI locale *) -declare arch_get_sanitise_register_info_invs[Syscall_AI_assms] - arch_get_sanitise_register_info_ex_nonz_cap_to[Syscall_AI_assms] - make_fault_msg_inv[Syscall_AI_assms] +declare arch_get_sanitise_register_info_invs[Arch_assms] + arch_get_sanitise_register_info_ex_nonz_cap_to[Arch_assms] + make_fault_msg_inv[Arch_assms] crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for pred_tcb_at[wp,Syscall_AI_assms]: "pred_tcb_at proj P t" + for pred_tcb_at[wp,Arch_assms]: "pred_tcb_at proj P t" crunch handle_arch_fault_reply - for invs[wp,Syscall_AI_assms]: "invs" + for invs[wp,Arch_assms]: "invs" crunch handle_arch_fault_reply - for cap_to[wp,Syscall_AI_assms]: "ex_nonz_cap_to c" + for cap_to[wp,Arch_assms]: "ex_nonz_cap_to c" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for it[wp,Syscall_AI_assms]: "\s. P (idle_thread s)" + for it[wp,Arch_assms]: "\s. P (idle_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for caps[wp,Syscall_AI_assms]: "\s. P (caps_of_state s)" + for caps[wp,Arch_assms]: "\s. P (caps_of_state s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cur_thread[wp,Syscall_AI_assms]: "\s. P (cur_thread s)" + for cur_thread[wp,Arch_assms]: "\s. P (cur_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for valid_objs[wp,Syscall_AI_assms]: "valid_objs" + for valid_objs[wp,Arch_assms]: "valid_objs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cte_wp_at[wp,Syscall_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" crunch invoke_irq_control - for typ_at[wp, Syscall_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" -lemma obj_refs_cap_rights_update[simp, Syscall_AI_assms]: +lemma obj_refs_cap_rights_update[simp, Arch_assms]: "obj_refs (cap_rights_update rs cap) = obj_refs cap" by (auto simp: cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split bool.splits) (* FIXME: move to TCB *) -lemma table_cap_ref_mask_cap [Syscall_AI_assms]: +lemma table_cap_ref_mask_cap [Arch_assms]: "table_cap_ref (mask_cap R cap) = table_cap_ref cap" 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 eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: +lemma eq_no_cap_to_obj_with_diff_ref [Arch_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) @@ -72,30 +72,30 @@ lemma getIFSR_invs[wp]: "valid invs (do_machine_op getIFSR) (\_. invs)" by (simp add: getIFSR_def do_machine_op_def split_def select_f_returns | wp)+ -lemma hv_invs[wp, Syscall_AI_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" +lemma hv_invs[wp, Arch_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" apply (cases flt, simp_all) apply (wp|simp)+ done -lemma handle_vm_fault_valid_fault[wp, Syscall_AI_assms]: +lemma handle_vm_fault_valid_fault[wp, Arch_assms]: "\\\ handle_vm_fault thread ft -,\\rv s. valid_fault rv\" apply (cases ft, simp_all) apply (wp no_irq_getDFSR no_irq_getIFSR| simp add: valid_fault_def)+ done -lemma hvmf_active [Syscall_AI_assms]: +lemma hvmf_active [Arch_assms]: "\st_tcb_at active t\ handle_vm_fault t w \\rv. st_tcb_at active t\" apply (cases w, simp_all) apply (wp | simp)+ done -lemma hvmf_ex_cap[wp, Syscall_AI_assms]: +lemma hvmf_ex_cap[wp, Arch_assms]: "\ex_nonz_cap_to p\ handle_vm_fault t b \\rv. ex_nonz_cap_to p\" apply (cases b, simp_all) apply (wp | simp)+ done -lemma hh_invs[wp, Syscall_AI_assms]: +lemma hh_invs[wp, Arch_assms]: "\invs and ct_active and st_tcb_at active thread and ex_nonz_cap_to thread\ handle_hypervisor_fault thread fault \\rv. invs\" @@ -105,12 +105,13 @@ lemma hv_inv_ex: "\P\ handle_vm_fault t vp \\_ _. True\, \\_. P\" by (cases vp; wpsimp wp: dmo_inv getDFSR_inv getFAR_inv getIFSR_inv getRestartPC_inv) +lemmas Syscall_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Syscall_AI?: Syscall_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Syscall_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.Syscall_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchTcbAcc_AI.thy b/proof/invariant-abstract/ARM/ArchTcbAcc_AI.thy index 1b82aa8d28..b482012586 100644 --- a/proof/invariant-abstract/ARM/ArchTcbAcc_AI.thy +++ b/proof/invariant-abstract/ARM/ArchTcbAcc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_AI locale *) lemmas cap_master_cap_simps = cap_master_cap_def[simplified cap_master_arch_cap_def, split_simps cap.split arch_cap.split] @@ -54,7 +54,7 @@ lemma cap_master_cap_tcb_cap_valid_arch: split: option.splits cap.splits arch_cap.splits Structures_A.thread_state.splits) -lemma storeWord_invs[wp, TcbAcc_AI_assms]: +lemma storeWord_invs[wp, Arch_assms]: "\in_user_frame p and invs\ do_machine_op (storeWord p w) \\rv. invs\" proof - have aligned_offset_ignore: @@ -81,12 +81,12 @@ proof - done qed -lemma valid_ipc_buffer_cap_0[simp, TcbAcc_AI_assms]: +lemma valid_ipc_buffer_cap_0[simp, Arch_assms]: "valid_ipc_buffer_cap cap a \ valid_ipc_buffer_cap cap 0" by (auto simp add: valid_ipc_buffer_cap_def case_bool_If split: cap.split arch_cap.split) -lemma thread_set_hyp_refs_trivial [TcbAcc_AI_assms]: +lemma thread_set_hyp_refs_trivial [Arch_assms]: assumes x: "\tcb. tcb_state (f tcb) = tcb_state tcb" assumes y: "\tcb. tcb_arch_ref (f tcb) = tcb_arch_ref tcb" shows "\\s. P (state_hyp_refs_of s)\ thread_set f t \\rv s. P (state_hyp_refs_of s)\" @@ -108,7 +108,7 @@ lemma mab_wb [simp]: unfolding msg_align_bits word_bits_conv by simp -lemma get_cap_valid_ipc [TcbAcc_AI_assms]: +lemma get_cap_valid_ipc [Arch_assms]: "\valid_objs and obj_at (\ko. \tcb. ko = TCB tcb \ tcb_ipc_buffer tcb = v) t\ get_cap (t, tcb_cnode_index 4) \\rv s. valid_ipc_buffer_cap rv v\" @@ -123,7 +123,7 @@ lemma get_cap_valid_ipc [TcbAcc_AI_assms]: -lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: +lemma pred_tcb_cap_wp_at [Arch_assms]: "\pred_tcb_at proj P t s; valid_objs s; ref \ dom tcb_cap_cases; \cap. (pred_tcb_at proj P t s \ tcb_cap_valid cap (t, ref) s) \ Q cap\ \ @@ -137,7 +137,7 @@ lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: apply fastforce+ done -lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: +lemma as_user_hyp_refs_of[wp, Arch_assms]: "\\s. P (state_hyp_refs_of s)\ as_user t m \\rv s. P (state_hyp_refs_of s)\" @@ -147,11 +147,11 @@ lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: lemmas sts_typ_ats = sts_typ_ats abs_atyp_at_lifts [OF set_thread_state_typ_at] -lemma arch_tcb_context_set_eq_ARM[TcbAcc_AI_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" +lemma arch_tcb_context_set_eq_ARM[Arch_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp -lemma arch_tcb_context_get_eq_ARM[TcbAcc_AI_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" +lemma arch_tcb_context_get_eq_ARM[Arch_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp @@ -159,17 +159,18 @@ lemma tcb_context_update_aux: "arch_tcb_context_set (P (arch_tcb_context_get atc = tcb_context_update (\ctx. P ctx) atcb" by (simp add: arch_tcb_context_set_def arch_tcb_context_get_def) -lemma thread_set_valid_arch_state[TcbAcc_AI_assms]: +lemma thread_set_valid_arch_state[Arch_assms]: "(\tcb. \(getF, v) \ ran tcb_cap_cases. getF (f tcb) = getF tcb) \ thread_set f t \ valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps thread_set_tcb thread_set.aobj_at) +lemmas TcbAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation TcbAcc_AI?: TcbAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact TcbAcc_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM.TcbAcc_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM/ArchTcb_AI.thy b/proof/invariant-abstract/ARM/ArchTcb_AI.thy index 80a13e218a..8a495f1333 100644 --- a/proof/invariant-abstract/ARM/ArchTcb_AI.thy +++ b/proof/invariant-abstract/ARM/ArchTcb_AI.thy @@ -10,17 +10,17 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_AI locale *) -lemma activate_idle_invs[Tcb_AI_assms]: +lemma activate_idle_invs[Arch_assms]: "\invs and ct_idle\ arch_activate_idle_thread thread \\rv. invs and ct_idle\" by (simp add: arch_activate_idle_thread_def) -lemma empty_fail_getRegister [intro!, simp, Tcb_AI_assms]: +lemma empty_fail_getRegister [intro!, simp, Arch_assms]: "empty_fail (getRegister r)" by (simp add: getRegister_def) @@ -37,7 +37,7 @@ lemma same_object_also_valid: (* arch specific *) split: cap.split_asm arch_cap.split_asm option.splits)+) done -lemma same_object_obj_refs[Tcb_AI_assms]: +lemma same_object_obj_refs[Arch_assms]: "\ same_object_as cap cap' \ \ obj_refs cap = obj_refs cap'" apply (cases cap, simp_all add: same_object_as_def) @@ -45,7 +45,7 @@ lemma same_object_obj_refs[Tcb_AI_assms]: split: cap.split_asm )+) by (cases "the_arch_cap cap"; cases "the_arch_cap cap'"; simp) -lemma arch_cap_badge_none_master[Tcb_AI_assms, simp]: +lemma arch_cap_badge_none_master[Arch_assms, simp]: "(arch_cap_badge (cap_master_arch_cap acap) = None) = (arch_cap_badge acap = None)" by simp @@ -137,13 +137,13 @@ lemma checked_insert_tcb_invs[wp]: (* arch specific *) done crunch arch_get_sanitise_register_info, arch_post_modify_registers - for tcb_at[wp, Tcb_AI_assms]: "tcb_at a" + for tcb_at[wp, Arch_assms]: "tcb_at a" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for invs[wp, Tcb_AI_assms]: "invs" + for invs[wp, Arch_assms]: "invs" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ex_nonz_cap_to[wp, Tcb_AI_assms]: "ex_nonz_cap_to a" + for ex_nonz_cap_to[wp, Arch_assms]: "ex_nonz_cap_to a" -lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: +lemma finalise_cap_not_cte_wp_at[Arch_assms]: assumes x: "P cap.NullCap" shows "\\s. \cp \ ran (caps_of_state s). P cp\ finalise_cap cap fin @@ -160,16 +160,16 @@ lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: done -lemma table_cap_ref_max_free_index_upd[simp,Tcb_AI_assms]: +lemma table_cap_ref_max_free_index_upd[simp,Arch_assms]: "table_cap_ref (max_free_index_update cap) = table_cap_ref cap" by (simp add: free_index_update_def table_cap_ref_def split: cap.splits) crunch arch_post_set_flags, arch_prepare_set_domain - for typ_at[wp, Tcb_AI_assms]: "\s. P (typ_at T p s)" - and invs[wp, Tcb_AI_assms]: "invs" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and invs[wp, Arch_assms]: "invs" (* Interface asks for a weaker lemma due to other arches needing an extra precondition *) -lemma arch_post_set_flags_invs'[Tcb_AI_assms]: +lemma arch_post_set_flags_invs'[Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_post_set_flags t flags \\_. invs\" by wpsimp @@ -180,12 +180,10 @@ crunch arch_prepare_set_domain and pspace_distinct[wp]: pspace_distinct (wp: crunch_wps) - interpretation Tcb_AI_1? : Tcb_AI_1 where state_ext_t = state_ext_t and is_cnode_or_valid_arch = is_cnode_or_valid_arch - by (unfold_locales; fact Tcb_AI_assms) - + by (unfold_locales; fact Arch_assms) lemma use_no_cap_to_obj_asid_strg: (* arch specific *) "(cte_at p s \ no_cap_to_obj_dr_emp cap s \ valid_cap cap s \ invs s) @@ -201,7 +199,7 @@ lemma use_no_cap_to_obj_asid_strg: (* arch specific *) apply (fastforce simp: table_cap_ref_def valid_cap_simps elim!: asid_low_high_bits)+ done -lemma cap_delete_no_cap_to_obj_asid[wp, Tcb_AI_assms]: +lemma cap_delete_no_cap_to_obj_asid[wp, Arch_assms]: "\no_cap_to_obj_dr_emp cap\ cap_delete slot \\rv. no_cap_to_obj_dr_emp cap\" @@ -230,7 +228,7 @@ lemma as_user_ipc_tcb_cap_valid4[wp]: apply (clarsimp simp: get_tcb_def) done -lemma tc_invs[Tcb_AI_assms]: +lemma tc_invs[Arch_assms]: "\invs and tcb_at a and (case_option \ (valid_cap o fst) e) and (case_option \ (valid_cap o fst) f) @@ -309,7 +307,7 @@ lemma check_valid_ipc_buffer_inv: apply (wp | simp add: whenE_def if_apply_def2 | wpcw)+ done -lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: +lemma check_valid_ipc_buffer_wp[Arch_assms]: "\\(s::'state_ext::state_ext state). is_arch_cap cap \ is_cnode_or_valid_arch cap \ valid_ipc_buffer_cap cap vptr \ is_aligned vptr msg_align_bits @@ -325,7 +323,7 @@ lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: valid_ipc_buffer_cap_def) done -lemma derive_no_cap_asid[wp,Tcb_AI_assms]: +lemma derive_no_cap_asid[wp,Arch_assms]: "\(no_cap_to_obj_with_diff_ref cap S)::'state_ext::state_ext state\bool\ derive_cap slot cap \\rv. no_cap_to_obj_with_diff_ref rv S\,-" @@ -339,7 +337,7 @@ lemma derive_no_cap_asid[wp,Tcb_AI_assms]: done -lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: +lemma decode_set_ipc_inv[wp,Arch_assms]: "\P::'state_ext::state_ext state \ bool\ decode_set_ipc_buffer args cap slot excaps \\rv. P\" apply (simp add: decode_set_ipc_buffer_def whenE_def split_def @@ -348,7 +346,7 @@ lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: apply simp done -lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_update_cap_data[Arch_assms]: "no_cap_to_obj_with_diff_ref c S s \ no_cap_to_obj_with_diff_ref (update_cap_data P x c) S s" apply (case_tac "update_cap_data P x c = NullCap") @@ -365,7 +363,7 @@ lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: done -lemma update_cap_valid[Tcb_AI_assms]: +lemma update_cap_valid[Arch_assms]: "valid_cap cap (s::'state_ext::state_ext state) \ valid_cap (case capdata of None \ cap_rights_update rs cap @@ -394,14 +392,15 @@ crunch invoke_tcb wp: hoare_drop_imps mapM_x_wp' check_cap_inv simp: crunch_simps) +lemmas Tcb_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI?: Tcb_AI where is_cnode_or_valid_arch = ARM.is_cnode_or_valid_arch proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; fact Tcb_AI_assms) + by (unfold_locales; fact ARM.Tcb_AI_assms) qed end diff --git a/proof/invariant-abstract/ARM/ArchUntyped_AI.thy b/proof/invariant-abstract/ARM/ArchUntyped_AI.thy index 3b4592c557..55a2195620 100644 --- a/proof/invariant-abstract/ARM/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/ARM/ArchUntyped_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_AI locale *) -lemma of_bl_nat_to_cref[Untyped_AI_assms]: +lemma of_bl_nat_to_cref[Arch_assms]: "\ x < 2 ^ bits; bits < word_bits \ \ (of_bl (nat_to_cref bits x) :: machine_word) = of_nat x" apply (clarsimp intro!: less_mask_eq @@ -21,7 +21,7 @@ lemma of_bl_nat_to_cref[Untyped_AI_assms]: by (metis add_lessD1 le_unat_uoi nat_le_iff_add nat_le_linear) -lemma cnode_cap_ex_cte[Untyped_AI_assms]: +lemma cnode_cap_ex_cte[Arch_assms]: "\ is_cnode_cap cap; cte_wp_at (\c. \m. cap = mask_cap m c) p s; (s::'state_ext::state_ext state) \ cap; valid_objs s; pspace_aligned s \ \ ex_cte_cap_wp_to is_cnode_cap (obj_ref_of cap, nat_to_cref (bits_of cap) x) s" @@ -36,7 +36,7 @@ lemma cnode_cap_ex_cte[Untyped_AI_assms]: -lemma inj_on_nat_to_cref[Untyped_AI_assms]: +lemma inj_on_nat_to_cref[Arch_assms]: "bits < 32 \ inj_on (nat_to_cref bits) {..< 2 ^ bits}" apply (rule inj_onI) apply (drule arg_cong[where f="\x. replicate (32 - bits) False @ x"]) @@ -54,7 +54,7 @@ lemma inj_on_nat_to_cref[Untyped_AI_assms]: done -lemma data_to_obj_type_sp[Untyped_AI_assms]: +lemma data_to_obj_type_sp[Arch_assms]: "\P\ data_to_obj_type x \\ts (s::'state_ext::state_ext state). ts \ ArchObject ASIDPoolObj \ P s\, -" unfolding data_to_obj_type_def apply (rule hoare_pre) @@ -63,7 +63,7 @@ lemma data_to_obj_type_sp[Untyped_AI_assms]: apply (simp add: arch_data_to_obj_type_def split: if_split_asm) done -lemma dui_inv_wf[wp, Untyped_AI_assms]: +lemma dui_inv_wf[wp, Arch_assms]: "\invs and cte_wp_at ((=) (cap.UntypedCap dev w sz idx)) slot and (\s. \cap \ set cs. is_cnode_cap cap \ (\r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -150,7 +150,7 @@ qed lemma asid_bits_ge_0: "(0::word32) < 2 ^ asid_bits" by (simp add: asid_bits_def) -lemma retype_ret_valid_caps_captable[Untyped_AI_assms]: +lemma retype_ret_valid_caps_captable[Arch_assms]: "\pspace_no_overlap_range_cover ptr sz (s::'state_ext::state_ext state) \ 0 < us \ range_cover ptr sz (obj_bits_api CapTableObject us) n \ ptr \ 0 \ @@ -163,7 +163,7 @@ by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def | rule is_aligned_add_multI[OF _ le_refl], (simp add:range_cover_def word_bits_def obj_bits_api_def slot_bits_def)+)+)[1] -lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]: +lemma retype_ret_valid_caps_aobj[Arch_assms]: "\ptr sz (s::'state_ext::state_ext state) x6 us n. \pspace_no_overlap_range_cover ptr sz s \ x6 \ ASIDPoolObj \ range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \ ptr \ 0\ @@ -207,7 +207,7 @@ lemma cap_refs_in_kernel_windowD2: apply fastforce done -lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: +lemma init_arch_objects_descendants_range[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). descendants_range x cref s \ init_arch_objects ty dev ptr n us y \\rv s. descendants_range x cref s\" @@ -217,7 +217,7 @@ lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: apply simp done -lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: +lemma init_arch_objects_caps_overlap_reserved[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). caps_overlap_reserved S s\ init_arch_objects ty dev ptr n us y \\rv s. caps_overlap_reserved S s\" @@ -225,7 +225,7 @@ lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: apply (wp retype_region_mdb init_arch_objects_hoare_lift) done -lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: +lemma set_untyped_cap_invs_simple[Arch_assms]: "\\s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \ pspace_no_overlap_range_cover ptr sz s \ invs s \ cte_wp_at (\c. is_untyped_cap c \ cap_bits c = sz \ obj_ref_of c = ptr \ cap_is_device c = dev) cref s \ idx \ 2^ sz\ set_cap (cap.UntypedCap dev ptr sz idx) cref @@ -271,7 +271,7 @@ lemma pbfs_atleast_pageBits': lemma pbfs_less_wb': "pageBitsForSize sz < word_bits"by (cases sz, simp_all add: word_bits_conv pageBits_def) -lemma delete_objects_rewrite[Untyped_AI_assms]: +lemma delete_objects_rewrite[Arch_assms]: "\ word_size_bits \ sz; sz\ word_bits; ptr && ~~ mask sz = ptr \ \ delete_objects ptr sz = do y \ modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz}); @@ -303,7 +303,7 @@ lemma reachable_pg_cap_exst_update[simp]: by (simp add: reachable_pg_cap_def vs_lookup_pages_def vs_lookup_pages1_def obj_at_def) -lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_caps[wp, Arch_assms]: "\valid_arch_caps and valid_cap (default_cap tp oref sz dev) and (\(s::'state_ext::state_ext state). \r\obj_refs (default_cap tp oref sz dev). @@ -336,7 +336,7 @@ lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: apply (auto simp: is_cap_simps)[1] done -lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: +lemma create_cap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range (default_cap tp oref sz dev) \ cap_range c) p\ create_cap tp sz p dev (cref, oref) \\rv. cap_refs_in_kernel_window\" apply (simp add: create_cap_def) @@ -502,7 +502,7 @@ lemma mapM_copy_global_mappings_nonempty_table[wp]: apply simp_all done -lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: +lemma init_arch_objects_nonempty_table[Arch_assms, wp]: "\(\s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \ valid_global_objs s \ valid_arch_state s \ pspace_aligned s) and K (\ref\set refs. is_aligned ref (obj_bits_api tp us))\ @@ -514,13 +514,13 @@ lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: apply (clarsimp simp: obj_bits_api_def default_arch_object_def pd_bits_def pageBits_def) done -lemma nonempty_table_caps_of[Untyped_AI_assms]: +lemma nonempty_table_caps_of[Arch_assms]: "nonempty_table S ko \ caps_of ko = {}" by (auto simp: caps_of_def cap_of_def nonempty_table_def a_type_def split: Structures_A.kernel_object.split if_split_asm) -lemma nonempty_default[simp, Untyped_AI_assms]: +lemma nonempty_default[simp, Arch_assms]: "tp \ Untyped \ \ nonempty_table S (default_object tp dev us d)" apply (case_tac tp, simp_all add: default_object_def nonempty_table_def a_type_def) apply (rename_tac aobject_type) @@ -545,7 +545,7 @@ crunch init_arch_objects lemmas init_arch_objects_ex_cte_cap_wp_to = init_arch_objects_excap -lemma obj_is_device_vui_eq[Untyped_AI_assms]: +lemma obj_is_device_vui_eq[Arch_assms]: "valid_untyped_inv ui s \ case ui of Retype slot reset ptr_base ptr tp us slots dev \ obj_is_device tp dev = dev" @@ -557,26 +557,27 @@ lemma obj_is_device_vui_eq[Untyped_AI_assms]: apply (auto simp: arch_is_frame_type_def) done -lemma create_cap_valid_arch_state[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (\_. True) cref\ create_cap tp sz p dev (cref,oref) \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps create_cap_tcb create_cap_aobj_at) -lemma set_cap_non_arch_valid_arch_state[Untyped_AI_assms]: +lemma set_cap_non_arch_valid_arch_state[Arch_assms]: "\\s. valid_arch_state s \ cte_wp_at (\_. \is_arch_cap cap) ptr s\ set_cap cap ptr \\rv. valid_arch_state \" by wpsimp +lemmas Untyped_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Untyped_AI? : Untyped_AI where nonempty_table = ARM.nonempty_table proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; (fact Untyped_AI_assms)?) + by (unfold_locales; (fact ARM.Untyped_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchAInvsPre.thy b/proof/invariant-abstract/ARM_HYP/ArchAInvsPre.thy index 6a2d67a303..bb4ae03aba 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchAInvsPre.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchAInvsPre.thy @@ -95,13 +95,13 @@ lemma device_frame_in_device_region: by (auto simp add: pspace_respects_device_region_def dom_def device_mem_def) -named_theorems AInvsPre_assms +clear_named_theorems Arch_assms (* accumulate assumptions for AInvsPre locale *) lemma get_page_info_0[simp]: "get_page_info (\obj. get_arch_obj (kheap s obj)) 0 x = None" by (simp add: get_page_info_def) -lemma (* ptable_rights_imp_frame *)[AInvsPre_assms]: +lemma (* ptable_rights_imp_frame *)[Arch_assms]: assumes "valid_state s" shows "ptable_rights t s x \ {} \ ptable_lift t s x = Some (addrFromPPtr y) \ @@ -130,12 +130,14 @@ lemma (* ptable_rights_imp_frame *)[AInvsPre_assms]: apply (case_tac sz, simp_all add: word_bits_conv)[1] apply (clarsimp simp: field_simps simp: data_at_def) done + +lemmas AInvsPre_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation AInvsPre?: AInvsPre proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, fact AInvsPre_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, fact ARM_HYP.AInvsPre_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchBCorres2_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchBCorres2_AI.thy index 354c20580e..4e0aeae0f8 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchBCorres2_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchBCorres2_AI.thy @@ -11,10 +11,10 @@ begin context Arch begin arch_global_naming -named_theorems BCorres2_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for BCorres2_AI locale *) crunch invoke_cnode - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state (simp: swp_def ignore: clearMemory without_preemption filterM) crunch create_cap,init_arch_objects,retype_region,delete_objects @@ -31,7 +31,7 @@ crunch invoke_untyped crunch set_mcpriority, set_priority, arch_get_sanitise_register_info, arch_post_modify_registers, set_flags, arch_post_set_flags - for (bcorres) bcorres[BCorres2_AI_assms,wp]: truncate_state + for (bcorres) bcorres[Arch_assms,wp]: truncate_state lemma invoke_tcb_bcorres[wp]: fixes a @@ -53,20 +53,21 @@ lemma invoke_irq_control_bcorres[wp]: "bcorres (invoke_irq_control a) (invoke_ir lemma invoke_irq_handler_bcorres[wp]: "bcorres (invoke_irq_handler a) (invoke_irq_handler a)" by (cases a; (wpsimp | rule conjI)+) -lemma make_arch_fault_msg_bcorres[wp,BCorres2_AI_assms]: +lemma make_arch_fault_msg_bcorres[wp,Arch_assms]: "bcorres (make_arch_fault_msg a b) (make_arch_fault_msg a b)" by (cases a; wpsimp) -lemma handle_arch_fault_reply_bcorres[wp,BCorres2_AI_assms]: +lemma handle_arch_fault_reply_bcorres[wp,Arch_assms]: "bcorres ( handle_arch_fault_reply a b c d) (handle_arch_fault_reply a b c d)" by (cases a; wpsimp simp: handle_arch_fault_reply_def) +lemmas BCorres2_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation BCorres2_AI?: BCorres2_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact BCorres2_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.BCorres2_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/ARM_HYP/ArchCNodeInv_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchCNodeInv_AI.thy index d1c0a99fc3..a6d6446f76 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchCNodeInv_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchCNodeInv_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_AI locale *) lemma set_cap_in_device_frame[wp]: "\in_device_frame buffer\ set_cap cap ref \\_. in_device_frame buffer\" @@ -31,7 +31,7 @@ lemma valid_cnode_capI: done (* unused *) -lemma derive_cap_objrefs [CNodeInv_AI_assms]: +lemma derive_cap_objrefs [Arch_assms]: "\\s. P (obj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (obj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wpsimp wp: ensure_no_children_inv simp: o_def)+)[11] @@ -41,7 +41,7 @@ lemma derive_cap_objrefs [CNodeInv_AI_assms]: done -lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: +lemma derive_cap_zobjrefs [Arch_assms]: "\\s. P (zobj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (zobj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wpsimp wp: ensure_no_children_inv simp: o_def)+)[11] @@ -50,7 +50,7 @@ lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: apply (wpsimp simp: o_def)+ done -lemma update_cap_objrefs [CNodeInv_AI_assms]: +lemma update_cap_objrefs [Arch_assms]: "\ update_cap_data P dt cap \ NullCap \ \ obj_refs (update_cap_data P dt cap) = obj_refs cap" by (case_tac cap, @@ -58,7 +58,7 @@ lemma update_cap_objrefs [CNodeInv_AI_assms]: split: if_split_asm) -lemma update_cap_zobjrefs [CNodeInv_AI_assms]: +lemma update_cap_zobjrefs [Arch_assms]: "\ update_cap_data P dt cap \ cap.NullCap \ \ zobj_refs (update_cap_data P dt cap) = zobj_refs cap" apply (case_tac cap, @@ -67,7 +67,7 @@ lemma update_cap_zobjrefs [CNodeInv_AI_assms]: done -lemma copy_mask [simp, CNodeInv_AI_assms]: +lemma copy_mask [simp, Arch_assms]: "copy_of (mask_cap R c) = copy_of c" apply (rule ext) apply (auto simp: copy_of_def is_cap_simps mask_cap_def @@ -76,14 +76,14 @@ lemma copy_mask [simp, CNodeInv_AI_assms]: split: cap.splits arch_cap.splits bool.splits) done -lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: +lemma update_cap_data_mask_Null [simp, Arch_assms]: "(update_cap_data P x (mask_cap m c) = NullCap) = (update_cap_data P x c = NullCap)" unfolding update_cap_data_def mask_cap_def apply (cases c) by (auto simp add: the_cnode_cap_def Let_def is_cap_simps cap_rights_update_def badge_update_def arch_update_cap_data_def split:bool.splits) -lemma cap_master_update_cap_data [CNodeInv_AI_assms]: +lemma cap_master_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap \ \ cap_master_cap (update_cap_data P x c) = cap_master_cap c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -106,12 +106,12 @@ lemma same_object_as_def2: by (auto simp: cap_master_cap_def bits_of_def split: arch_cap.splits cap.splits) -lemma same_object_as_cap_master [CNodeInv_AI_assms]: +lemma same_object_as_cap_master [Arch_assms]: "same_object_as cap cap' \ cap_master_cap cap = cap_master_cap cap'" by (simp add: same_object_as_def2) -lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: +lemma weak_derived_cap_is_device[Arch_assms]: "\weak_derived c' c\ \ cap_is_device c = cap_is_device c'" apply (auto simp: weak_derived_def copy_of_def is_cap_simps same_object_as_def2 @@ -119,7 +119,7 @@ lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: dest!: master_cap_eq_is_device_cap_eq) done -lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid (update_cap_data P x c) = cap_asid c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -128,7 +128,7 @@ lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: +lemma cap_vptr_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_vptr (update_cap_data P x c) = cap_vptr c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -137,7 +137,7 @@ lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_base_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid_base (update_cap_data P x c) = cap_asid_base c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -146,7 +146,7 @@ lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma same_object_as_update_cap_data [CNodeInv_AI_assms]: +lemma same_object_as_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap; same_object_as c' c \ \ same_object_as c' (update_cap_data P x c)" apply (clarsimp simp: same_object_as_def is_cap_simps @@ -165,7 +165,7 @@ lemma is_master_reply_update_cap_data[simp]: by (simp add:is_master_reply_cap_def update_cap_data_def arch_update_cap_data_def the_cnode_cap_def is_arch_cap_def badge_update_def split:cap.split) -lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: +lemma weak_derived_update_cap_data [Arch_assms]: "\update_cap_data P x c \ NullCap; weak_derived c c'\ \ weak_derived (update_cap_data P x c) c'" apply (simp add: weak_derived_def copy_of_def @@ -188,7 +188,7 @@ lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: Let_def split_def the_cnode_cap_def bits_of_def split: if_split_asm cap.splits)+ done -lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: +lemma cap_badge_update_cap_data [Arch_assms]: "update_cap_data False x c \ NullCap \ (bdg, cap_badge c) \ capBadge_ordering False \ (bdg, cap_badge (update_cap_data False x c)) \ capBadge_ordering False" apply clarsimp @@ -200,25 +200,25 @@ lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: done -lemma cap_vptr_rights_update[simp, CNodeInv_AI_assms]: +lemma cap_vptr_rights_update[simp, Arch_assms]: "cap_vptr (cap_rights_update f c) = cap_vptr c" by (simp add: cap_vptr_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_vptr_mask[simp, CNodeInv_AI_assms]: +lemma cap_vptr_mask[simp, Arch_assms]: "cap_vptr (mask_cap m c) = cap_vptr c" by (simp add: mask_cap_def del: cap_vptr_simps) -lemma cap_asid_base_rights [simp, CNodeInv_AI_assms]: +lemma cap_asid_base_rights [simp, Arch_assms]: "cap_asid_base (cap_rights_update R c) = cap_asid_base c" by (auto simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_asid_base_mask[simp, CNodeInv_AI_assms]: +lemma cap_asid_base_mask[simp, Arch_assms]: "cap_asid_base (mask_cap m c) = cap_asid_base c" by (simp add: mask_cap_def del: cap_asid_base_simps) -lemma weak_derived_mask [CNodeInv_AI_assms]: +lemma weak_derived_mask [Arch_assms]: "\ weak_derived c c'; cap_aligned c \ \ weak_derived (mask_cap m c) c'" unfolding weak_derived_def apply (simp del: cap_asid_base_simps cap_vptr_simps cap_asid_simps) @@ -233,14 +233,14 @@ lemma weak_derived_mask [CNodeInv_AI_assms]: done -lemma vs_cap_ref_update_cap_data[simp, CNodeInv_AI_assms]: +lemma vs_cap_ref_update_cap_data[simp, Arch_assms]: "vs_cap_ref (update_cap_data P d cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def update_cap_data_closedform arch_update_cap_data_def split: cap.split) -lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]: +lemma invs_irq_state_independent[intro!, simp, Arch_assms]: "invs (s\machine_state := machine_state s\irq_state := f (irq_state (machine_state s))\\) = invs s" apply (clarsimp simp: irq_state_independent_A_def invs_def @@ -257,7 +257,7 @@ lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]: done -lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: +lemma cte_at_nat_to_cref_zbits [Arch_assms]: "\ s \ Zombie oref zb n; m < n \ \ cte_at (oref, nat_to_cref (zombie_cte_bits zb) m) s" apply (subst(asm) valid_cap_def) @@ -271,7 +271,7 @@ lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: done -lemma copy_of_cap_range [CNodeInv_AI_assms]: +lemma copy_of_cap_range [Arch_assms]: "copy_of cap cap' \ cap_range cap = cap_range cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -283,7 +283,7 @@ lemma copy_of_cap_range [CNodeInv_AI_assms]: done -lemma copy_of_zobj_refs [CNodeInv_AI_assms]: +lemma copy_of_zobj_refs [Arch_assms]: "copy_of cap cap' \ zobj_refs cap = zobj_refs cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -295,7 +295,7 @@ lemma copy_of_zobj_refs [CNodeInv_AI_assms]: done -lemma vs_cap_ref_master [CNodeInv_AI_assms]: +lemma vs_cap_ref_master [Arch_assms]: "\ cap_master_cap cap = cap_master_cap cap'; cap_asid cap = cap_asid cap'; cap_asid_base cap = cap_asid_base cap'; @@ -307,13 +307,13 @@ lemma vs_cap_ref_master [CNodeInv_AI_assms]: apply (clarsimp simp: cap_asid_def split: arch_cap.split_asm option.split_asm) done -lemma weak_derived_vs_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_vs_cap_ref [Arch_assms]: "weak_derived c c' \ vs_cap_ref c = vs_cap_ref c'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm elim: vs_cap_ref_master[OF sym]) -lemma weak_derived_table_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_table_cap_ref [Arch_assms]: "weak_derived c c' \ table_cap_ref c = table_cap_ref c'" apply (clarsimp simp: weak_derived_def copy_of_def same_object_as_def2 @@ -362,7 +362,7 @@ lemmas weak_derived_ASIDPool [simp] = weak_derived_ASIDPool1 weak_derived_ASIDPool2 -lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: +lemma swap_of_caps_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -409,7 +409,7 @@ lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: done -lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: +lemma cap_swap_asid_map[wp, Arch_assms]: "\valid_asid_map and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -421,7 +421,7 @@ lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: done -lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: +lemma cap_swap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -434,7 +434,7 @@ lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: done -lemma cap_swap_vms[wp, CNodeInv_AI_assms]: +lemma cap_swap_vms[wp, Arch_assms]: "\valid_machine_state\ cap_swap c a c' b \\rv. valid_machine_state\" apply (simp add: valid_machine_state_def in_user_frame_def) apply (wp cap_swap_typ_at @@ -442,7 +442,7 @@ lemma cap_swap_vms[wp, CNodeInv_AI_assms]: done -lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: +lemma unat_of_bl_nat_to_cref[Arch_assms]: "\ n < 2 ^ len; len < word_bits \ \ unat (of_bl (nat_to_cref len n) :: word32) = n" apply (simp add: nat_to_cref_def word_bits_conv of_drop_to_bl @@ -461,7 +461,7 @@ lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: apply simp done -lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: +lemma zombie_is_cap_toE_pre[Arch_assms]: "\ s \ Zombie ptr zbits n; invs s; m < n \ \ (ptr, nat_to_cref (zombie_cte_bits zbits) m) \ cte_refs (Zombie ptr zbits n) irqn" apply (clarsimp simp add: valid_cap_def cap_aligned_def) @@ -503,12 +503,12 @@ lemma finalise_cap_makes_halted_proof: lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof crunch finalise_cap - for emptyable[wp, CNodeInv_AI_assms]: "emptyable sl" + for emptyable[wp, Arch_assms]: "emptyable sl" (simp: crunch_simps rule: emptyable_lift wp: crunch_wps suspend_emptyable unbind_notification_invs unbind_maybe_notification_invs arch_finalise_cap_pred_tcb_at) -lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: +lemma finalise_cap_not_reply_master_unlifted [Arch_assms]: "(rv, s') \ fst (finalise_cap cap sl s) \ \ is_master_reply_cap (fst rv)" by (case_tac cap, auto simp: is_cap_simps in_monad liftM_def @@ -516,7 +516,7 @@ lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: split: if_split_asm arch_cap.split_asm bool.split_asm option.split_asm) -lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: +lemma nat_to_cref_0_replicate [Arch_assms]: "\n. n < word_bits \ nat_to_cref n 0 = replicate n False" apply (subgoal_tac "nat_to_cref n (unat (of_bl (replicate n False))) = replicate n False") apply simp @@ -526,25 +526,26 @@ lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: done -lemma prepare_thread_delete_thread_cap [CNodeInv_AI_assms]: +lemma prepare_thread_delete_thread_cap [Arch_assms]: "\\s. caps_of_state s x = Some (cap.ThreadCap p)\ prepare_thread_delete t \\rv s. caps_of_state s x = Some (cap.ThreadCap p)\" by (wpsimp simp: prepare_thread_delete_def) -lemma cap_swap_valid_arch_state[wp, CNodeInv_AI_assms]: +lemma cap_swap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ cap_swap c a c' b \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_swap_typ_ats cap_swap_aobj_at) +lemmas CNodeInv_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI?: CNodeInv_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.CNodeInv_AI_assms)?) qed @@ -800,22 +801,23 @@ next qed -lemmas rec_del_invs'[CNodeInv_AI_assms] = rec_del_invs'' [where Q=\, +lemmas rec_del_invs'[Arch_assms] = rec_del_invs'' [where Q=\, simplified hoare_TrueI pred_conj_def simp_thms, OF TrueI TrueI TrueI TrueI, simplified] +lemmas CNodeInv_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_2?: CNodeInv_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.CNodeInv_AI_2_assms)?) qed context Arch begin arch_global_naming -lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: +lemma finalise_cap_rvk_prog [Arch_assms]: "\\s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\ finalise_cap a b \\_ s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\" @@ -825,7 +827,7 @@ lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: done -lemma rec_del_rvk_prog [CNodeInv_AI_assms]: +lemma rec_del_rvk_prog [Arch_assms]: "st \ \\s. revoke_progress_ord m (option_map cap_to_rpo \ caps_of_state s) \ (case args of ReduceZombieCall cap sl ex \ cte_wp_at (\c. c = cap) sl s \ is_final_cap' cap s @@ -909,13 +911,14 @@ next done qed +lemmas CNodeInv_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_3?: CNodeInv_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.CNodeInv_AI_3_assms)?) qed @@ -927,31 +930,32 @@ declare cap_revoke.simps[simp del] context Arch begin arch_global_naming crunch finalise_slot - for typ_at[wp, CNodeInv_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM set_object clearMemory) -lemma weak_derived_appropriate [CNodeInv_AI_assms]: +lemma weak_derived_appropriate [Arch_assms]: "weak_derived cap cap' \ appropriate_cte_cap cap = appropriate_cte_cap cap'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 appropriate_cte_master split: if_split_asm dest!: arg_cong[where f=appropriate_cte_cap]) +lemmas CNodeInv_AI_4_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_4?: CNodeInv_AI_4 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.CNodeInv_AI_4_assms)?) qed context Arch begin arch_global_naming -lemma cap_move_invs[wp, CNodeInv_AI_assms]: +lemma cap_move_invs[wp, Arch_assms]: "\invs and valid_cap cap and cte_wp_at ((=) cap.NullCap) ptr' and tcb_cap_valid cap ptr' and cte_wp_at (weak_derived cap) ptr @@ -997,13 +1001,14 @@ lemma arch_derive_is_arch: "\\\ arch_derive_cap c \\rv s. rv \ NullCap \ is_arch_cap rv\,-" by (wpsimp simp: is_arch_cap_def arch_derive_cap_def) +lemmas CNodeInv_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_5?: CNodeInv_AI_5 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.CNodeInv_AI_5_assms)?) qed diff --git a/proof/invariant-abstract/ARM_HYP/ArchCSpace_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchCSpace_AI.thy index 3542a34f0a..547dd25a6e 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchCSpace_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchCSpace_AI.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_AI locale *) lemma cte_at_length_limit: "\ cte_at p s; valid_objs s \ \ length (snd p) < word_bits - cte_level_bits" @@ -30,7 +30,7 @@ lemma cte_at_length_limit: done (* FIXME: move? *) -lemma getActiveIRQ_wp [CSpace_AI_assms]: +lemma getActiveIRQ_wp [Arch_assms]: "irq_state_independent_A P \ valid P (do_machine_op (getActiveIRQ in_kernel)) (\_. P)" apply (simp add: getActiveIRQ_def do_machine_op_def split_def exec_gets @@ -40,7 +40,7 @@ lemma getActiveIRQ_wp [CSpace_AI_assms]: apply (clarsimp simp: irq_state_independent_A_def in_monad return_def split: if_splits) done -lemma weak_derived_valid_cap [CSpace_AI_assms]: +lemma weak_derived_valid_cap [Arch_assms]: "\ s \ c; wellformed_cap c'; weak_derived c' c\ \ s \ c'" apply (case_tac "c = c'", simp) apply (clarsimp simp: weak_derived_def) @@ -51,7 +51,7 @@ lemma weak_derived_valid_cap [CSpace_AI_assms]: split: cap.splits arch_cap.splits option.splits) done -lemma copy_obj_refs [CSpace_AI_assms]: +lemma copy_obj_refs [Arch_assms]: "copy_of cap cap' \ obj_refs cap' = obj_refs cap" apply (cases cap) apply (auto simp: copy_of_def same_object_as_def is_cap_simps @@ -59,26 +59,26 @@ lemma copy_obj_refs [CSpace_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma weak_derived_cap_class[simp, CSpace_AI_assms]: +lemma weak_derived_cap_class[simp, Arch_assms]: "weak_derived cap src_cap \ cap_class cap = cap_class src_cap" apply (simp add:weak_derived_def) apply (auto simp:copy_of_def same_object_as_def is_cap_simps cap_asid_base_def split:if_splits cap.splits arch_cap.splits) done -lemma weak_derived_obj_refs [CSpace_AI_assms]: +lemma weak_derived_obj_refs [Arch_assms]: "weak_derived dcap cap \ obj_refs dcap = obj_refs cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma weak_derived_obj_ref_of [CSpace_AI_assms]: +lemma weak_derived_obj_ref_of [Arch_assms]: "weak_derived dcap cap \ obj_ref_of dcap = obj_ref_of cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma set_free_index_invs [CSpace_AI_assms]: +lemma set_free_index_invs [Arch_assms]: "\\s. (free_index_of cap \ idx \ is_untyped_cap cap \ idx \ 2^cap_bits cap) \ invs s \ cte_wp_at ((=) cap ) cref s\ set_cap (free_index_update (\_. idx) cap) cref @@ -131,7 +131,7 @@ lemma unique_table_refs_upd_eqD: apply (rule all_cong[where Q=\, simplified]) by auto -lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: +lemma set_untyped_cap_as_full_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at ((=) src_cap) src\ set_untyped_cap_as_full src_cap cap src \\ya. valid_arch_caps\" @@ -149,7 +149,7 @@ lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: apply clarsimp done -lemma set_untyped_cap_as_full[wp, CSpace_AI_assms]: +lemma set_untyped_cap_as_full[wp, Arch_assms]: "\\s. no_cap_to_obj_with_diff_ref a b s \ cte_wp_at ((=) src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. no_cap_to_obj_with_diff_ref a b s\" @@ -245,7 +245,7 @@ lemma is_derived_is_pt_pd: split: cap.splits arch_cap.splits)+ done -lemma cap_insert_valid_arch_caps [CSpace_AI_assms]: +lemma cap_insert_valid_arch_caps [Arch_assms]: "\valid_arch_caps and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_caps\" @@ -343,7 +343,7 @@ global_interpretation cap_insert_crunches?: cap_insert_crunches . context Arch begin arch_global_naming -lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma cap_insert_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range cap \ cap_range c) src\ cap_insert cap src dest @@ -356,7 +356,7 @@ lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: done -lemma mask_cap_valid[simp, CSpace_AI_assms]: +lemma mask_cap_valid[simp, Arch_assms]: "s \ c \ s \ mask_cap R c" apply (cases c, simp_all add: valid_cap_def mask_cap_def cap_rights_update_def @@ -366,21 +366,21 @@ lemma mask_cap_valid[simp, CSpace_AI_assms]: apply (rename_tac arch_cap) by (case_tac arch_cap, simp_all) -lemma mask_cap_objrefs[simp, CSpace_AI_assms]: +lemma mask_cap_objrefs[simp, Arch_assms]: "obj_refs (mask_cap rs cap) = obj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma mask_cap_zobjrefs[simp, CSpace_AI_assms]: +lemma mask_cap_zobjrefs[simp, Arch_assms]: "zobj_refs (mask_cap rs cap) = zobj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma derive_cap_valid_cap [CSpace_AI_assms]: +lemma derive_cap_valid_cap [Arch_assms]: "\valid_cap cap\ derive_cap slot cap \valid_cap\,-" apply (simp add: derive_cap_def) apply (rule hoare_pre) @@ -389,7 +389,7 @@ lemma derive_cap_valid_cap [CSpace_AI_assms]: done -lemma valid_cap_update_rights[simp, CSpace_AI_assms]: +lemma valid_cap_update_rights[simp, Arch_assms]: "valid_cap cap s \ valid_cap (cap_rights_update cr cap) s" apply (case_tac cap, simp_all add: cap_rights_update_def valid_cap_def cap_aligned_def @@ -400,7 +400,7 @@ lemma valid_cap_update_rights[simp, CSpace_AI_assms]: done -lemma update_cap_data_validI [CSpace_AI_assms]: +lemma update_cap_data_validI [Arch_assms]: "s \ cap \ s \ update_cap_data p d cap" apply (cases cap) apply (simp_all add: is_cap_defs update_cap_data_def Let_def split_def) @@ -413,7 +413,7 @@ lemma update_cap_data_validI [CSpace_AI_assms]: done -lemma tcb_cnode_index_def2 [CSpace_AI_assms]: +lemma tcb_cnode_index_def2 [Arch_assms]: "tcb_cnode_index n = nat_to_cref 3 n" apply (simp add: tcb_cnode_index_def nat_to_cref_def) apply (rule nth_equalityI) @@ -423,7 +423,7 @@ lemma tcb_cnode_index_def2 [CSpace_AI_assms]: done -lemma ex_nonz_tcb_cte_caps [CSpace_AI_assms]: +lemma ex_nonz_tcb_cte_caps [Arch_assms]: "\ex_nonz_cap_to t s; tcb_at t s; valid_objs s; ref \ dom tcb_cap_cases\ \ ex_cte_cap_wp_to (appropriate_cte_cap cp) (t, ref) s" apply (clarsimp simp: ex_nonz_cap_to_def ex_cte_cap_wp_to_def @@ -452,7 +452,7 @@ lemma no_cap_to_obj_with_diff_ref_triv: done -lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: +lemma setup_reply_master_arch_caps[wp, Arch_assms]: "\valid_arch_caps and tcb_at t and valid_objs and pspace_aligned\ setup_reply_master t \\rv. valid_arch_caps\" @@ -467,7 +467,7 @@ lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: done -lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma setup_reply_master_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and tcb_at t and pspace_in_kernel_window\ setup_reply_master t \\rv. cap_refs_in_kernel_window\" @@ -479,13 +479,13 @@ lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: (* FIXME: prove same_region_as_def2 instead or change def *) -lemma same_region_as_Untyped2 [CSpace_AI_assms]: +lemma same_region_as_Untyped2 [Arch_assms]: "\ is_untyped_cap pcap; same_region_as pcap cap \ \ (is_physical cap \ cap_range cap \ {} \ cap_range cap \ cap_range pcap)" by (fastforce simp: is_cap_simps cap_range_def is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma same_region_as_cap_class [CSpace_AI_assms]: +lemma same_region_as_cap_class [Arch_assms]: shows "same_region_as a b \ cap_class a = cap_class b" apply (case_tac a) apply (fastforce simp: cap_range_def arch_is_physical_def is_cap_simps @@ -514,22 +514,23 @@ lemma cap_insert_simple_arch_caps_no_ap: apply (intro conjI impI allI) by (auto simp:is_simple_cap_def[simplified is_simple_cap_arch_def] is_cap_simps) -lemma cap_insert_derived_valid_arch_state[CSpace_AI_assms]: +lemma cap_insert_derived_valid_arch_state[Arch_assms]: "\valid_arch_state and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_insert_tcb cap_insert_aobj_at) -lemma setup_reply_master_arch[CSpace_AI_assms]: +lemma setup_reply_master_arch[Arch_assms]: "setup_reply_master t \ valid_arch_state \" by (wpsimp simp: setup_reply_master_def wp: get_cap_wp) +lemmas CSpace_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CSpace_AI?: CSpace_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CSpace_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.CSpace_AI_assms)?) qed diff --git a/proof/invariant-abstract/ARM_HYP/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchDetSchedAux_AI.thy index 27d2e94922..e6156647fc 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchDetSchedAux_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchDetSchedAux_AI.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedAux_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedAux_AI locale *) lemma set_pd_etcbs[wp]: "set_pd p pd \\s. P (etcbs_of s)\" @@ -22,11 +22,11 @@ lemma set_pd_etcbs[wp]: crunch init_arch_objects for exst[wp]: "\s. P (exst s)" - and etcbs_of[wp, DetSchedAux_AI_assms]: "\s. P (etcbs_of s)" - and ready_queues[wp, DetSchedAux_AI_assms]: "\s. P (ready_queues s)" - and idle_thread[wp, DetSchedAux_AI_assms]: "\s. P (idle_thread s)" - and schedact[wp, DetSchedAux_AI_assms]: "\s. P (scheduler_action s)" - and cur_domain[wp, DetSchedAux_AI_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and schedact[wp, Arch_assms]: "\s. P (scheduler_action s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" (wp: crunch_wps) crunch init_arch_objects @@ -41,7 +41,7 @@ lemma tcb_sched_action_valid_idle_etcb: (wpsimp simp: tcb_sched_action_def set_tcb_queue_def) crunch init_arch_objects - for valid_blocked[wp, DetSchedAux_AI_assms]: valid_blocked + for valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift) lemma perform_asid_control_etcb_at: @@ -83,12 +83,13 @@ lemma perform_asid_control_invocation_valid_sched: apply simp done +lemmas DetSchedAux_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedAux_AI?: DetSchedAux_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedAux_AI_assms | wp)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.DetSchedAux_AI_assms | wp)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchDetSchedDomainTime_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchDetSchedDomainTime_AI.thy index 12471573c3..e3baac79a2 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchDetSchedDomainTime_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchDetSchedDomainTime_AI.thy @@ -10,13 +10,13 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedDomainTime_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedDomainTime_AI locale *) crunch vcpu_update, vcpu_save_reg, vgic_update, vcpu_enable, vcpu_disable, vcpu_restore, vcpu_write_reg, vcpu_read_reg, vcpu_save, vcpu_switch, set_vcpu, vgic_update_lr, read_vcpu_register, write_vcpu_register - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps simp: crunch_simps) crunch @@ -28,26 +28,27 @@ crunch arch_invoke_irq_handler, arch_prepare_next_domain, arch_prepare_set_domain, arch_post_set_flags, handle_spurious_irq, handle_reserved_irq, arch_mask_irq_signal - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (simp: crunch_simps wp: mapM_wp' transfer_caps_loop_pres crunch_wps) -declare init_arch_objects_exst[DetSchedDomainTime_AI_assms] +declare init_arch_objects_exst[Arch_assms] crunch handle_spurious_irq - for scheduler_action[wp, DetSchedDomainTime_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" + +lemmas DetSchedDomainTime_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.DetSchedDomainTime_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_perform_invocation - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps check_cap_inv) lemma vgic_maintenance_valid_domain_time: @@ -95,7 +96,7 @@ lemma timer_tick_valid_domain_time: crunch do_machine_op for domain_time_sched[wp]: "\s. P (domain_time s) (scheduler_action s)" -lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: +lemma handle_interrupt_valid_domain_time [Arch_assms]: "\\s :: det_ext state. 0 < domain_time s \ handle_interrupt i \\rv s. domain_time s = 0 \ scheduler_action s = choose_new_thread \" (is "\ ?dtnot0 \ _ \ _ \") @@ -117,12 +118,13 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: apply wpsimp+ done +lemmas DetSchedDomainTime_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedDomainTime_AI_2?: DetSchedDomainTime_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.DetSchedDomainTime_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchDetSchedSchedule_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchDetSchedSchedule_AI.thy index 8ef0d1f33b..36f46d3160 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchDetSchedSchedule_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchDetSchedSchedule_AI.thy @@ -10,10 +10,10 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedSchedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedSchedule_AI locale *) crunch prepare_thread_delete - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" (wp: crunch_wps) crunch set_vcpu, vcpu_disable, vcpu_restore, vcpu_save, vcpu_switch, switch_to_idle_thread, set_vm_root @@ -95,13 +95,13 @@ lemma set_vcpu_valid_sched_action'[wp]: crunch switch_to_idle_thread, switch_to_thread, vcpu_restore, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain - for valid_queues [wp, DetSchedSchedule_AI_assms]: valid_queues + for valid_queues [wp, Arch_assms]: valid_queues (simp: crunch_simps wp: crunch_wps ignore: tcb_sched_action) crunch switch_to_idle_thread, switch_to_thread, vcpu_disable, vcpu_restore, vcpu_save, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers - for weak_valid_sched_action [wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action + for weak_valid_sched_action [wp, Arch_assms]: weak_valid_sched_action (simp: crunch_simps wp: crunch_wps) crunch set_vm_root @@ -114,7 +114,7 @@ lemma vcpu_switch_valid_sched_action[wp]: unfolding valid_sched_action_def is_activatable_def st_tcb_at_kh_simp by (rule hoare_lift_Pf[where f=cur_thread]; wpsimp wp: hoare_vcg_imp_lift switch_in_cur_domain_lift) -lemma switch_to_idle_thread_ct_not_in_q[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_in_q[wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\_. ct_not_in_q\" unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def apply (wpsimp | wps)+ @@ -127,7 +127,7 @@ crunch set_vm_root, vcpu_switch thread (cur_domain s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_sched_action[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_sched_action[wp, Arch_assms]: "\valid_sched_action and valid_idle\ switch_to_idle_thread \\_. valid_sched_action\" @@ -142,13 +142,13 @@ crunch set_vm_root (scheduler_action s) (cur_domain s) (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_in_cur_domain[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_in_cur_domain[wp, Arch_assms]: "\\\ switch_to_idle_thread \\_. ct_in_cur_domain\" unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def by (wpsimp wp: hoare_vcg_imp_lift' hoare_vcg_disj_lift | simp add: ct_in_cur_domain_def | wps)+ crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (simp: crunch_simps wp: crunch_wps) lemma do_machine_op_activatable[wp]: @@ -165,37 +165,37 @@ lemma set_vcpu_is_activatable[wp]: crunch vcpu_disable, vcpu_restore, vcpu_save, vcpu_switch, vcpu_flush, set_vm_root for etcbs_of[wp]: "\s. P (etcbs_of s)" and is_activatable[wp]: "is_activatable t" - and valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + and valid_sched[wp, Arch_assms]: valid_sched (wp: crunch_wps valid_sched_lift simp: crunch_simps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for is_activatable[wp, DetSchedSchedule_AI_assms]: "is_activatable t" + for is_activatable[wp, Arch_assms]: "is_activatable t" (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for valid_sched_action [wp, DetSchedSchedule_AI_assms]: valid_sched_action + for valid_sched_action [wp, Arch_assms]: valid_sched_action (simp: crunch_simps ignore: set_asid_pool wp: crunch_wps valid_sched_action_lift[where f="set_asid_pool ptr pool" for ptr pool]) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain, arch_post_set_flags, arch_prepare_set_domain - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread - for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: + for ct_in_cur_domain_2[wp, Arch_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" (simp: crunch_simps wp: assert_inv crunch_wps ignore: set_vcpu) crunch vcpu_switch, arch_prepare_next_domain - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" - and valid_blocked[wp, DetSchedSchedule_AI_assms]: valid_blocked + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift crunch_wps) crunch arch_prepare_set_domain - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and valid_idle[wp, Arch_assms]: valid_idle lemma as_user_ct_in_q[wp]: "as_user t f \ct_in_q\" @@ -210,7 +210,7 @@ lemma vcpu_switch_ct_in_q[wp]: apply wp done -lemma arch_prepare_next_domain_ct_in_q[wp, DetSchedSchedule_AI_assms]: +lemma arch_prepare_next_domain_ct_in_q[wp, Arch_assms]: "arch_prepare_next_domain \ct_in_q\" unfolding ct_in_q_def by (wp_pre, wps, wpsimp+) @@ -224,22 +224,22 @@ lemma set_vm_root_valid_blocked_ct_in_q[wp]: "\valid_blocked and ct_in_q\ set_vm_root p \\_. valid_blocked and ct_in_q\" by wpsimp -lemma arch_switch_to_thread_valid_blocked[wp, DetSchedSchedule_AI_assms]: +lemma arch_switch_to_thread_valid_blocked[wp, Arch_assms]: "\valid_blocked and ct_in_q\ arch_switch_to_thread thread \\_. valid_blocked and ct_in_q\" by (wpsimp simp: arch_switch_to_thread_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" crunch arch_switch_to_idle_thread - for valid_idle[wp, DetSchedSchedule_AI_assms]: "valid_idle" + for valid_idle[wp, Arch_assms]: "valid_idle" (wp: crunch_wps simp: crunch_simps) crunch arch_prepare_next_domain, arch_prepare_set_domain - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" (simp: Let_def) -lemma switch_to_idle_thread_ct_not_queued[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_queued[wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\rv s. not_queued (cur_thread s) s\" @@ -256,27 +256,27 @@ lemma valid_blocked_idle_strg: apply simp done -lemma switch_to_idle_thread_valid_blocked[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_blocked[wp, Arch_assms]: "\valid_blocked and ct_in_q\ switch_to_idle_thread \\rv. valid_blocked\" by (strengthen valid_blocked_idle_strg | simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def | wp | wpc )+ crunch arch_switch_to_thread - for exst[wp, DetSchedSchedule_AI_assms]: "\s. P (exst s)" + for exst[wp, Arch_assms]: "\s. P (exst s)" lemma ct_in_state_cur_update[simp]: "ct_in_state P (s\cur_thread := thread\) = st_tcb_at P thread s" by (simp add: ct_in_state_def) -lemma stit_activatable'[DetSchedSchedule_AI_assms]: +lemma stit_activatable'[Arch_assms]: "\valid_idle\ switch_to_idle_thread \\rv . ct_in_state activatable\" unfolding switch_to_idle_thread_def arch_switch_to_idle_thread_def apply wpsimp apply (clarsimp simp: valid_idle_def ct_in_state_def pred_tcb_at_def obj_at_def) done -lemma switch_to_idle_thread_cur_thread_idle_thread[wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_cur_thread_idle_thread[wp, Arch_assms]: "\\\ switch_to_idle_thread \\_ s. cur_thread s = idle_thread s\" by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+ @@ -305,21 +305,21 @@ lemma set_vcpu_valid_sched[wp]: crunch arch_finalise_cap, prepare_thread_delete - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action) crunch arch_finalise_cap, prepare_thread_delete - for simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action + for simple_sched_action[wp, Arch_assms]: simple_sched_action (wp: hoare_drop_imps mapM_x_wp mapM_wp subset_refl simp: unless_def if_fun_split) crunch arch_finalise_cap, prepare_thread_delete, arch_invoke_irq_handler - for valid_sched [wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched [wp, Arch_assms]: valid_sched (ignore: set_object wp: crunch_wps subset_refl simp: if_fun_split) -lemma activate_thread_valid_sched [DetSchedSchedule_AI_assms]: +lemma activate_thread_valid_sched [Arch_assms]: "\valid_sched\ activate_thread \\_. valid_sched\" apply (simp add: activate_thread_def) apply (wp set_thread_state_runnable_valid_sched gts_wp | wpc | simp add: arch_activate_idle_thread_def)+ @@ -351,7 +351,7 @@ crunch perform_vcpu_invocation for valid_sched[wp]: valid_sched (wp: crunch_wps simp: crunch_simps ignore: set_thread_state) -lemma arch_perform_invocation_valid_sched[wp, DetSchedSchedule_AI_assms]: +lemma arch_perform_invocation_valid_sched[wp, Arch_assms]: "\invs and valid_sched and ct_active and valid_arch_inv a\ arch_perform_invocation a \\_.valid_sched\" @@ -362,24 +362,24 @@ lemma arch_perform_invocation_valid_sched[wp, DetSchedSchedule_AI_assms]: crunch handle_arch_fault_reply, handle_vm_fault - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (ignore: getFAR getDFSR getIFSR) crunch handle_vm_fault, handle_arch_fault_reply - for not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" + for not_queued[wp, Arch_assms]: "not_queued t" (ignore: getFAR getDFSR getIFSR) crunch handle_arch_fault_reply, handle_vm_fault - for sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" + for sched_act_not[wp, Arch_assms]: "scheduler_act_not t" (ignore: getFAR getDFSR getIFSR) -lemma hvmf_st_tcb_at [wp, DetSchedSchedule_AI_assms]: +lemma hvmf_st_tcb_at [wp, Arch_assms]: "\st_tcb_at P t' \ handle_vm_fault t w \\rv. st_tcb_at P t' \" by (cases w, simp_all) ((wp | simp)+) -lemma handle_vm_fault_st_tcb_cur_thread[wp, DetSchedSchedule_AI_assms]: +lemma handle_vm_fault_st_tcb_cur_thread[wp, Arch_assms]: "\ \s. st_tcb_at P (cur_thread s) s \ handle_vm_fault t f \\_ s. st_tcb_at P (cur_thread s) s \" apply (fold ct_in_state_def) apply (rule ct_in_state_thread_state_lift) @@ -388,37 +388,37 @@ lemma handle_vm_fault_st_tcb_cur_thread[wp, DetSchedSchedule_AI_assms]: done crunch arch_invoke_irq_control - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" crunch arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for valid_list[wp, DetSchedSchedule_AI_assms]: "valid_list" + for valid_list[wp, Arch_assms]: "valid_list" crunch handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info, arch_post_modify_registers - for cur_tcb[wp, DetSchedSchedule_AI_assms]: cur_tcb + for cur_tcb[wp, Arch_assms]: cur_tcb crunch arch_get_sanitise_register_info, arch_post_modify_registers - for not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t'" + for not_cur_thread[wp, Arch_assms]: "not_cur_thread t'" crunch arch_mask_irq_signal - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" -lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]: +lemma arch_post_modify_registers_not_idle_thread[Arch_assms]: "\\s::det_ext state. t \ idle_thread s\ arch_post_modify_registers c t \\_ s. t \ idle_thread s\" by (wpsimp simp: arch_post_modify_registers_def) crunch arch_post_cap_deletion - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q - and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action - and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t" - and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" - and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" - and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and ct_not_in_q[wp, Arch_assms]: ct_not_in_q + and simple_sched_action[wp, Arch_assms]: simple_sched_action + and not_cur_thread[wp, Arch_assms]: "not_cur_thread t" + and not_queued[wp, Arch_assms]: "not_queued t" + and sched_act_not[wp, Arch_assms]: "scheduler_act_not t" + and weak_valid_sched_action[wp, Arch_assms]: weak_valid_sched_action + and valid_idle[wp, Arch_assms]: valid_idle crunch flush_space, invalidate_asid_entry, get_asid_pool for flush_space_valid_idle[wp]: "\(s:: det_ext state). P (idle_thread s)" @@ -428,29 +428,30 @@ crunch delete_asid_pool (wp: crunch_wps simp: if_apply_def2) crunch arch_finalise_cap - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" (wp: crunch_wps) crunch arch_switch_to_thread - for etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" + for etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" crunch handle_spurious_irq - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and valid_idle[wp, Arch_assms]: valid_idle crunch prepare_thread_delete, arch_post_cap_deletion, arch_finalise_cap - for cur_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_thread s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for cur_thread[wp, Arch_assms]: "\s. P (cur_thread s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) +lemmas DetSchedSchedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.DetSchedSchedule_AI_assms)?) qed context Arch begin arch_global_naming @@ -518,12 +519,15 @@ lemma handle_hyp_fault_valid_sched[wp]: handle_hypervisor_fault t fault \\_. valid_sched :: det_state \ _\" by (cases fault; wpsimp wp: handle_fault_valid_sched simp: valid_fault_def) +lemmas [Arch_assms] = handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched + +lemmas DetSchedSchedule_AI_handle_hypervisor_fault_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI_handle_hypervisor_fault?: DetSchedSchedule_AI_handle_hypervisor_fault proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.DetSchedSchedule_AI_handle_hypervisor_fault_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchDeterministic_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchDeterministic_AI.thy index 04f53d9756..551ae9364d 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchDeterministic_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchDeterministic_AI.thy @@ -13,15 +13,15 @@ declare dxo_wp_weak[wp del] context Arch begin arch_global_naming -named_theorems Deterministic_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Deterministic_AI locale *) crunch vcpu_save, vcpu_enable, vcpu_disable, vcpu_restore, arch_get_sanitise_register_info, arch_post_modify_registers, arch_post_set_flags - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -lemma vcpu_switch_valid_list[wp, Deterministic_AI_assms]: +lemma vcpu_switch_valid_list[wp, Arch_assms]: "\valid_list\ vcpu_switch param_a \\_. valid_list\" apply (simp add: vcpu_switch_def) apply (rule hoare_pre) @@ -29,21 +29,22 @@ lemma vcpu_switch_valid_list[wp, Deterministic_AI_assms]: done crunch cap_swap_for_delete,set_cap,finalise_cap - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -declare get_cap_inv[Deterministic_AI_assms] +declare get_cap_inv[Arch_assms] + +lemmas Deterministic_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Deterministic_AI_1?: Deterministic_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.Deterministic_AI_assms)?) qed context Arch begin arch_global_naming -declare arch_invoke_irq_handler_valid_list[Deterministic_AI_assms] +declare arch_invoke_irq_handler_valid_list[Arch_assms] crunch invalidate_tlb_by_asid for valid_list[wp]: valid_list @@ -77,15 +78,15 @@ crunch perform_invocation (wp: crunch_wps simp: crunch_simps ignore: without_preemption) crunch handle_invocation - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps syscall_valid simp: crunch_simps ignore: without_preemption syscall) crunch handle_recv, handle_yield, handle_call - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: crunch_simps) -lemma handle_vm_fault_valid_list[wp, Deterministic_AI_assms]: +lemma handle_vm_fault_valid_list[wp, Arch_assms]: "\valid_list\ handle_vm_fault thread fault \\_.valid_list\" apply (cases fault,simp_all) apply (wp|simp)+ @@ -95,22 +96,24 @@ crunch vgic_maintenance, vppi_event for valid_list[wp]: valid_list (wp: hoare_drop_imps) -lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: +lemma handle_interrupt_valid_list[wp, Arch_assms]: "\valid_list\ handle_interrupt irq \\_.valid_list\" unfolding handle_interrupt_def ackInterrupt_def handle_reserved_irq_def by (wpsimp wp: hoare_drop_imps simp: arch_mask_irq_signal_def) crunch handle_send, handle_reply, handle_spurious_irq - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list crunch handle_hypervisor_fault - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list + +lemmas Deterministic_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end + global_interpretation Deterministic_AI_2?: Deterministic_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.Deterministic_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchDetype_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchDetype_AI.thy index 7c84c85eba..4ec794fa8d 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchDetype_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchDetype_AI.thy @@ -10,16 +10,16 @@ begin context Arch begin arch_global_naming -named_theorems Detype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_AI locale *) -lemma valid_globals_irq_node[Detype_AI_assms]: +lemma valid_globals_irq_node[Arch_assms]: "\ valid_global_refs s; cte_wp_at ((=) cap) ptr s \ \ interrupt_irq_node s irq \ cap_range cap" apply (erule(1) valid_global_refsD) apply (simp add: global_refs_def) done -lemma caps_of_state_ko[Detype_AI_assms]: +lemma caps_of_state_ko[Arch_assms]: "valid_cap cap s \ is_untyped_cap cap \ cap_range cap = {} \ @@ -38,7 +38,7 @@ lemma caps_of_state_ko[Detype_AI_assms]: is_cap_simps )+ done -lemma mapM_x_storeWord[Detype_AI_assms]: +lemma mapM_x_storeWord[Arch_assms]: (* FIXME: taken from Retype_C.thy and adapted wrt. the missing intvl syntax. *) assumes al: "is_aligned ptr word_size_bits" shows "mapM_x (\x. storeWord (ptr + of_nat x * word_size) 0) [0..x. if x \ S then {} else state_hyp_refs_of s x)" by (rule ext, simp add: state_hyp_refs_of_def detype_def) +lemmas Detype_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Detype_AI?: Detype_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Detype_AI_assms)?) + by (intro_locales; (unfold_locales; fact ARM_HYP.Detype_AI_assms)?) qed context detype_locale_arch begin diff --git a/proof/invariant-abstract/ARM_HYP/ArchEmptyFail_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchEmptyFail_AI.thy index 2f677d2128..f7dbd9aba6 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchEmptyFail_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchEmptyFail_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_AI locale *) crunch_ignore (empty_fail) (add: invalidateLocalTLB_ASID_impl invalidateLocalTLB_VAASID_impl cleanByVA_impl @@ -23,20 +23,21 @@ crunch_ignore (empty_fail) crunch loadWord, load_word_offs, storeWord, getRestartPC, get_mrs - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_load_word_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_load_word?: EmptyFail_AI_load_word proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.EmptyFail_AI_load_word_assms)?) qed context Arch begin arch_global_naming crunch handle_fault - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: kernel_object.splits option.splits arch_cap.splits cap.splits endpoint.splits bool.splits list.splits thread_state.splits split_def catch_def sum.splits Let_def @@ -121,12 +122,13 @@ lemma arch_decode_invocation_empty_fail[wp]: split: arch_cap.splits cap.splits option.splits | wp | intro conjI impI allI)+) +lemmas EmptyFail_AI_derive_cap_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_derive_cap?: EmptyFail_AI_derive_cap proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.EmptyFail_AI_derive_cap_assms)?) qed context Arch begin arch_global_naming @@ -135,7 +137,7 @@ crunch vcpu_update, vcpu_save_reg_range, vgic_update_lr, save_virt_timer for (empty_fail) empty_fail[wp] (ignore: set_object get_object simp: check_export_arch_timer_def) -lemma vcpu_save_empty_fail[wp,EmptyFail_AI_assms]: "empty_fail (vcpu_save a)" +lemma vcpu_save_empty_fail[wp,Arch_assms]: "empty_fail (vcpu_save a)" apply (simp add: vcpu_save_def) apply (wpsimp wp: empty_fail_dsb empty_fail_isb simp: vgic_update_def) done @@ -143,7 +145,7 @@ lemma vcpu_save_empty_fail[wp,EmptyFail_AI_assms]: "empty_fail (vcpu_save a)" crunch maskInterrupt, empty_slot, setHardwareASID, set_current_pd, finalise_cap, preemption_point, cap_swap_for_delete, decode_invocation - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: Let_def catch_def split_def OR_choiceE_def mk_ef_def option.splits endpoint.splits notification.splits thread_state.splits sum.splits cap.splits arch_cap.splits kernel_object.splits vmpage_size.splits pde.splits bool.splits list.splits @@ -154,26 +156,30 @@ crunch maskInterrupt, empty_slot, set_gic_vcpu_ctrl_lr_impl setCurrentPDPL2_impl) crunch setRegister, setNextPC - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_rec_del_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_rec_del?: EmptyFail_AI_rec_del proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.EmptyFail_AI_rec_del_assms)?) qed context Arch begin arch_global_naming + crunch cap_delete, choose_thread, arch_prepare_next_domain - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_schedule_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_schedule?: EmptyFail_AI_schedule proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.EmptyFail_AI_schedule_assms)?) qed context Arch begin arch_global_naming @@ -190,7 +196,7 @@ lemma deactivateInterrupt_empty_fail[wp]: by wpsimp crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: cap.splits arch_cap.splits split_def invocation_label.splits Let_def kernel_object.splits arch_kernel_obj.splits option.splits pde.splits pte.splits bool.splits apiobject_type.splits aobject_type.splits notification.splits @@ -199,12 +205,14 @@ crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits flush_type.splits page_directory_invocation.splits ignore: resetTimer_impl ackInterrupt_impl addressTranslateS1_impl handleSpuriousIRQ_impl) + +lemmas EmptyFail_AI_call_kernel_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_call_kernel?: EmptyFail_AI_call_kernel proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.EmptyFail_AI_call_kernel_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchFinalise_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchFinalise_AI.thy index 12bcf39aec..01319e9e50 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchFinalise_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchFinalise_AI.thy @@ -11,13 +11,13 @@ begin context Arch begin -named_theorems Finalise_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_AI locale *) crunch prepare_thread_delete for caps_of_state[wp]: "\s. P (caps_of_state s)" (wp: crunch_wps) -declare prepare_thread_delete_caps_of_state [Finalise_AI_assms] +declare prepare_thread_delete_caps_of_state [Arch_assms] arch_global_naming @@ -240,22 +240,22 @@ lemma unmap_page_tcb_cap_valid: done -lemma (* replaceable_cdt_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_cdt_update *)[simp,Arch_assms]: "replaceable (cdt_update f s) = replaceable s" by (fastforce simp: replaceable_def tcb_cap_valid_def) -lemma (* replaceable_revokable_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_revokable_update *)[simp,Arch_assms]: "replaceable (is_original_cap_update f s) = replaceable s" by (fastforce simp: replaceable_def is_final_cap'_def2 tcb_cap_valid_def) -lemma (* replaceable_more_update *) [simp,Finalise_AI_assms]: +lemma (* replaceable_more_update *) [simp,Arch_assms]: "replaceable (trans_state f s) sl cap cap' = replaceable s sl cap cap'" by (simp add: replaceable_def) -lemma (* obj_ref_ofI *) [Finalise_AI_assms]: "obj_refs cap = {x} \ obj_ref_of cap = x" +lemma (* obj_ref_ofI *) [Arch_assms]: "obj_refs cap = {x} \ obj_ref_of cap = x" by (case_tac cap, simp_all) (rename_tac arch_cap, case_tac arch_cap, simp_all) -lemma (* empty_slot_invs *) [Finalise_AI_assms]: +lemma (* empty_slot_invs *) [Arch_assms]: "\\s. invs s \ cte_wp_at (replaceable s sl cap.NullCap) sl s \ emptyable sl s \ (info \ NullCap \ post_cap_delete_pre info ((caps_of_state s) (sl \ NullCap)))\ @@ -331,7 +331,7 @@ lemma (* empty_slot_invs *) [Finalise_AI_assms]: apply (simp add: is_final_cap'_def2 cte_wp_at_caps_of_state) done -lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: +lemma dom_tcb_cap_cases_lt_ARCH [Arch_assms]: "dom tcb_cap_cases = {xs. length xs = 3 \ unat (of_bl xs :: machine_word) < 5}" apply (rule set_eqI, rule iffI) apply clarsimp @@ -341,7 +341,7 @@ lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: apply (clarsimp simp: nat_to_cref_unat_of_bl') done -lemma (* unbind_notification_final *) [wp,Finalise_AI_assms]: +lemma (* unbind_notification_final *) [wp,Arch_assms]: "\is_final_cap' cap\ unbind_notification t \ \rv. is_final_cap' cap\" unfolding unbind_notification_def apply (wp final_cap_lift thread_set_caps_of_state_trivial hoare_drop_imps @@ -359,7 +359,7 @@ lemma prepare_thread_delete_final[wp]: | wpc | clarsimp simp add: tcb_cap_cases_def)+ done -lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: +lemma (* finalise_cap_cases1 *)[Arch_assms]: "\\s. final \ is_final_cap' cap s \ cte_wp_at ((=) cap) slot s\ finalise_cap cap final @@ -395,12 +395,12 @@ crunch dissociate_vcpu_tcb ignore: do_machine_op set_object) (* ARMHYP fix *) crunch arch_finalise_cap - for typ_at[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp,Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps unless_def assertE_def ignore: maskInterrupt set_object) (* ARMHYP fix *) crunch prepare_thread_delete - for typ_at[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp,Arch_assms]: "\s. P (typ_at T p s)" lemma vcpu_set_tcb_at[wp]: "\\s. tcb_at p s\ set_vcpu t vcpu \\_ s. tcb_at p s\" apply (simp add: tcb_at_typ) @@ -414,7 +414,7 @@ crunch dissociate_vcpu_tcb crunch prepare_thread_delete for tcb_at[wp]: "\s. tcb_at p s" -lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: +lemma (* finalise_cap_new_valid_cap *)[wp,Arch_assms]: "\valid_cap cap\ finalise_cap cap x \\rv. valid_cap (fst rv)\" apply (cases cap, simp_all) apply (wp suspend_valid_cap prepare_thread_delete_typ_at @@ -764,7 +764,7 @@ crunch vcpu_finalise for invs[wp]: invs (ignore: dissociate_vcpu_tcb) -lemma arch_finalise_cap_invs' [wp,Finalise_AI_assms]: +lemma arch_finalise_cap_invs' [wp,Arch_assms]: "\invs and valid_cap (ArchObjectCap cap)\ arch_finalise_cap cap final \\rv. invs\" @@ -821,14 +821,14 @@ lemma arch_finalise_cap_vcpu: done -lemma obj_at_not_live_valid_arch_cap_strg [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r \ \ typ_at (AArch AVCPU) r s) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: live_def valid_cap_def obj_at_def a_type_arch_live valid_cap_simps hyp_live_def arch_live_def split: arch_cap.split_asm if_splits) -lemma obj_at_not_live_valid_arch_cap_strg' [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg' [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r \ cap \ VCPUCap r) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: live_def valid_cap_def obj_at_def @@ -878,7 +878,7 @@ lemma arch_finalise_cap_replaceable1: split: cap.splits arch_cap.splits vmpage_size.splits) -lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_slot_not_irq_node *)[Arch_assms]: "\if_unsafe_then_cap and valid_global_refs and cte_wp_at (\cp. cap_irqs cp \ {}) sl\ deleting_irq_handler irq @@ -899,7 +899,7 @@ lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: apply (clarsimp simp: appropriate_cte_cap_def split: cap.split_asm) done -lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Arch_assms]: "\ cte_wp_at ((=) cap) p s; is_final_cap' cap s; obj_refs cap' = obj_refs cap \ \ no_cap_to_obj_with_diff_ref cap' {p} s" @@ -921,7 +921,7 @@ lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: gen_obj_refs_Int) done -lemma (* suspend_no_cap_to_obj_ref *)[wp,Finalise_AI_assms]: +lemma (* suspend_no_cap_to_obj_ref *)[wp,Arch_assms]: "\no_cap_to_obj_with_diff_ref cap S\ suspend t \\rv. no_cap_to_obj_with_diff_ref cap S\" @@ -974,7 +974,7 @@ lemma arch_finalise_cap_replaceable: \\rv s. replaceable s sl (fst rv) (cap.ArchObjectCap cap)\" by (cases cap; simp add: arch_finalise_cap_vcpu arch_finalise_cap_replaceable1) -lemma finalise_cap_replaceable [Finalise_AI_assms]: +lemma finalise_cap_replaceable [Arch_assms]: "\\s. s \ cap \ x = is_final_cap' cap s \ valid_mdb s \ cte_wp_at ((=) cap) sl s \ valid_objs s \ sym_refs (state_refs_of s) \ (cap_irqs cap \ {} \ if_unsafe_then_cap s \ valid_global_refs s) @@ -1024,7 +1024,7 @@ lemma finalise_cap_replaceable [Finalise_AI_assms]: | wpc | simp add: valid_cap_simps is_nondevice_page_cap_simps)+)) -lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_cte_preserved *)[Arch_assms]: assumes x: "\cap. P cap \ \ can_fast_finalise cap" shows "\cte_wp_at P p\ deleting_irq_handler irq \\rv. cte_wp_at P p\" apply (simp add: deleting_irq_handler_def) @@ -1032,29 +1032,30 @@ lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: done crunch dissociate_vcpu_tcb - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) crunch prepare_thread_delete - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) crunch arch_finalise_cap - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) -declare arch_post_cap_deletion_cur_thread[Finalise_AI_assms] +declare arch_post_cap_deletion_cur_thread[Arch_assms] crunch arch_post_cap_deletion - for cur_domain[Finalise_AI_assms, wp]: "\s. P (cur_domain s)" + for cur_domain[Arch_assms, wp]: "\s. P (cur_domain s)" (wp: crunch_wps dxo_wp_weak) +lemmas Finalise_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_1?: Finalise_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -1078,7 +1079,7 @@ lemma fast_finalise_replaceable[wp]: apply (clarsimp simp: cap_irqs_def cap_irq_opt_def split: cap.split_asm) done -lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: +lemma (* cap_delete_one_invs *) [Arch_assms,wp]: "\invs and emptyable ptr\ cap_delete_one ptr \\rv. invs\" apply (simp add: cap_delete_one_def unless_def is_final_cap_def) apply (rule hoare_pre) @@ -1087,12 +1088,13 @@ lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: apply (drule cte_wp_at_valid_objs_valid_cap, fastforce+) done +lemmas Finalise_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_2?: Finalise_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Finalise_AI_2_assms)?) qed context Arch begin arch_global_naming @@ -1104,7 +1106,7 @@ crunch (wp: crunch_wps subset_refl) crunch prepare_thread_delete - for irq_node[Finalise_AI_assms,wp]: "\s. P (interrupt_irq_node s)" + for irq_node[Arch_assms,wp]: "\s. P (interrupt_irq_node s)" (wp: crunch_wps simp: crunch_simps) crunch arch_finalise_cap @@ -1671,7 +1673,7 @@ crunch prepare_thread_delete for invs[wp]: invs (ignore: set_object) -lemma (* finalise_cap_invs *)[Finalise_AI_assms]: +lemma (* finalise_cap_invs *)[Arch_assms]: shows "\invs and cte_wp_at ((=) cap) slot\ finalise_cap cap x \\rv. invs\" apply (cases cap, simp_all split del: if_split) apply (wp cancel_all_ipc_invs cancel_all_signals_invs unbind_notification_invs @@ -1688,16 +1690,16 @@ lemma (* finalise_cap_invs *)[Finalise_AI_assms]: apply (auto dest: cte_wp_at_valid_objs_valid_cap) done -lemma (* finalise_cap_irq_node *)[Finalise_AI_assms]: +lemma (* finalise_cap_irq_node *)[Arch_assms]: "\\s. P (interrupt_irq_node s)\ finalise_cap a b \\_ s. P (interrupt_irq_node s)\" apply (case_tac a,simp_all) apply (wp | clarsimp)+ done -lemmas (*arch_finalise_cte_irq_node *) [wp,Finalise_AI_assms] +lemmas (*arch_finalise_cte_irq_node *) [wp,Arch_assms] = hoare_use_eq_irq_node [OF arch_finalise_cap_irq_node arch_finalise_cap_cte_wp_at] -lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: +lemma (* deleting_irq_handler_st_tcb_at *) [Arch_assms]: "\st_tcb_at P t and K (\st. simple st \ P st)\ deleting_irq_handler irq \\rv. st_tcb_at P t\" @@ -1706,11 +1708,11 @@ lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: apply simp done -lemma irq_node_global_refs_ARCH [Finalise_AI_assms]: +lemma irq_node_global_refs_ARCH [Arch_assms]: "interrupt_irq_node s irq \ global_refs s" by (simp add: global_refs_def) -lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: +lemma (* get_irq_slot_fast_finalisable *)[wp,Arch_assms]: "\invs\ get_irq_slot irq \cte_wp_at can_fast_finalise\" apply (simp add: get_irq_slot_def) apply wp @@ -1732,12 +1734,12 @@ lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: apply (clarsimp simp: cap_range_def) done -lemma (* replaceable_or_arch_update_same *) [Finalise_AI_assms]: +lemma (* replaceable_or_arch_update_same *) [Arch_assms]: "replaceable_or_arch_update s slot cap cap" by (clarsimp simp: replaceable_or_arch_update_def replaceable_def is_arch_update_def is_cap_simps) -lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: +lemma (* replace_cap_invs_arch_update *)[Arch_assms]: "\\s. cte_wp_at (replaceable_or_arch_update s p cap) p s \ invs s \ cap \ cap.NullCap @@ -1755,7 +1757,7 @@ lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: apply simp done -lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: +lemma dmo_tcb_cap_valid_ARCH [Arch_assms]: "\\s. P (tcb_cap_valid cap ptr s)\ do_machine_op mop \\_ s. P (tcb_cap_valid cap ptr s)\" apply (simp add: tcb_cap_valid_def no_cap_to_obj_with_diff_ref_def) apply (rule hoare_pre) @@ -1764,7 +1766,7 @@ lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: apply simp done -lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: +lemma (* dmo_replaceable_or_arch_update *) [Arch_assms,wp]: "\\s. replaceable_or_arch_update s slot cap cap'\ do_machine_op mo \\r s. replaceable_or_arch_update s slot cap cap'\" @@ -1776,6 +1778,8 @@ lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: apply auto done +lemmas Finalise_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end arch_requalify_consts replaceable_or_arch_update @@ -1783,8 +1787,7 @@ arch_requalify_consts replaceable_or_arch_update interpretation Finalise_AI_3?: Finalise_AI_3 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Finalise_AI_3_assms)?) qed context Arch begin arch_global_naming @@ -1801,8 +1804,7 @@ end interpretation Finalise_AI_4?: Finalise_AI_4 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -2094,10 +2096,10 @@ lemma arch_finalise_cap_valid_cap [wp]: apply (wp | wpc | clarsimp simp: split: arch_cap.split option.split bool.split | safe)+ done -lemmas clearMemory_invs [wp,Finalise_AI_assms] +lemmas clearMemory_invs [wp,Arch_assms] = clearMemory_invs -lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: +lemma valid_idle_has_null_cap_ARCH[Arch_assms]: "\ if_unsafe_then_cap s; valid_global_refs s; valid_idle s; valid_irq_node s\ \ caps_of_state s (idle_thread s, v) = Some cap \ cap = NullCap" @@ -2113,7 +2115,7 @@ lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: apply (drule_tac x=word in spec, simp) done -lemma (* zombie_cap_two_nonidles *)[Finalise_AI_assms]: +lemma (* zombie_cap_two_nonidles *)[Arch_assms]: "\ caps_of_state s ptr = Some (Zombie ptr' zbits n); invs s \ \ fst ptr \ idle_thread s \ ptr' \ idle_thread s" apply (frule valid_global_refsD2, clarsimp+) @@ -2129,13 +2131,14 @@ lemma arch_derive_cap_notIRQ[wp]: "\\\ arch_derive_cap cap \\rv s. rv \ cap.IRQControlCap\,-" by (cases cap; wpsimp simp: arch_derive_cap_def o_def) +lemmas Finalise_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_5?: Finalise_AI_5 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Finalise_AI_5_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchInterruptAcc_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchInterruptAcc_AI.thy index 2611c46441..fd3791f8c5 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchInterruptAcc_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchInterruptAcc_AI.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems InterruptAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InterruptAcc_AI locale *) -lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: +lemma dmo_maskInterrupt_invs [Arch_assms]: "\all_invs_but_valid_irq_states_for irq and (\s. state = interrupt_states s irq)\ do_machine_op (maskInterrupt (state = IRQInactive) irq) \\rv. invs\" @@ -32,12 +32,13 @@ lemma handle_spurious_irq_invs: apply (clarsimp simp add: machine_op_lift_def machine_rest_lift_def in_monad select_f_def) done +lemmas InterruptAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation InterruptAcc_AI?: InterruptAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact InterruptAcc_AI_assms) + case 1 show ?case by (unfold_locales; fact ARM_HYP.InterruptAcc_AI_assms) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchInterrupt_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchInterrupt_AI.thy index d9d69b55be..5be02f248c 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchInterrupt_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchInterrupt_AI.thy @@ -28,16 +28,16 @@ primrec arch_irq_control_inv_valid_real :: defs arch_irq_control_inv_valid_def: "arch_irq_control_inv_valid \ arch_irq_control_inv_valid_real" -named_theorems Interrupt_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_AI locale *) -lemma (* decode_irq_control_invocation_inv *)[Interrupt_AI_assms]: +lemma (* decode_irq_control_invocation_inv *)[Arch_assms]: "\P\ decode_irq_control_invocation label args slot caps \\rv. P\" apply (simp add: decode_irq_control_invocation_def Let_def arch_check_irq_def range_check_def arch_decode_irq_control_invocation_def whenE_def, safe) apply (wp | simp)+ done -lemma decode_irq_control_valid [Interrupt_AI_assms]: +lemma decode_irq_control_valid [Arch_assms]: "\\s. invs s \ (\cap \ set caps. s \ cap) \ (\cap \ set caps. is_cnode_cap cap \ (\r \ cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -54,7 +54,7 @@ lemma decode_irq_control_valid [Interrupt_AI_assms]: apply (cases caps ; fastforce simp: cte_wp_at_eq_simp maxIRQ_def) done -lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: +lemma get_irq_slot_different_ARCH[Arch_assms]: "\\s. valid_global_refs s \ ex_cte_cap_wp_to is_cnode_cap ptr s\ get_irq_slot irq \\rv s. rv \ ptr\" @@ -66,7 +66,7 @@ lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: apply (clarsimp simp: global_refs_def is_cap_simps cap_range_def) done -lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: +lemma is_derived_use_interrupt_ARCH[Arch_assms]: "(is_ntfn_cap cap \ interrupt_derived cap cap') \ (is_derived m p cap cap')" apply (clarsimp simp: is_cap_simps) apply (clarsimp simp: interrupt_derived_def is_derived_def) @@ -74,15 +74,15 @@ lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: apply (simp add: is_cap_simps is_pt_cap_def vs_cap_ref_def) done -lemmas maskInterrupt_invs_ARCH[Interrupt_AI_assms] = maskInterrupt_invs +lemmas maskInterrupt_invs_ARCH[Arch_assms] = maskInterrupt_invs -lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Interrupt_AI_assms]: +lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Arch_assms]: "no_cap_to_obj_with_diff_ref (IRQHandlerCap irq) S = \" by (rule ext, simp add: no_cap_to_obj_with_diff_ref_def cte_wp_at_caps_of_state obj_ref_none_no_asid) -lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: +lemma (* set_irq_state_valid_cap *)[Arch_assms]: "\valid_cap cap\ set_irq_state IRQSignal irq \\rv. valid_cap cap\" apply (clarsimp simp: set_irq_state_def) apply (wp do_machine_op_valid_cap) @@ -92,7 +92,7 @@ lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: done crunch set_irq_state - for valid_global_refs[Interrupt_AI_assms]: "valid_global_refs" + for valid_global_refs[Arch_assms]: "valid_global_refs" crunch arch_invoke_irq_handler for typ_at[wp]: "\s. P (typ_at T p s)" @@ -106,7 +106,7 @@ lemma deactivateInterrupt_invs: by (cases config_ARM_GIC_V3; simp) (wpsimp wp: maskInterrupt_invs_ARCH) -lemma invoke_irq_handler_invs'[Interrupt_AI_assms]: +lemma invoke_irq_handler_invs'[Arch_assms]: assumes dmo_ex_inv[wp]: "\f. \invs and ex_inv\ do_machine_op f \\rv::unit. ex_inv\" assumes cap_insert_ex_inv[wp]: "\cap src dest. \ex_inv and invs and K (src \ dest)\ @@ -177,7 +177,7 @@ lemma valid_cap_SGISignalCap[simp, intro!]: unfolding valid_cap_def by (clarsimp simp: cap_aligned_def word_bits_def) -lemma invoke_irq_control_invs[Interrupt_AI_assms]: +lemma invoke_irq_control_invs[Arch_assms]: "\invs and irq_control_inv_valid i\ invoke_irq_control i \\rv. invs\" apply (cases i; simp) apply (wp cap_insert_simple_invs @@ -208,7 +208,7 @@ lemma invoke_irq_control_invs[Interrupt_AI_assms]: crunch resetTimer for device_state_inv[wp]: "\ms. P (device_state ms)" -lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: +lemma resetTimer_invs_ARCH[Arch_assms]: "\invs\ do_machine_op resetTimer \\_. invs\" apply (wp dmo_invs) apply safe @@ -221,11 +221,11 @@ lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: apply(erule use_valid, wp no_irq_resetTimer no_irq, assumption) done -lemma empty_fail_ackInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_ackInterrupt_ARCH[Arch_assms]: "empty_fail (ackInterrupt irq)" by (wp | simp add: ackInterrupt_def)+ -lemma empty_fail_maskInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_maskInterrupt_ARCH[Arch_assms]: "empty_fail (maskInterrupt f irq)" by (wp | simp add: maskInterrupt_def)+ @@ -292,7 +292,7 @@ crunch timer_tick for invs[wp]: invs (wp: thread_set_invs_trivial[OF ball_tcb_cap_casesI]) -lemma handle_interrupt_invs[Interrupt_AI_assms]: +lemma handle_interrupt_invs[Arch_assms]: "\invs\ handle_interrupt irq \\_. invs\" apply (simp add: handle_interrupt_def) apply (rule conjI; rule impI) @@ -309,7 +309,7 @@ lemma handle_interrupt_invs[Interrupt_AI_assms]: | rule conjI)+ done -lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: +lemma sts_arch_irq_control_inv_valid[wp, Arch_assms]: "\arch_irq_control_inv_valid i\ set_thread_state t st \\rv. arch_irq_control_inv_valid i\" @@ -319,12 +319,13 @@ lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: apply (wp ex_cte_cap_to_pres | simp add: cap_table_at_typ)+ done +lemmas Interrupt_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Interrupt_AI?: Interrupt_AI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: Interrupt_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: ARM_HYP.Interrupt_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchInvariants_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchInvariants_AI.thy index 8ea7ad6ac0..a2d799b68a 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchInvariants_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchInvariants_AI.thy @@ -31,6 +31,10 @@ end_qualify context Arch begin arch_global_naming +(* used to accumulate theorems for satisfying Arch interface assumptions; + remember to clear before starting a new accumulation *) +named_theorems Arch_assms + definition arch_tcb_to_iarch_tcb :: "arch_tcb \ iarch_tcb" where diff --git a/proof/invariant-abstract/ARM_HYP/ArchIpcCancel_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchIpcCancel_AI.thy index 1a33884511..9eb7e91422 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchIpcCancel_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchIpcCancel_AI.thy @@ -10,19 +10,20 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_AI locale *) crunch arch_post_cap_deletion - for typ_at[wp, IpcCancel_AI_assms]: "\s. P (typ_at T p s)" - and idle_thread[wp, IpcCancel_AI_assms]: "\s. P (idle_thread s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + +lemmas IpcCancel_AI_assms = Arch_assms (* extract accumulated assumptions *) end interpretation IpcCancel_AI?: IpcCancel_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact IpcCancel_AI_assms)?) + by (intro_locales; (unfold_locales; fact ARM_HYP.IpcCancel_AI_assms)?) qed diff --git a/proof/invariant-abstract/ARM_HYP/ArchIpc_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchIpc_AI.thy index fb2664ab17..1e9e79c36f 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchIpc_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchIpc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_AI_1_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_1 locale *) lemma cap_asid_PageCap_None [simp]: "cap_asid (ArchObjectCap (PageCap dev r R pgsz None)) = None" @@ -36,7 +36,7 @@ lemma arch_derive_cap_is_derived: | rule conjI)+) done -lemma derive_cap_is_derived [Ipc_AI_1_assms]: +lemma derive_cap_is_derived [Arch_assms]: "\\s. c'\ cap.NullCap \ cte_wp_at (\cap. cap_master_cap cap = cap_master_cap c' \ (cap_badge cap, cap_badge c') \ capBadge_ordering False \ cap_asid cap = cap_asid c' @@ -62,23 +62,24 @@ lemma derive_cap_is_derived [Ipc_AI_1_assms]: apply(clarsimp simp: valid_cap_def) done -lemma arch_cap_badge_rights_update[Ipc_AI_1_assms, simp]: +lemma arch_cap_badge_rights_update[Arch_assms, simp]: "arch_cap_badge (acap_rights_update rights acap) = arch_cap_badge acap" by simp +lemmas Ipc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_1_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.Ipc_AI_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_2 locale *) -lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights [simp, Arch_assms]: "is_derived m p (cap_rights_update R c) = is_derived m p c" apply (rule ext) apply (simp add: cap_rights_update_def is_derived_def is_cap_simps) @@ -90,12 +91,12 @@ lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: split: arch_cap.split cap.split bool.splits) -lemma data_to_message_info_valid [Ipc_AI_2_assms]: +lemma data_to_message_info_valid [Arch_assms]: "valid_message_info (data_to_message_info w)" by (simp add: valid_message_info_def data_to_message_info_def word_and_le1 msg_max_length_def msg_max_extra_caps_def Let_def not_less mask_def) -lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: +lemma get_extra_cptrs_length[wp, Arch_assms]: "\\s . valid_message_info mi\ get_extra_cptrs buf mi \\rv s. length rv \ msg_max_extra_caps\" @@ -110,18 +111,18 @@ lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: intro: length_upt) done -lemma cap_asid_rights_update [simp, Ipc_AI_2_assms]: +lemma cap_asid_rights_update [simp, Arch_assms]: "cap_asid (cap_rights_update R c) = cap_asid c" apply (simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits) done -lemma cap_rights_update_vs_cap_ref[simp, Ipc_AI_2_assms]: +lemma cap_rights_update_vs_cap_ref[simp, Arch_assms]: "vs_cap_ref (cap_rights_update rs cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) -lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights2[simp, Arch_assms]: "is_derived m p c (cap_rights_update R c') = is_derived m p c c'" apply (case_tac c') apply (simp_all add:cap_rights_update_def) @@ -131,12 +132,12 @@ lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: apply (case_tac acap1) by (auto simp: acap_rights_update_def) -lemma cap_range_update [simp, Ipc_AI_2_assms]: +lemma cap_range_update [simp, Arch_assms]: "cap_range (cap_rights_update R cap) = cap_range cap" by (simp add: cap_range_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits) -lemma derive_cap_idle[wp, Ipc_AI_2_assms]: +lemma derive_cap_idle[wp, Arch_assms]: "\\s. global_refs s \ cap_range cap = {}\ derive_cap slot cap \\c s. global_refs s \ cap_range c = {}\, -" @@ -148,7 +149,7 @@ lemma derive_cap_idle[wp, Ipc_AI_2_assms]: apply (case_tac arch_cap, simp_all) done -lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: +lemma arch_derive_cap_objrefs_iszombie [Arch_assms]: "\\s . P (set_option (aobj_ref cap)) False s\ arch_derive_cap cap \\rv s. rv \ NullCap \ P (obj_refs rv) (is_zombie rv) s\,-" @@ -156,7 +157,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: apply(rule hoare_pre, wpsimp+)+ done -lemma obj_refs_remove_rights[simp, Ipc_AI_2_assms]: +lemma obj_refs_remove_rights[simp, Arch_assms]: "obj_refs (remove_rights rs cap) = obj_refs cap" by (auto simp add: remove_rights_def cap_rights_update_def acap_rights_update_def @@ -171,7 +172,7 @@ lemma storeWord_um_inv: apply simp done -lemma store_word_offs_vms[wp, Ipc_AI_2_assms]: +lemma store_word_offs_vms[wp, Arch_assms]: "\valid_machine_state\ store_word_offs ptr offs v \\_. valid_machine_state\" proof - have aligned_offset_ignore: @@ -210,12 +211,12 @@ proof - done qed -lemma is_zombie_update_cap_data[simp, Ipc_AI_2_assms]: +lemma is_zombie_update_cap_data[simp, Arch_assms]: "is_zombie (update_cap_data P data cap) = is_zombie cap" by (simp add: update_cap_data_closedform arch_update_cap_data_def is_zombie_def split: cap.splits) -lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: +lemma valid_msg_length_strengthen [Arch_assms]: "valid_message_info mi \ unat (mi_length mi) \ msg_max_length" apply (clarsimp simp: valid_message_info_def) apply (subgoal_tac "unat (mi_length mi) \ unat (of_nat msg_max_length :: word32)") @@ -223,7 +224,7 @@ lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: apply (clarsimp simp: un_ui_le word_le_def) done -lemma copy_mrs_in_user_frame[wp, Ipc_AI_2_assms]: +lemma copy_mrs_in_user_frame[wp, Arch_assms]: "\in_user_frame p\ copy_mrs t buf t' buf' n \\rv. in_user_frame p\" by (simp add: in_user_frame_def) (wp hoare_vcg_ex_lift) @@ -231,7 +232,7 @@ lemma as_user_getRestart_inv[wp]: "as_user t getRestartPC \P\" by (simp add: getRestartPC_def, rule user_getreg_inv) -lemma make_arch_fault_msg_inv[wp, Ipc_AI_2_assms]: +lemma make_arch_fault_msg_inv[wp, Arch_assms]: "make_arch_fault_msg ft t \P\" by (cases ft; wpsimp) @@ -239,14 +240,14 @@ lemma make_fault_msg_inv[wp]: "make_fault_msg ft t \P\" by (cases ft; wpsimp wp: as_user_inv getRestartPC_inv mapM_wp' split_del: if_split) -lemma do_fault_transfer_invs[wp, Ipc_AI_2_assms]: +lemma do_fault_transfer_invs[wp, Arch_assms]: "\invs and tcb_at receiver\ do_fault_transfer badge sender receiver recv_buf \\rv. invs\" by (simp add: do_fault_transfer_def split_def | wp | clarsimp split: option.split)+ -lemma lookup_ipc_buffer_in_user_frame[wp, Ipc_AI_2_assms]: +lemma lookup_ipc_buffer_in_user_frame[wp, Arch_assms]: "\valid_objs and tcb_at t\ lookup_ipc_buffer b t \case_option (\_. True) in_user_frame\" apply (simp add: lookup_ipc_buffer_def) @@ -349,9 +350,9 @@ lemma transfer_caps_non_null_cte_wp_at: done crunch do_fault_transfer - for cte_wp_at[wp,Ipc_AI_2_assms]: "cte_wp_at P p" + for cte_wp_at[wp,Arch_assms]: "cte_wp_at P p" -lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: +lemma do_normal_transfer_non_null_cte_wp_at [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at (P and ((\) cap.NullCap)) ptr\ do_normal_transfer st send_buffer ep b gr rt recv_buffer @@ -362,7 +363,7 @@ lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: | clarsimp simp:imp)+ done -lemma is_derived_ReplyCap [simp, Ipc_AI_2_assms]: +lemma is_derived_ReplyCap [simp, Arch_assms]: "\m p R. is_derived m p (cap.ReplyCap t False R) = (\c. is_master_reply_cap c \ obj_ref_of c = t)" apply (subst fun_eq_iff) apply clarsimp @@ -383,7 +384,7 @@ lemma do_normal_transfer_tcb_caps: | simp add:imp)+ done -lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: +lemma do_ipc_transfer_tcb_caps [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at P (t, ref) and tcb_at t\ @@ -395,7 +396,7 @@ lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: | wpc | simp add:imp)+ done -lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: +lemma setup_caller_cap_valid_global_objs[wp, Arch_assms]: "\valid_global_objs\ setup_caller_cap send recv grant \\rv. valid_global_objs\" apply (simp add: valid_global_objs_def) unfolding setup_caller_cap_def @@ -403,9 +404,9 @@ lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: done crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for typ_at[Ipc_AI_2_assms]: "P (typ_at T p s)" + for typ_at[Arch_assms]: "P (typ_at T p s)" -lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_vspace_objs[wp, Arch_assms]: "\valid_vspace_objs\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_vspace_objs\" @@ -439,11 +440,11 @@ lemma setup_caller_cap_aobj_at: unfolding setup_caller_cap_def by (wpsimp wp: cap_insert_aobj_at sts.aobj_at) -lemma setup_caller_cap_valid_arch[Ipc_AI_2_assms, wp]: +lemma setup_caller_cap_valid_arch[Arch_assms, wp]: "setup_caller_cap st rt grant \valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps[rotated -1] setup_caller_cap_tcb_at setup_caller_cap_aobj_at) -lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_arch[Arch_assms]: "\slots caps ep buffer n mi. \valid_arch_state and valid_objs and valid_mdb and K (distinct slots) and (\s. \x \ set slots. real_cte_at x s \ cte_wp_at (\cap. cap = cap.NullCap) x s) @@ -452,17 +453,18 @@ lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps transfer_caps_loop_typ_ats transfer_caps_loop_aobj_at) +lemmas Ipc_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_2_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.Ipc_AI_2_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_3 locale *) lemma dmo_addressTranslateS1_pspace_respects_device_region[wp]: "do_machine_op (addressTranslateS1 pc) \pspace_respects_device_region\" @@ -473,10 +475,10 @@ crunch make_fault_msg (wp: as_user_inv getRestartPC_inv mapM_wp' simp: getRegister_def ignore: do_machine_op) crunch do_ipc_transfer - for pspace_respects_device_region[wp, Ipc_AI_3_assms]: "pspace_respects_device_region" + for pspace_respects_device_region[wp, Arch_assms]: "pspace_respects_device_region" (wp: crunch_wps ignore: const_on_failure simp: crunch_simps) -lemma do_ipc_transfer_respects_device_region[Ipc_AI_3_assms]: +lemma do_ipc_transfer_respects_device_region[Arch_assms]: "\cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\ do_ipc_transfer t ep bg grt r \\rv. cap_refs_respects_device_region\" @@ -494,7 +496,7 @@ lemma set_mrs_state_hyp_refs_of[wp]: by (wp set_mrs_thread_set_dmo thread_set_hyp_refs_trivial | simp)+ crunch do_ipc_transfer - for state_hyp_refs_of[wp, Ipc_AI_3_assms]: "\ s. P (state_hyp_refs_of s)" + for state_hyp_refs_of[wp, Arch_assms]: "\ s. P (state_hyp_refs_of s)" (wp: crunch_wps simp: zipWithM_x_mapM) lemma arch_derive_cap_untyped: @@ -513,18 +515,19 @@ lemma valid_arch_mdb_cap_swap: ((caps_of_state s)(a \ c', b \ c))" by auto -lemma do_ipc_transfer_valid_arch[Ipc_AI_3_assms]: +lemma do_ipc_transfer_valid_arch[Arch_assms]: "\valid_arch_state and valid_objs and valid_mdb \ do_ipc_transfer s ep bg grt r \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps dit_tcb_at do_ipc_transfer_aobj_at) +lemmas Ipc_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales;(fact Ipc_AI_3_assms)?) + case 1 show ?case by (unfold_locales;(fact ARM_HYP.Ipc_AI_3_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchRetype_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchRetype_AI.thy index 528198a3d2..64bcfffd74 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchRetype_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchRetype_AI.thy @@ -15,19 +15,19 @@ begin context Arch begin arch_global_naming -named_theorems Retype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_AI locale *) -lemma arch_kobj_size_cong[Retype_AI_assms]: +lemma arch_kobj_size_cong[Arch_assms]: "\a = a1; c=c1\ \ arch_kobj_size (default_arch_object a b c) = arch_kobj_size (default_arch_object a1 b1 c1)" by (simp add: default_arch_object_def split: aobject_type.splits) -lemma clearMemoryVM_return[simp, Retype_AI_assms]: +lemma clearMemoryVM_return[simp, Arch_assms]: "clearMemoryVM a b = return ()" by (simp add: clearMemoryVM_def) -lemma slot_bits_def2 [Retype_AI_assms]: "slot_bits = cte_level_bits" +lemma slot_bits_def2 [Arch_assms]: "slot_bits = cte_level_bits" by (simp add: slot_bits_def cte_level_bits_def) definition @@ -35,7 +35,7 @@ definition ArchObject SmallPageObj, ArchObject LargePageObj, ArchObject SectionObj, ArchObject SuperSectionObj}" -lemma no_gs_types_simps [simp, Retype_AI_assms]: +lemma no_gs_types_simps [simp, Arch_assms]: "Untyped \ no_gs_types" "TCBObject \ no_gs_types" "EndpointObject \ no_gs_types" @@ -45,7 +45,7 @@ lemma no_gs_types_simps [simp, Retype_AI_assms]: "ArchObject ASIDPoolObj \ no_gs_types" by (simp_all add: no_gs_types_def) -lemma retype_region_ret_folded [Retype_AI_assms]: +lemma retype_region_ret_folded [Arch_assms]: "\\\ retype_region y n bits ty dev \\r s. r = retype_addrs y ty n bits\" unfolding retype_region_def @@ -377,7 +377,7 @@ lemma mapM_copy_global_invs_mappings_restricted: done -lemma dmo_eq_kernel_restricted [wp, Retype_AI_assms]: +lemma dmo_eq_kernel_restricted [wp, Arch_assms]: "\\s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\ do_machine_op m \\rv s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\" @@ -441,7 +441,7 @@ lemma init_arch_objects_invs_from_restricted: done -lemma obj_bits_api_neq_0 [Retype_AI_assms]: +lemma obj_bits_api_neq_0 [Arch_assms]: "ty \ Untyped \ 0 < obj_bits_api ty us" unfolding obj_bits_api_def by (clarsimp simp: slot_bits_def default_arch_object_def vspace_bits_defs vcpu_bits_def @@ -475,19 +475,20 @@ lemma vs_lookup_pages_sub2: apply (rule table) done +lemmas Retype_AI_slot_bits_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_slot_bits?: Retype_AI_slot_bits proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact ARM_HYP.Retype_AI_slot_bits_assms) qed context Arch begin arch_global_naming -lemma valid_untyped_helper [Retype_AI_assms]: +lemma valid_untyped_helper [Arch_assms]: assumes valid_c : "s \ c" and cte_at : "cte_wp_at ((=) c) q s" and tyunt: "ty \ Untyped" @@ -561,13 +562,14 @@ lemma valid_default_arch_tcb: "\s. valid_arch_tcb default_arch_tcb s" by (simp add: default_arch_tcb_def valid_arch_tcb_def) +lemmas Retype_AI_valid_untyped_helper_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_valid_untyped_helper?: Retype_AI_valid_untyped_helper proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact ARM_HYP.Retype_AI_valid_untyped_helper_assms) qed @@ -576,11 +578,7 @@ locale retype_region_proofs_arch + Arch for s :: "'state_ext :: state_ext state" and ty us ptr sz n ps s' dev - - -context retype_region_proofs begin - -interpretation Arch . +begin lemma valid_cap: assumes cap: @@ -677,7 +675,7 @@ lemma hyp_refs_eq: split: aobject_type.splits) done -lemma wellformed_default_obj[Retype_AI_assms]: +lemma wellformed_default_obj[Arch_assms]: "\ ptra \ set (retype_addrs ptr ty n us); kheap s ptra = Some (ArchObj x5); arch_valid_obj x5 s\ \ arch_valid_obj x5 s'" @@ -686,11 +684,6 @@ lemma wellformed_default_obj[Retype_AI_assms]: split: arch_kernel_obj.splits option.splits) done -end - - -context retype_region_proofs_arch begin - lemma obj_at_valid_pte: "\valid_pte pte s; \P p. obj_at P p s \ obj_at P p s'\ \ valid_pte pte s'" @@ -1073,9 +1066,7 @@ end context Arch begin arch_global_naming -named_theorems Retype_AI_assms' - -lemma invs_post_retype_invs [Retype_AI_assms']: +lemma invs_post_retype_invs [Arch_assms]: "invs s \ post_retype_invs ty refs s" apply (clarsimp simp: post_retype_invs_def invs_def valid_state_def) apply (clarsimp simp: equal_kernel_mappings_def obj_at_def @@ -1085,9 +1076,11 @@ lemma invs_post_retype_invs [Retype_AI_assms']: lemmas equal_kernel_mappings_trans_state = more_update.equal_kernel_mappings_update -lemmas retype_region_proofs_assms [Retype_AI_assms'] +lemmas retype_region_proofs_assms [Arch_assms] = retype_region_proofs.post_retype_invs_axioms +lemmas Retype_AI_assms' = Arch_assms (* extract accumulated assumptions *) + end @@ -1097,10 +1090,9 @@ global_interpretation Retype_AI?: Retype_AI and post_retype_invs = post_retype_invs and region_in_kernel_window = region_in_kernel_window proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Retype_AI_assms)?) - (simp add: Retype_AI_axioms_def Retype_AI_assms') + by (intro_locales; (unfold_locales; fact ARM_HYP.Retype_AI_assms')?) + (simp add: Retype_AI_axioms_def ARM_HYP.Retype_AI_assms') qed diff --git a/proof/invariant-abstract/ARM_HYP/ArchSchedule_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchSchedule_AI.thy index c32752933a..5756e15b13 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchSchedule_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchSchedule_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_AI locale *) -lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]: +lemma dmo_mapM_storeWord_0_invs[wp,Arch_assms]: "valid invs (do_machine_op (mapM (\p. storeWord p 0) S)) (\_. invs)" apply (simp add: dom_mapM ef_storeWord) apply (rule mapM_UNIV_wp) @@ -39,17 +39,17 @@ lemma clearExMonitor_invs [wp]: machine_rest_lift_def in_monad select_f_def) done -lemma arch_stt_invs [wp,Schedule_AI_assms]: +lemma arch_stt_invs [wp,Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_switch_to_thread t \\_. invs\" apply (wpsimp simp: arch_switch_to_thread_def) by (rule sym_refs_VCPU_hyp_live; fastforce) -lemma arch_stt_tcb [wp,Schedule_AI_assms]: +lemma arch_stt_tcb [wp,Arch_assms]: "\tcb_at t'\ arch_switch_to_thread t' \\_. tcb_at t'\" by (wpsimp simp: arch_switch_to_thread_def wp: tcb_at_typ_at) -lemma arch_stt_st_tcb_at[Schedule_AI_assms]: +lemma arch_stt_st_tcb_at[Arch_assms]: "arch_switch_to_thread t \st_tcb_at Q t\" by (wpsimp simp: arch_switch_to_thread_def) @@ -69,7 +69,7 @@ crunch and ct[wp]: "\s. P (cur_thread s)" (wp: mapM_x_wp mapM_wp subset_refl) -lemma arch_stit_invs[wp, Schedule_AI_assms]: +lemma arch_stit_invs[wp, Arch_assms]: "\invs\ arch_switch_to_idle_thread \\r. invs\" by (wpsimp wp: svr_invs simp: arch_switch_to_idle_thread_def) @@ -84,19 +84,19 @@ crunch set_vm_root and it[wp]: "\s. P (idle_thread s)" (simp: crunch_simps wp: hoare_drop_imps) -lemma arch_stit_activatable[wp, Schedule_AI_assms]: +lemma arch_stit_activatable[wp, Arch_assms]: "\ct_in_state activatable\ arch_switch_to_idle_thread \\rv . ct_in_state activatable\" apply (clarsimp simp: arch_switch_to_idle_thread_def) apply (wpsimp simp: ct_in_state_def wp: ct_in_state_thread_state_lift) done -lemma stit_invs [wp,Schedule_AI_assms]: +lemma stit_invs [wp,Arch_assms]: "\invs\ switch_to_idle_thread \\rv. invs\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wpsimp|strengthen idle_strg)+ done -lemma stit_activatable[Schedule_AI_assms]: +lemma stit_activatable[Arch_assms]: "\invs\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wp | simp add: ct_in_state_def)+ @@ -108,7 +108,7 @@ crunch set_vm_root, vcpu_switch for scheduler_action[wp]: "\s. P (scheduler_action s)" (wp: crunch_wps simp: crunch_simps) -lemma arch_stt_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stt_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_thread t' \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_thread_def) @@ -118,24 +118,25 @@ lemma vcpu_invalidate_active_invs[wp]: by (wpsimp simp: cur_vcpu_at_def | strengthen invs_current_vcpu_update')+ crunch arch_prepare_next_domain - for ct[wp, Schedule_AI_assms]: "\s. P (cur_thread s)" - and activatable[wp, Schedule_AI_assms]: "ct_in_state activatable" - and st_tcb_at[wp, Schedule_AI_assms]: "\s. P (st_tcb_at Q t s)" - and valid_idle[wp, Schedule_AI_assms]: valid_idle - and invs[wp, Schedule_AI_assms]: invs + for ct[wp, Arch_assms]: "\s. P (cur_thread s)" + and activatable[wp, Arch_assms]: "ct_in_state activatable" + and st_tcb_at[wp, Arch_assms]: "\s. P (st_tcb_at Q t s)" + and valid_idle[wp, Arch_assms]: valid_idle + and invs[wp, Arch_assms]: invs (wp: crunch_wps ct_in_state_thread_state_lift) -lemma arch_stit_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stit_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_idle_thread \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_idle_thread_def) +lemmas Schedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Schedule_AI?: Schedule_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; unfold_locales; (fact Schedule_AI_assms)?) + by (intro_locales; unfold_locales; (fact ARM_HYP.Schedule_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy index 38520cf627..f81ad7cf76 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchSyscall_AI.thy @@ -15,45 +15,45 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_AI locale *) -declare arch_get_sanitise_register_info_invs[Syscall_AI_assms] - arch_get_sanitise_register_info_ex_nonz_cap_to[Syscall_AI_assms] - make_fault_msg_inv[Syscall_AI_assms] +declare arch_get_sanitise_register_info_invs[Arch_assms] + arch_get_sanitise_register_info_ex_nonz_cap_to[Arch_assms] + make_fault_msg_inv[Arch_assms] crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for pred_tcb_at[wp,Syscall_AI_assms]: "pred_tcb_at proj P t" + for pred_tcb_at[wp,Arch_assms]: "pred_tcb_at proj P t" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for invs[wp,Syscall_AI_assms]: "invs" + for invs[wp,Arch_assms]: "invs" crunch handle_arch_fault_reply - for cap_to[wp,Syscall_AI_assms]: "ex_nonz_cap_to c" + for cap_to[wp,Arch_assms]: "ex_nonz_cap_to c" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for it[wp,Syscall_AI_assms]: "\s. P (idle_thread s)" + for it[wp,Arch_assms]: "\s. P (idle_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for caps[wp,Syscall_AI_assms]: "\s. P (caps_of_state s)" + for caps[wp,Arch_assms]: "\s. P (caps_of_state s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cur_thread[wp,Syscall_AI_assms]: "\s. P (cur_thread s)" + for cur_thread[wp,Arch_assms]: "\s. P (cur_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for valid_objs[wp,Syscall_AI_assms]: "valid_objs" + for valid_objs[wp,Arch_assms]: "valid_objs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cte_wp_at[wp,Syscall_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" crunch invoke_irq_control, arch_get_sanitise_register_info - for typ_at[wp, Syscall_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" -lemma obj_refs_cap_rights_update[simp, Syscall_AI_assms]: +lemma obj_refs_cap_rights_update[simp, Arch_assms]: "obj_refs (cap_rights_update rs cap) = obj_refs cap" by (simp add: cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) (* FIXME: move to TCB *) -lemma table_cap_ref_mask_cap [Syscall_AI_assms]: +lemma table_cap_ref_mask_cap [Arch_assms]: "table_cap_ref (mask_cap R cap) = table_cap_ref cap" by (clarsimp simp add:mask_cap_def table_cap_ref_def acap_rights_update_def cap_rights_update_def arch_cap_fun_lift_def split:cap.splits arch_cap.splits) -lemma eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: +lemma eq_no_cap_to_obj_with_diff_ref [Arch_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) @@ -88,43 +88,44 @@ lemma addressTranslateS1_invs[wp]: machine_op_lift_def select_f_def) done -lemma hv_invs[wp, Syscall_AI_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" +lemma hv_invs[wp, Arch_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" apply (cases flt, simp_all) apply (wp|simp)+ done -lemma handle_vm_fault_valid_fault[wp, Syscall_AI_assms]: +lemma handle_vm_fault_valid_fault[wp, Arch_assms]: "\\\ handle_vm_fault thread ft -,\\rv s. valid_fault rv\" apply (cases ft, simp_all) apply (wp no_irq_getDFSR no_irq_getIFSR| simp add: valid_fault_def)+ done -lemma hvmf_active [Syscall_AI_assms]: +lemma hvmf_active [Arch_assms]: "\st_tcb_at active t\ handle_vm_fault t w \\rv. st_tcb_at active t\" apply (cases w, simp_all) apply (wp | simp)+ done -lemma hvmf_ex_cap[wp, Syscall_AI_assms]: +lemma hvmf_ex_cap[wp, Arch_assms]: "\ex_nonz_cap_to p\ handle_vm_fault t b \\rv. ex_nonz_cap_to p\" apply (cases b, simp_all) apply (wp | simp)+ done -lemma hh_invs[wp, Syscall_AI_assms]: +lemma hh_invs[wp, Arch_assms]: "\invs and ct_active and st_tcb_at active thread and ex_nonz_cap_to thread\ handle_hypervisor_fault thread fault \\rv. invs\" by (cases fault; wpsimp simp: valid_fault_def) crunch make_fault_msg - for cur_thread[wp, Syscall_AI_assms]: "\s. P (cur_thread s)" + for cur_thread[wp, Arch_assms]: "\s. P (cur_thread s)" + +lemmas Syscall_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Syscall_AI?: Syscall_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Syscall_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.Syscall_AI_assms)?) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchTcbAcc_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchTcbAcc_AI.thy index ed351aab7e..ae8d2c6470 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchTcbAcc_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchTcbAcc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_AI locale *) lemmas cap_master_cap_simps = cap_master_cap_def[simplified cap_master_arch_cap_def, split_simps cap.split arch_cap.split] @@ -54,7 +54,7 @@ lemma cap_master_cap_tcb_cap_valid_arch: split: option.splits cap.splits arch_cap.splits Structures_A.thread_state.splits) -lemma storeWord_invs[wp, TcbAcc_AI_assms]: +lemma storeWord_invs[wp, Arch_assms]: "\in_user_frame p and invs\ do_machine_op (storeWord p w) \\rv. invs\" proof - have aligned_offset_ignore: @@ -81,13 +81,13 @@ proof - done qed -lemma valid_ipc_buffer_cap_0[simp, TcbAcc_AI_assms]: +lemma valid_ipc_buffer_cap_0[simp, Arch_assms]: "valid_ipc_buffer_cap cap a \ valid_ipc_buffer_cap cap 0" by (auto simp add: valid_ipc_buffer_cap_def case_bool_If split: cap.split arch_cap.split) -lemma thread_set_hyp_refs_trivial [TcbAcc_AI_assms]: +lemma thread_set_hyp_refs_trivial [Arch_assms]: assumes x: "\tcb. tcb_state (f tcb) = tcb_state tcb" assumes y: "\tcb. tcb_arch_ref (f tcb) = tcb_arch_ref tcb" shows "\\s. P (state_hyp_refs_of s)\ thread_set f t \\rv s. P (state_hyp_refs_of s)\" @@ -110,7 +110,7 @@ lemma mab_wb [simp]: unfolding msg_align_bits word_bits_conv by simp -lemma get_cap_valid_ipc [TcbAcc_AI_assms]: +lemma get_cap_valid_ipc [Arch_assms]: "\valid_objs and obj_at (\ko. \tcb. ko = TCB tcb \ tcb_ipc_buffer tcb = v) t\ get_cap (t, tcb_cnode_index 4) \\rv s. valid_ipc_buffer_cap rv v\" @@ -125,7 +125,7 @@ lemma get_cap_valid_ipc [TcbAcc_AI_assms]: -lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: +lemma pred_tcb_cap_wp_at [Arch_assms]: "\pred_tcb_at proj P t s; valid_objs s; ref \ dom tcb_cap_cases; \cap. (pred_tcb_at proj P t s \ tcb_cap_valid cap (t, ref) s) \ Q cap\ \ @@ -139,7 +139,7 @@ lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: apply fastforce+ done -lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: +lemma as_user_hyp_refs_of[wp, Arch_assms]: "\\s. P (state_hyp_refs_of s)\ as_user t m \\rv s. P (state_hyp_refs_of s)\" @@ -149,11 +149,11 @@ lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: lemmas sts_typ_ats = sts_typ_ats abs_atyp_at_lifts [OF set_thread_state_typ_at] -lemma arch_tcb_context_set_eq_ARM[TcbAcc_AI_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" +lemma arch_tcb_context_set_eq_ARM[Arch_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp -lemma arch_tcb_context_get_eq_ARM[TcbAcc_AI_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" +lemma arch_tcb_context_get_eq_ARM[Arch_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp @@ -161,17 +161,18 @@ lemma tcb_context_update_aux: "arch_tcb_context_set (P (arch_tcb_context_get atc = tcb_context_update (\ctx. P ctx) atcb" by (simp add: arch_tcb_context_set_def arch_tcb_context_get_def) -lemma thread_set_valid_arch_state[TcbAcc_AI_assms]: +lemma thread_set_valid_arch_state[Arch_assms]: "(\tcb. \(getF, v) \ ran tcb_cap_cases. getF (f tcb) = getF tcb) \ thread_set f t \ valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps thread_set_tcb thread_set.aobj_at) +lemmas TcbAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation TcbAcc_AI?: TcbAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact TcbAcc_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact ARM_HYP.TcbAcc_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/ARM_HYP/ArchTcb_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchTcb_AI.thy index adee4e0505..19898322f9 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchTcb_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchTcb_AI.thy @@ -10,17 +10,17 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_AI locale *) -lemma activate_idle_invs[Tcb_AI_assms]: +lemma activate_idle_invs[Arch_assms]: "\invs and ct_idle\ arch_activate_idle_thread thread \\rv. invs and ct_idle\" by (simp add: arch_activate_idle_thread_def) -lemma empty_fail_getRegister [intro!, simp, Tcb_AI_assms]: +lemma empty_fail_getRegister [intro!, simp, Arch_assms]: "empty_fail (getRegister r)" by (simp add: getRegister_def) @@ -37,7 +37,7 @@ lemma same_object_also_valid: (* arch specific *) split: cap.split_asm arch_cap.split_asm option.splits)+) done -lemma same_object_obj_refs[Tcb_AI_assms]: +lemma same_object_obj_refs[Arch_assms]: "\ same_object_as cap cap' \ \ obj_refs cap = obj_refs cap'" apply (cases cap, simp_all add: same_object_as_def) @@ -45,7 +45,7 @@ lemma same_object_obj_refs[Tcb_AI_assms]: split: cap.split_asm)+ by (cases "the_arch_cap cap"; cases "the_arch_cap cap'"; simp) -lemma arch_cap_badge_none_master[Tcb_AI_assms, simp]: +lemma arch_cap_badge_none_master[Arch_assms, simp]: "(arch_cap_badge (cap_master_arch_cap acap) = None) = (arch_cap_badge acap = None)" by simp @@ -137,13 +137,13 @@ lemma checked_insert_tcb_invs[wp]: (* arch specific *) done crunch arch_get_sanitise_register_info, arch_post_modify_registers - for tcb_at[wp, Tcb_AI_assms]: "tcb_at a" + for tcb_at[wp, Arch_assms]: "tcb_at a" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for invs[wp, Tcb_AI_assms]: "invs" + for invs[wp, Arch_assms]: "invs" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ex_nonz_cap_to[wp, Tcb_AI_assms]: "ex_nonz_cap_to a" + for ex_nonz_cap_to[wp, Arch_assms]: "ex_nonz_cap_to a" -lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: +lemma finalise_cap_not_cte_wp_at[Arch_assms]: assumes x: "P cap.NullCap" shows "\\s. \cp \ ran (caps_of_state s). P cp\ finalise_cap cap fin @@ -161,13 +161,13 @@ lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: done crunch arch_post_set_flags, arch_prepare_set_domain - for typ_at[wp, Tcb_AI_assms]: "\s. P (typ_at T p s)" - and invs[wp, Tcb_AI_assms]: "invs" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and invs[wp, Arch_assms]: "invs" lemmas vcpu_flush_typ_ats [wp] = abs_typ_at_lifts[OF vcpu_flush_typ_at] (* Interface asks for a weaker lemma due to other arches needing an extra precondition *) -lemma arch_post_set_flags_invs'[Tcb_AI_assms]: +lemma arch_post_set_flags_invs'[Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_post_set_flags t flags \\_. invs\" by wpsimp @@ -178,16 +178,14 @@ crunch arch_prepare_set_domain and pspace_distinct[wp]: pspace_distinct (wp: crunch_wps) -lemma table_cap_ref_max_free_index_upd[simp,Tcb_AI_assms]: +lemma table_cap_ref_max_free_index_upd[simp,Arch_assms]: "table_cap_ref (max_free_index_update cap) = table_cap_ref cap" by (simp add:free_index_update_def table_cap_ref_def split:cap.splits) - interpretation Tcb_AI_1? : Tcb_AI_1 where state_ext_t = state_ext_t and is_cnode_or_valid_arch = is_cnode_or_valid_arch - by (unfold_locales; fact Tcb_AI_assms) - + by (unfold_locales; fact Arch_assms) lemma use_no_cap_to_obj_asid_strg: (* arch specific *) "(cte_at p s \ no_cap_to_obj_dr_emp cap s \ valid_cap cap s \ invs s) @@ -204,7 +202,7 @@ lemma use_no_cap_to_obj_asid_strg: (* arch specific *) done declare arch_cap_fun_lift_simps [simp del] -lemma cap_delete_no_cap_to_obj_asid[wp, Tcb_AI_assms]: +lemma cap_delete_no_cap_to_obj_asid[wp, Arch_assms]: "\no_cap_to_obj_dr_emp cap\ cap_delete slot \\rv. no_cap_to_obj_dr_emp cap\" @@ -233,7 +231,7 @@ lemma as_user_ipc_tcb_cap_valid4[wp]: apply (clarsimp simp: get_tcb_def) done -lemma tc_invs[Tcb_AI_assms]: +lemma tc_invs[Arch_assms]: "\invs and tcb_at a and (case_option \ (valid_cap o fst) e) and (case_option \ (valid_cap o fst) f) @@ -311,7 +309,7 @@ lemma check_valid_ipc_buffer_inv: (* arch_specific *) apply (wp | simp add: if_apply_def2 split del: if_split | wpcw)+ done -lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: +lemma check_valid_ipc_buffer_wp[Arch_assms]: "\\(s::'state_ext::state_ext state). is_arch_cap cap \ is_cnode_or_valid_arch cap \ valid_ipc_buffer_cap cap vptr \ is_aligned vptr msg_align_bits @@ -327,7 +325,7 @@ lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: valid_ipc_buffer_cap_def) done -lemma derive_no_cap_asid[wp,Tcb_AI_assms]: +lemma derive_no_cap_asid[wp,Arch_assms]: "\(no_cap_to_obj_with_diff_ref cap S)::'state_ext::state_ext state\bool\ derive_cap slot cap \\rv. no_cap_to_obj_with_diff_ref rv S\,-" @@ -341,7 +339,7 @@ lemma derive_no_cap_asid[wp,Tcb_AI_assms]: done -lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: +lemma decode_set_ipc_inv[wp,Arch_assms]: "\P::'state_ext::state_ext state \ bool\ decode_set_ipc_buffer args cap slot excaps \\rv. P\" apply (simp add: decode_set_ipc_buffer_def whenE_def split_def @@ -350,7 +348,7 @@ lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: apply simp done -lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_update_cap_data[Arch_assms]: "no_cap_to_obj_with_diff_ref c S s \ no_cap_to_obj_with_diff_ref (update_cap_data P x c) S s" apply (case_tac "update_cap_data P x c = NullCap") @@ -367,7 +365,7 @@ lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: done -lemma update_cap_valid[Tcb_AI_assms]: +lemma update_cap_valid[Arch_assms]: "valid_cap cap (s::'state_ext::state_ext state) \ valid_cap (case capdata of None \ cap_rights_update rs cap @@ -396,14 +394,15 @@ crunch invoke_tcb wp: hoare_drop_imps mapM_x_wp' check_cap_inv simp: crunch_simps) +lemmas Tcb_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI?: Tcb_AI where is_cnode_or_valid_arch = ARM_HYP.is_cnode_or_valid_arch proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; fact Tcb_AI_assms) + by (unfold_locales; fact ARM_HYP.Tcb_AI_assms) qed end diff --git a/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy b/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy index 637952e562..aa553a0d83 100644 --- a/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/ARM_HYP/ArchUntyped_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_AI locale *) -lemma of_bl_nat_to_cref[Untyped_AI_assms]: +lemma of_bl_nat_to_cref[Arch_assms]: "\ x < 2 ^ bits; bits < word_bits \ \ (of_bl (nat_to_cref bits x) :: machine_word) = of_nat x" apply (clarsimp intro!: less_mask_eq @@ -21,7 +21,7 @@ lemma of_bl_nat_to_cref[Untyped_AI_assms]: by (metis add_lessD1 le_unat_uoi nat_le_iff_add nat_le_linear) -lemma cnode_cap_ex_cte[Untyped_AI_assms]: +lemma cnode_cap_ex_cte[Arch_assms]: "\ is_cnode_cap cap; cte_wp_at (\c. \m. cap = mask_cap m c) p s; (s::'state_ext::state_ext state) \ cap; valid_objs s; pspace_aligned s \ \ ex_cte_cap_wp_to is_cnode_cap (obj_ref_of cap, nat_to_cref (bits_of cap) x) s" @@ -36,7 +36,7 @@ lemma cnode_cap_ex_cte[Untyped_AI_assms]: -lemma inj_on_nat_to_cref[Untyped_AI_assms]: +lemma inj_on_nat_to_cref[Arch_assms]: "bits < word_bits \ inj_on (nat_to_cref bits) {..< 2 ^ bits}" apply (rule inj_onI) apply (drule arg_cong[where f="\x. replicate (word_bits - bits) False @ x"]) @@ -54,7 +54,7 @@ lemma inj_on_nat_to_cref[Untyped_AI_assms]: done -lemma data_to_obj_type_sp[Untyped_AI_assms]: +lemma data_to_obj_type_sp[Arch_assms]: "\P\ data_to_obj_type x \\ts (s::'state_ext::state_ext state). ts \ ArchObject ASIDPoolObj \ P s\, -" unfolding data_to_obj_type_def apply (rule hoare_pre) @@ -63,7 +63,7 @@ lemma data_to_obj_type_sp[Untyped_AI_assms]: apply (simp add: arch_data_to_obj_type_def split: if_split_asm) done -lemma dui_inv_wf[wp, Untyped_AI_assms]: +lemma dui_inv_wf[wp, Arch_assms]: "\invs and cte_wp_at ((=) (cap.UntypedCap dev w sz idx)) slot and (\(s::'state_ext::state_ext state). \cap \ set cs. is_cnode_cap cap \ (\r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -148,7 +148,7 @@ qed lemma asid_bits_ge_0: "(0::word32) < 2 ^ asid_bits" by (simp add: asid_bits_def) -lemma retype_ret_valid_caps_captable[Untyped_AI_assms]: +lemma retype_ret_valid_caps_captable[Arch_assms]: "\pspace_no_overlap_range_cover ptr sz (s::'state_ext::state_ext state) \ 0 < us \ range_cover ptr sz (obj_bits_api CapTableObject us) n \ ptr \ 0 \ @@ -161,7 +161,7 @@ by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def | rule is_aligned_add_multI[OF _ le_refl], (simp add:range_cover_def word_bits_def obj_bits_api_def slot_bits_def)+)+)[1] -lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]: +lemma retype_ret_valid_caps_aobj[Arch_assms]: "\ptr sz (s::'state_ext::state_ext state) x6 us n. \pspace_no_overlap_range_cover ptr sz s \ x6 \ ASIDPoolObj \ range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \ ptr \ 0\ @@ -204,7 +204,7 @@ lemma cap_refs_in_kernel_windowD2: apply fastforce done -lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: +lemma init_arch_objects_descendants_range[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). descendants_range x cref s \ init_arch_objects ty dev ptr n us y \\rv s. descendants_range x cref s\" apply (simp add: descendants_range_def) @@ -213,7 +213,7 @@ lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: apply simp done -lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: +lemma init_arch_objects_caps_overlap_reserved[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). caps_overlap_reserved S s\ init_arch_objects ty dev ptr n us y \\rv s. caps_overlap_reserved S s\" @@ -221,7 +221,7 @@ lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: apply (wp retype_region_mdb init_arch_objects_hoare_lift) done -lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: +lemma set_untyped_cap_invs_simple[Arch_assms]: "\\s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \ pspace_no_overlap_range_cover ptr sz s \ invs s \ cte_wp_at (\c. is_untyped_cap c \ cap_bits c = sz \ obj_ref_of c = ptr \ cap_is_device c = dev) cref s \ idx \ 2^ sz\ set_cap (cap.UntypedCap dev ptr sz idx) cref @@ -267,7 +267,7 @@ lemma pbfs_atleast_pageBits': lemma pbfs_less_wb': "pageBitsForSize sz < word_bits"by (cases sz, simp_all add: word_bits_conv pageBits_def) -lemma delete_objects_rewrite[Untyped_AI_assms]: +lemma delete_objects_rewrite[Arch_assms]: "\word_size_bits \ sz; sz \ word_bits; ptr && ~~ mask sz = ptr\ \ delete_objects ptr sz = do y \ modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz}); @@ -299,7 +299,7 @@ lemma reachable_pg_cap_exst_update[simp]: by (simp add:reachable_pg_cap_def vs_lookup_pages_def vs_lookup_pages1_def obj_at_def) -lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_caps[wp, Arch_assms]: "\valid_arch_caps and valid_cap (default_cap tp oref sz dev) and (\(s::'state_ext::state_ext state). \r\obj_refs (default_cap tp oref sz dev). @@ -332,7 +332,7 @@ lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: apply (auto simp: is_cap_simps)[1] done -lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: +lemma create_cap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range (default_cap tp oref sz dev) \ cap_range c) p\ create_cap tp sz p dev (cref, oref) \\rv. cap_refs_in_kernel_window\" apply (simp add: create_cap_def) @@ -386,7 +386,7 @@ lemma mapM_copy_global_mappings_nonempty_table[wp]: apply simp_all done -lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: +lemma init_arch_objects_nonempty_table[Arch_assms, wp]: "\(\s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \ valid_global_objs s \ valid_arch_state s \ pspace_aligned s) and K (\ref\set refs. is_aligned ref (obj_bits_api tp us))\ @@ -398,13 +398,13 @@ lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: done -lemma nonempty_table_caps_of[Untyped_AI_assms]: +lemma nonempty_table_caps_of[Arch_assms]: "nonempty_table S ko \ caps_of ko = {}" by (auto simp: caps_of_def cap_of_def nonempty_table_def a_type_def split: Structures_A.kernel_object.split if_split_asm) -lemma nonempty_default[simp, Untyped_AI_assms]: +lemma nonempty_default[simp, Arch_assms]: "tp \ Untyped \ \ nonempty_table S (default_object tp dev us d)" apply (case_tac tp, simp_all add: default_object_def nonempty_table_def a_type_def) apply (rename_tac aobject_type) @@ -431,7 +431,7 @@ crunch init_arch_objects lemmas init_arch_objects_ex_cte_cap_wp_to = init_arch_objects_excap -lemma obj_is_device_vui_eq[Untyped_AI_assms]: +lemma obj_is_device_vui_eq[Arch_assms]: "valid_untyped_inv ui s \ case ui of Retype slot reset ptr_base ptr tp us slots dev \ obj_is_device tp dev = dev" @@ -443,26 +443,27 @@ lemma obj_is_device_vui_eq[Untyped_AI_assms]: apply (auto simp: arch_is_frame_type_def) done -lemma create_cap_valid_arch_state[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (\_. True) cref\ create_cap tp sz p dev (cref,oref) \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps create_cap_tcb create_cap_aobj_at) -lemma set_cap_non_arch_valid_arch_state[Untyped_AI_assms]: +lemma set_cap_non_arch_valid_arch_state[Arch_assms]: "\\s. valid_arch_state s \ cte_wp_at (\_. \is_arch_cap cap) ptr s\ set_cap cap ptr \\rv. valid_arch_state \" by wpsimp +lemmas Untyped_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Untyped_AI? : Untyped_AI where nonempty_table = ARM_HYP.nonempty_table proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; (fact Untyped_AI_assms)?) + by (unfold_locales; (fact ARM_HYP.Untyped_AI_assms)?) qed end diff --git a/proof/invariant-abstract/BCorres2_AI.thy b/proof/invariant-abstract/BCorres2_AI.thy index 3d2ee322d4..012d7ceb7f 100644 --- a/proof/invariant-abstract/BCorres2_AI.thy +++ b/proof/invariant-abstract/BCorres2_AI.thy @@ -23,6 +23,14 @@ locale BCorres2_AI = bcorres (make_arch_fault_msg a b :: 'a state \ _) (make_arch_fault_msg a b)" +(* same derivation on all architectures; needed inside is_extended' locale *) +lemma (in Arch) valid_vs_lookup_trans_state: + "valid_vs_lookup (trans_state g s) = valid_vs_lookup s" + by simp + +requalify_facts Arch.valid_vs_lookup_trans_state +lemmas [iff] = valid_vs_lookup_trans_state + definition all_but_exst where "all_but_exst P \ (\s. P (kheap s) (cdt s) (is_original_cap s) (cur_thread s) (idle_thread s) @@ -109,7 +117,6 @@ lemma dxo_ex: "((),x :: det_ext state) \ fst (do_extended_op f s) \P. \all_but_exst P\ f \\_. all_but_exst P\" @@ -203,10 +210,10 @@ lemma cte_wp_at[wp]: "I (\s. P (cte_wp_at P' p s))" by (rule lift_inv,si lemma no_cap_to_obj_dr_emp[wp]: "I (no_cap_to_obj_dr_emp x)" by (rule lift_inv,simp) -lemma valid_vs_lookup[wp]: "I (valid_vs_lookup)" +lemma valid_vs_lookup[wp]: + "I (valid_vs_lookup)" proof goal_cases - interpret Arch . - case 1 show ?case by (rule lift_inv, simp) + case 1 show ?case by (rule lift_inv, simp add: valid_vs_lookup_trans_state) qed lemma typ_at[wp]: "I (\s. P (typ_at T p s))" by (rule lift_inv,simp) diff --git a/proof/invariant-abstract/RISCV64/ArchAInvsPre.thy b/proof/invariant-abstract/RISCV64/ArchAInvsPre.thy index 7beaffcb88..19c42c47c2 100644 --- a/proof/invariant-abstract/RISCV64/ArchAInvsPre.thy +++ b/proof/invariant-abstract/RISCV64/ArchAInvsPre.thy @@ -211,7 +211,7 @@ lemma device_frame_in_device_region: \ device_state (machine_state s) p \ None" by (auto simp add: pspace_respects_device_region_def dom_def device_mem_def) -named_theorems AInvsPre_assms +clear_named_theorems Arch_assms (* accumulate assumptions for AInvsPre locale *) lemma get_vspace_of_thread_asid_or_global_pt: "(\asid. vspace_for_asid asid s = Some (get_vspace_of_thread (kheap s) (arch_state s) t)) @@ -219,7 +219,7 @@ lemma get_vspace_of_thread_asid_or_global_pt: by (auto simp: get_vspace_of_thread_def split: option.split kernel_object.split cap.split arch_cap.split) -lemma ptable_rights_imp_frame[AInvsPre_assms]: +lemma ptable_rights_imp_frame[Arch_assms]: assumes "valid_state s" shows "\ ptable_rights t s x \ {}; ptable_lift t s x = Some (addrFromPPtr y) \ \ in_user_frame y s \ in_device_frame y s" @@ -256,12 +256,13 @@ lemma ptable_rights_imp_frame[AInvsPre_assms]: apply simp done +lemmas AInvsPre_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation AInvsPre?: AInvsPre proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact AInvsPre_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.AInvsPre_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchBCorres2_AI.thy b/proof/invariant-abstract/RISCV64/ArchBCorres2_AI.thy index 0cf56636b5..292602cc64 100644 --- a/proof/invariant-abstract/RISCV64/ArchBCorres2_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchBCorres2_AI.thy @@ -11,10 +11,10 @@ begin context Arch begin arch_global_naming -named_theorems BCorres2_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for BCorres2_AI locale *) crunch invoke_cnode - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state (simp: swp_def ignore: clearMemory without_preemption filterM) crunch create_cap,init_arch_objects,retype_region,delete_objects @@ -31,7 +31,7 @@ crunch invoke_untyped crunch set_mcpriority, set_priority, arch_get_sanitise_register_info, arch_post_modify_registers, set_flags, arch_post_set_flags, maybe_handle_interrupt - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state lemma invoke_tcb_bcorres[wp]: fixes a @@ -65,20 +65,21 @@ lemma invoke_irq_control_bcorres[wp]: "bcorres (invoke_irq_control a) (invoke_ir lemma invoke_irq_handler_bcorres[wp]: "bcorres (invoke_irq_handler a) (invoke_irq_handler a)" by (cases a; wpsimp) -lemma make_arch_fault_msg_bcorres[wp,BCorres2_AI_assms]: +lemma make_arch_fault_msg_bcorres[wp,Arch_assms]: "bcorres (make_arch_fault_msg a b) (make_arch_fault_msg a b)" by (cases a; simp ; wp) -lemma handle_arch_fault_reply_bcorres[wp,BCorres2_AI_assms]: +lemma handle_arch_fault_reply_bcorres[wp,Arch_assms]: "bcorres ( handle_arch_fault_reply a b c d) (handle_arch_fault_reply a b c d)" by (cases a; simp add: handle_arch_fault_reply_def; wp) +lemmas BCorres2_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation BCorres2_AI?: BCorres2_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact BCorres2_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.BCorres2_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/RISCV64/ArchCNodeInv_AI.thy b/proof/invariant-abstract/RISCV64/ArchCNodeInv_AI.thy index 6594677ef2..b4ad5006bc 100644 --- a/proof/invariant-abstract/RISCV64/ArchCNodeInv_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchCNodeInv_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_AI locale *) lemma valid_cnode_capI: "\cap_table_at n w s; valid_objs s; pspace_aligned s; n > 0; length g \ 64\ @@ -26,7 +26,7 @@ lemma valid_cnode_capI: apply (simp add: word_bits_def cte_level_bits_def) done -lemma derive_cap_objrefs [CNodeInv_AI_assms]: +lemma derive_cap_objrefs [Arch_assms]: "\\s. P (obj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (obj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] @@ -34,7 +34,7 @@ lemma derive_cap_objrefs [CNodeInv_AI_assms]: apply (case_tac arch_cap, simp_all add: arch_derive_cap_def) by (wp | wpc |simp add: o_def)+ -lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: +lemma derive_cap_zobjrefs [Arch_assms]: "\\s. P (zobj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (zobj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] @@ -42,7 +42,7 @@ lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: apply (case_tac arch_cap, simp_all add: arch_derive_cap_def) by (wp | wpc |simp add: o_def)+ -lemma update_cap_objrefs [CNodeInv_AI_assms]: +lemma update_cap_objrefs [Arch_assms]: "\ update_cap_data P dt cap \ NullCap \ \ obj_refs (update_cap_data P dt cap) = obj_refs cap" by (case_tac cap, @@ -50,7 +50,7 @@ lemma update_cap_objrefs [CNodeInv_AI_assms]: split: if_split_asm arch_cap.splits) -lemma update_cap_zobjrefs [CNodeInv_AI_assms]: +lemma update_cap_zobjrefs [Arch_assms]: "\ update_cap_data P dt cap \ cap.NullCap \ \ zobj_refs (update_cap_data P dt cap) = zobj_refs cap" apply (case_tac cap, @@ -59,7 +59,7 @@ lemma update_cap_zobjrefs [CNodeInv_AI_assms]: done -lemma copy_mask [simp, CNodeInv_AI_assms]: +lemma copy_mask [simp, Arch_assms]: "copy_of (mask_cap R c) = copy_of c" apply (rule ext) apply (auto simp: copy_of_def is_cap_simps mask_cap_def @@ -68,7 +68,7 @@ lemma copy_mask [simp, CNodeInv_AI_assms]: split: cap.splits arch_cap.splits bool.splits) done -lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: +lemma update_cap_data_mask_Null [simp, Arch_assms]: "(update_cap_data P x (mask_cap m c) = NullCap) = (update_cap_data P x c = NullCap)" unfolding update_cap_data_def mask_cap_def apply (cases c) @@ -77,7 +77,7 @@ lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: apply (case_tac arch_cap; clarsimp simp: arch_update_cap_data_def acap_rights_update_def split: if_splits) done -lemma cap_master_update_cap_data [CNodeInv_AI_assms]: +lemma cap_master_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap \ \ cap_master_cap (update_cap_data P x c) = cap_master_cap c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -100,11 +100,11 @@ lemma same_object_as_def2: split: cap.splits arch_cap.splits) done -lemma same_object_as_cap_master [CNodeInv_AI_assms]: +lemma same_object_as_cap_master [Arch_assms]: "same_object_as cap cap' \ cap_master_cap cap = cap_master_cap cap'" by (simp add: same_object_as_def2) -lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: +lemma weak_derived_cap_is_device[Arch_assms]: "\weak_derived c' c\ \ cap_is_device c = cap_is_device c'" apply (auto simp: weak_derived_def copy_of_def is_cap_simps same_object_as_def2 @@ -112,7 +112,7 @@ lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: dest!: master_cap_eq_is_device_cap_eq) done -lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid (update_cap_data P x c) = cap_asid c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -121,7 +121,7 @@ lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: +lemma cap_vptr_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_vptr (update_cap_data P x c) = cap_vptr c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -130,7 +130,7 @@ lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_base_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid_base (update_cap_data P x c) = cap_asid_base c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -139,7 +139,7 @@ lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma same_object_as_update_cap_data [CNodeInv_AI_assms]: +lemma same_object_as_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap; same_object_as c' c \ \ same_object_as c' (update_cap_data P x c)" apply (clarsimp simp: same_object_as_def is_cap_simps @@ -160,7 +160,7 @@ lemma is_master_reply_update_cap_data[simp]: by (simp add:is_master_reply_cap_def update_cap_data_def arch_update_cap_data_def the_cnode_cap_def is_arch_cap_def badge_update_def split:cap.split) -lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: +lemma weak_derived_update_cap_data [Arch_assms]: "\update_cap_data P x c \ NullCap; weak_derived c c'\ \ weak_derived (update_cap_data P x c) c'" apply (simp add: weak_derived_def copy_of_def @@ -184,7 +184,7 @@ lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: +lemma cap_badge_update_cap_data [Arch_assms]: "update_cap_data False x c \ NullCap \ (bdg, cap_badge c) \ capBadge_ordering False \ (bdg, cap_badge (update_cap_data False x c)) \ capBadge_ordering False" apply clarsimp @@ -196,25 +196,25 @@ lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: done -lemma cap_vptr_rights_update[simp, CNodeInv_AI_assms]: +lemma cap_vptr_rights_update[simp, Arch_assms]: "cap_vptr (cap_rights_update f c) = cap_vptr c" by (simp add: cap_vptr_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_vptr_mask[simp, CNodeInv_AI_assms]: +lemma cap_vptr_mask[simp, Arch_assms]: "cap_vptr (mask_cap m c) = cap_vptr c" by (simp add: mask_cap_def) -lemma cap_asid_base_rights [simp, CNodeInv_AI_assms]: +lemma cap_asid_base_rights [simp, Arch_assms]: "cap_asid_base (cap_rights_update R c) = cap_asid_base c" by (auto simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_asid_base_mask[simp, CNodeInv_AI_assms]: +lemma cap_asid_base_mask[simp, Arch_assms]: "cap_asid_base (mask_cap m c) = cap_asid_base c" by (simp add: mask_cap_def) -lemma weak_derived_mask [CNodeInv_AI_assms]: +lemma weak_derived_mask [Arch_assms]: "\ weak_derived c c'; cap_aligned c \ \ weak_derived (mask_cap m c) c'" unfolding weak_derived_def apply simp @@ -229,16 +229,16 @@ lemma weak_derived_mask [CNodeInv_AI_assms]: done -lemma vs_cap_ref_update_cap_data[simp, CNodeInv_AI_assms]: +lemma vs_cap_ref_update_cap_data[simp, Arch_assms]: "vs_cap_ref (update_cap_data P d cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def update_cap_data_closedform arch_update_cap_data_def Let_def split: arch_cap.splits cap.split if_splits) -lemmas [CNodeInv_AI_assms] = invs_irq_state_independent +lemmas [Arch_assms] = invs_irq_state_independent -lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: +lemma cte_at_nat_to_cref_zbits [Arch_assms]: "\ s \ Zombie oref zb n; m < n \ \ cte_at (oref, nat_to_cref (zombie_cte_bits zb) m) s" apply (subst(asm) valid_cap_def) @@ -252,7 +252,7 @@ lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: done -lemma copy_of_cap_range [CNodeInv_AI_assms]: +lemma copy_of_cap_range [Arch_assms]: "copy_of cap cap' \ cap_range cap = cap_range cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -264,7 +264,7 @@ lemma copy_of_cap_range [CNodeInv_AI_assms]: done -lemma copy_of_zobj_refs [CNodeInv_AI_assms]: +lemma copy_of_zobj_refs [Arch_assms]: "copy_of cap cap' \ zobj_refs cap = zobj_refs cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -276,7 +276,7 @@ lemma copy_of_zobj_refs [CNodeInv_AI_assms]: done -lemma vs_cap_ref_master [CNodeInv_AI_assms]: +lemma vs_cap_ref_master [Arch_assms]: "\ cap_master_cap cap = cap_master_cap cap'; cap_asid cap = cap_asid cap'; cap_asid_base cap = cap_asid_base cap'; @@ -288,13 +288,13 @@ lemma vs_cap_ref_master [CNodeInv_AI_assms]: apply (clarsimp simp: cap_asid_def split: arch_cap.split_asm option.split_asm) done -lemma weak_derived_vs_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_vs_cap_ref [Arch_assms]: "weak_derived c c' \ vs_cap_ref c = vs_cap_ref c'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm elim: vs_cap_ref_master[OF sym]) -lemma weak_derived_table_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_table_cap_ref [Arch_assms]: "weak_derived c c' \ table_cap_ref c = table_cap_ref c'" apply (clarsimp simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm) @@ -348,7 +348,7 @@ lemma weak_derived_Page1[simp]: dest!: same_object_as_cap_master cap_master_cap_eqDs split: option.splits) -lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: +lemma swap_of_caps_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -404,7 +404,7 @@ lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: done -lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: +lemma cap_swap_asid_map[wp, Arch_assms]: "\valid_asid_map and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -416,7 +416,7 @@ lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: done -lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: +lemma cap_swap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -428,14 +428,14 @@ lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: simp: cte_wp_at_caps_of_state weak_derived_cap_range) done -lemma cap_swap_vms[wp, CNodeInv_AI_assms]: +lemma cap_swap_vms[wp, Arch_assms]: "\valid_machine_state\ cap_swap c a c' b \\rv. valid_machine_state\" apply (simp add: valid_machine_state_def in_user_frame_def) apply (wp cap_swap_typ_at hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_disj_lift) done -lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: +lemma unat_of_bl_nat_to_cref[Arch_assms]: "\ n < 2 ^ len; len < word_bits \ \ unat (of_bl (nat_to_cref len n) :: machine_word) = n" apply (simp add: nat_to_cref_def word_bits_conv of_drop_to_bl @@ -454,7 +454,7 @@ lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: apply simp done -lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: +lemma zombie_is_cap_toE_pre[Arch_assms]: "\ s \ Zombie ptr zbits n; invs s; m < n \ \ (ptr, nat_to_cref (zombie_cte_bits zbits) m) \ cte_refs (Zombie ptr zbits n) irqn" apply (clarsimp simp add: valid_cap_def cap_aligned_def) @@ -468,7 +468,7 @@ lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: crunch prepare_thread_delete for st_tcb_at_halted[wp]: "st_tcb_at halted t" -lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: +lemma finalise_cap_makes_halted_proof[Arch_assms]: "\invs and valid_cap cap and (\s. ex = is_final_cap' cap s) and cte_wp_at ((=) cap) slot\ finalise_cap cap ex @@ -495,12 +495,12 @@ lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof crunch finalise_cap - for emptyable[wp,CNodeInv_AI_assms]: "\s. emptyable sl s" + for emptyable[wp,Arch_assms]: "\s. emptyable sl s" (simp: crunch_simps rule: emptyable_lift wp: crunch_wps suspend_emptyable unbind_notification_invs unbind_maybe_notification_invs) -lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: +lemma finalise_cap_not_reply_master_unlifted [Arch_assms]: "(rv, s') \ fst (finalise_cap cap sl s) \ \ is_master_reply_cap (fst rv)" by (case_tac cap, auto simp: is_cap_simps in_monad liftM_def @@ -508,7 +508,7 @@ lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: split: if_split_asm arch_cap.split_asm bool.split_asm option.split_asm) -lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: +lemma nat_to_cref_0_replicate [Arch_assms]: "\n. n < word_bits \ nat_to_cref n 0 = replicate n False" apply (subgoal_tac "nat_to_cref n (unat (of_bl (replicate n False))) = replicate n False") apply simp @@ -517,25 +517,26 @@ lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: apply simp done -lemma prepare_thread_delete_thread_cap [CNodeInv_AI_assms]: +lemma prepare_thread_delete_thread_cap [Arch_assms]: "\\s. caps_of_state s x = Some (cap.ThreadCap p)\ prepare_thread_delete t \\rv s. caps_of_state s x = Some (cap.ThreadCap p)\" by (wpsimp simp: prepare_thread_delete_def) -lemma cap_swap_valid_arch_state[wp, CNodeInv_AI_assms]: +lemma cap_swap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ cap_swap c a c' b \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_swap_typ_ats cap_swap_aobj_at) +lemmas CNodeInv_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI?: CNodeInv_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.CNodeInv_AI_assms)?) qed @@ -792,22 +793,23 @@ next qed -lemmas rec_del_invs'[CNodeInv_AI_assms] = rec_del_invs'' [where Q=\, +lemmas rec_del_invs'[Arch_assms] = rec_del_invs'' [where Q=\, simplified hoare_TrueI pred_conj_def simp_thms, OF TrueI TrueI TrueI TrueI, simplified] +lemmas CNodeInv_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_2?: CNodeInv_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.CNodeInv_AI_2_assms)?) qed context Arch begin arch_global_naming -lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: +lemma finalise_cap_rvk_prog [Arch_assms]: "\\s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\ finalise_cap a b \\_ s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\" @@ -817,7 +819,7 @@ lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: done -lemma rec_del_rvk_prog [CNodeInv_AI_assms]: +lemma rec_del_rvk_prog [Arch_assms]: "st \ \\s. revoke_progress_ord m (option_map cap_to_rpo \ caps_of_state s) \ (case args of ReduceZombieCall cap sl ex \ cte_wp_at (\c. c = cap) sl s \ is_final_cap' cap s @@ -901,13 +903,14 @@ next done qed +lemmas CNodeInv_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_3?: CNodeInv_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.CNodeInv_AI_3_assms)?) qed @@ -919,31 +922,32 @@ declare cap_revoke.simps[simp del] context Arch begin arch_global_naming crunch finalise_slot - for typ_at[wp, CNodeInv_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM set_object clearMemory) -lemma weak_derived_appropriate [CNodeInv_AI_assms]: +lemma weak_derived_appropriate [Arch_assms]: "weak_derived cap cap' \ appropriate_cte_cap cap = appropriate_cte_cap cap'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 appropriate_cte_master split: if_split_asm dest!: arg_cong[where f=appropriate_cte_cap]) +lemmas CNodeInv_AI_4_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_4?: CNodeInv_AI_4 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.CNodeInv_AI_4_assms)?) qed context Arch begin arch_global_naming -lemma cap_move_invs[wp, CNodeInv_AI_assms]: +lemma cap_move_invs[wp, Arch_assms]: "\invs and valid_cap cap and cte_wp_at ((=) cap.NullCap) ptr' and tcb_cap_valid cap ptr' and cte_wp_at (weak_derived cap) ptr @@ -990,13 +994,14 @@ lemma arch_derive_is_arch: "\\\ arch_derive_cap c \\rv s. rv \ NullCap \ is_arch_cap rv\,-" by (wpsimp simp: is_arch_cap_def arch_derive_cap_def) +lemmas CNodeInv_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_5?: CNodeInv_AI_5 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.CNodeInv_AI_5_assms)?) qed diff --git a/proof/invariant-abstract/RISCV64/ArchCSpace_AI.thy b/proof/invariant-abstract/RISCV64/ArchCSpace_AI.thy index 5b3ec4fe49..691c0b3d02 100644 --- a/proof/invariant-abstract/RISCV64/ArchCSpace_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchCSpace_AI.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_AI locale *) lemma unique_table_refs_upd_eqD: "\ms a = Some b; obj_refs b = obj_refs b'; table_cap_ref b = table_cap_ref b'\ @@ -39,7 +39,7 @@ lemma cte_at_length_limit: done (* FIXME: move? *) -lemma getActiveIRQ_wp [CSpace_AI_assms]: +lemma getActiveIRQ_wp [Arch_assms]: "irq_state_independent_A P \ valid P (do_machine_op (getActiveIRQ in_kernel)) (\_. P)" apply (simp add: getActiveIRQ_def do_machine_op_def split_def exec_gets @@ -49,7 +49,7 @@ lemma getActiveIRQ_wp [CSpace_AI_assms]: apply (clarsimp simp: irq_state_independent_A_def in_monad return_def split: if_splits) done -lemma weak_derived_valid_cap [CSpace_AI_assms]: +lemma weak_derived_valid_cap [Arch_assms]: "\ s \ c; wellformed_cap c'; weak_derived c' c\ \ s \ c'" apply (case_tac "c = c'", simp) apply (clarsimp simp: weak_derived_def) @@ -60,7 +60,7 @@ lemma weak_derived_valid_cap [CSpace_AI_assms]: split: cap.splits arch_cap.splits option.splits) done -lemma copy_obj_refs [CSpace_AI_assms]: +lemma copy_obj_refs [Arch_assms]: "copy_of cap cap' \ obj_refs cap' = obj_refs cap" apply (cases cap) apply (auto simp: copy_of_def same_object_as_def is_cap_simps @@ -68,26 +68,26 @@ lemma copy_obj_refs [CSpace_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma weak_derived_cap_class[simp, CSpace_AI_assms]: +lemma weak_derived_cap_class[simp, Arch_assms]: "weak_derived cap src_cap \ cap_class cap = cap_class src_cap" apply (simp add:weak_derived_def) apply (auto simp:copy_of_def same_object_as_def is_cap_simps cap_asid_base_def split:if_splits cap.splits arch_cap.splits) done -lemma weak_derived_obj_refs [CSpace_AI_assms]: +lemma weak_derived_obj_refs [Arch_assms]: "weak_derived dcap cap \ obj_refs dcap = obj_refs cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma weak_derived_obj_ref_of [CSpace_AI_assms]: +lemma weak_derived_obj_ref_of [Arch_assms]: "weak_derived dcap cap \ obj_ref_of dcap = obj_ref_of cap" by (cases dcap, auto simp: is_cap_simps weak_derived_def copy_of_def same_object_as_def aobj_ref_cases split: if_split_asm cap.splits arch_cap.splits) -lemma set_free_index_invs [CSpace_AI_assms]: +lemma set_free_index_invs [Arch_assms]: "\\s. (free_index_of cap \ idx \ is_untyped_cap cap \ idx \ 2^cap_bits cap) \ invs s \ cte_wp_at ((=) cap ) cref s\ set_cap (free_index_update (\_. idx) cap) cref @@ -132,7 +132,7 @@ lemma set_free_index_invs [CSpace_AI_assms]: apply (simp add: not_kernel_window_def) done -lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: +lemma set_untyped_cap_as_full_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at ((=) src_cap) src\ set_untyped_cap_as_full src_cap cap src \\ya. valid_arch_caps\" @@ -144,7 +144,7 @@ lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: is_cap_simps cte_wp_at_caps_of_state) done -lemma set_untyped_cap_as_full[wp, CSpace_AI_assms]: +lemma set_untyped_cap_as_full[wp, Arch_assms]: "\\s. no_cap_to_obj_with_diff_ref a b s \ cte_wp_at ((=) src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. no_cap_to_obj_with_diff_ref a b s\" @@ -243,7 +243,7 @@ lemma is_derived_is_pt: apply (clarsimp simp: cap_master_cap_def is_pt_cap_def split: cap.splits arch_cap.splits)+ done -lemma cap_insert_valid_arch_caps [CSpace_AI_assms]: +lemma cap_insert_valid_arch_caps [Arch_assms]: "\valid_arch_caps and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_caps\" @@ -306,7 +306,7 @@ global_interpretation cap_insert_crunches?: cap_insert_crunches . context Arch begin arch_global_naming -lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma cap_insert_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range cap \ cap_range c) src\ cap_insert cap src dest @@ -319,7 +319,7 @@ lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: done -lemma mask_cap_valid[simp, CSpace_AI_assms]: +lemma mask_cap_valid[simp, Arch_assms]: "s \ c \ s \ mask_cap R c" apply (cases c, simp_all add: valid_cap_def mask_cap_def cap_rights_update_def @@ -329,21 +329,21 @@ lemma mask_cap_valid[simp, CSpace_AI_assms]: apply (rename_tac arch_cap) by (case_tac arch_cap, simp_all) -lemma mask_cap_objrefs[simp, CSpace_AI_assms]: +lemma mask_cap_objrefs[simp, Arch_assms]: "obj_refs (mask_cap rs cap) = obj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma mask_cap_zobjrefs[simp, CSpace_AI_assms]: +lemma mask_cap_zobjrefs[simp, Arch_assms]: "zobj_refs (mask_cap rs cap) = zobj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma derive_cap_valid_cap [CSpace_AI_assms]: +lemma derive_cap_valid_cap [Arch_assms]: "\valid_cap cap\ derive_cap slot cap \valid_cap\,-" apply (simp add: derive_cap_def) apply (rule hoare_pre) @@ -352,7 +352,7 @@ lemma derive_cap_valid_cap [CSpace_AI_assms]: done -lemma valid_cap_update_rights[simp, CSpace_AI_assms]: +lemma valid_cap_update_rights[simp, Arch_assms]: "valid_cap cap s \ valid_cap (cap_rights_update cr cap) s" apply (case_tac cap, simp_all add: cap_rights_update_def valid_cap_def cap_aligned_def @@ -363,7 +363,7 @@ lemma valid_cap_update_rights[simp, CSpace_AI_assms]: done -lemma update_cap_data_validI [CSpace_AI_assms]: +lemma update_cap_data_validI [Arch_assms]: "s \ cap \ s \ update_cap_data p d cap" apply (cases cap) apply (simp_all add: is_cap_defs update_cap_data_def Let_def split_def) @@ -376,7 +376,7 @@ lemma update_cap_data_validI [CSpace_AI_assms]: done -lemma tcb_cnode_index_def2 [CSpace_AI_assms]: +lemma tcb_cnode_index_def2 [Arch_assms]: "tcb_cnode_index n = nat_to_cref 3 n" apply (simp add: tcb_cnode_index_def nat_to_cref_def) apply (rule nth_equalityI) @@ -385,7 +385,7 @@ lemma tcb_cnode_index_def2 [CSpace_AI_assms]: done -lemma ex_nonz_tcb_cte_caps [CSpace_AI_assms]: +lemma ex_nonz_tcb_cte_caps [Arch_assms]: "\ex_nonz_cap_to t s; tcb_at t s; valid_objs s; ref \ dom tcb_cap_cases\ \ ex_cte_cap_wp_to (appropriate_cte_cap cp) (t, ref) s" apply (clarsimp simp: ex_nonz_cap_to_def ex_cte_cap_wp_to_def @@ -413,7 +413,7 @@ lemma no_cap_to_obj_with_diff_ref_triv: done -lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: +lemma setup_reply_master_arch_caps[wp, Arch_assms]: "\valid_arch_caps and tcb_at t and valid_objs and pspace_aligned\ setup_reply_master t \\rv. valid_arch_caps\" @@ -428,7 +428,7 @@ lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: done -lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma setup_reply_master_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and tcb_at t and pspace_in_kernel_window\ setup_reply_master t \\rv. cap_refs_in_kernel_window\" @@ -440,13 +440,13 @@ lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: (* FIXME: prove same_region_as_def2 instead or change def *) -lemma same_region_as_Untyped2 [CSpace_AI_assms]: +lemma same_region_as_Untyped2 [Arch_assms]: "\ is_untyped_cap pcap; same_region_as pcap cap \ \ (is_physical cap \ cap_range cap \ {} \ cap_range cap \ cap_range pcap)" by (fastforce simp: is_cap_simps cap_range_def is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma same_region_as_cap_class [CSpace_AI_assms]: +lemma same_region_as_cap_class [Arch_assms]: shows "same_region_as a b \ cap_class a = cap_class b" apply (case_tac a) apply (fastforce simp: cap_range_def arch_is_physical_def is_cap_simps @@ -475,22 +475,23 @@ lemma cap_insert_simple_arch_caps_no_ap: apply (intro conjI impI allI) by (auto simp:is_simple_cap_def[simplified is_simple_cap_arch_def] is_cap_simps) -lemma cap_insert_derived_valid_arch_state[CSpace_AI_assms]: +lemma cap_insert_derived_valid_arch_state[Arch_assms]: "\valid_arch_state and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps cap_insert_tcb cap_insert_aobj_at) -lemma setup_reply_master_arch[CSpace_AI_assms]: +lemma setup_reply_master_arch[Arch_assms]: "setup_reply_master t \ valid_arch_state \" by (wpsimp simp: setup_reply_master_def wp: get_cap_wp) +lemmas CSpace_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CSpace_AI?: CSpace_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CSpace_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.CSpace_AI_assms)?) qed diff --git a/proof/invariant-abstract/RISCV64/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/RISCV64/ArchDetSchedAux_AI.thy index 4c90536e6b..3bdbcbc034 100644 --- a/proof/invariant-abstract/RISCV64/ArchDetSchedAux_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchDetSchedAux_AI.thy @@ -10,18 +10,18 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedAux_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedAux_AI locale *) crunch init_arch_objects for exst[wp]: "\s. P (exst s)" and valid_queues[wp]: valid_queues and valid_sched_action[wp]: valid_sched_action and valid_sched[wp]: valid_sched - and etcbs_of[wp, DetSchedAux_AI_assms]: "\s. P (etcbs_of s)" - and ready_queues[wp, DetSchedAux_AI_assms]: "\s. P (ready_queues s)" - and idle_thread[wp, DetSchedAux_AI_assms]: "\s. P (idle_thread s)" - and schedact[wp, DetSchedAux_AI_assms]: "\s. P (scheduler_action s)" - and cur_domain[wp, DetSchedAux_AI_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and schedact[wp, Arch_assms]: "\s. P (scheduler_action s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" (wp: mapM_x_wp') lemma tcb_sched_action_valid_idle_etcb: @@ -30,7 +30,7 @@ lemma tcb_sched_action_valid_idle_etcb: (wpsimp simp: tcb_sched_action_def set_tcb_queue_def) crunch init_arch_objects - for valid_blocked[wp, DetSchedAux_AI_assms]: valid_blocked + for valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift) lemma perform_asid_control_etcb_at: @@ -72,12 +72,13 @@ lemma perform_asid_control_invocation_valid_sched: apply simp done +lemmas DetSchedAux_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedAux_AI?: DetSchedAux_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedAux_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.DetSchedAux_AI_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchDetSchedDomainTime_AI.thy b/proof/invariant-abstract/RISCV64/ArchDetSchedDomainTime_AI.thy index 598d61ceb2..48f5d724ac 100644 --- a/proof/invariant-abstract/RISCV64/ArchDetSchedDomainTime_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchDetSchedDomainTime_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedDomainTime_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedDomainTime_AI locale *) crunch arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread, @@ -19,26 +19,27 @@ crunch prepare_thread_delete, handle_hypervisor_fault, init_arch_objects, arch_post_modify_registers, arch_post_cap_deletion, handle_vm_fault, arch_invoke_irq_handler, arch_prepare_next_domain, arch_prepare_set_domain, arch_post_set_flags - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (simp: crunch_simps) crunch do_machine_op for exst[wp]: "\s. P (exst s)" -declare init_arch_objects_exst[DetSchedDomainTime_AI_assms] +declare init_arch_objects_exst[Arch_assms] + +lemmas DetSchedDomainTime_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.DetSchedDomainTime_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_perform_invocation - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps check_cap_inv) lemma timer_tick_valid_domain_time: @@ -62,7 +63,7 @@ lemma timer_tick_valid_domain_time: crunch do_machine_op for domain_time_sched[wp]: "\s. P (domain_time s) (scheduler_action s)" -lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: +lemma handle_interrupt_valid_domain_time [Arch_assms]: "\\s :: det_ext state. 0 < domain_time s \ handle_interrupt i \\rv s. domain_time s = 0 \ scheduler_action s = choose_new_thread \" (is "\ ?dtnot0 \ _ \ _ \") @@ -79,18 +80,19 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: done crunch handle_reserved_irq, arch_mask_irq_signal, handle_spurious_irq - for domain_fields_invs[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields_invs[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps mapM_wp subset_refl simp: crunch_simps) crunch handle_spurious_irq - for scheduler_action[wp, DetSchedDomainTime_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" + +lemmas DetSchedDomainTime_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI_2?: DetSchedDomainTime_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.DetSchedDomainTime_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchDetSchedSchedule_AI.thy b/proof/invariant-abstract/RISCV64/ArchDetSchedSchedule_AI.thy index 36a8617332..64165df349 100644 --- a/proof/invariant-abstract/RISCV64/ArchDetSchedSchedule_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchDetSchedSchedule_AI.thy @@ -10,21 +10,21 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedSchedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedSchedule_AI locale *) crunch prepare_thread_delete - for prepare_thread_delete_idle_thread[wp, DetSchedSchedule_AI_assms]: "\(s:: det_ext state). P (idle_thread s)" + for prepare_thread_delete_idle_thread[wp, Arch_assms]: "\(s:: det_ext state). P (idle_thread s)" crunch switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain - for valid_queues[wp, DetSchedSchedule_AI_assms]: valid_queues + for valid_queues[wp, Arch_assms]: valid_queues (simp: crunch_simps ignore: set_tcb_queue tcb_sched_action) crunch switch_to_idle_thread, switch_to_thread, set_vm_root, arch_get_sanitise_register_info, arch_post_modify_registers - for weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: "weak_valid_sched_action" + for weak_valid_sched_action[wp, Arch_assms]: "weak_valid_sched_action" (simp: crunch_simps) crunch set_vm_root @@ -33,7 +33,7 @@ crunch set_vm_root and ct_not_in_q'[wp]: "\s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) t" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_not_in_q [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_in_q [wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\_. ct_not_in_q\" apply (simp add: switch_to_idle_thread_def) apply wp @@ -48,7 +48,7 @@ crunch set_vm_root (etcbs_of s) (kheap s) thread (cur_domain s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_sched_action [wp, Arch_assms]: "\valid_sched_action and valid_idle\ switch_to_idle_thread \\_. valid_sched_action\" @@ -65,7 +65,7 @@ crunch set_vm_root (scheduler_action s) (cur_domain s) (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_in_cur_domain [wp, Arch_assms]: "\\\ switch_to_idle_thread \\_. ct_in_cur_domain\" by (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def split_def @@ -73,21 +73,21 @@ lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]: | simp add: ct_in_cur_domain_def)+ crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for is_activatable[wp, DetSchedSchedule_AI_assms]: "is_activatable t" + for is_activatable[wp, Arch_assms]: "is_activatable t" (simp: crunch_simps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for valid_sched_action[wp, DetSchedSchedule_AI_assms]: valid_sched_action + for valid_sched_action[wp, Arch_assms]: valid_sched_action (simp: crunch_simps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain, arch_post_set_flags, arch_prepare_set_domain - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps) crunch set_vm_root @@ -95,7 +95,7 @@ crunch set_vm_root (wp: crunch_wps whenE_wp simp: crunch_simps) crunch arch_switch_to_thread - for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" + for ct_in_cur_domain_2[wp, Arch_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" (simp: crunch_simps wp: assert_inv) crunch set_vm_root @@ -107,30 +107,30 @@ crunch set_vm_root (simp: crunch_simps) crunch switch_to_thread - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" (wp: crunch_wps) crunch arch_switch_to_idle_thread - for valid_idle[wp, DetSchedSchedule_AI_assms]: "valid_idle" + for valid_idle[wp, Arch_assms]: "valid_idle" (wp: crunch_wps simp: crunch_simps) crunch arch_switch_to_idle_thread, arch_prepare_next_domain - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" crunch arch_prepare_next_domain, arch_prepare_set_domain - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" (simp: Let_def) crunch arch_prepare_next_domain - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" - and ct_in_q[wp, DetSchedSchedule_AI_assms]: ct_in_q - and valid_blocked[wp, DetSchedSchedule_AI_assms]: valid_blocked + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and ct_in_q[wp, Arch_assms]: ct_in_q + and valid_blocked[wp, Arch_assms]: valid_blocked crunch arch_prepare_set_domain - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and valid_idle[wp, Arch_assms]: valid_idle lemma set_vm_root_valid_blocked_ct_in_q [wp]: "\valid_blocked and ct_in_q\ set_vm_root p \\_. valid_blocked and ct_in_q\" @@ -143,11 +143,11 @@ lemma as_user_ct_in_q[wp]: apply (clarsimp simp: ct_in_q_def st_tcb_at_def obj_at_def dest!: get_tcb_SomeD) done -lemma arch_switch_to_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma arch_switch_to_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ arch_switch_to_thread thread \\_. valid_blocked and ct_in_q\" by (wpsimp simp: arch_switch_to_thread_def) -lemma switch_to_idle_thread_ct_not_queued [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_queued [wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\rv s. not_queued (cur_thread s) s\" @@ -163,7 +163,7 @@ crunch set_vm_root (scheduler_action s) thread" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ switch_to_idle_thread \\rv. valid_blocked\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def | wp | wpc)+ apply clarsimp @@ -172,7 +172,7 @@ lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: done crunch arch_switch_to_thread - for exst[wp, DetSchedSchedule_AI_assms]: "\s. P (exst s :: det_ext)" + for exst[wp, Arch_assms]: "\s. P (exst s :: det_ext)" crunch arch_switch_to_idle_thread for cur_thread[wp]: "\s. P (cur_thread s)" @@ -182,14 +182,14 @@ lemma astit_st_tcb_at[wp]: apply (simp add: arch_switch_to_idle_thread_def) by (wpsimp) -lemma stit_activatable' [DetSchedSchedule_AI_assms]: +lemma stit_activatable' [Arch_assms]: "\valid_idle\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def ct_in_state_def do_machine_op_def split_def) apply wpsimp apply (clarsimp simp: valid_idle_def ct_in_state_def pred_tcb_at_def obj_at_def) done -lemma switch_to_idle_thread_cur_thread_idle_thread [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_cur_thread_idle_thread [wp, Arch_assms]: "\\\ switch_to_idle_thread \\_ s. cur_thread s = idle_thread s\" by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+ @@ -217,22 +217,22 @@ lemma set_asid_pool_valid_sched[wp]: crunch arch_finalise_cap, prepare_thread_delete - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action) crunch arch_finalise_cap, prepare_thread_delete - for simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action + for simple_sched_action[wp, Arch_assms]: simple_sched_action (wp: hoare_drop_imps mapM_x_wp mapM_wp subset_refl simp: unless_def if_fun_split) crunch arch_finalise_cap, prepare_thread_delete, arch_invoke_irq_handler, arch_mask_irq_signal - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" (ignore: set_object wp: crunch_wps subset_refl simp: if_fun_split) -lemma activate_thread_valid_sched [DetSchedSchedule_AI_assms]: +lemma activate_thread_valid_sched [Arch_assms]: "\valid_sched\ activate_thread \\_. valid_sched\" apply (simp add: activate_thread_def) apply (wp set_thread_state_runnable_valid_sched gts_wp | wpc | simp add: arch_activate_idle_thread_def)+ @@ -244,7 +244,7 @@ crunch for valid_sched[wp]: valid_sched (wp: mapM_x_wp' mapM_wp' crunch_wps) -lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: +lemma arch_perform_invocation_valid_sched [wp, Arch_assms]: "\invs and valid_sched and ct_active and valid_arch_inv a\ arch_perform_invocation a \\_.valid_sched\" @@ -255,24 +255,24 @@ lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: crunch handle_arch_fault_reply, handle_vm_fault - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps) crunch handle_vm_fault, handle_arch_fault_reply - for not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" + for not_queued[wp, Arch_assms]: "not_queued t" (simp: crunch_simps) crunch handle_arch_fault_reply, handle_vm_fault - for sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" + for sched_act_not[wp, Arch_assms]: "scheduler_act_not t" (simp: crunch_simps) -lemma hvmf_st_tcb_at [wp, DetSchedSchedule_AI_assms]: +lemma hvmf_st_tcb_at [wp, Arch_assms]: "\st_tcb_at P t' \ handle_vm_fault t w \\rv. st_tcb_at P t' \" unfolding handle_vm_fault_def by (cases w; wpsimp) -lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: +lemma handle_vm_fault_st_tcb_cur_thread [wp, Arch_assms]: "\ \s. st_tcb_at P (cur_thread s) s \ handle_vm_fault t f \\_ s. st_tcb_at P (cur_thread s) s \" unfolding handle_vm_fault_def apply (fold ct_in_state_def) @@ -280,37 +280,37 @@ lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: done crunch arch_invoke_irq_control - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" crunch arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for valid_list[wp, DetSchedSchedule_AI_assms]: "valid_list" + for valid_list[wp, Arch_assms]: "valid_list" crunch handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info, arch_post_modify_registers - for cur_tcb[wp, DetSchedSchedule_AI_assms]: cur_tcb + for cur_tcb[wp, Arch_assms]: cur_tcb (simp: crunch_simps) crunch arch_get_sanitise_register_info, arch_post_modify_registers - for not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t'" + for not_cur_thread[wp, Arch_assms]: "not_cur_thread t'" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" -lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]: +lemma arch_post_modify_registers_not_idle_thread[Arch_assms]: "\\s::det_ext state. t \ idle_thread s\ arch_post_modify_registers c t \\_ s. t \ idle_thread s\" by (wpsimp simp: arch_post_modify_registers_def) crunch arch_post_cap_deletion - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q - and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action - and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t" - and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" - and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" - and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and ct_not_in_q[wp, Arch_assms]: ct_not_in_q + and simple_sched_action[wp, Arch_assms]: simple_sched_action + and not_cur_thread[wp, Arch_assms]: "not_cur_thread t" + and not_queued[wp, Arch_assms]: "not_queued t" + and sched_act_not[wp, Arch_assms]: "scheduler_act_not t" + and weak_valid_sched_action[wp, Arch_assms]: weak_valid_sched_action + and valid_idle[wp, Arch_assms]: valid_idle crunch delete_asid_pool for delete_asid_pool[wp]: "\(s:: det_ext state). P (idle_thread s)" @@ -318,29 +318,30 @@ crunch delete_asid_pool crunch arch_finalise_cap - for arch_finalise_cap[wp, DetSchedSchedule_AI_assms]: "\(s:: det_ext state). P (idle_thread s)" + for arch_finalise_cap[wp, Arch_assms]: "\(s:: det_ext state). P (idle_thread s)" (wp: crunch_wps simp: if_fun_split) crunch arch_switch_to_thread - for etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" + for etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" crunch handle_spurious_irq - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and valid_idle[wp, Arch_assms]: valid_idle crunch prepare_thread_delete, arch_post_cap_deletion, arch_finalise_cap - for cur_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_thread s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for cur_thread[wp, Arch_assms]: "\s. P (cur_thread s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) +lemmas DetSchedSchedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.DetSchedSchedule_AI_assms)?) qed context Arch begin arch_global_naming @@ -356,12 +357,15 @@ lemma handle_reserved_irq_valid_sched: handle_reserved_irq irq \\rv. valid_sched\" unfolding handle_reserved_irq_def by (wpsimp simp: non_kernel_IRQs_def) +lemmas [Arch_assms] = handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched + +lemmas DetSchedSchedule_AI_handle_hypervisor_fault_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI_handle_hypervisor_fault?: DetSchedSchedule_AI_handle_hypervisor_fault proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.DetSchedSchedule_AI_handle_hypervisor_fault_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchDeterministic_AI.thy b/proof/invariant-abstract/RISCV64/ArchDeterministic_AI.thy index c543b9fb22..dfa5673457 100644 --- a/proof/invariant-abstract/RISCV64/ArchDeterministic_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchDeterministic_AI.thy @@ -10,27 +10,28 @@ begin context Arch begin arch_global_naming -named_theorems Deterministic_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Deterministic_AI locale *) crunch cap_swap_for_delete,set_cap,finalise_cap,arch_get_sanitise_register_info, arch_post_modify_registers, arch_post_set_flags - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -declare get_cap_inv[Deterministic_AI_assms] +declare get_cap_inv[Arch_assms] + +lemmas Deterministic_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Deterministic_AI_1?: Deterministic_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Deterministic_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_invoke_irq_handler - for valid_list[wp,Deterministic_AI_assms]: valid_list + for valid_list[wp,Arch_assms]: valid_list crunch invoke_untyped for valid_list[wp]: valid_list @@ -59,19 +60,19 @@ crunch perform_invocation (wp: crunch_wps simp: crunch_simps ignore: without_preemption) crunch handle_invocation - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps syscall_valid simp: crunch_simps ignore: without_preemption syscall) crunch handle_recv, handle_yield, handle_call - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: crunch_simps) -lemma handle_vm_fault_valid_list[wp, Deterministic_AI_assms]: +lemma handle_vm_fault_valid_list[wp, Arch_assms]: "handle_vm_fault thread fault \valid_list\" unfolding handle_vm_fault_def by (cases fault; wpsimp) -lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: +lemma handle_interrupt_valid_list[wp, Arch_assms]: "\valid_list\ handle_interrupt irq \\_.valid_list\" unfolding handle_interrupt_def ackInterrupt_def apply (rule hoare_pre) @@ -80,17 +81,18 @@ lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: | wp (once) hoare_drop_imps)+ crunch handle_send, handle_reply, handle_spurious_irq - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list crunch handle_hypervisor_fault - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list + +lemmas Deterministic_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Deterministic_AI_2?: Deterministic_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Deterministic_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchDetype_AI.thy b/proof/invariant-abstract/RISCV64/ArchDetype_AI.thy index 7ea5bce198..321905991a 100644 --- a/proof/invariant-abstract/RISCV64/ArchDetype_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchDetype_AI.thy @@ -10,16 +10,16 @@ begin context Arch begin arch_global_naming -named_theorems Detype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_AI locale *) -lemma valid_globals_irq_node[Detype_AI_assms]: +lemma valid_globals_irq_node[Arch_assms]: "\ valid_global_refs s; cte_wp_at ((=) cap) ptr s \ \ interrupt_irq_node s irq \ cap_range cap" apply (erule(1) valid_global_refsD) apply (simp add: global_refs_def) done -lemma caps_of_state_ko[Detype_AI_assms]: +lemma caps_of_state_ko[Arch_assms]: "valid_cap cap s \ is_untyped_cap cap \ cap_range cap = {} \ @@ -33,7 +33,7 @@ lemma caps_of_state_ko[Detype_AI_assms]: split: option.splits if_splits)+ done -lemma mapM_x_storeWord[Detype_AI_assms]: +lemma mapM_x_storeWord[Arch_assms]: (* FIXME: taken from Retype_C.thy and adapted wrt. the missing intvl syntax. *) assumes al: "is_aligned ptr word_size_bits" shows "mapM_x (\x. storeWord (ptr + of_nat x * word_size) 0) [0..x. if x \ S then {} else state_hyp_refs_of s x)" by (rule ext, simp add: state_hyp_refs_of_def detype_def) +lemmas Detype_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Detype_AI?: Detype_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Detype_AI_assms)?) + by (intro_locales; (unfold_locales; fact RISCV64.Detype_AI_assms)?) qed context detype_locale_arch begin diff --git a/proof/invariant-abstract/RISCV64/ArchEmptyFail_AI.thy b/proof/invariant-abstract/RISCV64/ArchEmptyFail_AI.thy index d832fe6bec..9542698166 100644 --- a/proof/invariant-abstract/RISCV64/ArchEmptyFail_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchEmptyFail_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_AI locale *) crunch_ignore (empty_fail) (add: setVSpaceRoot_impl sfence_impl hwASIDFlush_impl read_stval resetTimer_impl stval_val @@ -18,20 +18,21 @@ crunch_ignore (empty_fail) crunch loadWord, load_word_offs, storeWord, getRestartPC, get_mrs - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_load_word_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_load_word?: EmptyFail_AI_load_word proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.EmptyFail_AI_load_word_assms)?) qed context Arch begin arch_global_naming crunch handle_fault - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: kernel_object.splits option.splits arch_cap.splits cap.splits endpoint.splits bool.splits list.splits thread_state.splits split_def catch_def sum.splits Let_def) @@ -108,12 +109,13 @@ lemma arch_decode_invocation_empty_fail[wp]: decode_page_table_invocation_def decode_pt_inv_map_def decode_fr_inv_map_def Let_def)\) (* 15s *) +lemmas EmptyFail_AI_derive_cap_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_derive_cap?: EmptyFail_AI_derive_cap proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.EmptyFail_AI_derive_cap_assms)?) qed context Arch begin arch_global_naming @@ -129,32 +131,36 @@ lemma empty_fail_pt_lookup_from_level[wp]: crunch maskInterrupt, empty_slot, finalise_cap, preemption_point, cap_swap_for_delete, decode_invocation - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: Let_def catch_def split_def OR_choiceE_def mk_ef_def option.splits endpoint.splits notification.splits thread_state.splits sum.splits cap.splits arch_cap.splits kernel_object.splits vmpage_size.splits pte.splits bool.splits list.splits) crunch setRegister, setNextPC - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_rec_del_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_rec_del?: EmptyFail_AI_rec_del proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.EmptyFail_AI_rec_del_assms)?) qed context Arch begin arch_global_naming + crunch cap_delete, choose_thread, arch_prepare_next_domain - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_schedule_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_schedule?: EmptyFail_AI_schedule proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.EmptyFail_AI_schedule_assms)?) qed context Arch begin arch_global_naming @@ -163,12 +169,12 @@ crunch read_stval for (empty_fail) empty_fail[wp] (ignore_del: read_stval) -lemma plic_complete_claim_empty_fail[wp, EmptyFail_AI_assms]: +lemma plic_complete_claim_empty_fail[wp, Arch_assms]: "empty_fail (plic_complete_claim irq)" by (clarsimp simp: plic_complete_claim_def) crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: cap.splits arch_cap.splits split_def invocation_label.splits Let_def kernel_object.splits arch_kernel_obj.splits option.splits pte.splits bool.splits apiobject_type.splits aobject_type.splits notification.splits @@ -176,12 +182,13 @@ crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt page_table_invocation.splits page_invocation.splits asid_control_invocation.splits asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits) +lemmas EmptyFail_AI_call_kernel_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_call_kernel?: EmptyFail_AI_call_kernel proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.EmptyFail_AI_call_kernel_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchFinalise_AI.thy b/proof/invariant-abstract/RISCV64/ArchFinalise_AI.thy index fa9275cc97..afcf87f207 100644 --- a/proof/invariant-abstract/RISCV64/ArchFinalise_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchFinalise_AI.thy @@ -10,13 +10,13 @@ begin context Arch begin -named_theorems Finalise_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_AI locale *) crunch prepare_thread_delete for caps_of_state[wp]: "\s. P (caps_of_state s)" (wp: crunch_wps) -declare prepare_thread_delete_caps_of_state [Finalise_AI_assms] +declare prepare_thread_delete_caps_of_state [Arch_assms] arch_global_naming @@ -160,17 +160,17 @@ lemma unmap_page_tcb_cap_valid: done -lemma (* replaceable_cdt_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_cdt_update *)[simp,Arch_assms]: "replaceable (cdt_update f s) = replaceable s" by (fastforce simp: replaceable_def tcb_cap_valid_def reachable_frame_cap_def reachable_target_def) -lemma (* replaceable_revokable_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_revokable_update *)[simp,Arch_assms]: "replaceable (is_original_cap_update f s) = replaceable s" by (fastforce simp: replaceable_def is_final_cap'_def2 tcb_cap_valid_def reachable_frame_cap_def reachable_target_def) -lemma (* replaceable_more_update *) [simp,Finalise_AI_assms]: +lemma (* replaceable_more_update *) [simp,Arch_assms]: "replaceable (trans_state f s) sl cap cap' = replaceable s sl cap cap'" by (simp add: replaceable_def reachable_frame_cap_def reachable_target_def) @@ -182,9 +182,9 @@ lemma reachable_frame_cap_trans_state[simp]: "reachable_frame_cap cap (trans_state f s) = reachable_frame_cap cap s" by (simp add: reachable_frame_cap_def) -lemmas [Finalise_AI_assms] = obj_refs_obj_ref_of (* used under name obj_ref_ofI *) +lemmas [Arch_assms] = obj_refs_obj_ref_of (* used under name obj_ref_ofI *) -lemma (* empty_slot_invs *) [Finalise_AI_assms]: +lemma (* empty_slot_invs *) [Arch_assms]: "\\s. invs s \ cte_wp_at (replaceable s sl cap.NullCap) sl s \ emptyable sl s \ (info \ NullCap \ post_cap_delete_pre info ((caps_of_state s) (sl \ NullCap)))\ @@ -264,7 +264,7 @@ lemma (* empty_slot_invs *) [Finalise_AI_assms]: apply (simp add: is_final_cap'_def2 cte_wp_at_caps_of_state) by fastforce -lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: +lemma dom_tcb_cap_cases_lt_ARCH [Arch_assms]: "dom tcb_cap_cases = {xs. length xs = 3 \ unat (of_bl xs :: machine_word) < 5}" apply (rule set_eqI, rule iffI) apply clarsimp @@ -274,7 +274,7 @@ lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: apply (clarsimp simp: nat_to_cref_unat_of_bl') done -lemma (* unbind_notification_final *) [wp,Finalise_AI_assms]: +lemma (* unbind_notification_final *) [wp,Arch_assms]: "\is_final_cap' cap\ unbind_notification t \ \rv. is_final_cap' cap\" unfolding unbind_notification_def apply (wp final_cap_lift thread_set_caps_of_state_trivial hoare_drop_imps @@ -289,7 +289,7 @@ lemma length_and_unat_of_bl_length: "(length xs = x \ unat (of_bl xs :: 'a::len word) < 2 ^ x) = (length xs = x)" by (auto simp: unat_of_bl_length) -lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: +lemma (* finalise_cap_cases1 *)[Arch_assms]: "\\s. final \ is_final_cap' cap s \ cte_wp_at ((=) cap) slot s\ finalise_cap cap final @@ -319,17 +319,17 @@ lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: done crunch arch_finalise_cap - for typ_at[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp,Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps unless_def assertE_def ignore: maskInterrupt set_object) crunch prepare_thread_delete - for typ_at[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp,Arch_assms]: "\s. P (typ_at T p s)" crunch prepare_thread_delete for tcb_at[wp]: "\s. tcb_at p s" -lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: +lemma (* finalise_cap_new_valid_cap *)[wp,Arch_assms]: "\valid_cap cap\ finalise_cap cap x \\rv. valid_cap (fst rv)\" apply (cases cap; simp) apply (wp suspend_valid_cap prepare_thread_delete_typ_at @@ -385,7 +385,7 @@ lemma as_user_valid_ioc[wp]: "\valid_ioc\ as_user t f \\rv. valid_ioc\" unfolding valid_ioc_def by (wpsimp wp: hoare_vcg_imp_lift hoare_vcg_all_lift) -lemma arch_finalise_cap_invs' [wp,Finalise_AI_assms]: +lemma arch_finalise_cap_invs' [wp,Arch_assms]: "\invs and valid_cap (ArchObjectCap cap)\ arch_finalise_cap cap final \\rv. invs\" @@ -402,7 +402,7 @@ lemma as_user_unlive[wp]: apply (wpsimp wp: set_object_wp) by (clarsimp simp: obj_at_def live_def hyp_live_def arch_tcb_context_set_def dest!: get_tcb_SomeD) -lemma obj_at_not_live_valid_arch_cap_strg [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: valid_cap_def obj_at_def valid_arch_cap_ref_def @@ -571,7 +571,7 @@ lemma arch_finalise_cap_replaceable: done -lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_slot_not_irq_node *)[Arch_assms]: "\if_unsafe_then_cap and valid_global_refs and cte_wp_at (\cp. cap_irqs cp \ {}) sl\ deleting_irq_handler irq @@ -592,7 +592,7 @@ lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: apply (clarsimp simp: appropriate_cte_cap_def split: cap.split_asm) done -lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Arch_assms]: "\ cte_wp_at ((=) cap) p s; is_final_cap' cap s; obj_refs cap' = obj_refs cap \ \ no_cap_to_obj_with_diff_ref cap' {p} s" @@ -614,7 +614,7 @@ lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: gen_obj_refs_Int) done -lemma (* suspend_no_cap_to_obj_ref *)[wp,Finalise_AI_assms]: +lemma (* suspend_no_cap_to_obj_ref *)[wp,Arch_assms]: "\no_cap_to_obj_with_diff_ref cap S\ suspend t \\rv. no_cap_to_obj_with_diff_ref cap S\" @@ -648,7 +648,7 @@ lemma prepare_thread_delete_unlive[wp]: apply (clarsimp simp: obj_at_def, case_tac ko, simp_all add: is_tcb_def live_def arch_tcb_live_def) done -lemma finalise_cap_replaceable [Finalise_AI_assms]: +lemma finalise_cap_replaceable [Arch_assms]: "\\s. s \ cap \ x = is_final_cap' cap s \ valid_mdb s \ cte_wp_at ((=) cap) sl s \ valid_objs s \ sym_refs (state_refs_of s) \ (cap_irqs cap \ {} \ if_unsafe_then_cap s \ valid_global_refs s) @@ -698,7 +698,7 @@ lemma finalise_cap_replaceable [Finalise_AI_assms]: | wpc | simp add: valid_cap_simps)+)) -lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_cte_preserved *)[Arch_assms]: assumes x: "\cap. P cap \ \ can_fast_finalise cap" shows "\cte_wp_at P p\ deleting_irq_handler irq \\rv. cte_wp_at P p\" apply (simp add: deleting_irq_handler_def) @@ -706,24 +706,25 @@ lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: done crunch prepare_thread_delete - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" crunch arch_finalise_cap - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def wp: crunch_wps set_object_cte_at) -declare arch_post_cap_deletion_cur_thread[Finalise_AI_assms] +declare arch_post_cap_deletion_cur_thread[Arch_assms] crunch arch_post_cap_deletion - for cur_domain[Finalise_AI_assms, wp]: "\s. P (cur_domain s)" + for cur_domain[Arch_assms, wp]: "\s. P (cur_domain s)" (wp: crunch_wps dxo_wp_weak) +lemmas Finalise_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_1?: Finalise_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -747,7 +748,7 @@ lemma fast_finalise_replaceable[wp]: apply (clarsimp simp: cap_irqs_def cap_irq_opt_def split: cap.split_asm) done -lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: +lemma (* cap_delete_one_invs *) [Arch_assms,wp]: "\invs and emptyable ptr\ cap_delete_one ptr \\rv. invs\" apply (simp add: cap_delete_one_def unless_def is_final_cap_def) apply (rule hoare_pre) @@ -756,18 +757,19 @@ lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: apply (drule cte_wp_at_valid_objs_valid_cap, fastforce+) done +lemmas Finalise_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_2?: Finalise_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Finalise_AI_2_assms)?) qed context Arch begin arch_global_naming crunch prepare_thread_delete - for irq_node[Finalise_AI_assms,wp]: "\s. P (interrupt_irq_node s)" + for irq_node[Arch_assms,wp]: "\s. P (interrupt_irq_node s)" crunch arch_finalise_cap for irq_node[wp]: "\s. P (interrupt_irq_node s)" @@ -896,7 +898,7 @@ crunch prepare_thread_delete for invs[wp]: invs (ignore: set_object) -lemma (* finalise_cap_invs *)[Finalise_AI_assms]: +lemma (* finalise_cap_invs *)[Arch_assms]: shows "\invs and cte_wp_at ((=) cap) slot\ finalise_cap cap x \\rv. invs\" apply (cases cap, simp_all split del: if_split) apply (wp cancel_all_ipc_invs cancel_all_signals_invs unbind_notification_invs @@ -913,16 +915,16 @@ lemma (* finalise_cap_invs *)[Finalise_AI_assms]: apply (auto dest: cte_wp_at_valid_objs_valid_cap) done -lemma (* finalise_cap_irq_node *)[Finalise_AI_assms]: +lemma (* finalise_cap_irq_node *)[Arch_assms]: "\\s. P (interrupt_irq_node s)\ finalise_cap a b \\_ s. P (interrupt_irq_node s)\" apply (case_tac a,simp_all) apply (wp | clarsimp)+ done -lemmas (*arch_finalise_cte_irq_node *) [wp,Finalise_AI_assms] +lemmas (*arch_finalise_cte_irq_node *) [wp,Arch_assms] = hoare_use_eq_irq_node [OF arch_finalise_cap_irq_node arch_finalise_cap_cte_wp_at] -lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: +lemma (* deleting_irq_handler_st_tcb_at *) [Arch_assms]: "\st_tcb_at P t and K (\st. simple st \ P st)\ deleting_irq_handler irq \\rv. st_tcb_at P t\" @@ -931,11 +933,11 @@ lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: apply simp done -lemma irq_node_global_refs_ARCH [Finalise_AI_assms]: +lemma irq_node_global_refs_ARCH [Arch_assms]: "interrupt_irq_node s irq \ global_refs s" by (simp add: global_refs_def) -lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: +lemma (* get_irq_slot_fast_finalisable *)[wp,Arch_assms]: "\invs\ get_irq_slot irq \cte_wp_at can_fast_finalise\" apply (simp add: get_irq_slot_def) apply wp @@ -957,12 +959,12 @@ lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: apply (clarsimp simp: cap_range_def) done -lemma (* replaceable_or_arch_update_same *) [Finalise_AI_assms]: +lemma (* replaceable_or_arch_update_same *) [Arch_assms]: "replaceable_or_arch_update s slot cap cap" by (clarsimp simp: replaceable_or_arch_update_def replaceable_def is_arch_update_def is_cap_simps) -lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: +lemma (* replace_cap_invs_arch_update *)[Arch_assms]: "\\s. cte_wp_at (replaceable_or_arch_update s p cap) p s \ invs s \ cap \ cap.NullCap @@ -987,7 +989,7 @@ lemma dmo_pred_tcb_at[wp]: apply (clarsimp simp: pred_tcb_at_def obj_at_def) done -lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: +lemma dmo_tcb_cap_valid_ARCH [Arch_assms]: "do_machine_op mop \\s. P (tcb_cap_valid cap ptr s)\" apply (simp add: tcb_cap_valid_def no_cap_to_obj_with_diff_ref_def) apply (wp_pre, wps, rule hoare_vcg_prop) @@ -1005,7 +1007,7 @@ lemma dmo_reachable_target[wp]: apply simp done -lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: +lemma (* dmo_replaceable_or_arch_update *) [Arch_assms,wp]: "\\s. replaceable_or_arch_update s slot cap cap'\ do_machine_op mo \\r s. replaceable_or_arch_update s slot cap cap'\" @@ -1016,6 +1018,8 @@ lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: apply simp done +lemmas Finalise_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end arch_requalify_consts replaceable_or_arch_update @@ -1023,8 +1027,7 @@ arch_requalify_consts replaceable_or_arch_update interpretation Finalise_AI_3?: Finalise_AI_3 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Finalise_AI_3_assms)?) qed context Arch begin arch_global_naming @@ -1041,8 +1044,7 @@ end interpretation Finalise_AI_4?: Finalise_AI_4 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -1079,9 +1081,9 @@ lemma arch_finalise_cap_valid_cap[wp]: unfolding arch_finalise_cap_def by (wpsimp split: arch_cap.split option.split bool.split) -lemmas clearMemory_invs[wp,Finalise_AI_assms] = clearMemory_invs +lemmas clearMemory_invs[wp,Arch_assms] = clearMemory_invs -lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: +lemma valid_idle_has_null_cap_ARCH[Arch_assms]: "\ if_unsafe_then_cap s; valid_global_refs s; valid_idle s; valid_irq_node s; caps_of_state s (idle_thread s, v) = Some cap \ \ cap = NullCap" @@ -1097,7 +1099,7 @@ lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: apply (drule_tac x=word in spec, simp) done -lemma (* zombie_cap_two_nonidles *)[Finalise_AI_assms]: +lemma (* zombie_cap_two_nonidles *)[Arch_assms]: "\ caps_of_state s ptr = Some (Zombie ptr' zbits n); invs s \ \ fst ptr \ idle_thread s \ ptr' \ idle_thread s" apply (frule valid_global_refsD2, clarsimp+) @@ -1113,13 +1115,14 @@ lemma arch_derive_cap_notIRQ[wp]: "\\\ arch_derive_cap cap \\rv s. rv \ cap.IRQControlCap\,-" by (cases cap; wpsimp simp: arch_derive_cap_def o_def) +lemmas Finalise_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_5?: Finalise_AI_5 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Finalise_AI_5_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchInterruptAcc_AI.thy b/proof/invariant-abstract/RISCV64/ArchInterruptAcc_AI.thy index e066edf8c0..7cd8597468 100644 --- a/proof/invariant-abstract/RISCV64/ArchInterruptAcc_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchInterruptAcc_AI.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems InterruptAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InterruptAcc_AI locale *) -lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: +lemma dmo_maskInterrupt_invs [Arch_assms]: "\all_invs_but_valid_irq_states_for irq and (\s. state = interrupt_states s irq)\ do_machine_op (maskInterrupt (state = IRQInactive) irq) \\rv. invs\" @@ -30,12 +30,13 @@ lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: crunch handle_spurious_irq for invs: invs +lemmas InterruptAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation InterruptAcc_AI?: InterruptAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact InterruptAcc_AI_assms) + case 1 show ?case by (unfold_locales; fact RISCV64.InterruptAcc_AI_assms) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchInterrupt_AI.thy b/proof/invariant-abstract/RISCV64/ArchInterrupt_AI.thy index b4af67b425..9126baf9da 100644 --- a/proof/invariant-abstract/RISCV64/ArchInterrupt_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchInterrupt_AI.thy @@ -23,16 +23,16 @@ primrec arch_irq_control_inv_valid_real :: defs arch_irq_control_inv_valid_def: "arch_irq_control_inv_valid \ arch_irq_control_inv_valid_real" -named_theorems Interrupt_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_AI locale *) -lemma (* decode_irq_control_invocation_inv *)[Interrupt_AI_assms]: +lemma (* decode_irq_control_invocation_inv *)[Arch_assms]: "\P\ decode_irq_control_invocation label args slot caps \\rv. P\" apply (simp add: decode_irq_control_invocation_def Let_def arch_check_irq_def arch_decode_irq_control_invocation_def whenE_def, safe) apply (wp | simp)+ done -lemma decode_irq_control_valid [Interrupt_AI_assms]: +lemma decode_irq_control_valid [Arch_assms]: "\\s. invs s \ (\cap \ set caps. s \ cap) \ (\cap \ set caps. is_cnode_cap cap \ (\r \ cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -51,7 +51,7 @@ lemma decode_irq_control_valid [Interrupt_AI_assms]: apply fastforce done -lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: +lemma get_irq_slot_different_ARCH[Arch_assms]: "\\s. valid_global_refs s \ ex_cte_cap_wp_to is_cnode_cap ptr s\ get_irq_slot irq \\rv s. rv \ ptr\" @@ -63,7 +63,7 @@ lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: apply (clarsimp simp: global_refs_def is_cap_simps cap_range_def) done -lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: +lemma is_derived_use_interrupt_ARCH[Arch_assms]: "(is_ntfn_cap cap \ interrupt_derived cap cap') \ (is_derived m p cap cap')" apply (clarsimp simp: is_cap_simps) apply (clarsimp simp: interrupt_derived_def is_derived_def) @@ -71,7 +71,7 @@ lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: apply (simp add: is_cap_simps is_pt_cap_def vs_cap_ref_def) done -lemma maskInterrupt_invs_ARCH[Interrupt_AI_assms]: +lemma maskInterrupt_invs_ARCH[Arch_assms]: "\invs and (\s. \b \ interrupt_states s irq \ IRQInactive)\ do_machine_op (maskInterrupt b irq) \\rv. invs\" @@ -91,13 +91,13 @@ lemma dmo_plic_complete_claim[wp]: apply (auto simp: plic_complete_claim_def machine_op_lift_def machine_rest_lift_def in_monad select_f_def) done -lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Interrupt_AI_assms]: +lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Arch_assms]: "no_cap_to_obj_with_diff_ref (IRQHandlerCap irq) S = \" by (rule ext, simp add: no_cap_to_obj_with_diff_ref_def cte_wp_at_caps_of_state obj_ref_none_no_asid) -lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: +lemma (* set_irq_state_valid_cap *)[Arch_assms]: "\valid_cap cap\ set_irq_state IRQSignal irq \\rv. valid_cap cap\" apply (clarsimp simp: set_irq_state_def) apply (wp do_machine_op_valid_cap) @@ -107,9 +107,9 @@ lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: done crunch set_irq_state - for valid_global_refs[Interrupt_AI_assms]: "valid_global_refs" + for valid_global_refs[Arch_assms]: "valid_global_refs" -lemma invoke_irq_handler_invs'[Interrupt_AI_assms]: +lemma invoke_irq_handler_invs'[Arch_assms]: assumes dmo_ex_inv[wp]: "\f. \invs and ex_inv\ do_machine_op f \\rv::unit. ex_inv\" assumes cap_insert_ex_inv[wp]: "\cap src dest. \ex_inv and invs and K (src \ dest)\ @@ -165,7 +165,7 @@ lemma invoke_irq_handler_invs'[Interrupt_AI_assms]: done qed -lemma (* invoke_irq_control_invs *) [Interrupt_AI_assms]: +lemma (* invoke_irq_control_invs *) [Arch_assms]: "\invs and irq_control_inv_valid i\ invoke_irq_control i \\rv. invs\" apply (cases i, simp_all) apply (wp cap_insert_simple_invs @@ -189,7 +189,7 @@ lemma (* invoke_irq_control_invs *) [Interrupt_AI_assms]: crunch resetTimer for device_state_inv[wp]: "\ms. P (device_state ms)" -lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: +lemma resetTimer_invs_ARCH[Arch_assms]: "\invs\ do_machine_op resetTimer \\_. invs\" apply (wp dmo_invs) apply safe @@ -202,11 +202,11 @@ lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: apply(erule use_valid, wp no_irq_resetTimer no_irq, assumption) done -lemma empty_fail_ackInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_ackInterrupt_ARCH[Arch_assms]: "empty_fail (ackInterrupt irq)" by (wp | simp add: ackInterrupt_def)+ -lemma empty_fail_maskInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_maskInterrupt_ARCH[Arch_assms]: "empty_fail (maskInterrupt f irq)" by (wp | simp add: maskInterrupt_def)+ @@ -241,7 +241,7 @@ crunch timer_tick for invs[wp]: invs (wp: thread_set_invs_trivial[OF ball_tcb_cap_casesI]) -lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]: +lemma (* handle_interrupt_invs *) [Arch_assms]: "\invs\ handle_interrupt irq \\_. invs\" apply (simp add: handle_interrupt_def) apply (rule conjI; rule impI) @@ -258,7 +258,7 @@ lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]: | rule conjI)+ done -lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: +lemma sts_arch_irq_control_inv_valid[wp, Arch_assms]: "\arch_irq_control_inv_valid i\ set_thread_state t st \\rv. arch_irq_control_inv_valid i\" @@ -270,12 +270,13 @@ lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: crunch arch_invoke_irq_handler for typ_at[wp]: "\s. P (typ_at T p s)" +lemmas Interrupt_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Interrupt_AI?: Interrupt_AI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: Interrupt_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: RISCV64.Interrupt_AI_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchInvariants_AI.thy b/proof/invariant-abstract/RISCV64/ArchInvariants_AI.thy index e63699e3f0..560627c331 100644 --- a/proof/invariant-abstract/RISCV64/ArchInvariants_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchInvariants_AI.thy @@ -35,6 +35,10 @@ end_qualify context Arch begin arch_global_naming +(* used to accumulate theorems for satisfying Arch interface assumptions; + remember to clear before starting a new accumulation *) +named_theorems Arch_assms + (* compatibility with other architectures, input only *) abbreviation "vs_lookup s \ \level asid vref. vs_lookup_table level asid vref s" diff --git a/proof/invariant-abstract/RISCV64/ArchIpcCancel_AI.thy b/proof/invariant-abstract/RISCV64/ArchIpcCancel_AI.thy index 1a33884511..ec0184cd17 100644 --- a/proof/invariant-abstract/RISCV64/ArchIpcCancel_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchIpcCancel_AI.thy @@ -10,19 +10,20 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_AI locale *) crunch arch_post_cap_deletion - for typ_at[wp, IpcCancel_AI_assms]: "\s. P (typ_at T p s)" - and idle_thread[wp, IpcCancel_AI_assms]: "\s. P (idle_thread s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + +lemmas IpcCancel_AI_assms = Arch_assms (* extract accumulated assumptions *) end interpretation IpcCancel_AI?: IpcCancel_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact IpcCancel_AI_assms)?) + by (intro_locales; (unfold_locales; fact RISCV64.IpcCancel_AI_assms)?) qed diff --git a/proof/invariant-abstract/RISCV64/ArchIpc_AI.thy b/proof/invariant-abstract/RISCV64/ArchIpc_AI.thy index 89f7bf6ec3..43445372d8 100644 --- a/proof/invariant-abstract/RISCV64/ArchIpc_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchIpc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_AI_1_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_1 locale *) lemma cap_asid_PageCap_None[simp]: "cap_asid (ArchObjectCap (FrameCap r R pgsz dev None)) = None" @@ -36,7 +36,7 @@ lemma arch_derive_cap_is_derived: | rule conjI)+) done -lemma derive_cap_is_derived [Ipc_AI_1_assms]: +lemma derive_cap_is_derived [Arch_assms]: "\\s. c'\ cap.NullCap \ cte_wp_at (\cap. cap_master_cap cap = cap_master_cap c' \ (cap_badge cap, cap_badge c') \ capBadge_ordering False \ cap_asid cap = cap_asid c' @@ -62,23 +62,24 @@ lemma derive_cap_is_derived [Ipc_AI_1_assms]: apply(clarsimp simp: valid_cap_def) done -lemma arch_cap_badge_rights_update[Ipc_AI_1_assms, simp]: +lemma arch_cap_badge_rights_update[Arch_assms, simp]: "arch_cap_badge (acap_rights_update rights acap) = arch_cap_badge acap" by simp +lemmas Ipc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_1_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Ipc_AI_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_2 locale *) -lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights [simp, Arch_assms]: "is_derived m p (cap_rights_update R c) = is_derived m p c" apply (rule ext) apply (simp add: cap_rights_update_def is_derived_def is_cap_simps) @@ -90,12 +91,12 @@ lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: split: arch_cap.split cap.split bool.splits) -lemma data_to_message_info_valid [Ipc_AI_2_assms]: +lemma data_to_message_info_valid [Arch_assms]: "valid_message_info (data_to_message_info w)" by (simp add: valid_message_info_def data_to_message_info_def word_and_le1 msg_max_length_def msg_max_extra_caps_def Let_def not_less mask_def) -lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: +lemma get_extra_cptrs_length[wp, Arch_assms]: "\\s . valid_message_info mi\ get_extra_cptrs buf mi \\rv s. length rv \ msg_max_extra_caps\" @@ -110,17 +111,17 @@ lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: intro: length_upt) done -lemma cap_asid_rights_update [simp, Ipc_AI_2_assms]: +lemma cap_asid_rights_update [simp, Arch_assms]: "cap_asid (cap_rights_update R c) = cap_asid c" by (simp add: cap_rights_update_def acap_rights_update_def cap_asid_def split: cap.splits arch_cap.splits) -lemma cap_rights_update_vs_cap_ref[simp, Ipc_AI_2_assms]: +lemma cap_rights_update_vs_cap_ref[simp, Arch_assms]: "vs_cap_ref (cap_rights_update rs cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def vs_cap_ref_arch_def cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) -lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights2[simp, Arch_assms]: "is_derived m p c (cap_rights_update R c') = is_derived m p c c'" apply (case_tac c'; simp add: cap_rights_update_def) apply (clarsimp simp: is_derived_def is_cap_simps cap_master_cap_def vs_cap_ref_def @@ -129,12 +130,12 @@ lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: apply (case_tac acap1) by (auto simp: acap_rights_update_def) -lemma cap_range_update [simp, Ipc_AI_2_assms]: +lemma cap_range_update [simp, Arch_assms]: "cap_range (cap_rights_update R cap) = cap_range cap" by (simp add: cap_range_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits) -lemma derive_cap_idle[wp, Ipc_AI_2_assms]: +lemma derive_cap_idle[wp, Arch_assms]: "\\s. global_refs s \ cap_range cap = {}\ derive_cap slot cap \\c s. global_refs s \ cap_range c = {}\, -" @@ -146,7 +147,7 @@ lemma derive_cap_idle[wp, Ipc_AI_2_assms]: apply (case_tac arch_cap, simp_all) done -lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: +lemma arch_derive_cap_objrefs_iszombie [Arch_assms]: "\\s . P (set_option (aobj_ref cap)) False s\ arch_derive_cap cap \\rv s. rv \ NullCap \ P (obj_refs rv) (is_zombie rv) s\,-" @@ -154,7 +155,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: apply(rule hoare_pre, wpsimp+)+ done -lemma obj_refs_remove_rights[simp, Ipc_AI_2_assms]: +lemma obj_refs_remove_rights[simp, Arch_assms]: "obj_refs (remove_rights rs cap) = obj_refs cap" by (auto simp add: remove_rights_def cap_rights_update_def acap_rights_update_def @@ -166,7 +167,7 @@ lemma storeWord_um_inv: \\_ s. is_aligned a 3 \ x \ {a,a+1,a+2,a+3,a+4,a+5,a+6,a+7} \ underlying_memory s x = um x\" by (wpsimp simp: upto.simps storeWord_def is_aligned_mask) -lemma store_word_offs_vms[wp, Ipc_AI_2_assms]: +lemma store_word_offs_vms[wp, Arch_assms]: "\valid_machine_state\ store_word_offs ptr offs v \\_. valid_machine_state\" proof - have aligned_offset_ignore: @@ -205,12 +206,12 @@ proof - done qed -lemma is_zombie_update_cap_data[simp, Ipc_AI_2_assms]: +lemma is_zombie_update_cap_data[simp, Arch_assms]: "is_zombie (update_cap_data P data cap) = is_zombie cap" by (simp add: update_cap_data_closedform arch_update_cap_data_def is_zombie_def split: cap.splits) -lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: +lemma valid_msg_length_strengthen [Arch_assms]: "valid_message_info mi \ unat (mi_length mi) \ msg_max_length" apply (clarsimp simp: valid_message_info_def) apply (subgoal_tac "unat (mi_length mi) \ unat (of_nat msg_max_length :: machine_word)") @@ -218,7 +219,7 @@ lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: apply (clarsimp simp: un_ui_le word_le_def) done -lemma copy_mrs_in_user_frame[wp, Ipc_AI_2_assms]: +lemma copy_mrs_in_user_frame[wp, Arch_assms]: "\in_user_frame p\ copy_mrs t buf t' buf' n \\rv. in_user_frame p\" by (simp add: in_user_frame_def) (wp hoare_vcg_ex_lift) @@ -226,7 +227,7 @@ lemma as_user_getRestart_inv[wp]: "as_user t getRestartPC \P\" by (simp add: getRestartPC_def, rule user_getreg_inv) -lemma make_arch_fault_msg_inv[wp, Ipc_AI_2_assms]: +lemma make_arch_fault_msg_inv[wp, Arch_assms]: "make_arch_fault_msg ft t \P\" by (cases ft; wpsimp) @@ -234,14 +235,14 @@ lemma make_fault_msg_inv[wp]: "make_fault_msg ft t \P\" by (cases ft; wpsimp wp: as_user_inv getRestartPC_inv mapM_wp' split_del: if_split) -lemma do_fault_transfer_invs[wp, Ipc_AI_2_assms]: +lemma do_fault_transfer_invs[wp, Arch_assms]: "\invs and tcb_at receiver\ do_fault_transfer badge sender receiver recv_buf \\rv. invs\" by (simp add: do_fault_transfer_def split_def | wp | clarsimp split: option.split)+ -lemma lookup_ipc_buffer_in_user_frame[wp, Ipc_AI_2_assms]: +lemma lookup_ipc_buffer_in_user_frame[wp, Arch_assms]: "\valid_objs and tcb_at t\ lookup_ipc_buffer b t \case_option (\_. True) in_user_frame\" apply (simp add: lookup_ipc_buffer_def) @@ -338,9 +339,9 @@ lemma transfer_caps_non_null_cte_wp_at: done crunch do_fault_transfer - for cte_wp_at[wp,Ipc_AI_2_assms]: "cte_wp_at P p" + for cte_wp_at[wp,Arch_assms]: "cte_wp_at P p" -lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: +lemma do_normal_transfer_non_null_cte_wp_at [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at (P and ((\) cap.NullCap)) ptr\ do_normal_transfer st send_buffer ep b gr rt recv_buffer @@ -351,7 +352,7 @@ lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: | clarsimp simp:imp)+ done -lemma is_derived_ReplyCap [simp, Ipc_AI_2_assms]: +lemma is_derived_ReplyCap [simp, Arch_assms]: "\m p R. is_derived m p (cap.ReplyCap t False R) = (\c. is_master_reply_cap c \ obj_ref_of c = t)" apply (subst fun_eq_iff) apply clarsimp @@ -372,7 +373,7 @@ lemma do_normal_transfer_tcb_caps: | simp add:imp)+ done -lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: +lemma do_ipc_transfer_tcb_caps [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at P (t, ref) and tcb_at t\ @@ -384,7 +385,7 @@ lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: | wpc | simp add:imp)+ done -lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: +lemma setup_caller_cap_valid_global_objs[wp, Arch_assms]: "\valid_global_objs\ setup_caller_cap send recv grant \\rv. valid_global_objs\" apply (simp add: valid_global_objs_def) unfolding setup_caller_cap_def @@ -392,9 +393,9 @@ lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: done crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for inv[Ipc_AI_2_assms]: P + for inv[Arch_assms]: P -lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_vspace_objs[wp, Arch_assms]: "\valid_vspace_objs\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_vspace_objs\" @@ -415,11 +416,11 @@ lemma setup_caller_cap_aobj_at: unfolding setup_caller_cap_def by (wpsimp wp: cap_insert_aobj_at sts.aobj_at) -lemma setup_caller_cap_valid_arch[Ipc_AI_2_assms, wp]: +lemma setup_caller_cap_valid_arch[Arch_assms, wp]: "setup_caller_cap st rt grant \valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps[rotated -1] setup_caller_cap_tcb_at setup_caller_cap_aobj_at) -lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_arch[Arch_assms]: "\slots caps ep buffer n mi. \valid_arch_state and valid_objs and valid_mdb and K (distinct slots) and (\s. \x \ set slots. real_cte_at x s \ cte_wp_at (\cap. cap = cap.NullCap) x s) @@ -428,27 +429,28 @@ lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: \\_. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps transfer_caps_loop_typ_ats transfer_caps_loop_aobj_at) +lemmas Ipc_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_2_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Ipc_AI_2_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_3 locale *) crunch make_fault_msg for pspace_respects_device_region[wp]: "pspace_respects_device_region" (wp: as_user_inv getRestartPC_inv mapM_wp' simp: getRegister_def ignore: do_machine_op) crunch do_ipc_transfer - for pspace_respects_device_region[wp, Ipc_AI_3_assms]: "pspace_respects_device_region" + for pspace_respects_device_region[wp, Arch_assms]: "pspace_respects_device_region" (wp: crunch_wps ignore: const_on_failure simp: crunch_simps) -lemma do_ipc_transfer_respects_device_region[Ipc_AI_3_assms]: +lemma do_ipc_transfer_respects_device_region[Arch_assms]: "\cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\ do_ipc_transfer t ep bg grt r \\rv. cap_refs_respects_device_region\" @@ -466,7 +468,7 @@ lemma set_mrs_state_hyp_refs_of[wp]: by (wp set_mrs_thread_set_dmo thread_set_hyp_refs_trivial | simp)+ crunch do_ipc_transfer - for state_hyp_refs_of[wp, Ipc_AI_3_assms]: "\ s. P (state_hyp_refs_of s)" + for state_hyp_refs_of[wp, Arch_assms]: "\ s. P (state_hyp_refs_of s)" (wp: crunch_wps simp: zipWithM_x_mapM) lemma arch_derive_cap_untyped: @@ -487,18 +489,19 @@ lemma valid_arch_mdb_cap_swap: ((caps_of_state s)(a \ c', b \ c))" by (auto simp: valid_arch_mdb_def) -lemma do_ipc_transfer_valid_arch[Ipc_AI_3_assms]: +lemma do_ipc_transfer_valid_arch[Arch_assms]: "\valid_arch_state and valid_objs and valid_mdb \ do_ipc_transfer s ep bg grt r \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps dit_tcb_at do_ipc_transfer_aobj_at) +lemmas Ipc_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales;(fact Ipc_AI_3_assms)?) + case 1 show ?case by (unfold_locales;(fact RISCV64.Ipc_AI_3_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchRetype_AI.thy b/proof/invariant-abstract/RISCV64/ArchRetype_AI.thy index 225a84ff11..d2db36535a 100644 --- a/proof/invariant-abstract/RISCV64/ArchRetype_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchRetype_AI.thy @@ -15,26 +15,26 @@ begin context Arch begin arch_global_naming -named_theorems Retype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_AI locale *) -lemma arch_kobj_size_cong[Retype_AI_assms]: +lemma arch_kobj_size_cong[Arch_assms]: "\a = a1; c=c1\ \ arch_kobj_size (default_arch_object a b c) = arch_kobj_size (default_arch_object a1 b1 c1)" by (simp add: default_arch_object_def split: aobject_type.splits) -lemma clearMemoryVM_return[simp, Retype_AI_assms]: +lemma clearMemoryVM_return[simp, Arch_assms]: "clearMemoryVM a b = return ()" by (simp add: clearMemoryVM_def) -lemma slot_bits_def2 [Retype_AI_assms]: "slot_bits = cte_level_bits" +lemma slot_bits_def2 [Arch_assms]: "slot_bits = cte_level_bits" by (simp add: slot_bits_def cte_level_bits_def) definition "no_gs_types \ UNIV - {CapTableObject, ArchObject SmallPageObj, ArchObject LargePageObj, ArchObject HugePageObj}" -lemma no_gs_types_simps [simp, Retype_AI_assms]: +lemma no_gs_types_simps [simp, Arch_assms]: "Untyped \ no_gs_types" "TCBObject \ no_gs_types" "EndpointObject \ no_gs_types" @@ -43,7 +43,7 @@ lemma no_gs_types_simps [simp, Retype_AI_assms]: "ArchObject ASIDPoolObj \ no_gs_types" by (simp_all add: no_gs_types_def) -lemma retype_region_ret_folded [Retype_AI_assms]: +lemma retype_region_ret_folded [Arch_assms]: "\\\ retype_region y n bits ty dev \\r s. r = retype_addrs y ty n bits\" unfolding retype_region_def @@ -176,7 +176,7 @@ crunch copy_global_mappings for cap_refs_respects_device_region[wp]: "cap_refs_respects_device_region" (wp: crunch_wps) -lemma dmo_eq_kernel_restricted [wp, Retype_AI_assms]: +lemma dmo_eq_kernel_restricted [wp, Arch_assms]: "\\s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\ do_machine_op m \\rv s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\" @@ -223,25 +223,26 @@ lemma init_arch_objects_invs_from_restricted: done -lemma obj_bits_api_neq_0 [Retype_AI_assms]: +lemma obj_bits_api_neq_0 [Arch_assms]: "ty \ Untyped \ 0 < obj_bits_api ty us" unfolding obj_bits_api_def by (clarsimp simp: slot_bits_def default_arch_object_def bit_simps split: apiobject_type.splits aobject_type.splits) +lemmas Retype_AI_slot_bits_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_slot_bits?: Retype_AI_slot_bits proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact RISCV64.Retype_AI_slot_bits_assms) qed context Arch begin arch_global_naming -lemma valid_untyped_helper [Retype_AI_assms]: +lemma valid_untyped_helper [Arch_assms]: assumes valid_c : "s \ c" and cte_at : "cte_wp_at ((=) c) q s" and tyunt: "ty \ Untyped" @@ -314,13 +315,14 @@ lemma valid_default_arch_tcb: "\s. valid_arch_tcb default_arch_tcb s" by (simp add: default_arch_tcb_def valid_arch_tcb_def) +lemmas Retype_AI_valid_untyped_helper_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_valid_untyped_helper?: Retype_AI_valid_untyped_helper proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact RISCV64.Retype_AI_valid_untyped_helper_assms) qed @@ -329,11 +331,7 @@ locale retype_region_proofs_arch + Arch for s :: "'state_ext :: state_ext state" and ty us ptr sz n ps s' dev - - -context retype_region_proofs begin - -interpretation Arch . +begin lemma valid_cap: assumes cap: @@ -520,7 +518,7 @@ lemma vs_lookup_target': apply (fastforce dest: ptes_of) done -lemma wellformed_default_obj[Retype_AI_assms]: +lemma wellformed_default_obj[Arch_assms]: "\ ptra \ set (retype_addrs ptr ty n us); kheap s ptra = Some (ArchObj ao); arch_valid_obj ao s\ \ arch_valid_obj ao s'" @@ -528,11 +526,6 @@ lemma wellformed_default_obj[Retype_AI_assms]: split: arch_kernel_obj.splits option.splits) done -end - - -context retype_region_proofs_arch begin - lemma hyp_refs_eq: "state_hyp_refs_of s' = state_hyp_refs_of s" unfolding s'_def ps_def @@ -940,18 +933,18 @@ end context Arch begin arch_global_naming -named_theorems Retype_AI_assms' - -lemma invs_post_retype_invs [Retype_AI_assms']: +lemma invs_post_retype_invs [Arch_assms]: "invs s \ post_retype_invs ty refs s" by (clarsimp simp: post_retype_invs_def) lemmas equal_kernel_mappings_trans_state = more_update.equal_kernel_mappings_update -lemmas retype_region_proofs_assms [Retype_AI_assms'] +lemmas retype_region_proofs_assms [Arch_assms] = retype_region_proofs.post_retype_invs_axioms +lemmas Retype_AI_assms' = Arch_assms (* extract accumulated assumptions *) + end @@ -961,10 +954,9 @@ global_interpretation Retype_AI?: Retype_AI and post_retype_invs = post_retype_invs and region_in_kernel_window = region_in_kernel_window proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Retype_AI_assms)?) - (simp add: Retype_AI_axioms_def Retype_AI_assms') + by (intro_locales; (unfold_locales; fact RISCV64.Retype_AI_assms')?) + (simp add: Retype_AI_axioms_def RISCV64.Retype_AI_assms') qed diff --git a/proof/invariant-abstract/RISCV64/ArchSchedule_AI.thy b/proof/invariant-abstract/RISCV64/ArchSchedule_AI.thy index e5f609df22..65e0b3a2ac 100644 --- a/proof/invariant-abstract/RISCV64/ArchSchedule_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchSchedule_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_AI locale *) -lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]: +lemma dmo_mapM_storeWord_0_invs[wp,Arch_assms]: "do_machine_op (mapM (\p. storeWord p 0) S) \invs\" apply (simp add: dom_mapM ef_storeWord) apply (rule mapM_UNIV_wp) @@ -27,19 +27,19 @@ lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]: apply wp by (simp add: upto.simps word_bits_def) -lemma arch_stt_invs [wp,Schedule_AI_assms]: +lemma arch_stt_invs [wp,Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_switch_to_thread t \\_. invs\" apply (simp add: arch_switch_to_thread_def) apply wpsimp done -lemma arch_stt_tcb [wp,Schedule_AI_assms]: +lemma arch_stt_tcb [wp,Arch_assms]: "\tcb_at t'\ arch_switch_to_thread t' \\_. tcb_at t'\" apply (simp add: arch_switch_to_thread_def) apply (wp) done -lemma arch_stt_st_tcb_at[Schedule_AI_assms]: +lemma arch_stt_st_tcb_at[Arch_assms]: "arch_switch_to_thread t \st_tcb_at Q t\" by (wpsimp simp: arch_switch_to_thread_def) @@ -48,7 +48,7 @@ lemma idle_strg: by (clarsimp simp: invs_def valid_state_def valid_idle_def cur_tcb_def pred_tcb_at_def valid_machine_state_def obj_at_def is_tcb_def) -lemma arch_stit_invs[wp, Schedule_AI_assms]: +lemma arch_stit_invs[wp, Arch_assms]: "\invs\ arch_switch_to_idle_thread \\r. invs\" by (wpsimp simp: arch_switch_to_idle_thread_def) @@ -64,19 +64,19 @@ crunch set_vm_root and scheduler_action[wp]: "\s. P (scheduler_action s)" (simp: crunch_simps wp: hoare_drop_imps) -lemma arch_stit_activatable[wp, Schedule_AI_assms]: +lemma arch_stit_activatable[wp, Arch_assms]: "\ct_in_state activatable\ arch_switch_to_idle_thread \\rv . ct_in_state activatable\" apply (clarsimp simp: arch_switch_to_idle_thread_def) apply (wpsimp simp: ct_in_state_def wp: ct_in_state_thread_state_lift) done -lemma stit_invs [wp,Schedule_AI_assms]: +lemma stit_invs [wp,Arch_assms]: "switch_to_idle_thread \invs\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wpsimp|strengthen idle_strg)+ done -lemma stit_activatable[Schedule_AI_assms]: +lemma stit_activatable[Arch_assms]: "\invs\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wp | simp add: ct_in_state_def)+ @@ -84,29 +84,30 @@ lemma stit_activatable[Schedule_AI_assms]: elim!: pred_tcb_weaken_strongerE) done -lemma arch_stt_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stt_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_thread t' \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_thread_def) crunch arch_prepare_next_domain - for ct[wp, Schedule_AI_assms]: "\s. P (cur_thread s)" - and activatable[wp, Schedule_AI_assms]: "ct_in_state activatable" - and st_tcb_at[wp, Schedule_AI_assms]: "\s. P (st_tcb_at Q t s)" - and valid_idle[wp, Schedule_AI_assms]: valid_idle - and invs[wp, Schedule_AI_assms]: invs + for ct[wp, Arch_assms]: "\s. P (cur_thread s)" + and activatable[wp, Arch_assms]: "ct_in_state activatable" + and st_tcb_at[wp, Arch_assms]: "\s. P (st_tcb_at Q t s)" + and valid_idle[wp, Arch_assms]: valid_idle + and invs[wp, Arch_assms]: invs (wp: crunch_wps ct_in_state_thread_state_lift) -lemma arch_stit_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stit_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_idle_thread \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_idle_thread_def) +lemmas Schedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Schedule_AI?: Schedule_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; unfold_locales; (fact Schedule_AI_assms)?) + by (intro_locales; unfold_locales; (fact RISCV64.Schedule_AI_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy b/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy index b251291a9d..281b2850ff 100644 --- a/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchSyscall_AI.thy @@ -15,44 +15,44 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_AI locale *) -declare arch_get_sanitise_register_info_invs[Syscall_AI_assms] - arch_get_sanitise_register_info_ex_nonz_cap_to[Syscall_AI_assms] - make_fault_msg_inv[Syscall_AI_assms] +declare arch_get_sanitise_register_info_invs[Arch_assms] + arch_get_sanitise_register_info_ex_nonz_cap_to[Arch_assms] + make_fault_msg_inv[Arch_assms] crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for pred_tcb_at[wp,Syscall_AI_assms]: "pred_tcb_at proj P t" + for pred_tcb_at[wp,Arch_assms]: "pred_tcb_at proj P t" crunch handle_arch_fault_reply - for invs[wp,Syscall_AI_assms]: "invs" + for invs[wp,Arch_assms]: "invs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cap_to[wp,Syscall_AI_assms]: "ex_nonz_cap_to c" + for cap_to[wp,Arch_assms]: "ex_nonz_cap_to c" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for it[wp,Syscall_AI_assms]: "\s. P (idle_thread s)" + for it[wp,Arch_assms]: "\s. P (idle_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for caps[wp,Syscall_AI_assms]: "\s. P (caps_of_state s)" + for caps[wp,Arch_assms]: "\s. P (caps_of_state s)" crunch handle_arch_fault_reply, make_fault_msg, arch_get_sanitise_register_info - for cur_thread[wp,Syscall_AI_assms]: "\s. P (cur_thread s)" + for cur_thread[wp,Arch_assms]: "\s. P (cur_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for valid_objs[wp,Syscall_AI_assms]: "valid_objs" + for valid_objs[wp,Arch_assms]: "valid_objs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cte_wp_at[wp,Syscall_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" crunch invoke_irq_control - for typ_at[wp, Syscall_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" -lemma obj_refs_cap_rights_update[simp, Syscall_AI_assms]: +lemma obj_refs_cap_rights_update[simp, Arch_assms]: "obj_refs (cap_rights_update rs cap) = obj_refs cap" by (simp add: cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) (* FIXME: move to TCB *) -lemma table_cap_ref_mask_cap [Syscall_AI_assms]: +lemma table_cap_ref_mask_cap [Arch_assms]: "table_cap_ref (mask_cap R cap) = table_cap_ref cap" 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 eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: +lemma eq_no_cap_to_obj_with_diff_ref [Arch_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) @@ -61,19 +61,19 @@ lemma eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: table_cap_ref_mask_cap Ball_def) done -lemma hv_invs[wp, Syscall_AI_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" +lemma hv_invs[wp, Arch_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" unfolding handle_vm_fault_def by (cases flt; wpsimp) crunch getRegister, read_stval for inv[wp]: "P" (ignore_del: getRegister) -lemma hv_inv_ex [Syscall_AI_assms]: +lemma hv_inv_ex [Arch_assms]: "\P\ handle_vm_fault t vp \\_ _. True\, \\_. P\" unfolding handle_vm_fault_def by (cases vp; wpsimp wp: dmo_inv getRestartPC_inv det_getRestartPC as_user_inv) -lemma handle_vm_fault_valid_fault[wp, Syscall_AI_assms]: +lemma handle_vm_fault_valid_fault[wp, Arch_assms]: "\\\ handle_vm_fault thread ft -,\\rv s. valid_fault rv\" unfolding handle_vm_fault_def apply (cases ft, simp_all) @@ -81,26 +81,27 @@ lemma handle_vm_fault_valid_fault[wp, Syscall_AI_assms]: done -lemma hvmf_active [Syscall_AI_assms]: +lemma hvmf_active [Arch_assms]: "\st_tcb_at active t\ handle_vm_fault t w \\rv. st_tcb_at active t\" unfolding handle_vm_fault_def by (cases w; wpsimp) -lemma hvmf_ex_cap[wp, Syscall_AI_assms]: +lemma hvmf_ex_cap[wp, Arch_assms]: "\ex_nonz_cap_to p\ handle_vm_fault t b \\rv. ex_nonz_cap_to p\" unfolding handle_vm_fault_def by (cases b; wpsimp) -lemma hh_invs[wp, Syscall_AI_assms]: +lemma hh_invs[wp, Arch_assms]: "\invs and ct_active and st_tcb_at active thread and ex_nonz_cap_to_thread\ handle_hypervisor_fault thread fault \\rv. invs\" by (cases fault) wpsimp +lemmas Syscall_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Syscall_AI?: Syscall_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Syscall_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Syscall_AI_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchTcbAcc_AI.thy b/proof/invariant-abstract/RISCV64/ArchTcbAcc_AI.thy index 889af2827f..347513b1b9 100644 --- a/proof/invariant-abstract/RISCV64/ArchTcbAcc_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchTcbAcc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_AI locale *) lemmas cap_master_cap_simps = cap_master_cap_def[simplified cap_master_arch_cap_def, split_simps cap.split arch_cap.split] @@ -51,7 +51,7 @@ lemma cap_master_cap_tcb_cap_valid_arch: split: option.splits cap.splits arch_cap.splits Structures_A.thread_state.splits) -lemma storeWord_invs[wp, TcbAcc_AI_assms]: +lemma storeWord_invs[wp, Arch_assms]: "\in_user_frame p and invs\ do_machine_op (storeWord p w) \\rv. invs\" proof - have aligned_offset_ignore: @@ -79,12 +79,12 @@ proof - done qed -lemma valid_ipc_buffer_cap_0[simp, TcbAcc_AI_assms]: +lemma valid_ipc_buffer_cap_0[simp, Arch_assms]: "valid_ipc_buffer_cap cap a \ valid_ipc_buffer_cap cap 0" by (auto simp add: valid_ipc_buffer_cap_def case_bool_If split: cap.split arch_cap.split) -lemma thread_set_hyp_refs_trivial [TcbAcc_AI_assms]: +lemma thread_set_hyp_refs_trivial [Arch_assms]: assumes x: "\tcb. tcb_state (f tcb) = tcb_state tcb" assumes y: "\tcb. tcb_arch_ref (f tcb) = tcb_arch_ref tcb" shows "\\s. P (state_hyp_refs_of s)\ thread_set f t \\rv s. P (state_hyp_refs_of s)\" @@ -105,7 +105,7 @@ lemma mab_wb [simp]: unfolding msg_align_bits word_bits_conv by simp -lemma get_cap_valid_ipc [TcbAcc_AI_assms]: +lemma get_cap_valid_ipc [Arch_assms]: "\valid_objs and obj_at (\ko. \tcb. ko = TCB tcb \ tcb_ipc_buffer tcb = v) t\ get_cap (t, tcb_cnode_index 4) \\rv s. valid_ipc_buffer_cap rv v\" @@ -120,7 +120,7 @@ lemma get_cap_valid_ipc [TcbAcc_AI_assms]: -lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: +lemma pred_tcb_cap_wp_at [Arch_assms]: "\pred_tcb_at proj P t s; valid_objs s; ref \ dom tcb_cap_cases; \cap. (pred_tcb_at proj P t s \ tcb_cap_valid cap (t, ref) s) \ Q cap\ \ @@ -134,7 +134,7 @@ lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: apply fastforce+ done -lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: +lemma as_user_hyp_refs_of[wp, Arch_assms]: "\\s. P (state_hyp_refs_of s)\ as_user t m \\rv s. P (state_hyp_refs_of s)\" @@ -144,11 +144,11 @@ lemma as_user_hyp_refs_of[wp, TcbAcc_AI_assms]: lemmas sts_typ_ats = sts_typ_ats abs_atyp_at_lifts [OF set_thread_state_typ_at] -lemma arch_tcb_context_set_eq_RISCV64[TcbAcc_AI_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" +lemma arch_tcb_context_set_eq_RISCV64[Arch_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp -lemma arch_tcb_context_get_eq_RISCV64[TcbAcc_AI_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" +lemma arch_tcb_context_get_eq_RISCV64[Arch_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp @@ -156,17 +156,18 @@ lemma tcb_context_update_aux: "arch_tcb_context_set (P (arch_tcb_context_get atc = tcb_context_update (\ctx. P ctx) atcb" by (simp add: arch_tcb_context_set_def arch_tcb_context_get_def) -lemma thread_set_valid_arch_state[TcbAcc_AI_assms]: +lemma thread_set_valid_arch_state[Arch_assms]: "(\tcb. \(getF, v) \ ran tcb_cap_cases. getF (f tcb) = getF tcb) \ thread_set f t \ valid_arch_state \" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps thread_set_tcb thread_set.aobj_at) +lemmas TcbAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation TcbAcc_AI?: TcbAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact TcbAcc_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.TcbAcc_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/RISCV64/ArchTcb_AI.thy b/proof/invariant-abstract/RISCV64/ArchTcb_AI.thy index ee7397174f..81f2bf19d5 100644 --- a/proof/invariant-abstract/RISCV64/ArchTcb_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchTcb_AI.thy @@ -10,17 +10,17 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_AI locale *) -lemma activate_idle_invs[Tcb_AI_assms]: +lemma activate_idle_invs[Arch_assms]: "\invs and ct_idle\ arch_activate_idle_thread thread \\rv. invs and ct_idle\" by (simp add: arch_activate_idle_thread_def) -lemma empty_fail_getRegister [intro!, simp, Tcb_AI_assms]: +lemma empty_fail_getRegister [intro!, simp, Arch_assms]: "empty_fail (getRegister r)" by (simp add: getRegister_def) @@ -37,7 +37,7 @@ lemma same_object_also_valid: (* arch specific *) split: cap.split_asm arch_cap.split_asm option.splits)+) done -lemma same_object_obj_refs[Tcb_AI_assms]: +lemma same_object_obj_refs[Arch_assms]: "\ same_object_as cap cap' \ \ obj_refs cap = obj_refs cap'" apply (cases cap, simp_all add: same_object_as_def) @@ -50,7 +50,7 @@ where "is_cnode_or_valid_arch cap \ is_cnode_cap cap \ is_arch_cap cap \ (is_pt_cap cap \ cap_asid cap \ None)" -lemma arch_cap_badge_none_master[Tcb_AI_assms, simp]: +lemma arch_cap_badge_none_master[Arch_assms, simp]: "(arch_cap_badge (cap_master_arch_cap acap) = None) = (arch_cap_badge acap = None)" by simp @@ -126,13 +126,13 @@ lemma checked_insert_tcb_invs[wp]: (* arch specific *) done crunch arch_get_sanitise_register_info, arch_post_modify_registers - for tcb_at[wp, Tcb_AI_assms]: "tcb_at a" + for tcb_at[wp, Arch_assms]: "tcb_at a" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for invs[wp, Tcb_AI_assms]: "invs" + for invs[wp, Arch_assms]: "invs" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ex_nonz_cap_to[wp, Tcb_AI_assms]: "ex_nonz_cap_to a" + for ex_nonz_cap_to[wp, Arch_assms]: "ex_nonz_cap_to a" -lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: +lemma finalise_cap_not_cte_wp_at[Arch_assms]: assumes x: "P cap.NullCap" shows "\\s. \cp \ ran (caps_of_state s). P cp\ finalise_cap cap fin @@ -149,11 +149,11 @@ lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: done crunch arch_post_set_flags, arch_prepare_set_domain - for typ_at[wp, Tcb_AI_assms]: "\s. P (typ_at T p s)" - and invs[wp, Tcb_AI_assms]: "invs" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and invs[wp, Arch_assms]: "invs" (* Interface asks for a weaker lemma due to other arches needing an extra precondition *) -lemma arch_post_set_flags_invs'[Tcb_AI_assms]: +lemma arch_post_set_flags_invs'[Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_post_set_flags t flags \\_. invs\" by wpsimp @@ -164,18 +164,19 @@ crunch arch_prepare_set_domain and pspace_distinct[wp]: pspace_distinct (wp: crunch_wps) -lemma table_cap_ref_max_free_index_upd[simp,Tcb_AI_assms]: +lemma table_cap_ref_max_free_index_upd[simp,Arch_assms]: "table_cap_ref (max_free_index_update cap) = table_cap_ref cap" by (simp add:free_index_update_def table_cap_ref_def split:cap.splits) +lemmas Tcb_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI_1?: Tcb_AI_1 where state_ext_t = state_ext_t and is_cnode_or_valid_arch = is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Tcb_AI_assms)?) qed context Arch begin arch_global_naming @@ -194,7 +195,7 @@ lemma use_no_cap_to_obj_asid_strg: (* arch specific *) by (fastforce simp: table_cap_ref_def vspace_asid_def valid_cap_simps obj_at_def split: cap.splits arch_cap.splits option.splits prod.splits) -lemma cap_delete_no_cap_to_obj_asid[wp, Tcb_AI_assms]: +lemma cap_delete_no_cap_to_obj_asid[wp, Arch_assms]: "\no_cap_to_obj_dr_emp cap\ cap_delete slot \\rv. no_cap_to_obj_dr_emp cap\" @@ -228,7 +229,7 @@ lemma option_case_eq_None: "((case m of None \ None | Some (a,b) \ Some a) = None) = (m = None)" by (clarsimp split: option.splits) -lemma tc_invs[Tcb_AI_assms]: +lemma tc_invs[Arch_assms]: "\invs and tcb_at a and (case_option \ (valid_cap o fst) e) and (case_option \ (valid_cap o fst) f) @@ -306,7 +307,7 @@ lemma check_valid_ipc_buffer_inv: (* arch_specific *) apply (wp | simp add: if_apply_def2 split del: if_split | wpcw)+ done -lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: +lemma check_valid_ipc_buffer_wp[Arch_assms]: "\\(s::'state_ext::state_ext state). is_arch_cap cap \ is_cnode_or_valid_arch cap \ valid_ipc_buffer_cap cap vptr \ is_aligned vptr msg_align_bits @@ -322,7 +323,7 @@ lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: valid_ipc_buffer_cap_def) done -lemma derive_no_cap_asid[wp,Tcb_AI_assms]: +lemma derive_no_cap_asid[wp,Arch_assms]: "\(no_cap_to_obj_with_diff_ref cap S)::'state_ext::state_ext state\bool\ derive_cap slot cap \\rv. no_cap_to_obj_with_diff_ref rv S\,-" @@ -336,7 +337,7 @@ lemma derive_no_cap_asid[wp,Tcb_AI_assms]: done -lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: +lemma decode_set_ipc_inv[wp,Arch_assms]: "\P::'state_ext::state_ext state \ bool\ decode_set_ipc_buffer args cap slot excaps \\rv. P\" apply (simp add: decode_set_ipc_buffer_def whenE_def split_def @@ -345,7 +346,7 @@ lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: apply simp done -lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_update_cap_data[Arch_assms]: "no_cap_to_obj_with_diff_ref c S s \ no_cap_to_obj_with_diff_ref (update_cap_data P x c) S s" apply (case_tac "update_cap_data P x c = NullCap") @@ -362,7 +363,7 @@ lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: done -lemma update_cap_valid[Tcb_AI_assms]: +lemma update_cap_valid[Arch_assms]: "valid_cap cap (s::'state_ext::state_ext state) \ valid_cap (case capdata of None \ cap_rights_update rs cap @@ -394,13 +395,14 @@ crunch invoke_tcb wp: hoare_drop_imps mapM_x_wp' check_cap_inv simp: crunch_simps) +lemmas Tcb_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI?: Tcb_AI where is_cnode_or_valid_arch = RISCV64.is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact RISCV64.Tcb_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy b/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy index 6335cffa6f..1bad8d7a2e 100644 --- a/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/RISCV64/ArchUntyped_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_AI locale *) -lemma of_bl_nat_to_cref[Untyped_AI_assms]: +lemma of_bl_nat_to_cref[Arch_assms]: "\ x < 2 ^ bits; bits < word_bits \ \ (of_bl (nat_to_cref bits x) :: word64) = of_nat x" apply (clarsimp intro!: less_mask_eq @@ -21,7 +21,7 @@ lemma of_bl_nat_to_cref[Untyped_AI_assms]: by (metis add_lessD1 le_unat_uoi nat_le_iff_add nat_le_linear) -lemma cnode_cap_ex_cte[Untyped_AI_assms]: +lemma cnode_cap_ex_cte[Arch_assms]: "\ is_cnode_cap cap; cte_wp_at (\c. \m. cap = mask_cap m c) p s; (s::'state_ext::state_ext state) \ cap; valid_objs s; pspace_aligned s \ \ ex_cte_cap_wp_to is_cnode_cap (obj_ref_of cap, nat_to_cref (bits_of cap) x) s" @@ -36,7 +36,7 @@ lemma cnode_cap_ex_cte[Untyped_AI_assms]: -lemma inj_on_nat_to_cref[Untyped_AI_assms]: +lemma inj_on_nat_to_cref[Arch_assms]: "bits < word_bits \ inj_on (nat_to_cref bits) {..< 2 ^ bits}" apply (rule inj_onI) apply (drule arg_cong[where f="\x. replicate (64 - bits) False @ x"]) @@ -54,7 +54,7 @@ lemma inj_on_nat_to_cref[Untyped_AI_assms]: done -lemma data_to_obj_type_sp[Untyped_AI_assms]: +lemma data_to_obj_type_sp[Arch_assms]: "\P\ data_to_obj_type x \\ts (s::'state_ext::state_ext state). ts \ ArchObject ASIDPoolObj \ P s\, -" unfolding data_to_obj_type_def apply (rule hoare_pre) @@ -63,7 +63,7 @@ lemma data_to_obj_type_sp[Untyped_AI_assms]: apply (simp add: arch_data_to_obj_type_def split: if_split_asm) done -lemma dui_inv_wf[wp, Untyped_AI_assms]: +lemma dui_inv_wf[wp, Arch_assms]: "\invs and cte_wp_at ((=) (cap.UntypedCap dev w sz idx)) slot and (\s. \cap \ set cs. is_cnode_cap cap \ (\r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -148,7 +148,7 @@ qed lemma asid_bits_ge_0: "(0::word32) < 2 ^ asid_bits" by (simp add: asid_bits_def) -lemma retype_ret_valid_caps_captable[Untyped_AI_assms]: +lemma retype_ret_valid_caps_captable[Arch_assms]: "\pspace_no_overlap_range_cover ptr sz (s::'state_ext::state_ext state) \ 0 < us \ range_cover ptr sz (obj_bits_api CapTableObject us) n \ ptr \ 0 \ @@ -161,7 +161,7 @@ by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def | rule is_aligned_add_multI[OF _ le_refl], (simp add:range_cover_def word_bits_def obj_bits_api_def slot_bits_def)+)+)[1] -lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]: +lemma retype_ret_valid_caps_aobj[Arch_assms]: "\ptr sz (s::'state_ext::state_ext state) x6 us n. \pspace_no_overlap_range_cover ptr sz s \ x6 \ ASIDPoolObj \ range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \ ptr \ 0\ @@ -189,19 +189,19 @@ lemma cap_refs_in_kernel_windowD2: apply fastforce done -lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: +lemma init_arch_objects_descendants_range[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). descendants_range x cref s \ init_arch_objects ty dev ptr n us y \\rv s. descendants_range x cref s\" unfolding init_arch_objects_def by wp -lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: +lemma init_arch_objects_caps_overlap_reserved[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). caps_overlap_reserved S s\ init_arch_objects ty dev ptr n us y \\rv s. caps_overlap_reserved S s\" unfolding init_arch_objects_def by wp -lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: +lemma set_untyped_cap_invs_simple[Arch_assms]: "\\s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \ pspace_no_overlap_range_cover ptr sz s \ invs s \ cte_wp_at (\c. is_untyped_cap c \ cap_bits c = sz \ obj_ref_of c = ptr \ cap_is_device c = dev) cref s \ idx \ 2^ sz\ set_cap (cap.UntypedCap dev ptr sz idx) cref @@ -242,7 +242,7 @@ lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: lemmas pbfs_less_wb' = pageBitsForSize_bounded -lemma delete_objects_rewrite[Untyped_AI_assms]: +lemma delete_objects_rewrite[Arch_assms]: "\ word_size_bits \ sz; sz\ word_bits;ptr && ~~ mask sz = ptr\ \ delete_objects ptr sz = do y \ modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz}); modify (detype {ptr && ~~ mask sz..ptr + 2 ^ sz - 1}) @@ -274,7 +274,7 @@ lemma reachable_pg_cap_exst_update[simp]: "reachable_frame_cap x (trans_state f (s::'state_ext::state_ext state)) = reachable_frame_cap x s" by (simp add: reachable_frame_cap_def obj_at_def) -lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_caps[wp, Arch_assms]: "\valid_arch_caps and valid_cap (default_cap tp oref sz dev) and (\(s::'state_ext::state_ext state). \r\obj_refs (default_cap tp oref sz dev). @@ -309,7 +309,7 @@ lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: done -lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: +lemma create_cap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range (default_cap tp oref sz dev) \ cap_range c) p\ create_cap tp sz p dev (cref, oref) \\rv. cap_refs_in_kernel_window\" apply (simp add: create_cap_def) @@ -319,7 +319,7 @@ lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: apply blast done -lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: +lemma init_arch_objects_nonempty_table[Arch_assms, wp]: "\(\s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \ valid_global_objs s \ valid_arch_state s \ pspace_aligned s) and K (\ref\set refs. is_aligned ref (obj_bits_api tp us))\ @@ -327,13 +327,13 @@ lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: \\rv s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)\" unfolding init_arch_objects_def by wpsimp -lemma nonempty_table_caps_of[Untyped_AI_assms]: +lemma nonempty_table_caps_of[Arch_assms]: "nonempty_table S ko \ caps_of ko = {}" by (auto simp: caps_of_def cap_of_def nonempty_table_def a_type_def split: Structures_A.kernel_object.split if_split_asm) -lemma nonempty_default[simp, Untyped_AI_assms]: +lemma nonempty_default[simp, Arch_assms]: "tp \ Untyped \ \ nonempty_table S (default_object tp dev us d)" apply (case_tac tp, simp_all add: default_object_def nonempty_table_def a_type_def) apply (rename_tac aobject_type) @@ -345,7 +345,7 @@ crunch init_arch_objects lemmas init_arch_objects_ex_cte_cap_wp_to = init_arch_objects_excap -lemma obj_is_device_vui_eq[Untyped_AI_assms]: +lemma obj_is_device_vui_eq[Arch_assms]: "valid_untyped_inv ui s \ case ui of Retype slot reset ptr_base ptr tp us slots dev \ obj_is_device tp dev = dev" @@ -357,26 +357,27 @@ lemma obj_is_device_vui_eq[Untyped_AI_assms]: apply (auto simp: arch_is_frame_type_def) done -lemma create_cap_valid_arch_state[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (\_. True) cref\ create_cap tp sz p dev (cref,oref) \\rv. valid_arch_state\" by (wpsimp wp: valid_arch_state_lift_aobj_at_no_caps create_cap_tcb create_cap_aobj_at) -lemma set_cap_non_arch_valid_arch_state[Untyped_AI_assms]: +lemma set_cap_non_arch_valid_arch_state[Arch_assms]: "\\s. valid_arch_state s \ cte_wp_at (\_. \is_arch_cap cap) ptr s\ set_cap cap ptr \\rv. valid_arch_state \" by wpsimp +lemmas Untyped_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Untyped_AI? : Untyped_AI where nonempty_table = RISCV64.nonempty_table proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; (fact Untyped_AI_assms)?) + by (unfold_locales; (fact RISCV64.Untyped_AI_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchAInvsPre.thy b/proof/invariant-abstract/X64/ArchAInvsPre.thy index 4d42b94fc0..f5d1050a43 100644 --- a/proof/invariant-abstract/X64/ArchAInvsPre.thy +++ b/proof/invariant-abstract/X64/ArchAInvsPre.thy @@ -176,9 +176,9 @@ lemma device_frame_in_device_region: \ device_state (machine_state s) p \ None" by (auto simp add: pspace_respects_device_region_def dom_def device_mem_def) -named_theorems AInvsPre_assms +clear_named_theorems Arch_assms (* accumulate assumptions for AInvsPre locale *) -lemma ptable_rights_imp_frame[AInvsPre_assms]: +lemma ptable_rights_imp_frame[Arch_assms]: assumes "valid_state s" shows "ptable_rights t s x \ {} \ ptable_lift t s x = Some (addrFromPPtr y) \ @@ -215,12 +215,13 @@ lemma ptable_rights_imp_frame[AInvsPre_assms]: apply simp done +lemmas AInvsPre_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation AInvsPre?: AInvsPre proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact AInvsPre_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.AInvsPre_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchBCorres2_AI.thy b/proof/invariant-abstract/X64/ArchBCorres2_AI.thy index 3a4bcdf672..b643073eaf 100644 --- a/proof/invariant-abstract/X64/ArchBCorres2_AI.thy +++ b/proof/invariant-abstract/X64/ArchBCorres2_AI.thy @@ -11,10 +11,10 @@ begin context Arch begin arch_global_naming -named_theorems BCorres2_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for BCorres2_AI locale *) crunch invoke_cnode - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state (simp: swp_def ignore: clearMemory without_preemption filterM) crunch create_cap,init_arch_objects,retype_region,delete_objects @@ -33,7 +33,7 @@ crunch set_mcpriority, set_priority, set_flags, arch_post_set_flags, for (bcorres) bcorres[wp]: truncate_state crunch arch_get_sanitise_register_info, arch_post_modify_registers - for (bcorres) bcorres[wp, BCorres2_AI_assms]: truncate_state + for (bcorres) bcorres[wp, Arch_assms]: truncate_state crunch update_irq_state for (bcorres) bcorres[wp]: truncate_state @@ -69,20 +69,21 @@ lemma invoke_irq_handler_bcorres[wp]: "bcorres (invoke_irq_handler a) (invoke_ir apply (wp | simp)+ done -lemma make_arch_fault_msg_bcorres[wp,BCorres2_AI_assms]: +lemma make_arch_fault_msg_bcorres[wp,Arch_assms]: "bcorres (make_arch_fault_msg a b) (make_arch_fault_msg a b)" by (cases a; simp ; wp) -lemma handle_arch_fault_reply_bcorres[wp,BCorres2_AI_assms]: +lemma handle_arch_fault_reply_bcorres[wp,Arch_assms]: "bcorres ( handle_arch_fault_reply a b c d) (handle_arch_fault_reply a b c d)" by (cases a; simp add: handle_arch_fault_reply_def; wp) +lemmas BCorres2_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation BCorres2_AI?: BCorres2_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact BCorres2_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.BCorres2_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/X64/ArchCNodeInv_AI.thy b/proof/invariant-abstract/X64/ArchCNodeInv_AI.thy index 11f182be41..e98adfaab6 100644 --- a/proof/invariant-abstract/X64/ArchCNodeInv_AI.thy +++ b/proof/invariant-abstract/X64/ArchCNodeInv_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_AI locale *) lemma valid_cnode_capI: "\cap_table_at n w s; valid_objs s; pspace_aligned s; n > 0; length g \ 64\ @@ -27,7 +27,7 @@ lemma valid_cnode_capI: done (* unused *) -lemma derive_cap_objrefs [CNodeInv_AI_assms]: +lemma derive_cap_objrefs [Arch_assms]: "\\s. P (obj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (obj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] @@ -35,7 +35,7 @@ lemma derive_cap_objrefs [CNodeInv_AI_assms]: apply (case_tac arch_cap, simp_all add: arch_derive_cap_def) by (wp | wpc | simp add: o_def)+ -lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: +lemma derive_cap_zobjrefs [Arch_assms]: "\\s. P (zobj_refs cap)\ derive_cap slot cap \\rv s. rv \ NullCap \ P (zobj_refs rv)\,-" apply (cases cap, simp_all add: derive_cap_def is_zombie_def) apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11] @@ -43,7 +43,7 @@ lemma derive_cap_zobjrefs [CNodeInv_AI_assms]: apply (case_tac arch_cap, simp_all add: arch_derive_cap_def) by (wp | wpc |simp add: o_def)+ -lemma update_cap_objrefs [CNodeInv_AI_assms]: +lemma update_cap_objrefs [Arch_assms]: "\ update_cap_data P dt cap \ NullCap \ \ obj_refs (update_cap_data P dt cap) = obj_refs cap" by (case_tac cap, @@ -51,7 +51,7 @@ lemma update_cap_objrefs [CNodeInv_AI_assms]: split: if_split_asm arch_cap.splits) -lemma update_cap_zobjrefs [CNodeInv_AI_assms]: +lemma update_cap_zobjrefs [Arch_assms]: "\ update_cap_data P dt cap \ cap.NullCap \ \ zobj_refs (update_cap_data P dt cap) = zobj_refs cap" apply (case_tac cap, @@ -60,7 +60,7 @@ lemma update_cap_zobjrefs [CNodeInv_AI_assms]: done -lemma copy_mask [simp, CNodeInv_AI_assms]: +lemma copy_mask [simp, Arch_assms]: "copy_of (mask_cap R c) = copy_of c" apply (rule ext) apply (auto simp: copy_of_def is_cap_simps mask_cap_def @@ -69,7 +69,7 @@ lemma copy_mask [simp, CNodeInv_AI_assms]: split: cap.splits arch_cap.splits bool.splits) done -lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: +lemma update_cap_data_mask_Null [simp, Arch_assms]: "(update_cap_data P x (mask_cap m c) = NullCap) = (update_cap_data P x c = NullCap)" unfolding update_cap_data_def mask_cap_def apply (cases c) @@ -78,7 +78,7 @@ lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]: apply (case_tac arch_cap; clarsimp simp: arch_update_cap_data_def acap_rights_update_def split: if_splits) done -lemma cap_master_update_cap_data [CNodeInv_AI_assms]: +lemma cap_master_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap \ \ cap_master_cap (update_cap_data P x c) = cap_master_cap c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -101,11 +101,11 @@ lemma same_object_as_def2: split: cap.splits arch_cap.splits) done -lemma same_object_as_cap_master [CNodeInv_AI_assms]: +lemma same_object_as_cap_master [Arch_assms]: "same_object_as cap cap' \ cap_master_cap cap = cap_master_cap cap'" by (simp add: same_object_as_def2) -lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: +lemma weak_derived_cap_is_device[Arch_assms]: "\weak_derived c' c\ \ cap_is_device c = cap_is_device c'" apply (auto simp: weak_derived_def copy_of_def is_cap_simps same_object_as_def2 @@ -113,7 +113,7 @@ lemma weak_derived_cap_is_device[CNodeInv_AI_assms]: dest!: master_cap_eq_is_device_cap_eq) done -lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid (update_cap_data P x c) = cap_asid c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -122,7 +122,7 @@ lemma cap_asid_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: +lemma cap_vptr_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_vptr (update_cap_data P x c) = cap_vptr c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -131,7 +131,7 @@ lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: +lemma cap_asid_base_update_cap_data [Arch_assms]: "update_cap_data P x c \ NullCap \ cap_asid_base (update_cap_data P x c) = cap_asid_base c" apply (simp add: update_cap_data_def split del: if_split split: if_split_asm) @@ -140,7 +140,7 @@ lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]: split: arch_cap.split) done -lemma same_object_as_update_cap_data [CNodeInv_AI_assms]: +lemma same_object_as_update_cap_data [Arch_assms]: "\ update_cap_data P x c \ NullCap; same_object_as c' c \ \ same_object_as c' (update_cap_data P x c)" apply (clarsimp simp: same_object_as_def is_cap_simps @@ -161,7 +161,7 @@ lemma is_master_reply_update_cap_data[simp]: by (simp add:is_master_reply_cap_def update_cap_data_def arch_update_cap_data_def the_cnode_cap_def is_arch_cap_def badge_update_def split:cap.split) -lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: +lemma weak_derived_update_cap_data [Arch_assms]: "\update_cap_data P x c \ NullCap; weak_derived c c'\ \ weak_derived (update_cap_data P x c) c'" apply (simp add: weak_derived_def copy_of_def @@ -185,7 +185,7 @@ lemma weak_derived_update_cap_data [CNodeInv_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: +lemma cap_badge_update_cap_data [Arch_assms]: "update_cap_data False x c \ NullCap \ (bdg, cap_badge c) \ capBadge_ordering False \ (bdg, cap_badge (update_cap_data False x c)) \ capBadge_ordering False" apply clarsimp @@ -197,25 +197,25 @@ lemma cap_badge_update_cap_data [CNodeInv_AI_assms]: done -lemma cap_vptr_rights_update[simp, CNodeInv_AI_assms]: +lemma cap_vptr_rights_update[simp, Arch_assms]: "cap_vptr (cap_rights_update f c) = cap_vptr c" by (simp add: cap_vptr_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_vptr_mask[simp, CNodeInv_AI_assms]: +lemma cap_vptr_mask[simp, Arch_assms]: "cap_vptr (mask_cap m c) = cap_vptr c" by (simp add: mask_cap_def) -lemma cap_asid_base_rights [simp, CNodeInv_AI_assms]: +lemma cap_asid_base_rights [simp, Arch_assms]: "cap_asid_base (cap_rights_update R c) = cap_asid_base c" by (auto simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits bool.splits) -lemma cap_asid_base_mask[simp, CNodeInv_AI_assms]: +lemma cap_asid_base_mask[simp, Arch_assms]: "cap_asid_base (mask_cap m c) = cap_asid_base c" by (simp add: mask_cap_def) -lemma weak_derived_mask [CNodeInv_AI_assms]: +lemma weak_derived_mask [Arch_assms]: "\ weak_derived c c'; cap_aligned c \ \ weak_derived (mask_cap m c) c'" unfolding weak_derived_def apply simp @@ -230,14 +230,14 @@ lemma weak_derived_mask [CNodeInv_AI_assms]: done -lemma vs_cap_ref_update_cap_data[simp, CNodeInv_AI_assms]: +lemma vs_cap_ref_update_cap_data[simp, Arch_assms]: "vs_cap_ref (update_cap_data P d cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def update_cap_data_closedform arch_update_cap_data_def Let_def split: arch_cap.splits cap.split if_splits) -lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]: +lemma invs_irq_state_independent[intro!, simp, Arch_assms]: "invs (s\machine_state := machine_state s\irq_state := f (irq_state (machine_state s))\\) = invs s" by (clarsimp simp: irq_state_independent_A_def invs_def @@ -253,7 +253,7 @@ lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]: swp_def valid_irq_states_def) -lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: +lemma cte_at_nat_to_cref_zbits [Arch_assms]: "\ s \ Zombie oref zb n; m < n \ \ cte_at (oref, nat_to_cref (zombie_cte_bits zb) m) s" apply (subst(asm) valid_cap_def) @@ -267,7 +267,7 @@ lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]: done -lemma copy_of_cap_range [CNodeInv_AI_assms]: +lemma copy_of_cap_range [Arch_assms]: "copy_of cap cap' \ cap_range cap = cap_range cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -279,7 +279,7 @@ lemma copy_of_cap_range [CNodeInv_AI_assms]: done -lemma copy_of_zobj_refs [CNodeInv_AI_assms]: +lemma copy_of_zobj_refs [Arch_assms]: "copy_of cap cap' \ zobj_refs cap = zobj_refs cap'" apply (clarsimp simp: copy_of_def split: if_split_asm) apply (cases cap', simp_all add: same_object_as_def) @@ -291,7 +291,7 @@ lemma copy_of_zobj_refs [CNodeInv_AI_assms]: done -lemma vs_cap_ref_master [CNodeInv_AI_assms]: +lemma vs_cap_ref_master [Arch_assms]: "\ cap_master_cap cap = cap_master_cap cap'; cap_asid cap = cap_asid cap'; cap_asid_base cap = cap_asid_base cap'; @@ -303,13 +303,13 @@ lemma vs_cap_ref_master [CNodeInv_AI_assms]: apply (clarsimp simp: cap_asid_def split: arch_cap.split_asm option.split_asm) done -lemma weak_derived_vs_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_vs_cap_ref [Arch_assms]: "weak_derived c c' \ vs_cap_ref c = vs_cap_ref c'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 split: if_split_asm elim: vs_cap_ref_master[OF sym]) -lemma weak_derived_table_cap_ref [CNodeInv_AI_assms]: +lemma weak_derived_table_cap_ref [Arch_assms]: "weak_derived c c' \ table_cap_ref c = table_cap_ref c'" apply (clarsimp simp: weak_derived_def copy_of_def same_object_as_def2 @@ -360,7 +360,7 @@ lemmas weak_derived_ASIDPool [simp] = weak_derived_ASIDPool1 weak_derived_ASIDPool2 -lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: +lemma swap_of_caps_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -407,7 +407,7 @@ lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]: done -lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: +lemma cap_swap_asid_map[wp, Arch_assms]: "\valid_asid_map and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -419,7 +419,7 @@ lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]: done -lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]: +lemma cap_swap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ @@ -469,14 +469,14 @@ lemma cap_swap_ioport_control[wp]: apply (cases a, cases b) by (rule conjI; clarsimp)+ -lemma cap_swap_valid_arch_state[wp, CNodeInv_AI_assms]: +lemma cap_swap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\ cap_swap c a c' b \\_. valid_arch_state\" by (wp valid_arch_state_lift_ioports_aobj_at cap_swap_aobj_at)+ (simp add: valid_arch_state_def) -lemma cap_swap_vms[wp, CNodeInv_AI_assms]: +lemma cap_swap_vms[wp, Arch_assms]: "\valid_machine_state\ cap_swap c a c' b \\rv. valid_machine_state\" apply (simp add: valid_machine_state_def in_user_frame_def) apply (wp cap_swap_typ_at @@ -484,7 +484,7 @@ lemma cap_swap_vms[wp, CNodeInv_AI_assms]: done (* FIXME x64: this could probably be generic *) -lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: +lemma unat_of_bl_nat_to_cref[Arch_assms]: "\ n < 2 ^ len; len < word_bits \ \ unat (of_bl (nat_to_cref len n) :: machine_word) = n" apply (simp add: nat_to_cref_def word_bits_conv of_drop_to_bl @@ -503,7 +503,7 @@ lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]: apply simp done -lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: +lemma zombie_is_cap_toE_pre[Arch_assms]: "\ s \ Zombie ptr zbits n; invs s; m < n \ \ (ptr, nat_to_cref (zombie_cte_bits zbits) m) \ cte_refs (Zombie ptr zbits n) irqn" apply (clarsimp simp add: valid_cap_def cap_aligned_def) @@ -517,7 +517,7 @@ lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]: crunch prepare_thread_delete for st_tcb_at_halted[wp]: "st_tcb_at halted t" -lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: +lemma finalise_cap_makes_halted_proof[Arch_assms]: "\invs and valid_cap cap and (\s. ex = is_final_cap' cap s) and cte_wp_at ((=) cap) slot\ finalise_cap cap ex @@ -544,12 +544,12 @@ lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]: lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof crunch finalise_cap - for emptyable[wp,CNodeInv_AI_assms]: "\s. emptyable sl s" + for emptyable[wp,Arch_assms]: "\s. emptyable sl s" (simp: crunch_simps rule: emptyable_lift wp: crunch_wps suspend_emptyable unbind_notification_invs unbind_maybe_notification_invs) -lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: +lemma finalise_cap_not_reply_master_unlifted [Arch_assms]: "(rv, s') \ fst (finalise_cap cap sl s) \ \ is_master_reply_cap (fst rv)" by (case_tac cap, auto simp: is_cap_simps in_monad liftM_def @@ -557,7 +557,7 @@ lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]: split: if_split_asm arch_cap.split_asm bool.split_asm option.split_asm) -lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: +lemma nat_to_cref_0_replicate [Arch_assms]: "\n. n < word_bits \ nat_to_cref n 0 = replicate n False" apply (subgoal_tac "nat_to_cref n (unat (of_bl (replicate n False))) = replicate n False") apply simp @@ -566,19 +566,20 @@ lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]: apply simp done -lemma prepare_thread_delete_thread_cap [CNodeInv_AI_assms]: +lemma prepare_thread_delete_thread_cap [Arch_assms]: "\\s. caps_of_state s x = Some (cap.ThreadCap p)\ prepare_thread_delete t \\rv s. caps_of_state s x = Some (cap.ThreadCap p)\" by (wpsimp simp: prepare_thread_delete_def) +lemmas CNodeInv_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI?: CNodeInv_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.CNodeInv_AI_assms)?) qed @@ -848,22 +849,23 @@ next qed -lemmas rec_del_invs'[CNodeInv_AI_assms] = rec_del_invs'' [where Q=\, +lemmas rec_del_invs'[Arch_assms] = rec_del_invs'' [where Q=\, simplified hoare_TrueI pred_conj_def simp_thms, OF TrueI TrueI TrueI TrueI, simplified] +lemmas CNodeInv_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_2?: CNodeInv_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.CNodeInv_AI_2_assms)?) qed context Arch begin arch_global_naming -lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: +lemma finalise_cap_rvk_prog [Arch_assms]: "\\s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\ finalise_cap a b \\_ s. revoke_progress_ord m (\x. map_option cap_to_rpo (caps_of_state s x))\" @@ -873,7 +875,7 @@ lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]: done -lemma rec_del_rvk_prog [CNodeInv_AI_assms]: +lemma rec_del_rvk_prog [Arch_assms]: "st \ \\s. revoke_progress_ord m (option_map cap_to_rpo \ caps_of_state s) \ (case args of ReduceZombieCall cap sl ex \ cte_wp_at (\c. c = cap) sl s \ is_final_cap' cap s @@ -957,13 +959,14 @@ next done qed +lemmas CNodeInv_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_3?: CNodeInv_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.CNodeInv_AI_3_assms)?) qed @@ -975,25 +978,26 @@ declare cap_revoke.simps[simp del] context Arch begin arch_global_naming crunch finalise_slot - for typ_at[wp, CNodeInv_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM set_object clearMemory) -lemma weak_derived_appropriate [CNodeInv_AI_assms]: +lemma weak_derived_appropriate [Arch_assms]: "weak_derived cap cap' \ appropriate_cte_cap cap = appropriate_cte_cap cap'" by (auto simp: weak_derived_def copy_of_def same_object_as_def2 appropriate_cte_master split: if_split_asm dest!: arg_cong[where f=appropriate_cte_cap]) +lemmas CNodeInv_AI_4_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_4?: CNodeInv_AI_4 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.CNodeInv_AI_4_assms)?) qed @@ -1033,7 +1037,7 @@ lemma cap_move_valid_arch: by (wp valid_arch_state_lift_ioports_typ_at cap_move_ioports cap_move_typ_at) (simp add: valid_arch_state_def) -lemma cap_move_invs[wp, CNodeInv_AI_assms]: +lemma cap_move_invs[wp, Arch_assms]: "\invs and valid_cap cap and cte_wp_at ((=) cap.NullCap) ptr' and tcb_cap_valid cap ptr' and cte_wp_at (weak_derived cap) ptr @@ -1081,13 +1085,14 @@ lemma arch_derive_is_arch: "\\\ arch_derive_cap c \\rv s. rv \ NullCap \ is_arch_cap rv\,-" by (wpsimp simp: is_arch_cap_def arch_derive_cap_def) +lemmas CNodeInv_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CNodeInv_AI_5?: CNodeInv_AI_5 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.CNodeInv_AI_5_assms)?) qed diff --git a/proof/invariant-abstract/X64/ArchCSpace_AI.thy b/proof/invariant-abstract/X64/ArchCSpace_AI.thy index e731d504bb..21678595f0 100644 --- a/proof/invariant-abstract/X64/ArchCSpace_AI.thy +++ b/proof/invariant-abstract/X64/ArchCSpace_AI.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_AI locale *) lemma cte_at_length_limit: "\ cte_at p s; valid_objs s \ \ length (snd p) < word_bits - cte_level_bits" @@ -30,7 +30,7 @@ lemma cte_at_length_limit: done (* FIXME: move? *) -lemma getActiveIRQ_wp [CSpace_AI_assms]: +lemma getActiveIRQ_wp [Arch_assms]: "irq_state_independent_A P \ valid P (do_machine_op (getActiveIRQ in_kernel)) (\_. P)" apply (simp add: getActiveIRQ_def do_machine_op_def split_def exec_gets @@ -40,7 +40,7 @@ lemma getActiveIRQ_wp [CSpace_AI_assms]: apply (clarsimp simp: irq_state_independent_A_def in_monad return_def split: if_splits) done -lemma weak_derived_valid_cap [CSpace_AI_assms]: +lemma weak_derived_valid_cap [Arch_assms]: "\ s \ c; wellformed_cap c'; weak_derived c' c\ \ s \ c'" apply (case_tac "c = c'", simp) apply (clarsimp simp: weak_derived_def) @@ -51,7 +51,7 @@ lemma weak_derived_valid_cap [CSpace_AI_assms]: split: cap.splits arch_cap.splits option.splits) done -lemma copy_obj_refs [CSpace_AI_assms]: +lemma copy_obj_refs [Arch_assms]: "copy_of cap cap' \ obj_refs cap' = obj_refs cap" apply (cases cap) apply (auto simp: copy_of_def same_object_as_def is_cap_simps @@ -59,14 +59,14 @@ lemma copy_obj_refs [CSpace_AI_assms]: split: if_split_asm cap.splits arch_cap.splits) done -lemma weak_derived_cap_class[simp, CSpace_AI_assms]: +lemma weak_derived_cap_class[simp, Arch_assms]: "weak_derived cap src_cap \ cap_class cap = cap_class src_cap" apply (simp add:weak_derived_def) apply (auto simp:copy_of_def same_object_as_def is_cap_simps cap_asid_base_def split:if_splits cap.splits arch_cap.splits) done -lemma weak_derived_obj_refs [CSpace_AI_assms]: +lemma weak_derived_obj_refs [Arch_assms]: "weak_derived dcap cap \ obj_refs dcap = obj_refs cap" apply (cases dcap) by (clarsimp simp: is_cap_simps weak_derived_def copy_of_def @@ -74,7 +74,7 @@ lemma weak_derived_obj_refs [CSpace_AI_assms]: split: if_split_asm cap.splits | auto split: arch_cap.splits)+ -lemma weak_derived_obj_ref_of [CSpace_AI_assms]: +lemma weak_derived_obj_ref_of [Arch_assms]: "weak_derived dcap cap \ obj_ref_of dcap = obj_ref_of cap" apply (cases dcap) by (clarsimp simp: is_cap_simps weak_derived_def copy_of_def @@ -82,7 +82,7 @@ lemma weak_derived_obj_ref_of [CSpace_AI_assms]: split: if_split_asm cap.splits | auto split: arch_cap.splits)+ -lemma set_free_index_invs [CSpace_AI_assms]: +lemma set_free_index_invs [Arch_assms]: "\\s. (free_index_of cap \ idx \ is_untyped_cap cap \ idx \ 2^cap_bits cap) \ invs s \ cte_wp_at ((=) cap ) cref s\ set_cap (free_index_update (\_. idx) cap) cref @@ -134,7 +134,7 @@ lemma unique_table_refs_upd_eqD: apply (rule all_cong[where Q=\, simplified]) by auto -lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: +lemma set_untyped_cap_as_full_valid_arch_caps [Arch_assms]: "\valid_arch_caps and cte_wp_at ((=) src_cap) src\ set_untyped_cap_as_full src_cap cap src \\ya. valid_arch_caps\" @@ -152,7 +152,7 @@ lemma set_untyped_cap_as_full_valid_arch_caps [CSpace_AI_assms]: apply clarsimp done -lemma set_untyped_cap_as_full[wp, CSpace_AI_assms]: +lemma set_untyped_cap_as_full[wp, Arch_assms]: "\\s. no_cap_to_obj_with_diff_ref a b s \ cte_wp_at ((=) src_cap) src s\ set_untyped_cap_as_full src_cap cap src \\rv s. no_cap_to_obj_with_diff_ref a b s\" @@ -250,7 +250,7 @@ lemma is_derived_is_same_vspace_table_type: split: cap.splits arch_cap.splits)+ done -lemma cap_insert_valid_arch_caps [CSpace_AI_assms]: +lemma cap_insert_valid_arch_caps [Arch_assms]: "\valid_arch_caps and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_caps\" @@ -433,7 +433,7 @@ lemma cap_insert_derived_ioport_control: simp: cte_wp_at_caps_of_state ioport_control_unique_def is_cap_simps) done -lemma cap_insert_derived_valid_arch_state[CSpace_AI_assms]: +lemma cap_insert_derived_valid_arch_state[Arch_assms]: "\valid_arch_state and (\s. cte_wp_at (is_derived (cdt s) src cap) src s)\ cap_insert cap src dest \\rv. valid_arch_state \" @@ -477,7 +477,7 @@ global_interpretation cap_insert_crunches?: cap_insert_crunches . context Arch begin arch_global_naming -lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma cap_insert_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range cap \ cap_range c) src\ cap_insert cap src dest @@ -490,7 +490,7 @@ lemma cap_insert_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: done -lemma mask_cap_valid[simp, CSpace_AI_assms]: +lemma mask_cap_valid[simp, Arch_assms]: "s \ c \ s \ mask_cap R c" apply (cases c, simp_all add: valid_cap_def mask_cap_def cap_rights_update_def @@ -500,21 +500,21 @@ lemma mask_cap_valid[simp, CSpace_AI_assms]: apply (rename_tac arch_cap) by (case_tac arch_cap, simp_all) -lemma mask_cap_objrefs[simp, CSpace_AI_assms]: +lemma mask_cap_objrefs[simp, Arch_assms]: "obj_refs (mask_cap rs cap) = obj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma mask_cap_zobjrefs[simp, CSpace_AI_assms]: +lemma mask_cap_zobjrefs[simp, Arch_assms]: "zobj_refs (mask_cap rs cap) = zobj_refs cap" by (cases cap, simp_all add: mask_cap_def cap_rights_update_def acap_rights_update_def split: arch_cap.split bool.splits) -lemma derive_cap_valid_cap [CSpace_AI_assms]: +lemma derive_cap_valid_cap [Arch_assms]: "\valid_cap cap\ derive_cap slot cap \valid_cap\,-" apply (simp add: derive_cap_def) apply (rule hoare_pre) @@ -523,7 +523,7 @@ lemma derive_cap_valid_cap [CSpace_AI_assms]: done -lemma valid_cap_update_rights[simp, CSpace_AI_assms]: +lemma valid_cap_update_rights[simp, Arch_assms]: "valid_cap cap s \ valid_cap (cap_rights_update cr cap) s" apply (case_tac cap, simp_all add: cap_rights_update_def valid_cap_def cap_aligned_def @@ -534,7 +534,7 @@ lemma valid_cap_update_rights[simp, CSpace_AI_assms]: done -lemma update_cap_data_validI [CSpace_AI_assms]: +lemma update_cap_data_validI [Arch_assms]: "s \ cap \ s \ update_cap_data p d cap" apply (cases cap) apply (simp_all add: is_cap_defs update_cap_data_def Let_def split_def) @@ -547,7 +547,7 @@ lemma update_cap_data_validI [CSpace_AI_assms]: done -lemma tcb_cnode_index_def2 [CSpace_AI_assms]: +lemma tcb_cnode_index_def2 [Arch_assms]: "tcb_cnode_index n = nat_to_cref 3 n" apply (simp add: tcb_cnode_index_def nat_to_cref_def) apply (rule nth_equalityI) @@ -556,7 +556,7 @@ lemma tcb_cnode_index_def2 [CSpace_AI_assms]: done -lemma ex_nonz_tcb_cte_caps [CSpace_AI_assms]: +lemma ex_nonz_tcb_cte_caps [Arch_assms]: "\ex_nonz_cap_to t s; tcb_at t s; valid_objs s; ref \ dom tcb_cap_cases\ \ ex_cte_cap_wp_to (appropriate_cte_cap cp) (t, ref) s" apply (clarsimp simp: ex_nonz_cap_to_def ex_cte_cap_wp_to_def @@ -586,7 +586,7 @@ lemma no_cap_to_obj_with_diff_ref_triv: done -lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: +lemma setup_reply_master_arch_caps[wp, Arch_assms]: "\valid_arch_caps and tcb_at t and valid_objs and pspace_aligned\ setup_reply_master t \\rv. valid_arch_caps\" @@ -600,7 +600,7 @@ lemma setup_reply_master_arch_caps[wp, CSpace_AI_assms]: done -lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: +lemma setup_reply_master_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and tcb_at t and pspace_in_kernel_window\ setup_reply_master t \\rv. cap_refs_in_kernel_window\" @@ -612,13 +612,13 @@ lemma setup_reply_master_cap_refs_in_kernel_window[wp, CSpace_AI_assms]: (* FIXME: prove same_region_as_def2 instead or change def *) -lemma same_region_as_Untyped2 [CSpace_AI_assms]: +lemma same_region_as_Untyped2 [Arch_assms]: "\ is_untyped_cap pcap; same_region_as pcap cap \ \ (is_physical cap \ cap_range cap \ {} \ cap_range cap \ cap_range pcap)" by (fastforce simp: is_cap_simps cap_range_def is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma same_region_as_cap_class [CSpace_AI_assms]: +lemma same_region_as_cap_class [Arch_assms]: shows "same_region_as a b \ cap_class a = cap_class b" apply (case_tac a) apply (fastforce simp: cap_range_def arch_is_physical_def is_cap_simps @@ -656,18 +656,19 @@ lemma setup_reply_master_arch_ioport_control[wp]: unfolding setup_reply_master_def by (wpsimp wp: get_cap_wp simp: ioport_control_unique_def) -lemma setup_reply_master_arch[CSpace_AI_assms]: +lemma setup_reply_master_arch[Arch_assms]: "setup_reply_master t \ valid_arch_state \" by (wp valid_arch_state_lift_ioports_typ_at setup_reply_master_ioports)+ (auto simp: valid_arch_state_def) +lemmas CSpace_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation CSpace_AI?: CSpace_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact CSpace_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.CSpace_AI_assms)?) qed diff --git a/proof/invariant-abstract/X64/ArchDetSchedAux_AI.thy b/proof/invariant-abstract/X64/ArchDetSchedAux_AI.thy index 9eef4747c0..9e7edc6231 100644 --- a/proof/invariant-abstract/X64/ArchDetSchedAux_AI.thy +++ b/proof/invariant-abstract/X64/ArchDetSchedAux_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedAux_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedAux_AI locale *) lemma set_arch_obj_etcbs[wp]: "set_object ptr (ArchObj aobj) \\s. P (etcbs_of s)\" @@ -20,11 +20,11 @@ lemma set_arch_obj_etcbs[wp]: crunch init_arch_objects for exst[wp]: "\s. P (exst s)" - and etcbs_of[wp, DetSchedAux_AI_assms]: "\s. P (etcbs_of s)" - and ready_queues[wp, DetSchedAux_AI_assms]: "\s. P (ready_queues s)" - and idle_thread[wp, DetSchedAux_AI_assms]: "\s. P (idle_thread s)" - and schedact[wp, DetSchedAux_AI_assms]: "\s. P (scheduler_action s)" - and cur_domain[wp, DetSchedAux_AI_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" + and ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and schedact[wp, Arch_assms]: "\s. P (scheduler_action s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" (wp: crunch_wps simp: set_arch_obj_simps) crunch init_arch_objects @@ -39,7 +39,7 @@ lemma tcb_sched_action_valid_idle_etcb: (wpsimp simp: tcb_sched_action_def set_tcb_queue_def) crunch init_arch_objects - for valid_blocked[wp, DetSchedAux_AI_assms]: valid_blocked + for valid_blocked[wp, Arch_assms]: valid_blocked (wp: valid_blocked_lift set_cap_typ_at) lemma perform_asid_control_etcb_at: @@ -83,12 +83,13 @@ lemma perform_asid_control_invocation_valid_sched: apply simp done +lemmas DetSchedAux_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedAux_AI?: DetSchedAux_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedAux_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.DetSchedAux_AI_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchDetSchedDomainTime_AI.thy b/proof/invariant-abstract/X64/ArchDetSchedDomainTime_AI.thy index 8e86dcefe0..f0da499b64 100644 --- a/proof/invariant-abstract/X64/ArchDetSchedDomainTime_AI.thy +++ b/proof/invariant-abstract/X64/ArchDetSchedDomainTime_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedDomainTime_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedDomainTime_AI locale *) (* crunch chokes on the case distinction for InvalidPTE in the argument of mapM in this function *) lemma flush_table_domain_list_inv[wp]: @@ -19,7 +19,7 @@ lemma flush_table_domain_list_inv[wp]: by (wpsimp wp: crunch_wps) crunch arch_finalise_cap - for domain_fields[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields[wp, Arch_assms]: "domain_fields P" (wp: hoare_drop_imps mapM_wp mapM_x_wp' subset_refl simp: crunch_simps) crunch @@ -30,23 +30,24 @@ crunch arch_get_sanitise_register_info, handle_reserved_irq, arch_invoke_irq_handler, arch_mask_irq_signal, arch_prepare_next_domain, arch_prepare_set_domain, arch_post_set_flags - for domain_fields[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps) -declare init_arch_objects_exst[DetSchedDomainTime_AI_assms] +declare init_arch_objects_exst[Arch_assms] + +lemmas DetSchedDomainTime_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.DetSchedDomainTime_AI_assms)?) qed context Arch begin arch_global_naming crunch arch_perform_invocation - for domain_fields[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" + for domain_fields[wp, Arch_assms]: "domain_fields P" (wp: crunch_wps check_cap_inv) crunch do_machine_op @@ -73,7 +74,7 @@ lemma timer_tick_valid_domain_time: crunch do_machine_op for domain_time_sched[wp]: "\s. P (domain_time s) (scheduler_action s)" -lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: +lemma handle_interrupt_valid_domain_time [Arch_assms]: "\\s :: det_ext state. 0 < domain_time s \ handle_interrupt i \\rv s. domain_time s = 0 \ scheduler_action s = choose_new_thread \" (is "\ ?dtnot0 \ _ \ _ \") @@ -90,15 +91,16 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]: done crunch handle_spurious_irq - for domain_fields[wp, DetSchedDomainTime_AI_assms]: "domain_fields P" - and scheduler_action[wp, DetSchedDomainTime_AI_assms]: "\s. P (scheduler_action s)" + for domain_fields[wp, Arch_assms]: "domain_fields P" + and scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" + +lemmas DetSchedDomainTime_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation DetSchedDomainTime_AI_2?: DetSchedDomainTime_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.DetSchedDomainTime_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchDetSchedSchedule_AI.thy b/proof/invariant-abstract/X64/ArchDetSchedSchedule_AI.thy index ea5533e392..4c38f1a5e9 100644 --- a/proof/invariant-abstract/X64/ArchDetSchedSchedule_AI.thy +++ b/proof/invariant-abstract/X64/ArchDetSchedSchedule_AI.thy @@ -10,21 +10,21 @@ begin context Arch begin arch_global_naming -named_theorems DetSchedSchedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for DetSchedSchedule_AI locale *) crunch prepare_thread_delete - for prepare_thread_delete_idel_thread[wp, DetSchedSchedule_AI_assms]: "\(s:: det_ext state). P (idle_thread s)" + for prepare_thread_delete_idel_thread[wp, Arch_assms]: "\(s:: det_ext state). P (idle_thread s)" crunch switch_to_idle_thread, switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain - for valid_queues[wp, DetSchedSchedule_AI_assms]: valid_queues + for valid_queues[wp, Arch_assms]: valid_queues (simp: crunch_simps wp: crunch_wps ignore: tcb_sched_action ) crunch switch_to_idle_thread, switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: "weak_valid_sched_action" + for weak_valid_sched_action[wp, Arch_assms]: "weak_valid_sched_action" (simp: crunch_simps wp: crunch_wps) crunch set_vm_root @@ -33,7 +33,7 @@ crunch set_vm_root and ct_not_in_q'[wp]: "\s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) t" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_not_in_q [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_in_q [wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\_. ct_not_in_q\" apply (simp add: switch_to_idle_thread_def) apply wp @@ -48,7 +48,7 @@ crunch set_vm_root (etcbs_of s) (kheap s) thread (cur_domain s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_sched_action [wp, Arch_assms]: "\valid_sched_action and valid_idle\ switch_to_idle_thread \\_. valid_sched_action\" @@ -65,7 +65,7 @@ crunch set_vm_root (scheduler_action s) (cur_domain s) (etcbs_of s)" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_in_cur_domain [wp, Arch_assms]: "\\\ switch_to_idle_thread \\_. ct_in_cur_domain\" by (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def split_def @@ -74,23 +74,23 @@ lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]: crunch arch_switch_to_thread, arch_get_sanitise_register_info - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread, arch_get_sanitise_register_info - for is_activatable[wp, DetSchedSchedule_AI_assms]: "is_activatable t" + for is_activatable[wp, Arch_assms]: "is_activatable t" (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers - for valid_sched_action[wp, DetSchedSchedule_AI_assms]: valid_sched_action + for valid_sched_action[wp, Arch_assms]: valid_sched_action (simp: crunch_simps wp: crunch_wps) crunch arch_switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers, arch_prepare_next_domain, arch_post_set_flags, arch_prepare_set_domain - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (simp: crunch_simps wp: crunch_wps) crunch set_vm_root @@ -103,7 +103,7 @@ lemma arch_thread_set_ct_in_cur_domain_2[wp]: by wpsimp crunch arch_switch_to_thread - for ct_in_cur_domain_2[wp, DetSchedSchedule_AI_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" + for ct_in_cur_domain_2[wp, Arch_assms]: "\s. ct_in_cur_domain_2 thread (idle_thread s) (scheduler_action s) (cur_domain s) (etcbs_of s)" (simp: whenE_def) crunch set_vm_root @@ -115,19 +115,19 @@ crunch set_vm_root (simp: crunch_simps) crunch switch_to_thread - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" crunch arch_switch_to_idle_thread - for valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_idle[wp, Arch_assms]: valid_idle (wp: crunch_wps simp: crunch_simps) crunch arch_switch_to_idle_thread, arch_prepare_next_domain - for etcb_at[wp, DetSchedSchedule_AI_assms]: "etcb_at P t" + for etcb_at[wp, Arch_assms]: "etcb_at P t" crunch arch_prepare_next_domain, arch_prepare_set_domain - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" (simp: Let_def) lemma as_user_ct_in_q[wp]: @@ -136,14 +136,14 @@ lemma as_user_ct_in_q[wp]: by (wpsimp wp: hoare_vcg_imp_lift | wps)+ crunch arch_prepare_next_domain - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" - and ct_in_q[wp, DetSchedSchedule_AI_assms]: ct_in_q - and valid_blocked[wp, DetSchedSchedule_AI_assms]: valid_blocked + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" + and ct_in_q[wp, Arch_assms]: ct_in_q + and valid_blocked[wp, Arch_assms]: valid_blocked (wp: crunch_wps) crunch arch_prepare_set_domain - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (idle_thread s)" - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + and valid_idle[wp, Arch_assms]: valid_idle lemma set_vm_root_valid_blocked_ct_in_q [wp]: "\valid_blocked and ct_in_q\ set_vm_root p \\_. valid_blocked and ct_in_q\" @@ -153,11 +153,11 @@ crunch lazy_fpu_restore for valid_blocked[wp]: valid_blocked and ct_in_q[wp]: ct_in_q -lemma arch_switch_to_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma arch_switch_to_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ arch_switch_to_thread thread \\_. valid_blocked and ct_in_q\" by (wpsimp simp: arch_switch_to_thread_def) -lemma switch_to_idle_thread_ct_not_queued [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_ct_not_queued [wp, Arch_assms]: "\valid_queues and valid_idle\ switch_to_idle_thread \\rv s. not_queued (cur_thread s) s\" @@ -171,7 +171,7 @@ crunch set_vm_root for valid_blocked_2[wp]: "\s. valid_blocked_2 (ready_queues s) (kheap s) (scheduler_action s) thread" (wp: crunch_wps simp: crunch_simps) -lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_valid_blocked [wp, Arch_assms]: "\valid_blocked and ct_in_q\ switch_to_idle_thread \\rv. valid_blocked\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def | wp | wpc)+ apply clarsimp @@ -180,7 +180,7 @@ lemma switch_to_idle_thread_valid_blocked [wp, DetSchedSchedule_AI_assms]: done crunch arch_switch_to_thread - for exst[wp, DetSchedSchedule_AI_assms]: "\s. P (exst s :: det_ext)" + for exst[wp, Arch_assms]: "\s. P (exst s :: det_ext)" (ignore: ) crunch arch_switch_to_idle_thread @@ -195,7 +195,7 @@ lemma astit_st_tcb_at[wp]: apply (simp add: arch_switch_to_idle_thread_def) by (wpsimp) -lemma stit_activatable' [DetSchedSchedule_AI_assms]: +lemma stit_activatable' [Arch_assms]: "\valid_idle\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def do_machine_op_def split_def ct_in_state_def) apply wpsimp @@ -206,7 +206,7 @@ crunch set_vm_root for it[wp]: "\s. P (idle_thread s)" (simp: crunch_simps) -lemma switch_to_idle_thread_cur_thread_idle_thread [wp, DetSchedSchedule_AI_assms]: +lemma switch_to_idle_thread_cur_thread_idle_thread [wp, Arch_assms]: "\\\ switch_to_idle_thread \\_ s. cur_thread s = idle_thread s\" by (wp | simp add:switch_to_idle_thread_def arch_switch_to_idle_thread_def)+ @@ -240,7 +240,7 @@ lemma flush_table_ct_not_in_q[wp]: "\ct_not_in_q\ flush_table a crunch arch_finalise_cap, prepare_thread_delete - for ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q + for ct_not_in_q[wp, Arch_assms]: ct_not_in_q (wp: crunch_wps hoare_drop_imps unless_wp select_inv mapM_wp subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action) @@ -249,7 +249,7 @@ lemma flush_table_simple_sched_action[wp]: "\simple_sched_action\valid_sched\ activate_thread \\_. valid_sched\" apply (simp add: activate_thread_def) apply (wp set_thread_state_runnable_valid_sched gts_wp | wpc | simp add: arch_activate_idle_thread_def)+ @@ -297,7 +297,7 @@ crunch for valid_sched[wp]: valid_sched (wp: mapM_x_wp' mapM_wp') -lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: +lemma arch_perform_invocation_valid_sched [wp, Arch_assms]: "\invs and valid_sched and ct_active and valid_arch_inv a\ arch_perform_invocation a \\_.valid_sched\" @@ -308,24 +308,24 @@ lemma arch_perform_invocation_valid_sched [wp, DetSchedSchedule_AI_assms]: crunch handle_arch_fault_reply, handle_vm_fault, arch_mask_irq_signal, arch_invoke_irq_handler - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched + for valid_sched[wp, Arch_assms]: valid_sched (ignore: ) crunch handle_vm_fault, handle_arch_fault_reply - for not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" + for not_queued[wp, Arch_assms]: "not_queued t" (ignore: ) crunch handle_arch_fault_reply, handle_vm_fault - for sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" + for sched_act_not[wp, Arch_assms]: "scheduler_act_not t" (ignore: ) -lemma hvmf_st_tcb_at [wp, DetSchedSchedule_AI_assms]: +lemma hvmf_st_tcb_at [wp, Arch_assms]: "\st_tcb_at P t' \ handle_vm_fault t w \\rv. st_tcb_at P t' \" unfolding handle_vm_fault_def by (cases w, simp_all) ((wp | simp)+) -lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: +lemma handle_vm_fault_st_tcb_cur_thread [wp, Arch_assms]: "\ \s. st_tcb_at P (cur_thread s) s \ handle_vm_fault t f \\_ s. st_tcb_at P (cur_thread s) s \" unfolding handle_vm_fault_def apply (fold ct_in_state_def) @@ -333,38 +333,38 @@ lemma handle_vm_fault_st_tcb_cur_thread [wp, DetSchedSchedule_AI_assms]: done crunch arch_invoke_irq_control - for valid_sched[wp, DetSchedSchedule_AI_assms]: "valid_sched" + for valid_sched[wp, Arch_assms]: "valid_sched" crunch arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread, arch_prepare_next_domain - for valid_list[wp, DetSchedSchedule_AI_assms]: "valid_list" + for valid_list[wp, Arch_assms]: "valid_list" crunch handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info, arch_post_modify_registers - for cur_tcb[wp, DetSchedSchedule_AI_assms]: cur_tcb + for cur_tcb[wp, Arch_assms]: cur_tcb crunch arch_get_sanitise_register_info, arch_post_modify_registers - for not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t'" + for not_cur_thread[wp, Arch_assms]: "not_cur_thread t'" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ready_queues[wp, DetSchedSchedule_AI_assms]: "\s. P (ready_queues s)" + for ready_queues[wp, Arch_assms]: "\s. P (ready_queues s)" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for scheduler_action[wp, DetSchedSchedule_AI_assms]: "\s. P (scheduler_action s)" + for scheduler_action[wp, Arch_assms]: "\s. P (scheduler_action s)" -lemma arch_post_modify_registers_not_idle_thread[DetSchedSchedule_AI_assms]: +lemma arch_post_modify_registers_not_idle_thread[Arch_assms]: "\\s::det_ext state. t \ idle_thread s\ arch_post_modify_registers c t \\_ s. t \ idle_thread s\" by (wpsimp simp: arch_post_modify_registers_def) crunch arch_post_cap_deletion - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and ct_not_in_q[wp, DetSchedSchedule_AI_assms]: ct_not_in_q - and simple_sched_action[wp, DetSchedSchedule_AI_assms]: simple_sched_action - and not_cur_thread[wp, DetSchedSchedule_AI_assms]: "not_cur_thread t" - and not_queued[wp, DetSchedSchedule_AI_assms]: "not_queued t" - and sched_act_not[wp, DetSchedSchedule_AI_assms]: "scheduler_act_not t" - and weak_valid_sched_action[wp, DetSchedSchedule_AI_assms]: weak_valid_sched_action - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle - -lemma flush_table_idle_thread[wp, DetSchedSchedule_AI_assms]: + for valid_sched[wp, Arch_assms]: valid_sched + and ct_not_in_q[wp, Arch_assms]: ct_not_in_q + and simple_sched_action[wp, Arch_assms]: simple_sched_action + and not_cur_thread[wp, Arch_assms]: "not_cur_thread t" + and not_queued[wp, Arch_assms]: "not_queued t" + and sched_act_not[wp, Arch_assms]: "scheduler_act_not t" + and weak_valid_sched_action[wp, Arch_assms]: weak_valid_sched_action + and valid_idle[wp, Arch_assms]: valid_idle + +lemma flush_table_idle_thread[wp, Arch_assms]: "\\s. P (idle_thread s)\ flush_table param_a param_b param_c param_d \\_ s. P (idle_thread s)\" unfolding flush_table_def apply (wpsimp wp: mapM_x_wp') @@ -377,50 +377,54 @@ crunch crunch arch_finalise_cap - for idle_thread[wp, DetSchedSchedule_AI_assms]: "\ (s:: det_ext state). P (idle_thread s)" + for idle_thread[wp, Arch_assms]: "\ (s:: det_ext state). P (idle_thread s)" (wp: crunch_wps crunch_simps) crunch handle_spurious_irq - for valid_sched[wp, DetSchedSchedule_AI_assms]: valid_sched - and valid_idle[wp, DetSchedSchedule_AI_assms]: valid_idle + for valid_sched[wp, Arch_assms]: valid_sched + and valid_idle[wp, Arch_assms]: valid_idle crunch arch_switch_to_thread - for cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" crunch prepare_thread_delete, arch_post_cap_deletion, arch_finalise_cap - for cur_thread[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_thread s)" - and cur_domain[wp, DetSchedSchedule_AI_assms]: "\s. P (cur_domain s)" - and etcbs_of[wp, DetSchedSchedule_AI_assms]: "\s. P (etcbs_of s)" + for cur_thread[wp, Arch_assms]: "\s. P (cur_thread s)" + and cur_domain[wp, Arch_assms]: "\s. P (cur_domain s)" + and etcbs_of[wp, Arch_assms]: "\s. P (etcbs_of s)" (wp: mapM_x_wp_inv_weak crunch_wps simp: crunch_simps ignore: set_object) +lemmas DetSchedSchedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.DetSchedSchedule_AI_assms)?) qed context Arch begin arch_global_naming -lemma handle_hyp_fault_valid_sched[wp, DetSchedSchedule_AI_assms]: +lemma handle_hyp_fault_valid_sched[wp, Arch_assms]: "\valid_sched and invs and st_tcb_at active t and not_queued t and scheduler_act_not t and (ct_active or ct_idle)\ handle_hypervisor_fault t fault \\_. valid_sched\" by (cases fault; wpsimp wp: handle_fault_valid_sched simp: valid_fault_def) -lemma handle_reserved_irq_valid_sched[wp, DetSchedSchedule_AI_assms]: +lemma handle_reserved_irq_valid_sched[wp, Arch_assms]: "\valid_sched and invs and (\s. irq \ non_kernel_IRQs \ scheduler_act_sane s \ ct_not_queued s)\ handle_reserved_irq irq \\rv. valid_sched\" unfolding handle_reserved_irq_def by (wpsimp simp: non_kernel_IRQs_def) +lemmas [Arch_assms] = handle_hyp_fault_valid_sched handle_reserved_irq_valid_sched + +lemmas DetSchedSchedule_AI_handle_hypervisor_fault_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation DetSchedSchedule_AI_handle_hypervisor_fault?: DetSchedSchedule_AI_handle_hypervisor_fault proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.DetSchedSchedule_AI_handle_hypervisor_fault_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchDeterministic_AI.thy b/proof/invariant-abstract/X64/ArchDeterministic_AI.thy index f492a86155..440fa0228c 100644 --- a/proof/invariant-abstract/X64/ArchDeterministic_AI.thy +++ b/proof/invariant-abstract/X64/ArchDeterministic_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems Deterministic_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Deterministic_AI locale *) lemma flush_table_valid_list[wp]: "\valid_list\ flush_table a b c d \\rv. valid_list\" by (wp mapM_x_wp' | wpc | simp add: flush_table_def | rule hoare_pre)+ @@ -22,16 +22,17 @@ crunch set_object crunch cap_swap_for_delete,set_cap,finalise_cap,arch_get_sanitise_register_info, arch_post_modify_registers, arch_invoke_irq_handler, arch_post_set_flags - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: unless_def crunch_simps) -declare get_cap_inv[Deterministic_AI_assms] +declare get_cap_inv[Arch_assms] + +lemmas Deterministic_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Deterministic_AI_1?: Deterministic_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Deterministic_AI_assms)?) qed context Arch begin arch_global_naming @@ -95,23 +96,23 @@ crunch perform_invocation (wp: crunch_wps simp: crunch_simps ignore: without_preemption) crunch handle_invocation - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps syscall_valid simp: crunch_simps ignore: without_preemption syscall) crunch handle_recv, handle_yield, handle_call, handle_hypervisor_fault - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list (wp: crunch_wps simp: crunch_simps) -lemma handle_vm_fault_valid_list[wp, Deterministic_AI_assms]: +lemma handle_vm_fault_valid_list[wp, Arch_assms]: "\valid_list\ handle_vm_fault thread fault \\_.valid_list\" unfolding handle_vm_fault_def apply (cases fault,simp_all) apply (wp|simp)+ done -lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: +lemma handle_interrupt_valid_list[wp, Arch_assms]: "\valid_list\ handle_interrupt irq \\_.valid_list\" unfolding handle_interrupt_def ackInterrupt_def apply (rule hoare_pre) @@ -120,13 +121,15 @@ lemma handle_interrupt_valid_list[wp, Deterministic_AI_assms]: | wp (once) hoare_drop_imps)+ crunch handle_send, handle_reply, handle_spurious_irq - for valid_list[wp, Deterministic_AI_assms]: valid_list + for valid_list[wp, Arch_assms]: valid_list + +lemmas Deterministic_AI_2_assms = Arch_assms (* extract accumulated assumptions *) end + global_interpretation Deterministic_AI_2?: Deterministic_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Deterministic_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Deterministic_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchDetype_AI.thy b/proof/invariant-abstract/X64/ArchDetype_AI.thy index 081c887eb6..49881679cb 100644 --- a/proof/invariant-abstract/X64/ArchDetype_AI.thy +++ b/proof/invariant-abstract/X64/ArchDetype_AI.thy @@ -10,16 +10,16 @@ begin context Arch begin arch_global_naming -named_theorems Detype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_AI locale *) -lemma valid_globals_irq_node[Detype_AI_assms]: +lemma valid_globals_irq_node[Arch_assms]: "\ valid_global_refs s; cte_wp_at ((=) cap) ptr s \ \ interrupt_irq_node s irq \ cap_range cap" apply (erule(1) valid_global_refsD) apply (simp add: global_refs_def) done -lemma caps_of_state_ko[Detype_AI_assms]: +lemma caps_of_state_ko[Arch_assms]: "valid_cap cap s \ is_untyped_cap cap \ cap_range cap = {} \ @@ -33,7 +33,7 @@ lemma caps_of_state_ko[Detype_AI_assms]: split: option.splits if_splits)+ done -lemma mapM_x_storeWord[Detype_AI_assms]: +lemma mapM_x_storeWord[Arch_assms]: (* FIXME: taken from Retype_C.thy and adapted wrt. the missing intvl syntax. *) assumes al: "is_aligned ptr word_size_bits" shows "mapM_x (\x. storeWord (ptr + of_nat x * word_size) 0) [0..x. if x \ S then {} else state_hyp_refs_of s x)" by (rule ext, simp add: state_hyp_refs_of_def detype_def) +lemmas Detype_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Detype_AI?: Detype_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Detype_AI_assms)?) + by (intro_locales; (unfold_locales; fact X64.Detype_AI_assms)?) qed context detype_locale_arch begin diff --git a/proof/invariant-abstract/X64/ArchEmptyFail_AI.thy b/proof/invariant-abstract/X64/ArchEmptyFail_AI.thy index 8ed8529338..4b5ab1a6e8 100644 --- a/proof/invariant-abstract/X64/ArchEmptyFail_AI.thy +++ b/proof/invariant-abstract/X64/ArchEmptyFail_AI.thy @@ -10,27 +10,28 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_AI locale *) crunch load_word_offs, get_mrs, invalidate_page_structure_cache_asid - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (* FIXME: remove from locale *) -declare loadWord_empty_fail[EmptyFail_AI_assms] +declare loadWord_empty_fail[Arch_assms] + +lemmas EmptyFail_AI_load_word_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation EmptyFail_AI_load_word?: EmptyFail_AI_load_word proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.EmptyFail_AI_load_word_assms)?) qed context Arch begin arch_global_naming crunch handle_fault - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: kernel_object.splits option.splits arch_cap.splits cap.splits endpoint.splits bool.splits list.splits thread_state.splits split_def catch_def sum.splits Let_def) @@ -127,12 +128,13 @@ lemma arch_decode_invocation_empty_fail[wp]: decode_page_directory_invocation_def decode_pdpt_invocation_def split: arch_cap.splits cap.splits option.splits | wp | intro conjI impI allI)+) +lemmas EmptyFail_AI_derive_cap_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_derive_cap?: EmptyFail_AI_derive_cap proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.EmptyFail_AI_derive_cap_assms)?) qed context Arch begin arch_global_naming @@ -144,48 +146,54 @@ lemma flush_table_empty_fail[simp, wp]: "empty_fail (flush_table a b c d)" crunch maskInterrupt, empty_slot, finalise_cap, preemption_point, cap_swap_for_delete, decode_invocation - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: Let_def catch_def split_def OR_choiceE_def mk_ef_def option.splits endpoint.splits notification.splits thread_state.splits sum.splits cap.splits arch_cap.splits kernel_object.splits vmpage_size.splits pde.splits bool.splits list.splits set_object_def) +lemmas EmptyFail_AI_rec_del_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_rec_del?: EmptyFail_AI_rec_del proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.EmptyFail_AI_rec_del_assms)?) qed context Arch begin arch_global_naming + crunch cap_delete, choose_thread, arch_prepare_next_domain - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] + +lemmas EmptyFail_AI_schedule_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_schedule?: EmptyFail_AI_schedule proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.EmptyFail_AI_schedule_assms)?) qed context Arch begin arch_global_naming crunch possible_switch_to, handle_event, activate_thread, maybe_handle_interrupt - for (empty_fail) empty_fail[wp, EmptyFail_AI_assms] + for (empty_fail) empty_fail[wp, Arch_assms] (simp: cap.splits arch_cap.splits split_def invocation_label.splits Let_def kernel_object.splits arch_kernel_obj.splits option.splits pde.splits pte.splits bool.splits apiobject_type.splits aobject_type.splits notification.splits thread_state.splits endpoint.splits catch_def sum.splits cnode_invocation.splits page_table_invocation.splits page_invocation.splits asid_control_invocation.splits asid_pool_invocation.splits arch_invocation.splits irq_state.splits syscall.splits) + +lemmas EmptyFail_AI_call_kernel_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation EmptyFail_AI_call_kernel?: EmptyFail_AI_call_kernel proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact EmptyFail_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.EmptyFail_AI_call_kernel_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchFinalise_AI.thy b/proof/invariant-abstract/X64/ArchFinalise_AI.thy index 48a177a34f..7aa7395131 100644 --- a/proof/invariant-abstract/X64/ArchFinalise_AI.thy +++ b/proof/invariant-abstract/X64/ArchFinalise_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin -named_theorems Finalise_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_AI locale *) -lemma obj_at_not_live_valid_arch_cap_strg [Finalise_AI_assms]: +lemma obj_at_not_live_valid_arch_cap_strg [Arch_assms]: "(s \ ArchObjectCap cap \ aobj_ref cap = Some r) \ obj_at (\ko. \ live ko) r s" by (clarsimp simp: valid_cap_def obj_at_def @@ -202,22 +202,22 @@ lemma unmap_page_tcb_cap_valid: apply (wp unmap_page_tcb_at hoare_vcg_ex_lift hoare_vcg_all_lift)+ done -lemma (* replaceable_cdt_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_cdt_update *)[simp,Arch_assms]: "replaceable (cdt_update f s) = replaceable s" by (fastforce simp: replaceable_def tcb_cap_valid_def) -lemma (* replaceable_revokable_update *)[simp,Finalise_AI_assms]: +lemma (* replaceable_revokable_update *)[simp,Arch_assms]: "replaceable (is_original_cap_update f s) = replaceable s" by (fastforce simp: replaceable_def is_final_cap'_def2 tcb_cap_valid_def) -lemma (* replaceable_more_update *) [simp,Finalise_AI_assms]: +lemma (* replaceable_more_update *) [simp,Arch_assms]: "replaceable (trans_state f s) sl cap cap' = replaceable s sl cap cap'" by (simp add: replaceable_def) -lemma (* obj_ref_ofI *) [Finalise_AI_assms]: "obj_refs cap = {x} \ obj_ref_of cap = x" +lemma (* obj_ref_ofI *) [Arch_assms]: "obj_refs cap = {x} \ obj_ref_of cap = x" by (case_tac cap, simp_all) (rename_tac arch_cap, case_tac arch_cap, simp_all) -lemma (* empty_slot_invs *) [Finalise_AI_assms]: +lemma (* empty_slot_invs *) [Arch_assms]: "\\s. invs s \ cte_wp_at (replaceable s sl cap.NullCap) sl s \ emptyable sl s \ (info \ NullCap \ post_cap_delete_pre info ((caps_of_state s) (sl \ NullCap)))\ @@ -298,7 +298,7 @@ lemma (* empty_slot_invs *) [Finalise_AI_assms]: apply (simp add: is_final_cap'_def2 cte_wp_at_caps_of_state) done -lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: +lemma dom_tcb_cap_cases_lt_ARCH [Arch_assms]: "dom tcb_cap_cases = {xs. length xs = 3 \ unat (of_bl xs :: machine_word) < 5}" apply (rule set_eqI, rule iffI) apply clarsimp @@ -308,7 +308,7 @@ lemma dom_tcb_cap_cases_lt_ARCH [Finalise_AI_assms]: apply (clarsimp simp: nat_to_cref_unat_of_bl'[simplified word_bits_def]) done -lemma (* unbind_notification_final *) [wp,Finalise_AI_assms]: +lemma (* unbind_notification_final *) [wp,Arch_assms]: "\is_final_cap' cap\ unbind_notification t \ \rv. is_final_cap' cap\" unfolding unbind_notification_def apply (wp final_cap_lift thread_set_caps_of_state_trivial hoare_drop_imps @@ -324,7 +324,7 @@ crunch prepare_thread_delete for is_final_cap'[wp]: "is_final_cap' cap" (wp: crunch_wps) -lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: +lemma (* finalise_cap_cases1 *)[Arch_assms]: "\\s. final \ is_final_cap' cap s \ cte_wp_at ((=) cap) slot s\ finalise_cap cap final @@ -356,20 +356,20 @@ lemma (* finalise_cap_cases1 *)[Finalise_AI_assms]: done crunch arch_finalise_cap, prepare_thread_delete - for typ_at_arch[wp,Finalise_AI_assms]: "\s. P (typ_at T p s)" + for typ_at_arch[wp,Arch_assms]: "\s. P (typ_at T p s)" (wp: crunch_wps simp: crunch_simps unless_def assertE_def ignore: maskInterrupt ) crunch prepare_thread_delete for valid_cap[wp]: "valid_cap cap" and tcb_at[wp]: "tcb_at p" - and cte_wp_at[wp, Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" - and irq_node[wp, Finalise_AI_assms]: "\s. P (interrupt_irq_node s)" - and caps_of_state[wp, Finalise_AI_assms]: "\s. P (caps_of_state s)" + and cte_wp_at[wp, Arch_assms]: "\s. P (cte_wp_at P' p s)" + and irq_node[wp, Arch_assms]: "\s. P (interrupt_irq_node s)" + and caps_of_state[wp, Arch_assms]: "\s. P (caps_of_state s)" and invs[wp]: invs (wp: crunch_wps simp: crunch_simps) -lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: +lemma (* finalise_cap_new_valid_cap *)[wp,Arch_assms]: "\valid_cap cap\ finalise_cap cap x \\rv. valid_cap (fst rv)\" apply (cases cap, simp_all) apply (wp suspend_valid_cap @@ -383,7 +383,7 @@ lemma (* finalise_cap_new_valid_cap *)[wp,Finalise_AI_assms]: split del: if_split|clarsimp|wpc)+ done -lemma (* arch_finalise_cap_invs *)[wp,Finalise_AI_assms]: +lemma (* arch_finalise_cap_invs *)[wp,Arch_assms]: "\invs and valid_cap (ArchObjectCap cap)\ arch_finalise_cap cap final \\rv. invs\" @@ -434,7 +434,7 @@ lemma arch_finalise_cap_replaceable[wp]: split: cap.splits arch_cap.splits option.splits vmpage_size.splits) done -lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_slot_not_irq_node *)[Arch_assms]: "\if_unsafe_then_cap and valid_global_refs and cte_wp_at (\cp. cap_irqs cp \ {}) sl\ deleting_irq_handler irq @@ -455,7 +455,7 @@ lemma (* deleting_irq_handler_slot_not_irq_node *)[Finalise_AI_assms]: apply (clarsimp simp: appropriate_cte_cap_def split: cap.split_asm) done -lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Arch_assms]: "\ cte_wp_at ((=) cap) p s; is_final_cap' cap s; obj_refs cap' = obj_refs cap \ \ no_cap_to_obj_with_diff_ref cap' {p} s" @@ -477,7 +477,7 @@ lemma no_cap_to_obj_with_diff_ref_finalI_ARCH[Finalise_AI_assms]: gen_obj_refs_Int) done -lemma (* suspend_no_cap_to_obj_ref *)[wp,Finalise_AI_assms]: +lemma (* suspend_no_cap_to_obj_ref *)[wp,Arch_assms]: "\no_cap_to_obj_with_diff_ref cap S\ suspend t \\rv. no_cap_to_obj_with_diff_ref cap S\" @@ -598,7 +598,7 @@ crunch suspend, unbind_notification for valid_cur_fpu[wp]: valid_cur_fpu (wp: crunch_wps simp: crunch_simps) -lemma finalise_cap_replaceable [Finalise_AI_assms]: +lemma finalise_cap_replaceable [Arch_assms]: "\\s. s \ cap \ x = is_final_cap' cap s \ valid_mdb s \ valid_cur_fpu s \ cte_wp_at ((=) cap) sl s \ valid_objs s \ sym_refs (state_refs_of s) \ (cap_irqs cap \ {} \ if_unsafe_then_cap s \ valid_global_refs s) @@ -649,7 +649,7 @@ lemma finalise_cap_replaceable [Finalise_AI_assms]: | wpc | simp add: valid_cap_simps)+)) -lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_assms]: +lemma (* deleting_irq_handler_cte_preserved *)[Arch_assms]: assumes x: "\cap. P cap \ \ can_fast_finalise cap" shows "\cte_wp_at P p\ deleting_irq_handler irq \\rv. cte_wp_at P p\" apply (simp add: deleting_irq_handler_def) @@ -668,23 +668,24 @@ lemma set_asid_pool_cte_wp_at: crunch arch_finalise_cap - for cte_wp_at[wp,Finalise_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" (simp: crunch_simps assertE_def set_arch_obj_simps wp: set_aobject_cte_wp_at crunch_wps set_object_cte_at ignore: set_object) -declare arch_post_cap_deletion_cur_thread[Finalise_AI_assms] +declare arch_post_cap_deletion_cur_thread[Arch_assms] crunch arch_post_cap_deletion - for cur_domain[Finalise_AI_assms, wp]: "\s. P (cur_domain s)" + for cur_domain[Arch_assms, wp]: "\s. P (cur_domain s)" (wp: crunch_wps dxo_wp_weak) +lemmas Finalise_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_1?: Finalise_AI_1 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -708,7 +709,7 @@ lemma fast_finalise_replaceable[wp]: apply (clarsimp simp: cap_irqs_def cap_irq_opt_def split: cap.split_asm) done -lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: +lemma (* cap_delete_one_invs *) [Arch_assms,wp]: "\invs and emptyable ptr\ cap_delete_one ptr \\rv. invs\" apply (simp add: cap_delete_one_def unless_def is_final_cap_def) apply (rule hoare_pre) @@ -717,12 +718,13 @@ lemma (* cap_delete_one_invs *) [Finalise_AI_assms,wp]: apply (drule cte_wp_at_valid_objs_valid_cap, fastforce+) done +lemmas Finalise_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_2?: Finalise_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Finalise_AI_2_assms)?) qed context Arch begin arch_global_naming @@ -1314,7 +1316,7 @@ crunch invalidate_page_structure_cache_asid, hw_asid_invalidate crunch do_machine_op for valid_asid_table[wp]: "\s. valid_asid_table (x64_asid_table (arch_state s)) s" -lemma (* finalise_cap_invs *)[Finalise_AI_assms]: +lemma (* finalise_cap_invs *)[Arch_assms]: shows "\invs and cte_wp_at ((=) cap) slot\ finalise_cap cap x \\rv. invs\" apply (cases cap, simp_all split del: if_split) apply (wp cancel_all_ipc_invs cancel_all_signals_invs unbind_notification_invs @@ -1331,16 +1333,16 @@ lemma (* finalise_cap_invs *)[Finalise_AI_assms]: apply (auto dest: cte_wp_at_valid_objs_valid_cap) done -lemma (* finalise_cap_irq_node *)[Finalise_AI_assms]: +lemma (* finalise_cap_irq_node *)[Arch_assms]: "\\s. P (interrupt_irq_node s)\ finalise_cap a b \\_ s. P (interrupt_irq_node s)\" apply (case_tac a,simp_all) apply (wp | clarsimp)+ done -lemmas (*arch_finalise_cte_irq_node *) [wp,Finalise_AI_assms] +lemmas (*arch_finalise_cte_irq_node *) [wp,Arch_assms] = hoare_use_eq_irq_node [OF arch_finalise_cap_irq_node arch_finalise_cap_cte_wp_at] -lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: +lemma (* deleting_irq_handler_st_tcb_at *) [Arch_assms]: "\st_tcb_at P t and K (\st. simple st \ P st)\ deleting_irq_handler irq \\rv. st_tcb_at P t\" @@ -1349,11 +1351,11 @@ lemma (* deleting_irq_handler_st_tcb_at *) [Finalise_AI_assms]: apply simp done -lemma irq_node_global_refs_ARCH [Finalise_AI_assms]: +lemma irq_node_global_refs_ARCH [Arch_assms]: "interrupt_irq_node s irq \ global_refs s" by (simp add: global_refs_def) -lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: +lemma (* get_irq_slot_fast_finalisable *)[wp,Arch_assms]: "\invs\ get_irq_slot irq \cte_wp_at can_fast_finalise\" apply (simp add: get_irq_slot_def) apply wp @@ -1375,12 +1377,12 @@ lemma (* get_irq_slot_fast_finalisable *)[wp,Finalise_AI_assms]: apply (clarsimp simp: cap_range_def) done -lemma (* replaceable_or_arch_update_same *) [Finalise_AI_assms]: +lemma (* replaceable_or_arch_update_same *) [Arch_assms]: "replaceable_or_arch_update s slot cap cap" by (clarsimp simp: replaceable_or_arch_update_def replaceable_def is_arch_update_def is_cap_simps) -lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: +lemma (* replace_cap_invs_arch_update *)[Arch_assms]: "\\s. cte_wp_at (replaceable_or_arch_update s p cap) p s \ invs s \ cap \ cap.NullCap @@ -1401,7 +1403,7 @@ lemma (* replace_cap_invs_arch_update *)[Finalise_AI_assms]: crunch hw_asid_invalidate for pred_tcb_at_P[wp]: "\s. P (pred_tcb_at proj Q p s)" -lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: +lemma dmo_tcb_cap_valid_ARCH [Arch_assms]: "\\s. P (tcb_cap_valid cap ptr s)\ do_machine_op mop \\_ s. P (tcb_cap_valid cap ptr s)\" apply (simp add: tcb_cap_valid_def no_cap_to_obj_with_diff_ref_def) apply (rule hoare_pre) @@ -1410,7 +1412,7 @@ lemma dmo_tcb_cap_valid_ARCH [Finalise_AI_assms]: apply simp done -lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: +lemma (* dmo_replaceable_or_arch_update *) [Arch_assms,wp]: "\\s. replaceable_or_arch_update s slot cap cap'\ do_machine_op mo \\r s. replaceable_or_arch_update s slot cap cap'\" @@ -1422,6 +1424,8 @@ lemma (* dmo_replaceable_or_arch_update *) [Finalise_AI_assms,wp]: apply auto done +lemmas Finalise_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end arch_requalify_consts replaceable_or_arch_update @@ -1429,15 +1433,13 @@ arch_requalify_consts replaceable_or_arch_update interpretation Finalise_AI_3?: Finalise_AI_3 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Finalise_AI_3_assms)?) qed interpretation Finalise_AI_4?: Finalise_AI_4 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Finalise_AI_assms)?) qed context Arch begin arch_global_naming @@ -1679,9 +1681,9 @@ crunch unmap_page_table, (wp: mapM_wp_inv mapM_x_wp' crunch_wps simp: crunch_simps set_arch_obj_simps ignore: set_object) -lemmas clearMemory_invs[wp, Finalise_AI_assms] = clearMemory_invs +lemmas clearMemory_invs[wp, Arch_assms] = clearMemory_invs -lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: +lemma valid_idle_has_null_cap_ARCH[Arch_assms]: "\ if_unsafe_then_cap s; valid_global_refs s; valid_idle s; valid_irq_node s\ \ caps_of_state s (idle_thread s, v) = Some cap \ cap = NullCap" @@ -1697,7 +1699,7 @@ lemma valid_idle_has_null_cap_ARCH[Finalise_AI_assms]: apply (drule_tac x=word in spec, simp) done -lemma (* zombie_cap_two_nonidles *)[Finalise_AI_assms]: +lemma (* zombie_cap_two_nonidles *)[Arch_assms]: "\ caps_of_state s ptr = Some (Zombie ptr' zbits n); invs s \ \ fst ptr \ idle_thread s \ ptr' \ idle_thread s" apply (frule valid_global_refsD2, clarsimp+) @@ -1740,13 +1742,14 @@ lemma arch_derive_cap_notIRQ[wp]: "\\\ arch_derive_cap cap \\rv s. rv \ cap.IRQControlCap\,-" by (cases cap; wpsimp simp: arch_derive_cap_def o_def) +lemmas Finalise_AI_5_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Finalise_AI_5?: Finalise_AI_5 where replaceable_or_arch_update = replaceable_or_arch_update proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Finalise_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Finalise_AI_5_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchInterruptAcc_AI.thy b/proof/invariant-abstract/X64/ArchInterruptAcc_AI.thy index 64a3f58419..2d9b34a8bf 100644 --- a/proof/invariant-abstract/X64/ArchInterruptAcc_AI.thy +++ b/proof/invariant-abstract/X64/ArchInterruptAcc_AI.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems InterruptAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InterruptAcc_AI locale *) -lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: +lemma dmo_maskInterrupt_invs [Arch_assms]: "\all_invs_but_valid_irq_states_for irq and (\s. state = interrupt_states s irq)\ do_machine_op (maskInterrupt (state = IRQInactive) irq) \\rv. invs\" @@ -28,12 +28,13 @@ lemma dmo_maskInterrupt_invs [InterruptAcc_AI_assms]: crunch handle_spurious_irq for invs: invs +lemmas InterruptAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation InterruptAcc_AI?: InterruptAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact InterruptAcc_AI_assms) + case 1 show ?case by (unfold_locales; fact X64.InterruptAcc_AI_assms) qed end diff --git a/proof/invariant-abstract/X64/ArchInterrupt_AI.thy b/proof/invariant-abstract/X64/ArchInterrupt_AI.thy index 5f16e5b38d..00e66fd935 100644 --- a/proof/invariant-abstract/X64/ArchInterrupt_AI.thy +++ b/proof/invariant-abstract/X64/ArchInterrupt_AI.thy @@ -32,9 +32,9 @@ where defs arch_irq_control_inv_valid_def: "arch_irq_control_inv_valid \ arch_irq_control_inv_valid_real" -named_theorems Interrupt_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_AI locale *) -lemma (* decode_irq_control_invocation_inv *)[Interrupt_AI_assms]: +lemma (* decode_irq_control_invocation_inv *)[Arch_assms]: "\P\ decode_irq_control_invocation label args slot caps \\rv. P\" apply (simp add: decode_irq_control_invocation_def Let_def arch_check_irq_def arch_decode_irq_control_invocation_def whenE_def split del: if_split) @@ -129,7 +129,7 @@ lemma arch_decode_irq_control_valid[wp]: done end -lemma (* decode_irq_control_valid *)[Interrupt_AI_assms]: +lemma (* decode_irq_control_valid *)[Arch_assms]: "\\s. invs s \ (\cap \ set caps. s \ cap) \ (\cap \ set caps. is_cnode_cap cap \ (\r \ cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -144,7 +144,7 @@ lemma (* decode_irq_control_valid *)[Interrupt_AI_assms]: | wp (once) hoare_drop_imps)+ done -lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: +lemma get_irq_slot_different_ARCH[Arch_assms]: "\\s. valid_global_refs s \ ex_cte_cap_wp_to is_cnode_cap ptr s\ get_irq_slot irq \\rv s. rv \ ptr\" @@ -156,7 +156,7 @@ lemma get_irq_slot_different_ARCH[Interrupt_AI_assms]: apply (clarsimp simp: global_refs_def is_cap_simps cap_range_def) done -lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: +lemma is_derived_use_interrupt_ARCH[Arch_assms]: "(is_ntfn_cap cap \ interrupt_derived cap cap') \ (is_derived m p cap cap')" apply (clarsimp simp: is_cap_simps) apply (clarsimp simp: interrupt_derived_def is_derived_def) @@ -164,7 +164,7 @@ lemma is_derived_use_interrupt_ARCH[Interrupt_AI_assms]: apply (simp add: is_cap_simps is_pt_cap_def vs_cap_ref_def) done -lemma maskInterrupt_invs_ARCH[Interrupt_AI_assms]: +lemma maskInterrupt_invs_ARCH[Arch_assms]: "\invs and (\s. \b \ interrupt_states s irq \ IRQInactive)\ do_machine_op (maskInterrupt b irq) \\rv. invs\" @@ -174,7 +174,7 @@ lemma maskInterrupt_invs_ARCH[Interrupt_AI_assms]: valid_irq_states_but_def valid_irq_masks_but_def valid_machine_state_def cur_tcb_def valid_irq_states_def valid_irq_masks_def) done -lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Interrupt_AI_assms]: +lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Arch_assms]: "no_cap_to_obj_with_diff_ref (IRQHandlerCap irq) S = \" by (rule ext, simp add: no_cap_to_obj_with_diff_ref_def cte_wp_at_caps_of_state @@ -183,7 +183,7 @@ lemma no_cap_to_obj_with_diff_IRQHandler_ARCH[Interrupt_AI_assms]: crunch do_machine_op for valid_cap: "valid_cap cap" -lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: +lemma (* set_irq_state_valid_cap *)[Arch_assms]: "\valid_cap cap\ set_irq_state IRQSignal irq \\rv. valid_cap cap\" apply (clarsimp simp: set_irq_state_def) apply (wp do_machine_op_valid_cap) @@ -193,12 +193,12 @@ lemma (* set_irq_state_valid_cap *)[Interrupt_AI_assms]: done crunch set_irq_state - for valid_global_refs[Interrupt_AI_assms]: "valid_global_refs" + for valid_global_refs[Arch_assms]: "valid_global_refs" crunch arch_invoke_irq_handler for typ_at[wp]: "\s. P (typ_at T p s)" -lemma invoke_irq_handler_invs'[Interrupt_AI_assms]: +lemma invoke_irq_handler_invs'[Arch_assms]: assumes dmo_ex_inv[wp]: "\f. \invs and ex_inv\ do_machine_op f \\rv::unit. ex_inv\" assumes cap_insert_ex_inv[wp]: "\cap src dest. \ex_inv and invs and K (src \ dest)\ @@ -309,7 +309,7 @@ lemma arch_invoke_irq_control_invs[wp]: maxUserIRQ_def maxIRQ_def order.trans ex_cte_cap_to_cnode_always_appropriate_strg) -lemma (* invoke_irq_control_invs *) [Interrupt_AI_assms]: +lemma (* invoke_irq_control_invs *) [Arch_assms]: "\invs and irq_control_inv_valid i\ invoke_irq_control i \\rv. invs\" apply (cases i, simp_all) apply (rule hoare_pre) @@ -326,7 +326,7 @@ lemma (* invoke_irq_control_invs *) [Interrupt_AI_assms]: crunch resetTimer for device_state_inv[wp]: "\ms. P (device_state ms)" -lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: +lemma resetTimer_invs_ARCH[Arch_assms]: "\invs\ do_machine_op resetTimer \\_. invs\" apply (wp dmo_invs) apply safe @@ -339,11 +339,11 @@ lemma resetTimer_invs_ARCH[Interrupt_AI_assms]: apply(erule use_valid, wp no_irq_resetTimer no_irq, assumption) done -lemma empty_fail_ackInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_ackInterrupt_ARCH[Arch_assms]: "empty_fail (ackInterrupt irq)" by (wp | simp add: ackInterrupt_def)+ -lemma empty_fail_maskInterrupt_ARCH[Interrupt_AI_assms]: +lemma empty_fail_maskInterrupt_ARCH[Arch_assms]: "empty_fail (maskInterrupt f irq)" by (wp | simp add: maskInterrupt_def)+ @@ -355,7 +355,7 @@ crunch timer_tick for invs[wp]: invs (wp: thread_set_invs_trivial[OF ball_tcb_cap_casesI]) -lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]: +lemma (* handle_interrupt_invs *) [Arch_assms]: "\invs\ handle_interrupt irq \\_. invs\" apply (simp add: handle_interrupt_def ) apply (rule conjI; rule impI) @@ -370,7 +370,7 @@ lemma (* handle_interrupt_invs *) [Interrupt_AI_assms]: apply (wp hoare_drop_imps resetTimer_invs_ARCH | simp add: get_irq_state_def handle_reserved_irq_def)+ done -lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: +lemma sts_arch_irq_control_inv_valid[wp, Arch_assms]: "\arch_irq_control_inv_valid i\ set_thread_state t st \\rv. arch_irq_control_inv_valid i\" @@ -383,14 +383,13 @@ lemma sts_arch_irq_control_inv_valid[wp, Interrupt_AI_assms]: crunch arch_invoke_irq_handler for typ_at[wp]: "\s. P (typ_at T p s)" -end - +lemmas Interrupt_AI_assms = Arch_assms (* extract accumulated assumptions *) +end interpretation Interrupt_AI?: Interrupt_AI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: Interrupt_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales, simp_all add: X64.Interrupt_AI_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchInvariants_AI.thy b/proof/invariant-abstract/X64/ArchInvariants_AI.thy index 89591f1569..39f736fcba 100644 --- a/proof/invariant-abstract/X64/ArchInvariants_AI.thy +++ b/proof/invariant-abstract/X64/ArchInvariants_AI.thy @@ -30,6 +30,10 @@ end_qualify context Arch begin arch_global_naming +(* used to accumulate theorems for satisfying Arch interface assumptions; + remember to clear before starting a new accumulation *) +named_theorems Arch_assms + definition arch_tcb_to_iarch_tcb :: "arch_tcb \ iarch_tcb" where "arch_tcb_to_iarch_tcb arch_tcb \ \ itcb_cur_fpu = tcb_cur_fpu arch_tcb \" diff --git a/proof/invariant-abstract/X64/ArchIpcCancel_AI.thy b/proof/invariant-abstract/X64/ArchIpcCancel_AI.thy index 369304e6e0..2828bf01c4 100644 --- a/proof/invariant-abstract/X64/ArchIpcCancel_AI.thy +++ b/proof/invariant-abstract/X64/ArchIpcCancel_AI.thy @@ -10,26 +10,27 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_AI locale *) crunch set_endpoint - for v_ker_map[wp,IpcCancel_AI_assms]: "valid_kernel_mappings" + for v_ker_map[wp,Arch_assms]: "valid_kernel_mappings" (ignore: set_object wp: set_object_v_ker_map crunch_wps) crunch set_endpoint - for eq_ker_map[wp,IpcCancel_AI_assms]: "equal_kernel_mappings" + for eq_ker_map[wp,Arch_assms]: "equal_kernel_mappings" (ignore: set_object wp: set_object_equal_mappings crunch_wps) crunch arch_post_cap_deletion - for typ_at[wp, IpcCancel_AI_assms]: "\s. P (typ_at T p s)" - and idle_thread[wp, IpcCancel_AI_assms]: "\s. P (idle_thread s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" + and idle_thread[wp, Arch_assms]: "\s. P (idle_thread s)" + +lemmas IpcCancel_AI_assms = Arch_assms (* extract accumulated assumptions *) end interpretation IpcCancel_AI?: IpcCancel_AI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact IpcCancel_AI_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.IpcCancel_AI_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchIpc_AI.thy b/proof/invariant-abstract/X64/ArchIpc_AI.thy index bf6bc50048..f4dda67197 100644 --- a/proof/invariant-abstract/X64/ArchIpc_AI.thy +++ b/proof/invariant-abstract/X64/ArchIpc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_AI_1_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_1 locale *) lemma arch_derive_cap_is_derived: "\\s. cte_wp_at (\cap . cap_master_cap cap = @@ -32,7 +32,7 @@ lemma arch_derive_cap_is_derived: | rule conjI)+) done -lemma derive_cap_is_derived [Ipc_AI_1_assms]: +lemma derive_cap_is_derived [Arch_assms]: "\\s. c'\ cap.NullCap \ cte_wp_at (\cap. cap_master_cap cap = cap_master_cap c' \ (cap_badge cap, cap_badge c') \ capBadge_ordering False \ cap_asid cap = cap_asid c' @@ -58,27 +58,28 @@ lemma derive_cap_is_derived [Ipc_AI_1_assms]: apply(clarsimp simp: valid_cap_def) done -lemma arch_cap_badge_rights_update[Ipc_AI_1_assms, simp]: +lemma arch_cap_badge_rights_update[Arch_assms, simp]: "arch_cap_badge (acap_rights_update rights acap) = arch_cap_badge acap" by simp +lemmas Ipc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_1_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Ipc_AI_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_2 locale *) lemma cap_asid_PageCap_None [simp]: "cap_asid (ArchObjectCap (PageCap d r R typ pgsz None)) = None" by (simp add: cap_asid_def) -lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights [simp, Arch_assms]: "is_derived m p (cap_rights_update R c) = is_derived m p c" apply (rule ext) apply (simp add: cap_rights_update_def is_derived_def is_cap_simps) @@ -90,12 +91,12 @@ lemma is_derived_cap_rights [simp, Ipc_AI_2_assms]: split: arch_cap.split cap.split bool.splits) -lemma data_to_message_info_valid [Ipc_AI_2_assms]: +lemma data_to_message_info_valid [Arch_assms]: "valid_message_info (data_to_message_info w)" by (simp add: valid_message_info_def data_to_message_info_def word_and_le1 msg_max_length_def msg_max_extra_caps_def Let_def not_less mask_def) -lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: +lemma get_extra_cptrs_length[wp, Arch_assms]: "\\s . valid_message_info mi\ get_extra_cptrs buf mi \\rv s. length rv \ msg_max_extra_caps\" @@ -110,19 +111,19 @@ lemma get_extra_cptrs_length[wp, Ipc_AI_2_assms]: intro: length_upt) done -lemma cap_asid_rights_update [simp, Ipc_AI_2_assms]: +lemma cap_asid_rights_update [simp, Arch_assms]: "cap_asid (cap_rights_update R c) = cap_asid c" apply (simp add: cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits) apply (clarsimp simp: cap_asid_def) done -lemma cap_rights_update_vs_cap_ref[simp, Ipc_AI_2_assms]: +lemma cap_rights_update_vs_cap_ref[simp, Arch_assms]: "vs_cap_ref (cap_rights_update rs cap) = vs_cap_ref cap" by (simp add: vs_cap_ref_def cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) -lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: +lemma is_derived_cap_rights2[simp, Arch_assms]: "is_derived m p c (cap_rights_update R c') = is_derived m p c c'" apply (case_tac c') apply (simp_all add:cap_rights_update_def) @@ -132,12 +133,12 @@ lemma is_derived_cap_rights2[simp, Ipc_AI_2_assms]: apply (case_tac acap1) by (auto simp: acap_rights_update_def) -lemma cap_range_update [simp, Ipc_AI_2_assms]: +lemma cap_range_update [simp, Arch_assms]: "cap_range (cap_rights_update R cap) = cap_range cap" by (simp add: cap_range_def cap_rights_update_def acap_rights_update_def split: cap.splits arch_cap.splits) -lemma derive_cap_idle[wp, Ipc_AI_2_assms]: +lemma derive_cap_idle[wp, Arch_assms]: "\\s. global_refs s \ cap_range cap = {}\ derive_cap slot cap \\c s. global_refs s \ cap_range c = {}\, -" @@ -149,7 +150,7 @@ lemma derive_cap_idle[wp, Ipc_AI_2_assms]: apply (case_tac arch_cap, simp_all) done -lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: +lemma arch_derive_cap_objrefs_iszombie [Arch_assms]: "\\s . P (set_option (aobj_ref cap)) False s\ arch_derive_cap cap \\rv s. rv \ NullCap \ P (obj_refs rv) (is_zombie rv) s\,-" @@ -157,7 +158,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_2_assms]: apply(rule hoare_pre, wpc?, wp+, simp)+ done -lemma obj_refs_remove_rights[simp, Ipc_AI_2_assms]: +lemma obj_refs_remove_rights[simp, Arch_assms]: "obj_refs (remove_rights rs cap) = obj_refs cap" by (auto simp add: remove_rights_def cap_rights_update_def acap_rights_update_def @@ -172,7 +173,7 @@ lemma storeWord_um_inv: apply (simp add: upto0_7_def) done -lemma store_word_offs_vms[wp, Ipc_AI_2_assms]: +lemma store_word_offs_vms[wp, Arch_assms]: "\valid_machine_state\ store_word_offs ptr offs v \\_. valid_machine_state\" proof - have aligned_offset_ignore: @@ -211,12 +212,12 @@ proof - done qed -lemma is_zombie_update_cap_data[simp, Ipc_AI_2_assms]: +lemma is_zombie_update_cap_data[simp, Arch_assms]: "is_zombie (update_cap_data P data cap) = is_zombie cap" by (clarsimp simp: update_cap_data_closedform arch_update_cap_data_def is_zombie_def Let_def split: cap.splits arch_cap.splits) -lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: +lemma valid_msg_length_strengthen [Arch_assms]: "valid_message_info mi \ unat (mi_length mi) \ msg_max_length" apply (clarsimp simp: valid_message_info_def) apply (subgoal_tac "unat (mi_length mi) \ unat (of_nat msg_max_length :: machine_word)") @@ -224,7 +225,7 @@ lemma valid_msg_length_strengthen [Ipc_AI_2_assms]: apply (clarsimp simp: un_ui_le word_le_def) done -lemma copy_mrs_in_user_frame[wp, Ipc_AI_2_assms]: +lemma copy_mrs_in_user_frame[wp, Arch_assms]: "\in_user_frame p\ copy_mrs t buf t' buf' n \\rv. in_user_frame p\" by (simp add: in_user_frame_def) (wp hoare_vcg_ex_lift) @@ -232,7 +233,7 @@ lemma as_user_getRestart_inv[wp]: "as_user t getRestartPC \P\" by (simp add: getRestartPC_def, rule user_getreg_inv) -lemma make_arch_fault_msg_inv[wp, Ipc_AI_2_assms]: +lemma make_arch_fault_msg_inv[wp, Arch_assms]: "make_arch_fault_msg ft t \P\" by (cases ft; wpsimp) @@ -240,14 +241,14 @@ lemma make_fault_msg_inv[wp]: "make_fault_msg ft t \P\" by (cases ft; wpsimp wp: as_user_inv getRestartPC_inv mapM_wp' split_del: if_split) -lemma do_fault_transfer_invs[wp, Ipc_AI_2_assms]: +lemma do_fault_transfer_invs[wp, Arch_assms]: "\invs and tcb_at receiver\ do_fault_transfer badge sender receiver recv_buf \\rv. invs\" by (simp add: do_fault_transfer_def split_def | wp | clarsimp split: option.split)+ -lemma lookup_ipc_buffer_in_user_frame[wp, Ipc_AI_2_assms]: +lemma lookup_ipc_buffer_in_user_frame[wp, Arch_assms]: "\valid_objs and tcb_at t\ lookup_ipc_buffer b t \case_option (\_. True) in_user_frame\" apply (simp add: lookup_ipc_buffer_def) @@ -349,9 +350,9 @@ lemma transfer_caps_non_null_cte_wp_at: done crunch do_fault_transfer - for cte_wp_at[wp,Ipc_AI_2_assms]: "cte_wp_at P p" + for cte_wp_at[wp,Arch_assms]: "cte_wp_at P p" -lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: +lemma do_normal_transfer_non_null_cte_wp_at [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at (P and ((\) cap.NullCap)) ptr\ do_normal_transfer st send_buffer ep b gr rt recv_buffer @@ -362,7 +363,7 @@ lemma do_normal_transfer_non_null_cte_wp_at [Ipc_AI_2_assms]: | clarsimp simp:imp)+ done -lemma is_derived_ReplyCap [simp, Ipc_AI_2_assms]: +lemma is_derived_ReplyCap [simp, Arch_assms]: "\m p R. is_derived m p (cap.ReplyCap t False R) = (\c. is_master_reply_cap c \ obj_ref_of c = t)" apply (subst fun_eq_iff) apply clarsimp @@ -383,7 +384,7 @@ lemma do_normal_transfer_tcb_caps: | simp add:imp)+ done -lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: +lemma do_ipc_transfer_tcb_caps [Arch_assms]: assumes imp: "\c. P c \ \ is_untyped_cap c" shows "\valid_objs and cte_wp_at P (t, ref) and tcb_at t\ @@ -395,14 +396,14 @@ lemma do_ipc_transfer_tcb_caps [Ipc_AI_2_assms]: | wpc | simp add:imp)+ done -lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_2_assms]: +lemma setup_caller_cap_valid_global_objs[wp, Arch_assms]: "\valid_global_objs\ setup_caller_cap send recv grant \\rv. valid_global_objs\" apply (wp valid_global_objs_lift valid_vso_at_lift) apply (simp_all add: setup_caller_cap_def split del: if_split) apply (wp sts_obj_at_impossible | simp add: tcb_not_empty_table)+ done -lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_vspace_objs[wp, Arch_assms]: "\valid_vspace_objs\ transfer_caps_loop ep buffer n caps slots mi \\rv. valid_vspace_objs\" @@ -418,7 +419,7 @@ lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_2_assms]: done crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for typ_at[Ipc_AI_2_assms]: "P (typ_at T p s)" + for typ_at[Arch_assms]: "P (typ_at T p s)" lemma transfer_caps_loop_ioports: "\slots caps ep buffer n mi. @@ -459,7 +460,7 @@ lemma transfer_caps_loop_ioport_control: apply clarsimp done -lemma transfer_caps_loop_valid_arch[Ipc_AI_2_assms]: +lemma transfer_caps_loop_valid_arch[Arch_assms]: "\slots caps ep buffer n mi. \valid_arch_state and valid_objs and valid_mdb and K (distinct slots) and (\s. \x \ set slots. real_cte_at x s \ cte_wp_at (\cap. cap = cap.NullCap) x s) @@ -483,7 +484,7 @@ lemma setup_caller_cap_ioport_control[wp]: apply (auto simp: ioport_control_unique_def) done -lemma setup_caller_cap_valid_arch[Ipc_AI_2_assms, wp]: +lemma setup_caller_cap_valid_arch[Arch_assms, wp]: "setup_caller_cap st rt grant \valid_arch_state\" by (wp valid_arch_state_lift_ioports_aobj_at[rotated -1] setup_caller_cap_ioports setup_caller_cap_aobj_at)+ @@ -495,30 +496,31 @@ crunch do_ipc_transfer (wp: crunch_wps hoare_vcg_const_Ball_lift transfer_caps_loop_ioports simp: zipWithM_x_mapM crunch_simps ball_conj_distrib ) +lemmas Ipc_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_2 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_2_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Ipc_AI_2_assms)?) qed context Arch begin arch_global_naming -named_theorems Ipc_AI_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_AI_3 locale *) crunch do_ipc_transfer - for pspace_respects_device_region[wp, Ipc_AI_3_assms]: "pspace_respects_device_region" + for pspace_respects_device_region[wp, Arch_assms]: "pspace_respects_device_region" (wp: crunch_wps ignore: const_on_failure simp: crunch_simps) -lemma do_ipc_transfer_valid_arch[Ipc_AI_3_assms]: +lemma do_ipc_transfer_valid_arch[Arch_assms]: "\valid_arch_state and valid_objs and valid_mdb \ do_ipc_transfer s ep bg grt r \\rv. valid_arch_state\" by (wp valid_arch_state_lift_ioports_aobj_at do_ipc_transfer_ioports do_ipc_transfer_aobj_at)+ (simp add: valid_arch_state_def) -lemma do_ipc_transfer_respects_device_region[Ipc_AI_3_assms]: +lemma do_ipc_transfer_respects_device_region[Arch_assms]: "\cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\ do_ipc_transfer t ep bg grt r \\rv. cap_refs_respects_device_region\" @@ -545,7 +547,7 @@ lemma set_mrs_state_hyp_refs_of[wp]: by (wp set_mrs_thread_set_dmo thread_set_hyp_refs_trivial | simp)+ crunch do_ipc_transfer - for state_hyp_refs_of[wp, Ipc_AI_3_assms]: "\ s. P (state_hyp_refs_of s)" + for state_hyp_refs_of[wp, Arch_assms]: "\ s. P (state_hyp_refs_of s)" (wp: crunch_wps simp: zipWithM_x_mapM) lemma arch_derive_cap_untyped: @@ -568,12 +570,13 @@ lemma valid_arch_mdb_cap_swap: apply (simp del: split_paired_All) done +lemmas Ipc_AI_3_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Ipc_AI?: Ipc_AI_3 proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Ipc_AI_3_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Ipc_AI_3_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchRetype_AI.thy b/proof/invariant-abstract/X64/ArchRetype_AI.thy index 852da5b3b7..f0d27285f6 100644 --- a/proof/invariant-abstract/X64/ArchRetype_AI.thy +++ b/proof/invariant-abstract/X64/ArchRetype_AI.thy @@ -15,19 +15,19 @@ begin context Arch begin arch_global_naming -named_theorems Retype_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_AI locale *) -lemma arch_kobj_size_cong[Retype_AI_assms]: +lemma arch_kobj_size_cong[Arch_assms]: assumes "ty = ty'" "n = n'" shows "arch_kobj_size (default_arch_object ty dev n ) = arch_kobj_size (default_arch_object ty' dev' n')" by (simp add: assms default_arch_object_def split: aobject_type.splits) -lemma clearMemoryVM_return[simp, Retype_AI_assms]: +lemma clearMemoryVM_return[simp, Arch_assms]: "clearMemoryVM a b = return ()" by (simp add: clearMemoryVM_def) -lemma slot_bits_def2 [Retype_AI_assms]: "slot_bits = cte_level_bits" +lemma slot_bits_def2 [Arch_assms]: "slot_bits = cte_level_bits" by (simp add: slot_bits_def cte_level_bits_def) definition @@ -35,7 +35,7 @@ definition ArchObject SmallPageObj, ArchObject LargePageObj, ArchObject HugePageObj}" -lemma no_gs_types_simps [simp, Retype_AI_assms]: +lemma no_gs_types_simps [simp, Arch_assms]: "Untyped \ no_gs_types" "TCBObject \ no_gs_types" "EndpointObject \ no_gs_types" @@ -45,7 +45,7 @@ lemma no_gs_types_simps [simp, Retype_AI_assms]: "ArchObject ASIDPoolObj \ no_gs_types" by (simp_all add: no_gs_types_def) -lemma retype_region_ret_folded [Retype_AI_assms]: +lemma retype_region_ret_folded [Arch_assms]: "\\\ retype_region y n bits ty d \\r s. r = retype_addrs y ty n bits\" unfolding retype_region_def @@ -491,7 +491,7 @@ lemma mapM_copy_global_invs_mappings_restricted: done -lemma dmo_eq_kernel_restricted [wp, Retype_AI_assms]: +lemma dmo_eq_kernel_restricted [wp, Arch_assms]: "\\s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\ do_machine_op m \\rv s. equal_kernel_mappings (kheap_update (f (kheap s)) s)\" @@ -544,7 +544,7 @@ lemma init_arch_objects_invs_from_restricted: done -lemma obj_bits_api_neq_0 [Retype_AI_assms]: +lemma obj_bits_api_neq_0 [Arch_assms]: "ty \ Untyped \ 0 < obj_bits_api ty us" unfolding obj_bits_api_def by (auto simp: slot_bits_def default_arch_object_def simple_bit_simps @@ -578,19 +578,20 @@ lemma vs_lookup_pages_sub2: apply (rule table) done +lemmas Retype_AI_slot_bits_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_slot_bits?: Retype_AI_slot_bits proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact X64.Retype_AI_slot_bits_assms) qed context Arch begin arch_global_naming -lemma valid_untyped_helper [Retype_AI_assms]: +lemma valid_untyped_helper [Arch_assms]: assumes valid_c : "s \ c" and cte_at : "cte_wp_at ((=) c) q s" and tyunt: "ty \ Untyped" @@ -662,13 +663,14 @@ lemma valid_default_arch_tcb: "\s. valid_arch_tcb default_arch_tcb s" by (simp add: default_arch_tcb_def valid_arch_tcb_def) +lemmas Retype_AI_valid_untyped_helper_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Retype_AI_valid_untyped_helper?: Retype_AI_valid_untyped_helper proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; fact Retype_AI_assms) + case 1 show ?case by (unfold_locales; fact X64.Retype_AI_valid_untyped_helper_assms) qed @@ -677,11 +679,7 @@ locale retype_region_proofs_arch + Arch for s :: "'state_ext :: state_ext state" and ty us ptr sz n ps s' - - -context retype_region_proofs begin - -interpretation Arch . +begin lemma valid_cap: assumes cap: @@ -758,11 +756,6 @@ lemma vs_lookup_pages': lemma hyp_refs_eq: "state_hyp_refs_of s' = state_hyp_refs_of s" unfolding s'_def ps_def by (auto simp: state_hyp_refs_of_def split: option.splits) -end - - -context retype_region_proofs_arch begin - lemma valid_vspace_obj_pres: "valid_vspace_obj ao s \ valid_vspace_obj ao s'" apply (cases ao; simp add: obj_at_pres) apply (erule allEI ballEI; rename_tac t i; case_tac "t i"; fastforce simp: data_at_def obj_at_pres)+ @@ -1191,9 +1184,7 @@ end context Arch begin arch_global_naming -named_theorems Retype_AI_assms' - -lemma invs_post_retype_invs [Retype_AI_assms']: +lemma invs_post_retype_invs [Arch_assms]: "invs s \ post_retype_invs ty refs s" apply (clarsimp simp: post_retype_invs_def invs_def valid_state_def) apply (clarsimp simp: equal_kernel_mappings_def obj_at_def @@ -1203,9 +1194,11 @@ lemma invs_post_retype_invs [Retype_AI_assms']: lemmas equal_kernel_mappings_trans_state = more_update.equal_kernel_mappings_update -lemmas retype_region_proofs_assms [Retype_AI_assms'] +lemmas retype_region_proofs_assms [Arch_assms] = retype_region_proofs.post_retype_invs_axioms +lemmas Retype_AI_assms' = Arch_assms (* extract accumulated assumptions *) + end @@ -1215,10 +1208,9 @@ global_interpretation Retype_AI?: Retype_AI and post_retype_invs = post_retype_invs and region_in_kernel_window = region_in_kernel_window proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; (unfold_locales; fact Retype_AI_assms)?) - (simp add: Retype_AI_axioms_def Retype_AI_assms') + by (intro_locales; (unfold_locales; fact X64.Retype_AI_assms')?) + (simp add: Retype_AI_axioms_def X64.Retype_AI_assms') qed diff --git a/proof/invariant-abstract/X64/ArchSchedule_AI.thy b/proof/invariant-abstract/X64/ArchSchedule_AI.thy index 415dde9abf..5b9f59133c 100644 --- a/proof/invariant-abstract/X64/ArchSchedule_AI.thy +++ b/proof/invariant-abstract/X64/ArchSchedule_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_AI locale *) -lemma dmo_mapM_storeWord_0_invs[wp,Schedule_AI_assms]: +lemma dmo_mapM_storeWord_0_invs[wp,Arch_assms]: "valid invs (do_machine_op (mapM (\p. storeWord p 0) S)) (\_. invs)" apply (simp add: dom_mapM) apply (rule mapM_UNIV_wp) @@ -111,20 +111,20 @@ crunch set_vm_root for ex_nonz_cap_to[wp]: "ex_nonz_cap_to t" (wp: crunch_wps simp: crunch_simps) -lemma arch_stt_invs [wp,Schedule_AI_assms]: +lemma arch_stt_invs [wp,Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_switch_to_thread t \\_. invs\" unfolding arch_switch_to_thread_def by wpsimp -lemma arch_stt_tcb [wp,Schedule_AI_assms]: +lemma arch_stt_tcb [wp,Arch_assms]: "arch_switch_to_thread t' \tcb_at t'\" by (wpsimp simp: arch_switch_to_thread_def wp: tcb_at_typ_at) -lemma arch_stt_st_tcb_at[Schedule_AI_assms]: +lemma arch_stt_st_tcb_at[Arch_assms]: "arch_switch_to_thread t \st_tcb_at Q t\" by (wpsimp simp: arch_switch_to_thread_def) -lemma arch_stit_invs[wp, Schedule_AI_assms]: +lemma arch_stit_invs[wp, Arch_assms]: "\invs\ arch_switch_to_idle_thread \\r. invs\" by (wpsimp wp: svr_invs simp: arch_switch_to_idle_thread_def) @@ -145,19 +145,19 @@ crunch set_vm_root and scheduler_action[wp]: "\s. P (scheduler_action s)" (wp: crunch_wps simp: crunch_simps) -lemma arch_stit_activatable[wp, Schedule_AI_assms]: +lemma arch_stit_activatable[wp, Arch_assms]: "\ct_in_state activatable\ arch_switch_to_idle_thread \\rv . ct_in_state activatable\" apply (clarsimp simp: arch_switch_to_idle_thread_def) apply (wpsimp simp: ct_in_state_def wp: ct_in_state_thread_state_lift) done -lemma stit_invs [wp,Schedule_AI_assms]: +lemma stit_invs [wp,Arch_assms]: "switch_to_idle_thread \invs\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wpsimp|strengthen idle_strg)+ done -lemma stit_activatable[Schedule_AI_assms]: +lemma stit_activatable[Arch_assms]: "\invs\ switch_to_idle_thread \\rv . ct_in_state activatable\" apply (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def) apply (wp | simp add: ct_in_state_def)+ @@ -165,29 +165,30 @@ lemma stit_activatable[Schedule_AI_assms]: elim!: pred_tcb_weaken_strongerE) done -lemma arch_stt_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stt_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_thread t' \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_thread_def) crunch arch_prepare_next_domain - for ct[wp, Schedule_AI_assms]: "\s. P (cur_thread s)" - and activatable[wp, Schedule_AI_assms]: "ct_in_state activatable" - and st_tcb_at[wp, Schedule_AI_assms]: "\s. P (st_tcb_at Q t s)" - and valid_idle[wp, Schedule_AI_assms]: valid_idle - and invs[wp, Schedule_AI_assms]: invs + for ct[wp, Arch_assms]: "\s. P (cur_thread s)" + and activatable[wp, Arch_assms]: "ct_in_state activatable" + and st_tcb_at[wp, Arch_assms]: "\s. P (st_tcb_at Q t s)" + and valid_idle[wp, Arch_assms]: valid_idle + and invs[wp, Arch_assms]: invs (wp: crunch_wps ct_in_state_thread_state_lift) -lemma arch_stit_scheduler_action [wp, Schedule_AI_assms]: +lemma arch_stit_scheduler_action [wp, Arch_assms]: "\\s. P (scheduler_action s)\ arch_switch_to_idle_thread \\_ s. P (scheduler_action s)\" by (wpsimp simp: arch_switch_to_idle_thread_def) +lemmas Schedule_AI_assms = Arch_assms (* extract accumulated assumptions *) + end interpretation Schedule_AI?: Schedule_AI proof goal_cases - interpret Arch . case 1 show ?case - by (intro_locales; unfold_locales; (fact Schedule_AI_assms)?) + by (intro_locales; unfold_locales; (fact X64.Schedule_AI_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchSyscall_AI.thy b/proof/invariant-abstract/X64/ArchSyscall_AI.thy index 52822f79c8..a054ccf5f6 100644 --- a/proof/invariant-abstract/X64/ArchSyscall_AI.thy +++ b/proof/invariant-abstract/X64/ArchSyscall_AI.thy @@ -15,44 +15,44 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_AI locale *) -declare arch_get_sanitise_register_info_invs[Syscall_AI_assms] - arch_get_sanitise_register_info_ex_nonz_cap_to[Syscall_AI_assms] - make_fault_msg_inv[Syscall_AI_assms] +declare arch_get_sanitise_register_info_invs[Arch_assms] + arch_get_sanitise_register_info_ex_nonz_cap_to[Arch_assms] + make_fault_msg_inv[Arch_assms] crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for pred_tcb_at[wp,Syscall_AI_assms]: "pred_tcb_at proj P t" + for pred_tcb_at[wp,Arch_assms]: "pred_tcb_at proj P t" crunch handle_arch_fault_reply - for invs[wp,Syscall_AI_assms]: "invs" + for invs[wp,Arch_assms]: "invs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cap_to[wp,Syscall_AI_assms]: "ex_nonz_cap_to c" + for cap_to[wp,Arch_assms]: "ex_nonz_cap_to c" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for it[wp,Syscall_AI_assms]: "\s. P (idle_thread s)" + for it[wp,Arch_assms]: "\s. P (idle_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for caps[wp,Syscall_AI_assms]: "\s. P (caps_of_state s)" + for caps[wp,Arch_assms]: "\s. P (caps_of_state s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cur_thread[wp,Syscall_AI_assms]: "\s. P (cur_thread s)" + for cur_thread[wp,Arch_assms]: "\s. P (cur_thread s)" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for valid_objs[wp,Syscall_AI_assms]: "valid_objs" + for valid_objs[wp,Arch_assms]: "valid_objs" crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for cte_wp_at[wp,Syscall_AI_assms]: "\s. P (cte_wp_at P' p s)" + for cte_wp_at[wp,Arch_assms]: "\s. P (cte_wp_at P' p s)" crunch invoke_irq_control - for typ_at[wp, Syscall_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" -lemma obj_refs_cap_rights_update[simp, Syscall_AI_assms]: +lemma obj_refs_cap_rights_update[simp, Arch_assms]: "obj_refs (cap_rights_update rs cap) = obj_refs cap" by (simp add: cap_rights_update_def acap_rights_update_def split: cap.split arch_cap.split) (* FIXME: move to TCB *) -lemma table_cap_ref_mask_cap [Syscall_AI_assms]: +lemma table_cap_ref_mask_cap [Arch_assms]: "table_cap_ref (mask_cap R cap) = table_cap_ref cap" 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 eq_no_cap_to_obj_with_diff_ref [Syscall_AI_assms]: +lemma eq_no_cap_to_obj_with_diff_ref [Arch_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) @@ -64,7 +64,7 @@ lemma getFaultAddress_invs[wp]: "valid invs (do_machine_op getFaultAddress) (\_. invs)" by (simp add: getFaultAddress_def do_machine_op_def split_def select_f_returns | wp)+ -lemma hv_invs[wp, Syscall_AI_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" +lemma hv_invs[wp, Arch_assms]: "\invs\ handle_vm_fault t' flt \\r. invs\" unfolding handle_vm_fault_def apply (cases flt, simp_all) apply (wp|simp)+ @@ -74,7 +74,7 @@ crunch getFaultAddress, getRegister for inv[wp]: "P" (ignore_del: getRegister) -lemma hv_inv_ex [Syscall_AI_assms]: +lemma hv_inv_ex [Arch_assms]: "\P\ handle_vm_fault t vp \\_ _. True\, \\_. P\" unfolding handle_vm_fault_def apply (cases vp, simp_all) @@ -86,39 +86,40 @@ lemma hv_inv_ex [Syscall_AI_assms]: lemma no_irq_getFaultAddress: "no_irq getFaultAddress" by (wp | clarsimp simp: getFaultAddress_def)+ -lemma handle_vm_fault_valid_fault[wp, Syscall_AI_assms]: +lemma handle_vm_fault_valid_fault[wp, Arch_assms]: "\\\ handle_vm_fault thread ft -,\\rv s. valid_fault rv\" unfolding handle_vm_fault_def apply (cases ft, simp_all) apply (wp no_irq_getFaultAddress | simp add: valid_fault_def)+ done -lemma hvmf_active [Syscall_AI_assms]: +lemma hvmf_active [Arch_assms]: "\st_tcb_at active t\ handle_vm_fault t w \\rv. st_tcb_at active t\" unfolding handle_vm_fault_def apply (cases w, simp_all) apply (wp | simp)+ done -lemma hvmf_ex_cap[wp, Syscall_AI_assms]: +lemma hvmf_ex_cap[wp, Arch_assms]: "\ex_nonz_cap_to p\ handle_vm_fault t b \\rv. ex_nonz_cap_to p\" unfolding handle_vm_fault_def apply (cases b, simp_all) apply (wp | simp)+ done -lemma hh_invs[wp, Syscall_AI_assms]: +lemma hh_invs[wp, Arch_assms]: "\invs and ct_active and st_tcb_at active thread and ex_nonz_cap_to_thread\ handle_hypervisor_fault thread fault \\rv. invs\" by (cases fault) wpsimp +lemmas Syscall_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Syscall_AI?: Syscall_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Syscall_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Syscall_AI_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchTcbAcc_AI.thy b/proof/invariant-abstract/X64/ArchTcbAcc_AI.thy index 2cf57a4ba8..6bc86ea063 100644 --- a/proof/invariant-abstract/X64/ArchTcbAcc_AI.thy +++ b/proof/invariant-abstract/X64/ArchTcbAcc_AI.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_AI locale *) lemmas cap_master_cap_simps = cap_master_cap_def[simplified cap_master_arch_cap_def, split_simps cap.split arch_cap.split] @@ -60,7 +60,7 @@ lemma cap_master_cap_tcb_cap_valid_arch: split: option.splits cap.splits arch_cap.splits Structures_A.thread_state.splits) -lemma storeWord_invs[wp, TcbAcc_AI_assms]: +lemma storeWord_invs[wp, Arch_assms]: "\in_user_frame p and invs\ do_machine_op (storeWord p w) \\rv. invs\" proof - have aligned_offset_ignore: @@ -88,12 +88,12 @@ proof - done qed -lemma valid_ipc_buffer_cap_0[simp, TcbAcc_AI_assms]: +lemma valid_ipc_buffer_cap_0[simp, Arch_assms]: "valid_ipc_buffer_cap cap a \ valid_ipc_buffer_cap cap 0" by (auto simp: valid_ipc_buffer_cap_def case_bool_If split: cap.split arch_cap.split) -lemma thread_set_hyp_refs_trivial [TcbAcc_AI_assms]: +lemma thread_set_hyp_refs_trivial [Arch_assms]: assumes x: "\tcb. tcb_state (f tcb) = tcb_state tcb" assumes y: "\tcb. tcb_arch_ref (f tcb) = tcb_arch_ref tcb" shows "\\s. P (state_hyp_refs_of s)\ thread_set f t \\rv s. P (state_hyp_refs_of s)\" @@ -114,7 +114,7 @@ lemma mab_wb [simp]: unfolding msg_align_bits word_bits_conv by simp -lemma get_cap_valid_ipc [TcbAcc_AI_assms]: +lemma get_cap_valid_ipc [Arch_assms]: "\valid_objs and obj_at (\ko. \tcb. ko = TCB tcb \ tcb_ipc_buffer tcb = v) t\ get_cap (t, tcb_cnode_index 4) \\rv s. valid_ipc_buffer_cap rv v\" @@ -129,7 +129,7 @@ lemma get_cap_valid_ipc [TcbAcc_AI_assms]: -lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]: +lemma pred_tcb_cap_wp_at [Arch_assms]: "\pred_tcb_at proj P t s; valid_objs s; ref \ dom tcb_cap_cases; \cap. (pred_tcb_at proj P t s \ tcb_cap_valid cap (t, ref) s) \ Q cap\ \ @@ -153,12 +153,12 @@ lemma as_user_hyp_refs_of[wp]: lemmas sts_typ_ats = sts_typ_ats abs_atyp_at_lifts [OF set_thread_state_typ_at] -lemma arch_tcb_context_set_eq[TcbAcc_AI_assms]: +lemma arch_tcb_context_set_eq[Arch_assms]: "arch_tcb_context_set (arch_tcb_context_get t) t = t" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp -lemma arch_tcb_context_get_eq[TcbAcc_AI_assms]: +lemma arch_tcb_context_get_eq[Arch_assms]: "arch_tcb_context_get (arch_tcb_context_set uc t) = uc" unfolding arch_tcb_context_get_def arch_tcb_context_set_def by simp @@ -178,19 +178,20 @@ lemma thread_set_ioports: "\valid_ioports\ thread_set f t \\rv. valid_ioports\" by (wpsimp wp: valid_ioports_lift thread_set_caps_of_state_trivial y) -lemma thread_set_valid_arch_state[TcbAcc_AI_assms]: +lemma thread_set_valid_arch_state[Arch_assms]: "(\tcb. \(getF, v) \ ran tcb_cap_cases. getF (f tcb) = getF tcb) \ thread_set f t \ valid_arch_state \" by (wp valid_arch_state_lift_ioports_aobj_at thread_set_ioports thread_set.aobj_at thread_set_caps_of_state_trivial | simp add: valid_arch_state_def)+ +lemmas TcbAcc_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation TcbAcc_AI?: TcbAcc_AI proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact TcbAcc_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.TcbAcc_AI_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/invariant-abstract/X64/ArchTcb_AI.thy b/proof/invariant-abstract/X64/ArchTcb_AI.thy index b27bba49b0..99993ae7b7 100644 --- a/proof/invariant-abstract/X64/ArchTcb_AI.thy +++ b/proof/invariant-abstract/X64/ArchTcb_AI.thy @@ -10,17 +10,17 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_AI locale *) -lemma activate_idle_invs[Tcb_AI_assms]: +lemma activate_idle_invs[Arch_assms]: "\invs and ct_idle\ arch_activate_idle_thread thread \\rv. invs and ct_idle\" by (simp add: arch_activate_idle_thread_def) -lemma empty_fail_getRegister [intro!, simp, Tcb_AI_assms]: +lemma empty_fail_getRegister [intro!, simp, Arch_assms]: "empty_fail (getRegister r)" by (simp add: getRegister_def) @@ -37,7 +37,7 @@ lemma same_object_also_valid: (* arch specific *) split: cap.split_asm arch_cap.split_asm option.splits)+) done -lemma same_object_obj_refs[Tcb_AI_assms]: +lemma same_object_obj_refs[Arch_assms]: "\ same_object_as cap cap' \ \ obj_refs cap = obj_refs cap'" apply (cases cap, simp_all add: same_object_as_def) @@ -45,7 +45,7 @@ lemma same_object_obj_refs[Tcb_AI_assms]: split: cap.split_asm)+ by (cases "the_arch_cap cap"; cases "the_arch_cap cap'"; simp) -lemma arch_cap_badge_none_master[Tcb_AI_assms, simp]: +lemma arch_cap_badge_none_master[Arch_assms, simp]: "(arch_cap_badge (cap_master_arch_cap acap) = None) = (arch_cap_badge acap = None)" by simp @@ -142,13 +142,13 @@ lemma checked_insert_tcb_invs[wp]: (* arch specific *) done crunch arch_get_sanitise_register_info, arch_post_modify_registers - for tcb_at[wp, Tcb_AI_assms]: "tcb_at a" + for tcb_at[wp, Arch_assms]: "tcb_at a" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for invs[wp, Tcb_AI_assms]: "invs" + for invs[wp, Arch_assms]: "invs" crunch arch_get_sanitise_register_info, arch_post_modify_registers - for ex_nonz_cap_to[wp, Tcb_AI_assms]: "ex_nonz_cap_to a" + for ex_nonz_cap_to[wp, Arch_assms]: "ex_nonz_cap_to a" -lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: +lemma finalise_cap_not_cte_wp_at[Arch_assms]: assumes x: "P cap.NullCap" shows "\\s. \cp \ ran (caps_of_state s). P cp\ finalise_cap cap fin @@ -165,12 +165,12 @@ lemma finalise_cap_not_cte_wp_at[Tcb_AI_assms]: done crunch arch_post_set_flags, arch_prepare_set_domain - for typ_at[wp, Tcb_AI_assms]: "\s. P (typ_at T p s)" + for typ_at[wp, Arch_assms]: "\s. P (typ_at T p s)" crunch arch_prepare_set_domain - for invs[wp, Tcb_AI_assms]: "invs" + for invs[wp, Arch_assms]: "invs" -lemma arch_post_set_flags_invs[wp, Tcb_AI_assms]: +lemma arch_post_set_flags_invs[wp, Arch_assms]: "\invs and ex_nonz_cap_to t\ arch_post_set_flags t flags \\_. invs\" unfolding arch_post_set_flags_def by wpsimp @@ -182,18 +182,19 @@ crunch arch_prepare_set_domain and pspace_distinct[wp]: pspace_distinct (wp: crunch_wps) -lemma table_cap_ref_max_free_index_upd[simp,Tcb_AI_assms]: +lemma table_cap_ref_max_free_index_upd[simp,Arch_assms]: "table_cap_ref (max_free_index_update cap) = table_cap_ref cap" by (simp add:free_index_update_def table_cap_ref_def split:cap.splits) +lemmas Tcb_AI_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI_1?: Tcb_AI_1 where state_ext_t = state_ext_t and is_cnode_or_valid_arch = is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Tcb_AI_assms)?) qed context Arch begin arch_global_naming @@ -212,7 +213,7 @@ lemma use_no_cap_to_obj_asid_strg: (* arch specific *) apply (fastforce simp: table_cap_ref_def valid_cap_simps wellformed_mapdata_def elim!: asid_low_high_bits)+ done -lemma cap_delete_no_cap_to_obj_asid[wp, Tcb_AI_assms]: +lemma cap_delete_no_cap_to_obj_asid[wp, Arch_assms]: "\no_cap_to_obj_dr_emp cap\ cap_delete slot \\rv. no_cap_to_obj_dr_emp cap\" @@ -225,7 +226,7 @@ lemma cap_delete_no_cap_to_obj_asid[wp, Tcb_AI_assms]: | rule obj_ref_none_no_asid)+ done -lemma tc_invs[Tcb_AI_assms]: +lemma tc_invs[Arch_assms]: "\invs and tcb_at a and (case_option \ (valid_cap o fst) e) and (case_option \ (valid_cap o fst) f) @@ -304,7 +305,7 @@ lemma check_valid_ipc_buffer_inv: (* arch_specific *) apply (wp | simp add: if_apply_def2 split del: if_split | wpcw)+ done -lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: +lemma check_valid_ipc_buffer_wp[Arch_assms]: "\\(s::'state_ext::state_ext state). is_arch_cap cap \ is_cnode_or_valid_arch cap \ valid_ipc_buffer_cap cap vptr \ is_aligned vptr msg_align_bits @@ -320,7 +321,7 @@ lemma check_valid_ipc_buffer_wp[Tcb_AI_assms]: valid_ipc_buffer_cap_def) done -lemma derive_no_cap_asid[wp,Tcb_AI_assms]: +lemma derive_no_cap_asid[wp,Arch_assms]: "\(no_cap_to_obj_with_diff_ref cap S)::'state_ext::state_ext state\bool\ derive_cap slot cap \\rv. no_cap_to_obj_with_diff_ref rv S\,-" @@ -334,7 +335,7 @@ lemma derive_no_cap_asid[wp,Tcb_AI_assms]: done -lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: +lemma decode_set_ipc_inv[wp,Arch_assms]: "\P::'state_ext::state_ext state \ bool\ decode_set_ipc_buffer args cap slot excaps \\rv. P\" apply (simp add: decode_set_ipc_buffer_def whenE_def split_def @@ -343,7 +344,7 @@ lemma decode_set_ipc_inv[wp,Tcb_AI_assms]: apply simp done -lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: +lemma no_cap_to_obj_with_diff_ref_update_cap_data[Arch_assms]: "no_cap_to_obj_with_diff_ref c S s \ no_cap_to_obj_with_diff_ref (update_cap_data P x c) S s" apply (case_tac "update_cap_data P x c = NullCap") @@ -360,7 +361,7 @@ lemma no_cap_to_obj_with_diff_ref_update_cap_data[Tcb_AI_assms]: done -lemma update_cap_valid[Tcb_AI_assms]: +lemma update_cap_valid[Arch_assms]: "valid_cap cap (s::'state_ext::state_ext state) \ valid_cap (case capdata of None \ cap_rights_update rs cap @@ -392,13 +393,14 @@ crunch invoke_tcb wp: hoare_drop_imps mapM_x_wp' check_cap_inv simp: crunch_simps) +lemmas Tcb_AI_2_assms = Arch_assms (* extract accumulated assumptions *) + end global_interpretation Tcb_AI?: Tcb_AI where is_cnode_or_valid_arch = X64.is_cnode_or_valid_arch proof goal_cases - interpret Arch . - case 1 show ?case by (unfold_locales; (fact Tcb_AI_assms)?) + case 1 show ?case by (unfold_locales; (fact X64.Tcb_AI_2_assms)?) qed end diff --git a/proof/invariant-abstract/X64/ArchUntyped_AI.thy b/proof/invariant-abstract/X64/ArchUntyped_AI.thy index 63676f9a96..12aec61a70 100644 --- a/proof/invariant-abstract/X64/ArchUntyped_AI.thy +++ b/proof/invariant-abstract/X64/ArchUntyped_AI.thy @@ -10,9 +10,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_AI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_AI locale *) -lemma of_bl_nat_to_cref[Untyped_AI_assms]: +lemma of_bl_nat_to_cref[Arch_assms]: "\ x < 2 ^ bits; bits < word_bits \ \ (of_bl (nat_to_cref bits x) :: word64) = of_nat x" apply (clarsimp intro!: less_mask_eq @@ -21,7 +21,7 @@ lemma of_bl_nat_to_cref[Untyped_AI_assms]: by (metis add_lessD1 le_unat_uoi nat_le_iff_add nat_le_linear) -lemma cnode_cap_ex_cte[Untyped_AI_assms]: +lemma cnode_cap_ex_cte[Arch_assms]: "\ is_cnode_cap cap; cte_wp_at (\c. \m. cap = mask_cap m c) p s; (s::'state_ext::state_ext state) \ cap; valid_objs s; pspace_aligned s \ \ ex_cte_cap_wp_to is_cnode_cap (obj_ref_of cap, nat_to_cref (bits_of cap) x) s" @@ -36,7 +36,7 @@ lemma cnode_cap_ex_cte[Untyped_AI_assms]: -lemma inj_on_nat_to_cref[Untyped_AI_assms]: +lemma inj_on_nat_to_cref[Arch_assms]: "bits < word_bits \ inj_on (nat_to_cref bits) {..< 2 ^ bits}" apply (rule inj_onI) apply (drule arg_cong[where f="\x. replicate (64 - bits) False @ x"]) @@ -54,7 +54,7 @@ lemma inj_on_nat_to_cref[Untyped_AI_assms]: done -lemma data_to_obj_type_sp[Untyped_AI_assms]: +lemma data_to_obj_type_sp[Arch_assms]: "\P\ data_to_obj_type x \\ts (s::'state_ext::state_ext state). ts \ ArchObject ASIDPoolObj \ P s\, -" unfolding data_to_obj_type_def apply (rule hoare_pre) @@ -63,7 +63,7 @@ lemma data_to_obj_type_sp[Untyped_AI_assms]: apply (simp add: arch_data_to_obj_type_def split: if_split_asm) done -lemma dui_inv_wf[wp, Untyped_AI_assms]: +lemma dui_inv_wf[wp, Arch_assms]: "\invs and cte_wp_at ((=) (cap.UntypedCap dev w sz idx)) slot and (\s. \cap \ set cs. is_cnode_cap cap \ (\r\cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s)) @@ -148,7 +148,7 @@ qed lemma asid_bits_ge_0: "(0::word32) < 2 ^ asid_bits" by (simp add: asid_bits_def) -lemma retype_ret_valid_caps_captable[Untyped_AI_assms]: +lemma retype_ret_valid_caps_captable[Arch_assms]: "\pspace_no_overlap_range_cover ptr sz (s::'state_ext::state_ext state) \ 0 < us \ range_cover ptr sz (obj_bits_api CapTableObject us) n \ ptr \ 0 \ @@ -161,7 +161,7 @@ by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def | rule is_aligned_add_multI[OF _ le_refl], (simp add:range_cover_def word_bits_def obj_bits_api_def slot_bits_def)+)+)[1] -lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]: +lemma retype_ret_valid_caps_aobj[Arch_assms]: "\ptr sz (s::'state_ext::state_ext state) x6 us n. \pspace_no_overlap_range_cover ptr sz s \ x6 \ ASIDPoolObj \ range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \ ptr \ 0\ @@ -214,7 +214,7 @@ lemma cap_refs_in_kernel_windowD2: apply fastforce done -lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: +lemma init_arch_objects_descendants_range[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). descendants_range x cref s \ init_arch_objects ty dev ptr n us y \\rv s. descendants_range x cref s\" apply (simp add:descendants_range_def) @@ -228,7 +228,7 @@ lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]: -lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]: +lemma init_arch_objects_caps_overlap_reserved[wp,Arch_assms]: "\\(s::'state_ext::state_ext state). caps_overlap_reserved S s\ init_arch_objects ty dev ptr n us y \\rv s. caps_overlap_reserved S s\" @@ -252,7 +252,7 @@ lemma safe_ioport_insert_not_ioport[simp]: "\is_ioport_cap newcap \ safe_ioport_insert newcap oldcap s" by (clarsimp simp: safe_ioport_insert_def) -lemma set_untyped_cap_invs_simple[Untyped_AI_assms]: +lemma set_untyped_cap_invs_simple[Arch_assms]: "\\s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \ pspace_no_overlap_range_cover ptr sz s \ invs s \ cte_wp_at (\c. is_untyped_cap c \ cap_bits c = sz \ obj_ref_of c = ptr \ cap_is_device c = dev) cref s \ idx \ 2^ sz\ set_cap (cap.UntypedCap dev ptr sz idx) cref @@ -298,7 +298,7 @@ lemma pbfs_atleast_pageBits': lemma pbfs_less_wb': "pageBitsForSize sz < word_bits"by (cases sz, simp_all add: word_bits_conv pageBits_def bit_simps) -lemma delete_objects_rewrite[Untyped_AI_assms]: +lemma delete_objects_rewrite[Arch_assms]: "\ word_size_bits \ sz; sz\ word_bits;ptr && ~~ mask sz = ptr\ \ delete_objects ptr sz = do y \ modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz}); modify (detype {ptr && ~~ mask sz..ptr + 2 ^ sz - 1}) @@ -336,7 +336,7 @@ lemma default_PDPT_capD: apply (case_tac x6, simp_all add: arch_default_cap_def) done -lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_caps[wp, Arch_assms]: "\valid_arch_caps and valid_cap (default_cap tp oref sz dev) and (\(s::'state_ext::state_ext state). \r\obj_refs (default_cap tp oref sz dev). @@ -371,7 +371,7 @@ lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]: done -lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]: +lemma create_cap_cap_refs_in_kernel_window[wp, Arch_assms]: "\cap_refs_in_kernel_window and cte_wp_at (\c. cap_range (default_cap tp oref sz dev) \ cap_range c) p\ create_cap tp sz p dev (cref, oref) \\rv. cap_refs_in_kernel_window\" apply (simp add: create_cap_def) @@ -396,7 +396,7 @@ lemma create_cap_ioport_control[wp]: unfolding create_cap_def by (wpsimp simp: ioport_control_unique_def) -lemma create_cap_valid_arch_state[wp, Untyped_AI_assms]: +lemma create_cap_valid_arch_state[wp, Arch_assms]: "\valid_arch_state and cte_wp_at (\_. True) cref\ create_cap tp sz p dev (cref,oref) \\rv. valid_arch_state\" @@ -546,7 +546,7 @@ lemma mapM_copy_global_mappings_nonempty_table[wp]: apply simp_all done -lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: +lemma init_arch_objects_nonempty_table[Arch_assms, wp]: "\(\s. \ (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \ valid_global_objs s \ valid_arch_state s \ pspace_aligned s) and K (\ref\set refs. is_aligned ref (obj_bits_api tp us))\ @@ -559,13 +559,13 @@ lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]: apply (clarsimp simp: obj_bits_api_def default_arch_object_def pml4_bits_def pageBits_def) done -lemma nonempty_table_caps_of[Untyped_AI_assms]: +lemma nonempty_table_caps_of[Arch_assms]: "nonempty_table S ko \ caps_of ko = {}" by (auto simp: caps_of_def cap_of_def nonempty_table_def a_type_def split: Structures_A.kernel_object.split if_split_asm) -lemma nonempty_default[simp, Untyped_AI_assms]: +lemma nonempty_default[simp, Arch_assms]: "tp \ Untyped \ \ nonempty_table S (default_object tp dev us d)" apply (case_tac tp, simp_all add: default_object_def nonempty_table_def a_type_def) apply (rename_tac aobject_type) @@ -589,7 +589,7 @@ crunch init_arch_objects lemmas init_arch_objects_ex_cte_cap_wp_to = init_arch_objects_excap -lemma obj_is_device_vui_eq[Untyped_AI_assms]: +lemma obj_is_device_vui_eq[Arch_assms]: "valid_untyped_inv ui s \ case ui of Retype slot reset ptr_base ptr tp us slots dev \ obj_is_device tp dev = dev" @@ -601,16 +601,17 @@ lemma obj_is_device_vui_eq[Untyped_AI_assms]: apply (auto simp: arch_is_frame_type_def) done -lemmas [Untyped_AI_assms] = set_cap_non_arch_valid_arch_state +lemmas [Arch_assms] = set_cap_non_arch_valid_arch_state + +lemmas Untyped_AI_assms = Arch_assms (* extract accumulated assumptions *) end global_interpretation Untyped_AI? : Untyped_AI where nonempty_table = X64.nonempty_table proof goal_cases - interpret Arch . case 1 show ?case - by (unfold_locales; (fact Untyped_AI_assms)?) + by (unfold_locales; (fact X64.Untyped_AI_assms)?) qed end diff --git a/proof/refine/AARCH64/ArchADT_H.thy b/proof/refine/AARCH64/ArchADT_H.thy index 503c282f37..0a866f7be7 100644 --- a/proof/refine/AARCH64/ArchADT_H.thy +++ b/proof/refine/AARCH64/ArchADT_H.thy @@ -13,14 +13,14 @@ begin context Arch begin arch_global_naming -named_theorems ADT_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H locale *) definition vm_rights_of :: "vmrights \ rights set" where "vm_rights_of x \ case x of VMKernelOnly \ vm_kernel_only | VMReadOnly \ vm_read_only | VMReadWrite \ vm_read_write" -lemma vm_rights_of_vmrights_map_id[ADT_H_assms, simp]: +lemma vm_rights_of_vmrights_map_id[Arch_assms, simp]: "rs \ valid_vm_rights \ vm_rights_of (vmrights_map rs) = rs" by (auto simp: vm_rights_of_def vmrights_map_def valid_vm_rights_def vm_read_write_def vm_read_only_def vm_kernel_only_def) @@ -104,7 +104,7 @@ fun ArchCapabilityMap :: "arch_capability \ cap" where | "ArchCapabilityMap (arch_capability.SMCCap smc_badge) = cap.ArchObjectCap (arch_cap.SMCCap smc_badge)" -lemma acap_relation_imp_ArchCapabilityMap[ADT_H_assms]: +lemma acap_relation_imp_ArchCapabilityMap[Arch_assms]: "\wellformed_acap ac; acap_relation ac ac'\ \ ArchCapabilityMap ac' = cap.ArchObjectCap ac" by (case_tac ac; simp add: wellformed_cap_simps ucast_down_ucast_id is_down) @@ -114,7 +114,7 @@ primrec ArchFaultMap :: "Fault_H.arch_fault \ ExceptionTypes_A.arch_ | "ArchFaultMap (AARCH64_H.VGICMaintenance m) = AARCH64_A.VGICMaintenance m" | "ArchFaultMap (AARCH64_H.VPPIEvent irq) = AARCH64_A.VPPIEvent irq" -lemma ArchFaultMap_arch_fault_map[ADT_H_assms]: +lemma ArchFaultMap_arch_fault_map[Arch_assms]: "ArchFaultMap (arch_fault_map f) = f" by (cases f; simp add: ArchFaultMap_def arch_fault_map_def) @@ -163,7 +163,7 @@ definition absArchState :: arm_gicvcpu_numlistregs = num_list_regs, arm_current_fpu_owner = current_fpu_owner \" -lemma absArchState_correct[ADT_H_assms]: +lemma absArchState_correct[Arch_assms]: "(s,s') \ state_relation \ absArchState (ksArchState s') (aobjs_of' s') = arch_state s" apply (prop_tac "(arch_state s, ksArchState s') \ arch_state_relation (aobjs_of' s')") apply (simp add: state_relation_def) @@ -173,19 +173,20 @@ lemma absArchState_correct[ADT_H_assms]: apply (simp add: o_def ucast_up_ucast_id is_up map_option.identity) done +lemmas ADT_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState interpretation ADT_H?: ADT_H vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.ADT_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems ADT_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H_2 locale *) (* Due to DataPage, current FPU owner and gsPPTypes this can't be made generic. In order to unify the type across architectures, we use the arch kernel state. *) @@ -205,7 +206,7 @@ definition absHeap :: | Some (KOArch ako) \ map_option ArchObj (absHeapArch h (gsPTTypes aks) x ako) | None \ None" -lemma absHeap_correct[ADT_H_2_assms]: +lemma absHeap_correct[Arch_assms]: fixes s' :: kernel_state assumes pspace_aligned: "pspace_aligned s" assumes pspace_distinct: "pspace_distinct s" @@ -612,6 +613,8 @@ proof - done qed +lemmas ADT_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts absHeap @@ -619,8 +622,7 @@ arch_requalify_consts absHeap interpretation ADT_H_2?: ADT_H_2 vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState absHeap proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.ADT_H_2_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchArchAcc_R.thy b/proof/refine/AARCH64/ArchArchAcc_R.thy index 962767f7cb..19a6d52284 100644 --- a/proof/refine/AARCH64/ArchArchAcc_R.thy +++ b/proof/refine/AARCH64/ArchArchAcc_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems ArchAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ArchAcc_R locale *) lemma asid_pool_at_ko: "asid_pool_at p s \ \pool. ko_at (ArchObj (AARCH64_A.ASIDPool pool)) p s" @@ -35,7 +35,7 @@ lemma pteBits_pte_bits[simp]: "pteBits = pte_bits" by (simp add: bit_simps pteBits_def) -lemma pspace_aligned_cross[ArchAcc_R_assms]: +lemma pspace_aligned_cross[Arch_assms]: "\ pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_aligned' s'" apply (clarsimp simp: pspace_aligned'_def pspace_aligned_def pspace_relation_def) apply (rename_tac p' ko') @@ -98,7 +98,7 @@ lemma obj_relation_cuts_range_limit: apply fastforce+ done -lemma obj_relation_cuts_range_mask_range[ArchAcc_R_assms]: +lemma obj_relation_cuts_range_mask_range[Arch_assms]: "\ (p', P) \ obj_relation_cuts ko p; P ko ko'; is_aligned p (obj_bits ko) \ \ p' \ mask_range p (obj_bits ko)" apply (drule (1) obj_relation_cuts_range_limit, clarsimp) @@ -123,7 +123,7 @@ lemma obj_relation_cuts_obj_bits: lemmas is_aligned_add_step_le' = is_aligned_add_step_le[simplified mask_2pm1 add_diff_eq] -lemma pspace_distinct_cross[ArchAcc_R_assms]: +lemma pspace_distinct_cross[Arch_assms]: "\ pspace_distinct s; pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_distinct' s'" apply (frule (1) pspace_aligned_cross) @@ -904,7 +904,7 @@ lemma corres_gets_global_pt [corres]: lemmas getObject_PTE_corres'[corres] = getObject_PTE_corres[@lift_corres_args] lemmas storePTE_corres'[corres] = storePTE_corres[@lift_corres_args] -lemma arch_cap_rights_update[ArchAcc_R_assms]: +lemma arch_cap_rights_update[Arch_assms]: "acap_relation c c' \ cap_relation (cap.ArchObjectCap (acap_rights_update (acap_rights c \ msk) c)) (Arch.maskCapRights (rights_mask_map msk) c')" @@ -931,7 +931,7 @@ lemma arch_deriveCap_valid: apply (simp add: AARCH64_H.deriveCap_def split del: if_split cong: if_cong) apply (wp undefined_validE_R) apply (cases arch_cap; simp add: isCap_defs) - apply (simp add: valid_cap'_def capAligned_def global.capUntypedPtr_def capUntypedPtr_def) + apply (simp add: valid_cap'_def capAligned_def global.capUntypedPtr_def AARCH64_H.capUntypedPtr_def) done lemma mdata_map_simps[simp]: @@ -1181,12 +1181,13 @@ lemma setObject_ASID_ctes_of'[wp]: \\rv s. P (ctes_of s)\" by (rule ctes_of_from_cte_wp_at [where Q=\, simplified]) wp -end +lemmas ArchAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation ArchAcc_R?: ArchAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact ArchAcc_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.ArchAcc_R_assms)?) qed end diff --git a/proof/refine/AARCH64/ArchArch_R.thy b/proof/refine/AARCH64/ArchArch_R.thy index 62278a57d7..4b04ec00ec 100644 --- a/proof/refine/AARCH64/ArchArch_R.thy +++ b/proof/refine/AARCH64/ArchArch_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Arch_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Arch_R locale *) declare arch_cap.sel[datatype_schematic] @@ -433,7 +433,7 @@ lemma ARMMMU_improve_cases: done crunch Arch.decodeInvocation - for inv[Arch_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (wp: crunch_wps mapME_x_inv_wp getASID_wp hoare_vcg_imp_lift' simp: crunch_simps ARMMMU_improve_cases) @@ -1017,7 +1017,7 @@ lemma decodeSMCInvocation_corres: by (corres corres: corres_returnOk[where P=\ and P'=\] simp: archinv_relation_def smc_invocation_map_def) -lemma arch_decodeInvocation_corres[Arch_R_assms]: +lemma arch_decodeInvocation_corres[Arch_assms]: "\ acap_relation arch_cap arch_cap'; list_all2 cap_relation (map fst excaps) (map fst excaps'); list_all2 (\s s'. s' = cte_map s) (map snd excaps) (map snd excaps') \ \ @@ -1319,7 +1319,7 @@ lemma performARMVCPUInvocation_corres: apply (rule inv_corres [THEN corres_guard_imp]; simp add: invs_no_0_obj' invs_implies)+ done -lemma arch_performInvocation_corres[Arch_R_assms]: +lemma arch_performInvocation_corres[Arch_assms]: "archinv_relation ai ai' \ corres (dc \ (=)) (einvs and ct_active and valid_arch_inv ai and schact_is_rct) @@ -1442,7 +1442,7 @@ crunch performVSpaceInvocation, performARMVCPUInvocation, performSGISignalGenera performSMCInvocation for tcb_at'[wp]: "\s. tcb_at' p s" -lemma invokeArch_tcb_at'[Arch_R_assms]: +lemma invokeArch_tcb_at'[Arch_assms]: "\invs' and valid_arch_inv' ai and ct_active' and st_tcb_at' active' p\ Arch.performInvocation ai \\rv. tcb_at' p\" @@ -1451,7 +1451,7 @@ lemma invokeArch_tcb_at'[Arch_R_assms]: wp: performASIDControlInvocation_tcb_at') done -lemma sts_valid_arch_inv'[Arch_R_assms]: (* FIXME AARCH64 cleanup *) +lemma sts_valid_arch_inv'[Arch_assms]: (* FIXME AARCH64 cleanup *) "\valid_arch_inv' ai\ setThreadState st t \\rv. valid_arch_inv' ai\" apply (cases ai, simp_all add: valid_arch_inv'_def) apply (clarsimp simp: valid_vsi'_def split: vspace_invocation.splits) @@ -1712,7 +1712,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (wpsimp simp: valid_arch_inv'_def) done -lemma arch_decodeInvocation_wf_interface[Arch_R_assms]: +lemma arch_decodeInvocation_wf_interface[Arch_assms]: "\invs' and valid_cap' (ArchObjectCap arch_cap) 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 @@ -2071,7 +2071,7 @@ lemma performSMCInvocation_invs[wp]: unfolding performSMCInvocation_def by (wpsimp wp: dmo_invs_lift' hoare_drop_imps) -lemma arch_performInvocation_invs'[Arch_R_assms]: +lemma arch_performInvocation_invs'[Arch_assms]: "\invs' and ct_active' and valid_arch_inv' invocation\ Arch.performInvocation invocation \\rv. invs'\" @@ -2080,10 +2080,12 @@ lemma arch_performInvocation_invs'[Arch_R_assms]: apply wpsimp+ done -lemma setObject_TCB_valid_duplicates'[Arch_R_assms, wp]: +lemma setObject_TCB_valid_duplicates'[Arch_assms, wp]: "setObject p (tcb::tcb) \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp +lemmas Arch_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -2092,8 +2094,7 @@ arch_requalify_consts interpretation Arch_R?: Arch_R valid_arch_inv' archinv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Arch_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Arch_R_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchBits_R.thy b/proof/refine/AARCH64/ArchBits_R.thy index bf5efd6d5d..642efaa975 100644 --- a/proof/refine/AARCH64/ArchBits_R.thy +++ b/proof/refine/AARCH64/ArchBits_R.thy @@ -11,30 +11,30 @@ begin context Arch begin arch_global_naming -named_theorems Bits_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Bits_R locale *) crunch_ignore (add: lookupPTSlotFromLevel lookupPTFromLevel) -lemma atcbContext_get_eq[Bits_R_assms, simp]: +lemma atcbContext_get_eq[Arch_assms, simp]: "atcbContextGet (atcbContextSet x atcb) = x" by (simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_eq[Bits_R_assms, simp]: +lemma atcbContext_set_eq[Arch_assms, simp]: "atcbContextSet (atcbContextGet t) t = t" by (cases t, simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_set[Bits_R_assms, simp]: +lemma atcbContext_set_set[Arch_assms, simp]: "atcbContextSet x (atcbContextSet y atcb) = atcbContextSet x atcb" by (cases atcb, simp add: atcbContextSet_def) -lemma objBitsKO_less_word_bits[Bits_R_assms]: +lemma objBitsKO_less_word_bits[Arch_assms]: "objBitsKO ko < word_bits" unfolding objBits_def by (case_tac ko; simp add: pageBits_def pteBits_def objBits_simps' word_bits_def split: arch_kernel_object.split) -lemma objBitsKO_neq_0[Bits_R_assms]: +lemma objBitsKO_neq_0[Arch_assms]: "objBitsKO ko \ 0" unfolding objBits_def by (case_tac ko; @@ -55,7 +55,7 @@ lemma arch_isCap_simps: (* isArchSGISignalCap_def is already in expanded exists form, so no need to spell it out. *) lemmas isCap_simps = gen_isCap_simps arch_isCap_simps isArchSGISignalCap_def isArchSMCCap_simp -lemma pageBits_le_maxUntypedSizeBits[Bits_R_assms, simp]: +lemma pageBits_le_maxUntypedSizeBits[Arch_assms, simp]: "pageBits \ maxUntypedSizeBits" by (simp add: pageBits_def maxUntypedSizeBits_def) @@ -89,7 +89,9 @@ lemma projectKO_VCPU: lemmas arch_projectKOs = projectKO_ASID projectKO_PTE projectKO_user_data projectKO_user_data_device projectKO_VCPU -end +lemmas Bits_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) (* for projectKO_opt, we want to export the arch-specific instantiation lemmas *) arch_requalify_facts arch_projectKOs @@ -101,8 +103,7 @@ lemmas projectKOs = gen_projectKOs arch_projectKOs interpretation Bits_R?: Bits_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Bits_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.Bits_R_assms)?) qed end diff --git a/proof/refine/AARCH64/ArchCNodeInv_R.thy b/proof/refine/AARCH64/ArchCNodeInv_R.thy index 851cf92ac1..0b6acfc75f 100644 --- a/proof/refine/AARCH64/ArchCNodeInv_R.thy +++ b/proof/refine/AARCH64/ArchCNodeInv_R.thy @@ -14,49 +14,49 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_R locale *) definition arch_finalise_prop_stuff :: "(kernel_state \ bool) \ bool" where "arch_finalise_prop_stuff P = True" -lemma arch_finalise_prop_stuff_top[CNodeInv_R_assms, simp]: +lemma arch_finalise_prop_stuff_top[Arch_assms, simp]: "arch_finalise_prop_stuff \" by (simp add: arch_finalise_prop_stuff_def) -lemma acap_relation_arch_update_cap_data_NullCap[CNodeInv_R_assms]: +lemma acap_relation_arch_update_cap_data_NullCap[Arch_assms]: "acap_relation acap acap' \ (arch_update_cap_data P x acap = cap.NullCap) = (Arch.updateCapData P x acap' = NullCap)" unfolding arch_update_cap_data_def AARCH64_H.updateCapData_def by (cases acap; simp) -lemma cnode_guard_size_bits_wordRadix[CNodeInv_R_assms]: +lemma cnode_guard_size_bits_wordRadix[Arch_assms]: "cnode_guard_size_bits = wordRadix" by (simp add: cnode_guard_size_bits_def wordRadix_def) -lemma cteRightsBits_cnode_padding_bits[CNodeInv_R_assms]: +lemma cteRightsBits_cnode_padding_bits[Arch_assms]: "cteRightsBits = cnode_padding_bits" by (simp add: cteRightsBits_def cnode_padding_bits_def) (* FIXME arch-split: valid_cnode_capI in CNodeInv_AI exposes the value of word_bits, replace with this *) -lemma valid_cnode_capI'[CNodeInv_R_assms]: +lemma valid_cnode_capI'[Arch_assms]: "\cap_table_at n w s; valid_objs s; pspace_aligned s; 0 < n; length g \ word_bits\ \ s \ cap.CNodeCap w n g" by (simp add: word_bits_def valid_cnode_capI) -lemma arch_capBadge_updateCapData_True[CNodeInv_R_assms]: +lemma arch_capBadge_updateCapData_True[Arch_assms]: "Arch.updateCapData True x acap \ NullCap \ capBadge (Arch.updateCapData True x acap) = arch_capBadge acap" unfolding AARCH64_H.updateCapData_def by (cases acap; simp) crunch fpuRelease, prepareThreadDelete - for ctes_of[CNodeInv_R_assms, wp]: "\s. P (ctes_of s)" + for ctes_of[Arch_assms, wp]: "\s. P (ctes_of s)" crunch prepareThreadDelete - for not_recursive_ctes[CNodeInv_R_assms]: "\s. P (not_recursive_ctes s)" + for not_recursive_ctes[Arch_assms]: "\s. P (not_recursive_ctes s)" (simp: prepareThreadDelete_def not_recursive_ctes_def cteCaps_of_def) -lemma in_preempt'[CNodeInv_R_assms]: +lemma in_preempt'[Arch_assms]: "(Inr rv, s') \ fst (preemptionPoint s) \ \f g. s' = ksWorkUnitsCompleted_update f (s \ ksMachineState := ksMachineState s \ irq_state := g (irq_state (ksMachineState s)) \\)" @@ -82,19 +82,19 @@ lemma sameRegionAs_eq_parent: \ sameRegionAs c' cap" by (clarsimp simp: weak_derived'_def sameRegionAs_def2 isCap_simps) -lemma sameRegion_ep[CNodeInv_R_assms]: +lemma sameRegion_ep[Arch_assms]: "\ sameRegionAs cap cap'; isEndpointCap cap \ \ isEndpointCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegion_ntfn[CNodeInv_R_assms]: +lemma sameRegion_ntfn[Arch_assms]: "\ sameRegionAs cap cap'; isNotificationCap cap \ \ isNotificationCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegionAs_Zombie[CNodeInv_R_assms, simp]: +lemma sameRegionAs_Zombie[Arch_assms, simp]: "\ sameRegionAs (Zombie p zb n) cap" by (simp add: sameRegionAs_def3 isCap_simps) -lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: +lemma isFinal_notUntyped_capRange_disjoint[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); cteCaps_of s sl' = Some cap'; sl \ sl'; capUntypedPtr cap = capUntypedPtr cap'; capBits cap = capBits cap'; isThreadCap cap \ isCNodeCap cap; s \' cap; @@ -116,7 +116,7 @@ lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: (clarsimp simp: sameObjectAs_def3 isCap_simps)?)+ done -lemma ztc_sameRegion[CNodeInv_R_assms]: +lemma ztc_sameRegion[Arch_assms]: "\ isCNodeCap cap \ isThreadCap cap \ isZombie cap \ \ sameRegionAs cap cap' = sameObjectAs cap cap'" apply (subgoal_tac "\ isUntypedCap cap \ \ isArchFrameCap cap @@ -125,7 +125,7 @@ lemma ztc_sameRegion[CNodeInv_R_assms]: apply (auto simp: isCap_simps) done -lemma mdb_chunked_update_final[CNodeInv_R_assms]: +lemma mdb_chunked_update_final[Arch_assms]: assumes chunked: "mdb_chunked m" and slot: "m slot = Some (CTE cap node)" and Fin1: "\x cte. m x = Some cte \ x \ slot @@ -184,19 +184,19 @@ proof - done qed -lemma sameRegionAs_ThreadCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_ThreadCap_eq[Arch_assms]: "sameRegionAs (ThreadCap p) (ThreadCap p') = (p = p')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_IRQHandlerCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_IRQHandlerCap_eq[Arch_assms]: "sameRegionAs (IRQHandlerCap irq) (IRQHandlerCap irq') = (irq = irq')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_CNodeCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_CNodeCap_eq[Arch_assms]: "sameRegionAs (CNodeCap p b g gs) (CNodeCap p' b' g' gs') = (p = p' \ b = b')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma ztc_untyped_helper[CNodeInv_R_assms]: +lemma ztc_untyped_helper[Arch_assms]: "\ isCNodeCap cap' \ isThreadCap cap' \ isZombie cap'; sameRegionAs cap cap' \ \ isUntypedCap cap \ sameRegionAs cap' cap" apply (erule sameRegionAsE) @@ -210,12 +210,12 @@ lemma ztc_untyped_helper[CNodeInv_R_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma valid_arch_badges_PhysicalClass[CNodeInv_R_assms]: +lemma valid_arch_badges_PhysicalClass[Arch_assms]: "\ valid_arch_badges cap'' cap' node'; capClass cap'' = PhysicalClass; capClass cap = PhysicalClass \ \ valid_arch_badges cap cap' node'" by (auto simp: valid_arch_badges_def isCap_simps) -lemma isFinal_Zombie[CNodeInv_R_assms]: +lemma isFinal_Zombie[Arch_assms]: "isFinal (Zombie p' b n) p cs" by (simp add: isFinal_def sameObjectAs_def2 gen_isCap_simps) @@ -223,25 +223,25 @@ crunch Arch.postCapDeletion for no_cte_prop[wp]: "no_cte_prop P" (* interface, above crunch does not result in same lemma on all architectures *) -lemma arch_postCapDeletion_no_cte_prop[CNodeInv_R_assms]: +lemma arch_postCapDeletion_no_cte_prop[Arch_assms]: "\no_cte_prop P and K (arch_finalise_prop_stuff P)\ Arch.postCapDeletion t \\_. no_cte_prop P\" by wpsimp -lemma post_cap_delete_pre'_IRQHandlerCap[CNodeInv_R_assms]: +lemma post_cap_delete_pre'_IRQHandlerCap[Arch_assms]: "post_cap_delete_pre' (IRQHandlerCap irq) sl cs = (arch_valid_irq irq \ (\sl'. sl \ sl' \ cs sl' \ Some (IRQHandlerCap irq)))" by (simp add: post_cap_delete_pre'_def) -lemma final_post_cap_delete_pre'_ArchObjectCap[CNodeInv_R_assms]: +lemma final_post_cap_delete_pre'_ArchObjectCap[Arch_assms]: "\ isFinal (ArchObjectCap acap) sl (cteCaps_of s); arch_cap_has_cleanup' acap; valid_arch_cap' acap s\ \ post_cap_delete_pre' (ArchObjectCap acap) sl (cteCaps_of s)" by (clarsimp simp add: post_cap_delete_pre'_def arch_cap_has_cleanup'_def isCap_simps) crunch Arch_finaliseCap, prepareThreadDelete - for st_tcb_at'[CNodeInv_R_assms, wp]: "st_tcb_at' P t" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" (simp: crunch_simps pteAtIndex_def wp: crunch_wps getObject_inv loadObject_default_inv rule: AARCH64_H.finaliseCap_def) @@ -270,7 +270,7 @@ lemma archThreadSet_rvk_prog': by (wpsimp simp: cteCaps_of_def) crunch prepareThreadDelete, Arch_finaliseCap - for rvk_prog'[CNodeInv_R_assms]: + for rvk_prog'[Arch_assms]: "\s. revoke_progress_ord m (\x. option_map capToRPO (cteCaps_of s x))" (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of getObject_inv loadObject_default_inv @@ -284,7 +284,7 @@ lemma arch_recycleCap_improve_cases: \ (if isASIDPoolCap cap then v else undefined) = v" by (cases cap, simp_all add: isCap_simps) -lemma cap_relation_trans[CNodeInv_R_assms]: +lemma cap_relation_trans[Arch_assms]: "\ cap_relation cap cap'; cap_relation cap cap'' \ \ cap' = cap''" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) @@ -324,7 +324,7 @@ crunch ignore: saveVirtTimer) crunch Arch_finaliseCap, prepareThreadDelete - for irq_states'[CNodeInv_R_assms, wp]: valid_irq_states' + for irq_states'[Arch_assms, wp]: valid_irq_states' (wp: crunch_wps unless_wp getASID_wp no_irq_setVSpaceRoot simp: crunch_simps o_def pteAtIndex_def rule: AARCH64_H.finaliseCap_def) @@ -518,18 +518,19 @@ end (* mdb_move *) context Arch begin arch_global_naming -lemmas [CNodeInv_R_assms] = +lemmas [Arch_assms] = mdb_swap.cteSwap_valid_mdb_helper mdb_move.cteMove_valid_mdb_helper +lemmas CNodeInv_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts arch_finalise_prop_stuff interpretation CNodeInv_R?: CNodeInv_R arch_finalise_prop_stuff proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CNodeInv_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CNodeInv_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/AARCH64/ArchCSpace1_R.thy b/proof/refine/AARCH64/ArchCSpace1_R.thy index c45d172a5d..1898b130cb 100644 --- a/proof/refine/AARCH64/ArchCSpace1_R.thy +++ b/proof/refine/AARCH64/ArchCSpace1_R.thy @@ -13,22 +13,22 @@ begin context Arch begin arch_global_naming -named_theorems CSpace1_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R locale *) -lemma ghost_relation_wrapper_same_abs_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_abs_set_cap[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap cap dest a); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma ghost_relation_wrapper_set_cap_twice[CSpace1_R_assms]: +lemma ghost_relation_wrapper_set_cap_twice[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap dcap src a); ((), a'') \ fst (set_cap scap dest a'); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a'' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma archMDBAssertions_cross[CSpace1_R_assms]: +lemma archMDBAssertions_cross[Arch_assms]: "\ valid_arch_mdb (is_original_cap s) (caps_of_state s); valid_arch_state s; valid_objs s; (s, s') \ state_relation \ \ archMDBAssertions s'" @@ -93,7 +93,7 @@ lemma isMDBParentOf_trans: apply (erule(1) capBadge_ordering_trans) done -lemma parentOf_trans[CSpace1_R_assms]: +lemma parentOf_trans[Arch_assms]: "\ s \ a parentOf b; s \ b parentOf c \ \ s \ a parentOf c" by (auto simp: parentOf_def elim: isMDBParentOf_trans) @@ -109,7 +109,7 @@ lemma is_physical_relation: by (auto simp: is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma obj_ref_of_relation[CSpace1_R_assms]: +lemma obj_ref_of_relation[Arch_assms]: "\ cap_relation c c'; capClass c' = PhysicalClass \ \ obj_ref_of c = capUntypedPtr c'" by (cases c; simp) (rename_tac arch_cap, case_tac arch_cap, auto) @@ -134,7 +134,7 @@ lemma obj_size_relation: apply (case_tac arch_cap; simp add: objBits_def AARCH64_H.capUntypedSize_def bit_simps') done -lemma same_region_as_relation[CSpace1_R_assms]: +lemma same_region_as_relation[Arch_assms]: "\ cap_relation c d; cap_relation c' d' \ \ same_region_as c c' = sameRegionAs d d'" apply (cases c) apply clarsimp @@ -171,7 +171,7 @@ lemma cap_relation_SMCCap[simp]: (cap = cap.ArchObjectCap (arch_cap.SMCCap smc_badge))" by (cases cap) auto -lemma can_be_is[CSpace1_R_assms]: +lemma can_be_is[Arch_assms]: "\ cap_relation c (cteCap cte); cap_relation c' (cteCap cte'); mdbRevocable (cteMDBNode cte) = r; mdbFirstBadged (cteMDBNode cte') = r' \ \ @@ -196,14 +196,14 @@ lemma can_be_is[CSpace1_R_assms]: apply (auto simp: Let_def isCap_simps is_cap_simps dest!: acap_relation_SGISignalCapD)[1] done -lemma maskCap_valid[CSpace1_R_assms, simp]: +lemma maskCap_valid[Arch_assms, simp]: "s \' global.maskCapRights R cap = s \' cap" by (clarsimp simp: valid_cap'_def global.maskCapRights_def isCap_simps capAligned_def AARCH64_H.maskCapRights_def split: capability.split arch_capability.split cong: if_cong) -lemma cap_map_update_data[CSpace1_R_assms]: +lemma cap_map_update_data[Arch_assms]: assumes "cap_relation c c'" shows "cap_relation (update_cap_data p x c) (updateCapData p x c')" proof - @@ -249,7 +249,7 @@ qed sublocale setCTE: typ_at_props' "setCTE c cte" by typ_at_props' -lemma arch_updateCapData_Master[CSpace1_R_assms]: +lemma arch_updateCapData_Master[Arch_assms]: "Arch.updateCapData P d acap \ NullCap \ capMasterCap (Arch.updateCapData P d acap) = capMasterCap (ArchObjectCap acap)" by (cases acap; simp add: AARCH64_H.updateCapData_def split: if_split_asm) @@ -261,28 +261,28 @@ private method updateCapData_cases for c = (rename_tac arch_capability), (case_tac arch_capability; simp add: AARCH64_H.updateCapData_def isCap_simps Let_def) -lemma capASID_update[CSpace1_R_assms, simp]: +lemma capASID_update[Arch_assms, simp]: "capASID (RetypeDecls_H.updateCapData P x c) = capASID c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_vptr_update'[CSpace1_R_assms, simp]: +lemma cap_vptr_update'[Arch_assms, simp]: "cap_vptr' (RetypeDecls_H.updateCapData P x c) = cap_vptr' c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_asid_base_update'[CSpace1_R_assms, simp]: +lemma cap_asid_base_update'[Arch_assms, simp]: "cap_asid_base' (RetypeDecls_H.updateCapData P x c) = cap_asid_base' c" unfolding cap_asid_base'_def by (updateCapData_cases c) -lemma updateCapData_Reply[CSpace1_R_assms, simp]: +lemma updateCapData_Reply[Arch_assms, simp]: "isReplyCap (updateCapData P x c) = isReplyCap c" by (updateCapData_cases c) end (* context private method *) -lemma capASID_mask[CSpace1_R_assms, simp]: +lemma capASID_mask[Arch_assms, simp]: "capASID (maskCapRights x c) = capASID c" unfolding capASID_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -291,7 +291,7 @@ lemma capASID_mask[CSpace1_R_assms, simp]: simp_all add: AARCH64_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_vptr_mask'[CSpace1_R_assms, simp]: +lemma cap_vptr_mask'[Arch_assms, simp]: "cap_vptr' (maskCapRights x c) = cap_vptr' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -300,7 +300,7 @@ lemma cap_vptr_mask'[CSpace1_R_assms, simp]: simp_all add: AARCH64_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_asid_base_mask'[CSpace1_R_assms, simp]: +lemma cap_asid_base_mask'[Arch_assms, simp]: "cap_asid_base' (maskCapRights x c) = cap_asid_base' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -431,7 +431,7 @@ proof - done qed -lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: +lemma set_cap_not_quite_corres_prequel[Arch_assms]: assumes cr: "pspace_relation (kheap s) (ksPSpace s')" "(x,t') \ fst (setCTE p' c' s')" @@ -480,7 +480,7 @@ lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: done (* FIXME: move *) -lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: +lemma pspace_relation_cte_wp_atI'[Arch_assms]: "\ pspace_relation (kheap s) (ksPSpace s'); cte_wp_at' ((=) cte) x s'; valid_objs s \ \ \c slot. cte_wp_at ((=) c) slot s \ cap_relation c (cteCap cte) \ x = cte_map slot" @@ -504,23 +504,23 @@ lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: split: Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm) done -lemma same_region_as_final_matters[CSpace1_R_assms]: +lemma same_region_as_final_matters[Arch_assms]: "\same_region_as c c'; final_matters c\ \ final_matters c'" by (rule ccontr) (simp add: final_matters_def final_matters_arch_def cap_relation_split_asm split: cap.split_asm arch_cap.splits) -lemma same_region_as_arch_gen_refs[CSpace1_R_assms]: +lemma same_region_as_arch_gen_refs[Arch_assms]: "\same_region_as c c'; final_matters c \ \ arch_gen_refs c = arch_gen_refs c'" by (auto simp: final_matters_def cap_relation_split_asm is_cap_simps split: cap.split_asm arch_cap.splits) -lemma arch_same_region_aobj_ref[CSpace1_R_assms]: +lemma arch_same_region_aobj_ref[Arch_assms]: "\arch_same_region_as ac ac'; final_matters_arch ac; final_matters_arch ac'\ \ aobj_ref ac = aobj_ref ac'" by (simp add: final_matters_arch_def split: AARCH64_A.arch_cap.splits) -lemma obj_refs_relation_Master[CSpace1_R_assms]: +lemma obj_refs_relation_Master[Arch_assms]: "cap_relation cap cap' \ obj_refs cap = (if capClass (capMasterCap cap') = PhysicalClass \ \ isUntypedCap (capMasterCap cap') then {capUntypedPtr (capMasterCap cap')} @@ -532,13 +532,13 @@ lemma arch_gen_refs_relation_Master: "cap_relation cap cap' \ arch_gen_refs cap = {}" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma arch_gen_refs_cap_relation_Master_eq[CSpace1_R_assms]: +lemma arch_gen_refs_cap_relation_Master_eq[Arch_assms]: "\cap_relation c (cteCap cte); capMasterCap (cteCap cte') = capMasterCap (cteCap cte); cap_relation c' (cteCap cte')\ \ arch_gen_refs c = arch_gen_refs c'" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma descendants_of_update_ztc[CSpace1_R_assms]: +lemma descendants_of_update_ztc[Arch_assms]: assumes c: "\x. \ m \ x \ slot; \ P \ \ \cte'. m x = Some cte' \ capMasterCap (cteCap cte') \ capMasterCap (cteCap cte) @@ -735,7 +735,7 @@ proof (simp add: descendants_of'_def subset_iff, by simp qed -lemma capRange_cap_relation[CSpace1_R_assms]: +lemma capRange_cap_relation[Arch_assms]: "\ cap_relation cap cap'; capClass cap' = PhysicalClass \ \ capRange cap' = {obj_ref_of cap .. obj_ref_of cap + obj_size cap - 1}" by (simp add: capRange_def objBits_simps' cte_level_bits_def @@ -743,16 +743,16 @@ lemma capRange_cap_relation[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm option.split sum.split) -lemma obj_refs_cap_relation_untyped_ptr[CSpace1_R_assms]: +lemma obj_refs_cap_relation_untyped_ptr[Arch_assms]: "\ cap_relation cap cap'; obj_refs cap \ {} \ \ capUntypedPtr cap' \ obj_refs cap" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) -lemma ghost_relation_wrapper_same_concrete_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_concrete_set_cap[Arch_assms]: "\ ghost_relation_wrapper s c; ((), s') \ fst (set_cap cap src s) \ \ ghost_relation_wrapper s' c" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma revokable_plus_orderD[CSpace1_R_assms]: +lemma revokable_plus_orderD[Arch_assms]: "\ isCapRevocable new old; (capBadge old, capBadge new) \ capBadge_ordering P; capMasterCap old = capMasterCap new \ \ (isUntypedCap new \ (\x. capBadge old = Some 0 \ capBadge new = Some x \ x \ 0))" @@ -767,7 +767,7 @@ lemma valid_arch_badges_SMC: unfolding valid_arch_badges_def by (auto simp: isCap_simps) -lemma valid_badges_def2[CSpace1_R_assms]: +lemma valid_badges_def2[Arch_assms]: "valid_badges m = (\p p' cap node cap' node'. m p = Some (CTE cap node) \ @@ -814,7 +814,7 @@ lemma capRange_SMC[simp]: "capRange (ArchObjectCap (SMCCap smc_badge)) = {}" by (simp add: capRange_def) -lemma is_cap_revocable_eq[CSpace1_R_assms]: +lemma is_cap_revocable_eq[Arch_assms]: "\ cap_relation c c'; cap_relation src_cap src_cap'; sameRegionAs src_cap' c'; is_untyped_cap src_cap \ \ is_ep_cap c \ \ is_ntfn_cap c\ \ is_cap_revocable c src_cap = isCapRevocable c' src_cap'" @@ -824,10 +824,10 @@ lemma is_cap_revocable_eq[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm) done -lemmas use_update_ztc_one_descendants[CSpace1_R_assms] = +lemmas use_update_ztc_one_descendants[Arch_assms] = use_update_ztc_one[OF AARCH64.descendants_of_update_ztc, simplified] -lemma is_derived'_genD[CSpace1_R_assms]: +lemma is_derived'_genD[Arch_assms]: "is_derived' m p cap' cap \ cap' \ NullCap \ \ isZombie cap \ @@ -839,11 +839,11 @@ lemma is_derived'_genD[CSpace1_R_assms]: (isReplyCap cap' \ \ capReplyMaster cap')" by (simp add: AARCH64.is_derived'_def) -lemma acap_relation_capBadge[CSpace1_R_assms]: +lemma acap_relation_capBadge[Arch_assms]: "acap_relation acap acap' \ arch_capBadge acap' = arch_cap_badge acap" by (cases acap; simp) -lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: +lemma obj_relation_cuts_in_obj_range[Arch_assms]: "\ (y, P) \ obj_relation_cuts ko x; x \ obj_range x ko; kheap s x = Some ko; valid_objs s; pspace_aligned s \ \ y \ obj_range x ko" @@ -890,7 +890,7 @@ lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: apply (simp add: word_bits_def) done -lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: +lemma isMDBParentOf_CTE_gen[Arch_assms]: "\isArchObjectCap cap \ isMDBParentOf (CTE cap node) cte = (\cap' node'. cte = CTE cap' node' \ sameRegionAs cap cap' @@ -898,19 +898,21 @@ lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: \ (capBadge cap, capBadge cap') \ capBadge_ordering (mdbFirstBadged node'))" by (simp add: isMDBParentOf_CTE isCap_simps) + +lemmas CSpace1_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R?: CSpace1_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace1_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace1_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_2 locale *) -lemma updateMDB_pspace_relation[CSpace1_R_2_assms]: +lemma updateMDB_pspace_relation[Arch_assms]: assumes "(x, s'') \ fst (updateMDB p f s')" assumes "pspace_relation (kheap s) (ksPSpace s')" assumes "pspace_aligned' s'" "pspace_distinct' s'" @@ -968,7 +970,7 @@ lemma cap_asid_cap_relation: "cap_relation c c' \ capASID c' = map_option ucast (cap_asid c)" by (auto simp: capASID_def cap_asid_def split: cap.splits arch_cap.splits option.splits) -lemma is_derived_eq[CSpace1_R_2_assms]: +lemma is_derived_eq[Arch_assms]: "\ cap_relation c c'; cap_relation d d'; cdt_relation (swp cte_at s) (cdt s) (ctes_of s'); cte_at p s \ \ is_derived (cdt s) p c d = is_derived' (ctes_of s') (cte_map p) c' d'" @@ -1020,7 +1022,7 @@ lemma isMDBParentOf_eq_child: apply (clarsimp simp: sameRegionAs_def2 isCap_simps) done -lemma isMDBParentOf_eq[CSpace1_R_2_assms]: +lemma isMDBParentOf_eq[Arch_assms]: "\ isMDBParentOf c d; weak_derived' (cteCap c) (cteCap c'); mdbRevocable (cteMDBNode c') = mdbRevocable (cteMDBNode c); @@ -1072,11 +1074,11 @@ lemma sameRegionAs_SGISignalCap2[simp]: isIRQControlCapDescendant_def split: if_splits) -lemma arch_mdb_preservation_refl[simp, intro!, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_refl[simp, intro!, Arch_assms]: "arch_mdb_preservation cap cap" by (simp add: arch_mdb_preservation_def) -lemma arch_mdb_preservation_sym[CSpace1_R_2_assms]: +lemma arch_mdb_preservation_sym[Arch_assms]: "arch_mdb_preservation cap cap' = arch_mdb_preservation cap' cap" by (auto simp: arch_mdb_preservation_def) @@ -1084,11 +1086,11 @@ lemma arch_mdb_preservation_non_arch: "\ \isArchObjectCap cap; \isArchObjectCap cap' \ \ arch_mdb_preservation cap cap'" by (simp add: arch_mdb_preservation_def isCap_simps) -lemma arch_mdb_preservation_Untyped[simp, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_Untyped[simp, Arch_assms]: "arch_mdb_preservation (UntypedCap d p sz idx) (UntypedCap d' p' sz' idx')" by (simp add: arch_mdb_preservation_non_arch isCap_simps) -lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: +lemma parentOf_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. \m x = Some cte; m' x = Some cte'\ \ @@ -1130,7 +1132,7 @@ lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: apply blast done -lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: +lemma mdb_chunked_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. @@ -1176,7 +1178,7 @@ lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: apply (clarsimp simp:mdb_next_rel_def node) done -lemma valid_badges_preserve_oneway[CSpace1_R_2_assms]: +lemma valid_badges_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes misc: "\x cte cte'. @@ -1239,12 +1241,13 @@ definition is_simple_cap' :: "capability \ bool" where \ isArchFrameCap cap \ \ isArchSMCCap cap" +lemmas CSpace1_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R_2?: CSpace1_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_2_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace1_R_2_assms)?)) qed (* needed to prove dest_no_parent_n in Arch, then export to mdb_insert_der *) @@ -1376,19 +1379,20 @@ end context Arch begin arch_global_naming -named_theorems CSpace1_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_3 locale *) -lemmas [CSpace1_R_3_assms] = +lemmas [Arch_assms] = is_derived_maskedAsFull derived_sameRegionAs maskedAsFull_revokable mdb_insert_der.dest_no_parent_n mdb_insert_sib.src_no_mdb_parent mdb_insert_sib.parent_preserved -end +lemmas CSpace1_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace1_R_3?: CSpace1_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_3_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace1_R_3_assms)?)) qed locale Arch_masterCap = Arch + masterCap diff --git a/proof/refine/AARCH64/ArchCSpace_I.thy b/proof/refine/AARCH64/ArchCSpace_I.thy index 4ecdd4ef4e..c2765c21e5 100644 --- a/proof/refine/AARCH64/ArchCSpace_I.thy +++ b/proof/refine/AARCH64/ArchCSpace_I.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_I_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I locale *) lemma arch_capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (ASIDPoolCap r asid) = r" @@ -22,14 +22,14 @@ lemma arch_capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (VCPUCap r) = r" by (auto simp: AARCH64_H.capUntypedPtr_def) -lemma maskCapRights_allRights[CSpace_I_assms, simp]: +lemma maskCapRights_allRights[Arch_assms, simp]: "maskCapRights allRights c = c" - unfolding global.maskCapRights_def isCap_defs allRights_def maskCapRights_def maskVMRights_def + unfolding global.maskCapRights_def isCap_defs allRights_def AARCH64_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma isPhysicalCap[CSpace_I_assms, simp]: +lemma isPhysicalCap[Arch_assms, simp]: "isPhysicalCap cap = (capClass cap = PhysicalClass)" - by (simp add: global.isPhysicalCap_def isPhysicalCap_def + by (simp add: global.isPhysicalCap_def AARCH64_H.isPhysicalCap_def split: capability.split arch_capability.split) definition arch_capMasterCap :: "arch_capability \ arch_capability" where @@ -47,17 +47,17 @@ definition arch_capMasterCap :: "arch_capability \ arch_capability" lemmas arch_capMasterCap_simps[simp] = arch_capMasterCap_def[split_simps arch_capability.split] -lemma acapClass_arch_capMasterCap[CSpace_I_assms,simp]: +lemma acapClass_arch_capMasterCap[Arch_assms,simp]: "acapClass (arch_capMasterCap acap) = acapClass acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma capUntypedPtr_arch_capMasterCap[CSpace_I_assms, simp]: +lemma capUntypedPtr_arch_capMasterCap[Arch_assms, simp]: "Arch.capUntypedPtr (arch_capMasterCap acap) = Arch.capUntypedPtr acap" unfolding arch_capMasterCap_def by (simp add: AARCH64_H.capUntypedPtr_def split: arch_capability.splits) -lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: +lemma acapBits_arch_capMasterCap[Arch_assms, simp]: "acapBits (arch_capMasterCap acap) = acapBits acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) @@ -65,11 +65,11 @@ lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: lemmas isArchFrameCap_simps[simp] = isArchFrameCap_def[split_simps capability.split arch_capability.split] -lemma isArchFrameCap_arch_capMasterCap[CSpace_I_assms, simp]: +lemma isArchFrameCap_arch_capMasterCap[Arch_assms, simp]: "isArchFrameCap (ArchObjectCap (arch_capMasterCap acap)) = isArchFrameCap (ArchObjectCap acap)" by (simp add: arch_capMasterCap_def split: arch_capability.split) -lemma isArchFrameCap_non_arch[CSpace_I_assms]: +lemma isArchFrameCap_non_arch[Arch_assms]: "\is_ArchObjectCap cap \ isArchFrameCap cap = False" by (simp add: isArchFrameCap_def is_ArchObjectCap_def split: capability.split) @@ -89,18 +89,19 @@ lemma arch_capBadge_def2: "arch_capBadge acap = (if is_SMCCap acap then Some (capSMCBadge acap) else None)" by (cases acap; simp add: is_SMCCap_def) -end +lemmas CSpace_I_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I?: CSpace_I AARCH64.arch_capMasterCap AARCH64.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace_I_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_I_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I_2 locale *) (* for the Arch locale we want the fully expanded version covering all cases, but avoiding the capMasterCap_ArchObjectCap rewrite case for an unspecified ArchObjectCap *) @@ -110,7 +111,7 @@ lemmas capMasterCap_simps[simp] = capMasterCap_def[simplified arch_capMasterCap_def, split_simps capability.split arch_capability.split] -lemma isArchFrameCap_capMasterCap[CSpace_I_2_assms, simp]: +lemma isArchFrameCap_capMasterCap[Arch_assms, simp]: "isArchFrameCap (capMasterCap cap) = isArchFrameCap cap" by (simp add: isArchFrameCap_def split: capability.split arch_capability.split) @@ -142,7 +143,7 @@ lemmas arch_capMasterCap_eqDs[dest!] = arch_capMasterCap_eqDs1 arch_capMasterCap lemma capUntypedSize_capBits: "capClass cap = PhysicalClass \ capUntypedSize cap = 2 ^ (capBits cap)" - by (fastforce simp: global.capUntypedSize_def objBits_simps bit_simps' capUntypedSize_def + by (fastforce simp: global.capUntypedSize_def objBits_simps bit_simps' AARCH64_H.capUntypedSize_def split: capability.splits arch_capability.splits zombie_type.splits) lemma sameRegionAs_def2: @@ -218,7 +219,7 @@ lemma sameRegionAsE: \ \ R" by (simp add: sameRegionAs_def3, fastforce simp: gen_isCap_Master arch_isCap_Master) -lemma sameObjectAsE[CSpace_I_2_assms]: +lemma sameObjectAsE[Arch_assms]: "\ sameObjectAs cap cap'; \ capMasterCap cap = capMasterCap cap'; \ isNullCap cap; \ isZombie cap; \ isUntypedCap cap; @@ -229,7 +230,7 @@ lemma sameObjectAs_sameRegionAs: "sameObjectAs cap cap' \ sameRegionAs cap cap'" by (clarsimp simp add: sameObjectAs_def2 sameRegionAs_def2 isCap_simps) -lemma sameObjectAs_sym[CSpace_I_2_assms]: +lemma sameObjectAs_sym[Arch_assms]: "sameObjectAs c d = sameObjectAs d c" by (auto simp: sameObjectAs_def2) @@ -239,17 +240,17 @@ lemma sameObject_capRange: apply (clarsimp simp: sameObjectAs_def2) done -lemma sameRegionAs_Null[CSpace_I_2_assms, simp]: +lemma sameRegionAs_Null[Arch_assms, simp]: "sameRegionAs c NullCap = False" "sameRegionAs NullCap c = False" by (simp add: sameRegionAs_def3 capRange_def isCap_simps)+ -lemma sameRegionAs_classes[CSpace_I_2_assms]: +lemma sameRegionAs_classes[Arch_assms]: "sameRegionAs cap cap' \ capClass cap = capClass cap'" by (erule sameRegionAsE, rule master_eqI) (clarsimp simp: capRange_def isCap_simps intro!: capClass_Master split: if_split_asm)+ -lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: +lemma sameRegionAs_capRange_Int[Arch_assms]: "\ sameRegionAs cap cap'; capClass cap = PhysicalClass \ capClass cap' = PhysicalClass; capAligned cap; capAligned cap' \ \ capRange cap' \ capRange cap \ {}" @@ -261,26 +262,26 @@ lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: apply (fastforce simp: capRange_Master isCap_simps)+ done -lemma sameRegionAs_trans[CSpace_I_2_assms]: +lemma sameRegionAs_trans[Arch_assms]: "\ sameRegionAs a b; sameRegionAs b c \ \ sameRegionAs a c" by (simp add: sameRegionAs_def2, elim conjE disjE) (auto simp: isCap_simps capRange_def) (* long *) -lemma capMasterCap_maskCapRights[simp, CSpace_I_2_assms]: +lemma capMasterCap_maskCapRights[simp, Arch_assms]: "capMasterCap (maskCapRights msk cap) = capMasterCap cap" apply (cases cap; simp add: global.maskCapRights_def Let_def isCap_simps capMasterCap_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: AARCH64_H.maskCapRights_def Let_def isCap_simps) done -lemma capBadge_maskCapRights[simp, CSpace_I_2_assms]: +lemma capBadge_maskCapRights[simp, Arch_assms]: "capBadge (maskCapRights msk cap) = capBadge cap" apply (cases cap; simp add: global.maskCapRights_def Let_def gen_isCap_simps capBadge_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: AARCH64_H.maskCapRights_def Let_def isCap_simps) done -lemma cte_refs_capRange[CSpace_I_2_assms]: +lemma cte_refs_capRange[Arch_assms]: "\ s \' c; \irq. c \ IRQHandlerCap irq \ \ cte_refs' c x \ capRange c" apply (cases c; simp add: capRange_def gen_isCap_simps) apply (clarsimp dest!: valid_capAligned @@ -351,15 +352,15 @@ lemma cte_refs_capRange[CSpace_I_2_assms]: apply (simp add: word_bits_def) done -lemma capBits_Master[CSpace_I_2_assms]: +lemma capBits_Master[Arch_assms]: "capBits (capMasterCap cap) = capBits cap" by (clarsimp simp: capMasterCap_def split: capability.split arch_capability.split) -lemma capUntyped_Master[CSpace_I_2_assms]: +lemma capUntyped_Master[Arch_assms]: "capUntypedPtr (capMasterCap cap) = capUntypedPtr cap" by (clarsimp simp: capMasterCap_def AARCH64_H.capUntypedPtr_def split: capability.split arch_capability.split) -lemma distinct_zombies_copyMasterE[CSpace_I_2_assms]: +lemma distinct_zombies_copyMasterE[Arch_assms]: "\ distinct_zombies m; m x = Some cte; capClass (cteCap cte') = PhysicalClass \ capMasterCap (cteCap cte) = capMasterCap (cteCap cte'); @@ -381,19 +382,20 @@ lemmas distinct_zombies_sameMasterE = distinct_zombies_copyMasterE[where x=x and y=x for x, simplified, OF _ _ _] -declare distinct_zombies_sameMasterE[CSpace_I_2_assms] +declare distinct_zombies_sameMasterE[Arch_assms] -lemma cap_table_at_gsCNodes_eq[CSpace_I_2_assms]: +lemma cap_table_at_gsCNodes_eq[Arch_assms]: "(s, s') \ state_relation \ (gsCNodes s' ptr = Some bits) = cap_table_at bits ptr s" by (fastforce simp: state_relation_def ghost_relation_def obj_at_def is_cap_table) -end +lemmas CSpace_I_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I_2?: CSpace_I_2 AARCH64.arch_capMasterCap AARCH64.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace_I_2_assms)?)?) qed (* Arch constant definitions required to exist for sane locales in CSpace1_R *) diff --git a/proof/refine/AARCH64/ArchCSpace_R.thy b/proof/refine/AARCH64/ArchCSpace_R.thy index fc841d4fa8..db071e435a 100644 --- a/proof/refine/AARCH64/ArchCSpace_R.thy +++ b/proof/refine/AARCH64/ArchCSpace_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R locale *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = arch_deriveCap_corres arch_deriveCap_inv arch_deriveCap_valid (* does not work well as simp rule *) @@ -24,7 +24,7 @@ lemma capMasterCap_isArchSGISignalCap: by (auto simp: capMasterCap_def arch_capMasterCap_def isCap_simps split: capability.splits arch_capability.splits) -lemma capAligned_master[CSpace_R_assms]: +lemma capAligned_master[Arch_assms]: "\capAligned cap; capMasterCap cap = capMasterCap ncap\ \ capAligned ncap" apply (case_tac cap) apply (clarsimp simp: capAligned_def)+ @@ -42,7 +42,7 @@ sublocale updateCap: typ_at_props' "updateCap slot newCap" sublocale cteInsert: typ_at_props' "cteInsert newCap srcSlot destSlot" by typ_at_props' -lemma maskedAsFull_derived'[CSpace_R_assms]: +lemma maskedAsFull_derived'[Arch_assms]: "\m src = Some (CTE s_cap s_node); is_derived' m ptr b c\ \ is_derived' (m(src \ CTE (maskedAsFull s_cap cap) s_node)) ptr b c" apply (subgoal_tac "m(src \ CTE (maskedAsFull s_cap cap) s_node) @@ -57,37 +57,37 @@ lemma maskedAsFull_derived'[CSpace_R_assms]: apply (clarsimp simp:modify_map_def) done -lemma capMaster_capRange[CSpace_R_assms]: +lemma capMaster_capRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ capRange c = capRange c'" by (simp add: capMasterCap_def arch_capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_untypedRange[CSpace_R_assms]: +lemma capMaster_untypedRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ untypedRange c = untypedRange c'" by (simp add: capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_capClass[CSpace_R_assms]: +lemma capMaster_capClass[Arch_assms]: "capMasterCap c = capMasterCap c' \ capClass c = capClass c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma valid_arch_badges_mdbPrev_update[simp, CSpace_R_assms]: +lemma valid_arch_badges_mdbPrev_update[simp, Arch_assms]: "valid_arch_badges cap cap' (mdbPrev_update f node) = valid_arch_badges cap cap' node" by (simp add: valid_arch_badges_def) -lemma valid_arch_badges_master[CSpace_R_assms]: +lemma valid_arch_badges_master[Arch_assms]: "\ capMasterCap src_cap = capMasterCap cap; (capBadge src_cap, capBadge cap) \ capBadge_ordering False; valid_arch_badges src_cap cap' node \ \ valid_arch_badges cap cap' node" by (auto simp: valid_arch_badges_def isCap_simps) -lemma valid_arch_badges_firstBadged[CSpace_R_assms]: +lemma valid_arch_badges_firstBadged[Arch_assms]: "\ valid_arch_badges cap cap' node; mdbFirstBadged node = mdbFirstBadged node' \ \ valid_arch_badges cap cap' node'" by (simp add: valid_arch_badges_def) -lemma badge_derived'_capRange[CSpace_R_assms]: +lemma badge_derived'_capRange[Arch_assms]: "badge_derived' cap src_cap \ capRange cap = capRange src_cap" apply (clarsimp simp: badge_derived'_def) apply (case_tac cap; clarsimp simp: gen_isCap_simps capRange_def) @@ -95,11 +95,11 @@ lemma badge_derived'_capRange[CSpace_R_assms]: apply (case_tac arch_capability; clarsimp simp: isCap_simps capRange_def) done -lemma valid_arch_badges_non_arch[CSpace_R_assms]: +lemma valid_arch_badges_non_arch[Arch_assms]: "\ \isArchObjectCap c; \isArchObjectCap c' \ \ valid_arch_badges c c' node" by (clarsimp simp add: valid_arch_badges_def isCap_simps) -lemma capMasterCap_valid_arch_badges_isCapRevocable[CSpace_R_assms]: +lemma capMasterCap_valid_arch_badges_isCapRevocable[Arch_assms]: "capMasterCap src_cap = capMasterCap cap \ valid_arch_badges src_cap cap (MDB word1 src (Arch.isCapRevocable cap src_cap) (Arch.isCapRevocable cap src_cap))" @@ -110,7 +110,7 @@ lemma capMasterCap_valid_arch_badges_isCapRevocable[CSpace_R_assms]: apply (case_tac acap; clarsimp simp: isCap_simps) done -lemma setCTE_valid_arch[CSpace_R_assms, wp]: +lemma setCTE_valid_arch[Arch_assms, wp]: "setCTE p c \valid_arch_state'\" apply (wp valid_arch_state_lift' setCTE_typ_at') apply (simp add: setCTE_def) @@ -123,7 +123,7 @@ lemma setCTE_valid_arch[CSpace_R_assms, wp]: apply assumption done -lemma setCTE_global_refs[CSpace_R_assms, wp]: +lemma setCTE_global_refs[Arch_assms, wp]: "setCTE p c \\s. P (global_refs' s)\" apply (simp add: setCTE_def setObject_def split_def updateObject_cte global_refs'_def) apply (wpsimp+; auto) @@ -134,14 +134,14 @@ crunch cteInsert (wp: crunch_wps simp: cte_wp_at_ctes_of) crunch cteInsert - for valid_arch_state'[CSpace_R_assms, wp]: valid_arch_state' + for valid_arch_state'[Arch_assms, wp]: valid_arch_state' (wp: crunch_wps) -lemma acapClass_not_Reply[CSpace_R_assms]: +lemma acapClass_not_Reply[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) -lemma isArchMDBParentOf_non_arch[CSpace_R_assms]: +lemma isArchMDBParentOf_non_arch[Arch_assms]: "\isArchObjectCap cap \ isArchMDBParentOf cap cap' b" "\isArchObjectCap cap' \ isArchMDBParentOf cap cap' b" by (simp add: isArchMDBParentOf_def2 isCap_simps)+ @@ -310,29 +310,30 @@ context Arch begin arch_global_naming (* since these are not used after this theory, drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = Arch_mdb_insert.chunked_n[simplified Arch_mdb_insert_def] Arch_mdb_insert_sib.untyped_inc_n[simplified Arch_mdb_insert_sib_def] Arch_mdb_move.parent_preserved[simplified Arch_mdb_move_def] Arch_mdb_move.children_preserved[simplified Arch_mdb_move_def] -lemma cteInsert_pspace_in_kernel_mappings'[CSpace_R_assms]: +lemma cteInsert_pspace_in_kernel_mappings'[Arch_assms]: "cteInsert cap src dest \pspace_in_kernel_mappings'\" by wp -end +lemmas CSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R?: CSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_2 locale *) -lemma deriveCap_derived[CSpace_R_2_assms]: +lemma deriveCap_derived[Arch_assms]: "\\s. c'\ capability.NullCap \ cte_wp_at' (\cte. badge_derived' c' (cteCap cte) \ capASID c' = capASID (cteCap cte) \ cap_asid_base' c' = cap_asid_base' (cteCap cte) @@ -362,7 +363,7 @@ lemma deriveCap_derived[CSpace_R_2_assms]: | clarsimp split: option.split_asm)+) done -lemma arch_deriveCap_untyped_derived[CSpace_R_2_assms, wp]: +lemma arch_deriveCap_untyped_derived[Arch_assms, wp]: "\\s. cte_wp_at' (\cte. untyped_derived_eq c' (cteCap cte)) slot s\ AARCH64_H.deriveCap slot (capCap c') \\rv s. cte_wp_at' (untyped_derived_eq rv o cteCap) slot s\, -" @@ -404,7 +405,7 @@ crunch setupReplyMaster for valid_arch'[wp]: "valid_arch_state'" (wp: crunch_wps simp: crunch_simps) -lemma ex_nonz_tcb_cte_caps'[CSpace_R_2_assms]: +lemma ex_nonz_tcb_cte_caps'[Arch_assms]: "\ex_nonz_cap_to' t s; tcb_at' t s; valid_objs' s; sl \ dom tcb_cte_cases\ \ ex_cte_cap_to' (t + sl) s" apply (clarsimp simp: ex_nonz_cap_to'_def ex_cte_cap_to'_def cte_wp_at_ctes_of) @@ -431,7 +432,7 @@ lemma ex_nonz_cap_not_global': apply (clarsimp simp: ctes_of_valid_cap') done -lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: +lemma setupReplyMaster_invs'[Arch_assms, wp]: "\invs' and tcb_at' t and ex_nonz_cap_to' t\ setupReplyMaster t \\rv. invs'\" @@ -446,7 +447,7 @@ lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: ex_nonz_cap_not_global' dom_def) done -lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: +lemma arch_update_setCTE_mdb[Arch_assms]: "\cte_wp_at' (is_arch_update' cap) p and cte_wp_at' ((=) oldcte) p and valid_mdb'\ setCTE p (cteCap_update (\_. cap) oldcte) \\rv. valid_mdb'\" @@ -570,17 +571,17 @@ lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: apply (clarsimp simp add: is_arch_update'_def isCap_simps) done -lemma capMaster_zobj_refs[CSpace_R_2_assms]: +lemma capMaster_zobj_refs[Arch_assms]: "capMasterCap c = capMasterCap c' \ zobj_refs' c = zobj_refs' c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma zobj_refs_Master[CSpace_R_2_assms]: +lemma zobj_refs_Master[Arch_assms]: "zobj_refs' (capMasterCap cap) = zobj_refs' cap" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.split arch_capability.split) -lemma setCTE_pspace_in_kernel_mappings'[CSpace_R_2_assms]: +lemma setCTE_pspace_in_kernel_mappings'[Arch_assms]: "setCTE ptr val \pspace_in_kernel_mappings'\" by wp @@ -593,7 +594,7 @@ lemma valid_badges_IRQControlD: unfolding valid_badges_def by (fastforce simp: isCap_simps valid_arch_badges_def) -lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: +lemma setUntypedCapAsFull_safe_parent_for'[Arch_assms]: "\\s. safe_parent_for' (ctes_of s) slot a \ cte_wp_at' ((=) srcCTE) slot s\ setUntypedCapAsFull (cteCap srcCTE) c' slot \\rv s. safe_parent_for' (ctes_of s) slot a\" @@ -613,7 +614,7 @@ lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: apply simp done -lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: +lemma maskedAsFull_revokable_safe_parent[Arch_assms]: "\is_simple_cap' c'; safe_parent_for' m p c'; m p = Some cte; cteCap cte = (maskedAsFull src_cap' a)\ \ isCapRevocable c' (maskedAsFull src_cap' a) = isCapRevocable c' src_cap'" @@ -622,12 +623,12 @@ lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: apply (auto simp: isCap_simps is_simple_cap'_def) done -lemma setUntypedCapAsFull_archMDBAssertions[CSpace_R_2_assms, wp]: +lemma setUntypedCapAsFull_archMDBAssertions[Arch_assms, wp]: "setUntypedCapAsFull src_cap cap p \archMDBAssertions\" unfolding archMDBAssertions_def arch_mdb_assert_def by wp -lemma sameRegion_capRange_sub[CSpace_R_2_assms]: +lemma sameRegion_capRange_sub[Arch_assms]: "sameRegionAs cap cap' \ capRange cap' \ capRange cap" apply (clarsimp simp: sameRegionAs_def2 gen_isCap_Master arch_isCap_Master capRange_Master cong: conj_cong) @@ -635,7 +636,7 @@ lemma sameRegion_capRange_sub[CSpace_R_2_assms]: apply (fastforce simp: isCap_simps capRange_def split: if_split_asm) done -lemma capRange_sameRegionAs[CSpace_R_2_assms]: +lemma capRange_sameRegionAs[Arch_assms]: "\ sameRegionAs x y; s \' y; capClass x = PhysicalClass \ capClass y = PhysicalClass \ \ capRange x \ capRange y \ {}" apply (erule sameRegionAsE) @@ -652,7 +653,7 @@ lemma capRange_sameRegionAs[CSpace_R_2_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: +lemma safe_parent_for_capRange_capBits[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ capRange (cteCap cte) \ capBits cap \ capBits (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) @@ -662,7 +663,7 @@ lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: capMasterCap_def capRange_Master objBits_simps split: capability.splits arch_capability.splits) -lemma safe_parent_for_descendants'[CSpace_R_2_assms]: +lemma safe_parent_for_descendants'[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE pcap n); isUntypedCap pcap \ \ descendants_of' p m = {}" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) @@ -674,7 +675,7 @@ lemma safe_parent_not_ntfn': "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ \isNotificationCap src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) -lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_untypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ untypedRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -692,7 +693,7 @@ lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_capUntypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -707,14 +708,14 @@ lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_capClass[CSpace_R_2_assms]: +lemma safe_parent_capClass[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ capClass cap = capClass src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps sameRegionAs_def2 capRange_Master capRange_def capMasterCap_def split: capability.splits arch_capability.splits) (* Generic-only parts of is_simple_cap'. isArchFrameCap appears on all architectures and so is safe. *) -lemma is_simple_cap'_genD[CSpace_R_2_assms]: +lemma is_simple_cap'_genD[Arch_assms]: "is_simple_cap' cap \ cap \ NullCap \ cap \ IRQControlCap \ \ isUntypedCap cap \ \ isReplyCap cap \ \ isEndpointCap cap \ \ isNotificationCap cap \ \ isThreadCap cap \ \ isCNodeCap cap \ @@ -783,14 +784,15 @@ end context Arch begin arch_global_naming -lemmas [CSpace_R_2_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child +lemmas [Arch_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child -end +lemmas CSpace_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_2?: CSpace_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace_R_2_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales @@ -1124,17 +1126,17 @@ end (* Arch_mdb_insert_simple' *) context Arch begin arch_global_naming -named_theorems CSpace_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_3 locale *) (* since mdb_insert_simple' is not used after this theory, drop the Arch assumption directly instead of requalifying *) -lemmas [CSpace_R_3_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] +lemmas [Arch_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] -lemmas [CSpace_R_3_assms] = +lemmas [Arch_assms] = updateCap_valid_arch_state' master_cap_relation -lemma derived'_not_Null[CSpace_R_3_assms, simp]: +lemma derived'_not_Null[Arch_assms, simp]: "\ is_derived' m p c capability.NullCap" "\ is_derived' m p capability.NullCap c" by (clarsimp simp: is_derived'_def badge_derived'_def)+ @@ -1147,7 +1149,7 @@ lemma cte_refs_maskCapRights[simp]: split del: if_split split: arch_capability.split) -lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: +lemma ghost_relation_wrapper_set_cap_setCTE[Arch_assms]: "\ ghost_relation_wrapper a c; ((), c') \ fst (setCTE (cte_map slot) (cteCap_update (\_. cap') rv) c); ((), a') \ fst (set_cap cap slot a)\ @@ -1159,16 +1161,17 @@ lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: apply (rule use_valid[OF _ setCTE_arch]; simp) done -lemma updateMDB_pspace_in_kernel_mappings'[CSpace_R_3_assms]: +lemma updateMDB_pspace_in_kernel_mappings'[Arch_assms]: "updateMDB x f \pspace_in_kernel_mappings'\" by wp -end +lemmas CSpace_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_3?: CSpace_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.CSpace_R_3_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales diff --git a/proof/refine/AARCH64/ArchDetype_R.thy b/proof/refine/AARCH64/ArchDetype_R.thy index 4d6b68f460..02b4fbc330 100644 --- a/proof/refine/AARCH64/ArchDetype_R.thy +++ b/proof/refine/AARCH64/ArchDetype_R.thy @@ -267,7 +267,7 @@ end (* detype_locale' *) context Arch begin arch_global_naming -named_theorems Detype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R locale *) lemma vmid_for_asid'_detype: assumes table: @@ -303,7 +303,7 @@ lemma freeMemory_invs: (* FIXME: is_aligned base magnitude; magnitude \ word_size_bits: both already follow from valid_cap in the abstract precondition *) -lemma deleteObjects_corres[Detype_R_assms]: +lemma deleteObjects_corres[Arch_assms]: "\ is_aligned base magnitude; magnitude \ word_size_bits \ \ corres dc (\s. einvs s @@ -483,7 +483,7 @@ context Arch begin arch_global_naming Not all of them need to deal with these arch details, so if the def2/def3 lemmas can be generalised or wrapped, some of the lemmas in this block can become generic. *) -lemma deleteObjects_null_filter[Detype_R_assms]: +lemma deleteObjects_null_filter[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -503,7 +503,7 @@ lemma deleteObjects_null_filter[Detype_R_assms]: apply (unfold_locales, simp_all) done -lemma deleteObjects_invs'[Detype_R_assms]: +lemma deleteObjects_invs'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -535,7 +535,7 @@ proof - done qed -lemma deleteObjects_st_tcb_at'[Detype_R_assms]: +lemma deleteObjects_st_tcb_at'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -590,7 +590,7 @@ lemma deleteObjects_cap_to': apply (simp add: delete_locale_def) done -lemma deleteObject_no_overlap[Detype_R_assms, wp]: +lemma deleteObject_no_overlap[Arch_assms, wp]: "\valid_cap' (UntypedCap d ptr bits idx) and valid_pspace'\ deleteObjects ptr bits \\_ s. pspace_no_overlap' ptr bits s\" @@ -609,7 +609,7 @@ lemma deleteObject_no_overlap[Detype_R_assms, wp]: apply simp done -lemma deleteObjects_cte_wp_at'[Detype_R_assms]: +lemma deleteObjects_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ p \ mask_range ptr bits \ s \' (UntypedCap d ptr bits idx) \ valid_pspace' s\ deleteObjects ptr bits @@ -628,13 +628,13 @@ lemma deleteObjects_cte_wp_at'[Detype_R_assms]: apply (case_tac s, simp) done -lemma deleteObjects_nosch[wp, Detype_R_assms]: +lemma deleteObjects_nosch[wp, Arch_assms]: "deleteObjects ptr sz \\s. P (ksSchedulerAction s)\" by (simp add: deleteObjects_def3 | wp hoare_drop_imp)+ lemmas getObjSize_simps = AARCH64_H.getObjectSize_def[split_simps AARCH64_H.object_type.split apiobject_type.split] -lemma createObject_cte_wp_at'[Detype_R_assms]: +lemma createObject_cte_wp_at'[Arch_assms]: "\\s. Types_H.getObjectSize ty us < word_bits \ is_aligned ptr (Types_H.getObjectSize ty us) \ pspace_no_overlap' ptr (Types_H.getObjectSize ty us) s \ @@ -850,7 +850,7 @@ crunch updatePTType and pspace_aligned'[wp]: pspace_aligned' and pspace_distinct'[wp]: pspace_distinct' -lemma createObject_setCTE_commute[Detype_R_assms]: +lemma createObject_setCTE_commute[Arch_assms]: "monad_commute (cte_wp_at' (\_. True) src and pspace_aligned' and pspace_distinct' and @@ -932,7 +932,7 @@ lemma monad_commute_gsUntyped_updatePTType: apply fastforce done -lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: +lemma createObject_gsUntypedZeroRanges_commute[Arch_assms]: "monad_commute \ (RetypeDecls_H.createObject ty ptr us dev) @@ -955,26 +955,27 @@ lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: apply (simp add: curDomain_def monad_commute_def exec_modify exec_gets) done -lemma createNewCaps_not_nc[Detype_R_assms]: +lemma createNewCaps_not_nc[Arch_assms]: "\\\ createNewCaps ty ptr n us d \\r s. (\cap\set r. cap \ capability.NullCap)\" unfolding createNewCaps_def Arch_createNewCaps_def by (wpsimp simp: Arch_createNewCaps_def split_del: if_split)+ +lemmas Detype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R?: Detype_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Detype_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Detype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R_2 locale *) -lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: +lemma createNewCaps_pspace_no_overlap'[Arch_assms]: "\\s. range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n)) \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ ptr \ 0\ @@ -1026,7 +1027,7 @@ lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: | assumption | clarsimp simp: word_bits_def | intro conjI range_cover_le[where n = "Suc n"] range_cover.aligned)+) -lemma createNewCaps_ret_len[Detype_R_2_assms]: +lemma createNewCaps_ret_len[Arch_assms]: "\K (n < 2 ^ word_bits \ n \ 0)\ createNewCaps ty ptr n us d \\rv s. n = length rv\" @@ -1048,7 +1049,7 @@ lemma createNewCaps_ret_len[Detype_R_2_assms]: | intro conjI impI)+)+ done -lemma createNewCaps_Cons[Detype_R_2_assms]: +lemma createNewCaps_Cons[Arch_assms]: assumes cover:"range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n))" and "valid_pspace' s" "valid_arch_state' s" and "pspace_no_overlap' ptr sz s" @@ -1352,7 +1353,7 @@ proof - done qed -lemma createObject_def2[Detype_R_2_assms]: +lemma createObject_def2[Arch_assms]: "(RetypeDecls_H.createObject ty ptr us dev >>= (\x. return [x])) = createNewCaps ty ptr (Suc 0) us dev" apply (clarsimp simp: global.createObject_def createNewCaps_def placeNewObject_def2) @@ -1375,7 +1376,7 @@ lemma createObject_def2[Detype_R_2_assms]: crunch updatePTType for pspace_no_overlap'[wp]: "pspace_no_overlap' p n" -lemma ArchCreateObject_pspace_no_overlap'[Detype_R_2_assms]: +lemma ArchCreateObject_pspace_no_overlap'[Arch_assms]: "\\s. pspace_no_overlap' (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \ pspace_aligned' s \ pspace_distinct' s \ @@ -1451,12 +1452,13 @@ lemma createObject_pspace_aligned_distinct': split: AARCH64_H.object_type.splits apiobject_type.splits) done +lemmas Detype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R_2?: Detype_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Detype_R_2_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchEmptyFail.thy b/proof/refine/AARCH64/ArchEmptyFail.thy index 6aa4c59116..ccf504b049 100644 --- a/proof/refine/AARCH64/ArchEmptyFail.thy +++ b/proof/refine/AARCH64/ArchEmptyFail.thy @@ -10,21 +10,22 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_R locale *) -lemma empty_fail_lookupIPCBuffer[EmptyFail_R_assms]: +lemma empty_fail_lookupIPCBuffer[Arch_assms]: "empty_fail (lookupIPCBuffer r t)" by (clarsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv split: capability.splits arch_capability.splits | wp | wpc | safe)+ declare setRegister_empty_fail[intro!, simp] (* FIXME: tag original instead *) -end +lemmas EmptyFail_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation EmptyFail_R?: EmptyFail_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact EmptyFail_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.EmptyFail_R_assms)?) qed end diff --git a/proof/refine/AARCH64/ArchEmptyFail_H.thy b/proof/refine/AARCH64/ArchEmptyFail_H.thy index 5b8f5fc9dc..7006b8577a 100644 --- a/proof/refine/AARCH64/ArchEmptyFail_H.thy +++ b/proof/refine/AARCH64/ArchEmptyFail_H.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H locale *) -lemma arch_deriveCap_empty_fail[EmptyFail_H_assms, intro!, wp, simp]: +lemma arch_deriveCap_empty_fail[Arch_assms, intro!, wp, simp]: "empty_fail (Arch.deriveCap x y)" unfolding AARCH64_H.deriveCap_def by (cases y, auto simp: isCap_simps cong: if_cong) @@ -57,7 +57,7 @@ lemma empty_fail_pt_type_exhausted: by (case_tac pt_t; simp) crunch decodeARMMMUInvocation, Arch_postCapDeletion, setRegister, prepareThreadDelete - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def pteAtIndex_def wp: empty_fail_catch empty_fail_pt_type_exhausted empty_fail_arch_cap_exhausted rule: AARCH64_H.postCapDeletion_def) @@ -73,7 +73,7 @@ lemma empty_fail_lookupPTFromLevel[intro!, wp, simp]: crunch Arch_finaliseCap, Arch.switchToThread, Arch.switchToIdleThread, prepareNextDomain, getRestartPC, makeArchFaultMessage - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (rule: AARCH64_H.finaliseCap_def) crunch @@ -83,32 +83,34 @@ crunch handleArchFaultReply, prepareSetDomain, postModifyRegisters, postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler, Arch.performInvocation, handleSpuriousIRQ, maskIrqSignal, handleVMFault, checkIRQ, prepareThreadDelete, Arch.postCapDeletion - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H?: EmptyFail_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.EmptyFail_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems EmptyFail_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H_2 locale *) crunch handleReservedIRQ, handleHypervisorFault - for (empty_fail) empty_fail[EmptyFail_H_2_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H_2?: EmptyFail_H_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.EmptyFail_H_2_assms)?)?) qed crunch callKernel diff --git a/proof/refine/AARCH64/ArchFinalise_R.thy b/proof/refine/AARCH64/ArchFinalise_R.thy index d406d33b96..839842ce1b 100644 --- a/proof/refine/AARCH64/ArchFinalise_R.thy +++ b/proof/refine/AARCH64/ArchFinalise_R.thy @@ -12,13 +12,13 @@ begin context Arch begin arch_global_naming -named_theorems Finalise_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R locale *) lemma isArchSGISignalCap_NullCap[simp]: "\isArchSGISignalCap NullCap" by (simp add: isCap_simps) -lemma arch_postCapDeletion_ksArchState_lift[Finalise_R_assms]: +lemma arch_postCapDeletion_ksArchState_lift[Arch_assms]: "\\s as. P (s\ksArchState := as\) = P s\ \ Arch.postCapDeletion ac \P\" unfolding postCapDeletion_def by wpsimp @@ -27,7 +27,7 @@ sublocale clearUntypedFreeIndex: typ_at_props' "clearUntypedFreeIndex slot" by typ_at_props' crunch setIRQState - for umm[Finalise_R_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" + for umm[Arch_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" (wp: dmo_lift') (* better crunch names for Arch.postCapDeletion *) @@ -39,7 +39,7 @@ crunch Arch_postCapDeletion and valid_arch_state'[wp]: valid_arch_state' (rule: AARCH64_H.postCapDeletion_def) -lemma arch_postCapDeletion_corres[Finalise_R_assms]: +lemma arch_postCapDeletion_corres[Arch_assms]: "acap_relation cap cap' \ corres dc \ \ (arch_post_cap_deletion cap) (AARCH64_H.postCapDeletion cap')" by (clarsimp simp: arch_post_cap_deletion_def AARCH64_H.postCapDeletion_def) @@ -48,16 +48,16 @@ abbreviation (input) "Arch_finaliseCap \ Arch.finaliseCap" crunch Arch_finaliseCap, prepareThreadDelete - for typ_at'[Finalise_R_assms, wp]: "\s. P (typ_at' T p s)" - and aligned'[Finalise_R_assms, wp]: "pspace_aligned'" - and distinct'[Finalise_R_assms, wp]: "pspace_distinct'" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" + and aligned'[Arch_assms, wp]: "pspace_aligned'" + and distinct'[Arch_assms, wp]: "pspace_distinct'" (wp: crunch_wps getObject_inv loadObject_default_inv simp: crunch_simps unless_def o_def ignore_del: setObject rule: AARCH64_H.finaliseCap_def) crunch prepareThreadDelete, Arch_finaliseCap - for it'[Finalise_R_assms, wp]: "\s. P (ksIdleThread s)" + for it'[Arch_assms, wp]: "\s. P (ksIdleThread s)" (wp: hoare_drop_imps simp: crunch_simps updateObject_default_def rule: AARCH64_H.finaliseCap_def) @@ -79,6 +79,8 @@ definition post_cap_delete_pre' :: "capability \ paddr \ IRQHandlerCap irq \ irq \ maxIRQ \ (\sl'. sl \ sl' \ cs sl' \ Some cap) | _ \ False" +lemmas Finalise_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -423,15 +425,14 @@ end (* mdb_empty *) interpretation Finalise_R?: Finalise_R arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Finalise_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Finalise_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_2 locale *) -lemma not_Final_removeable[Finalise_R_2_assms]: +lemma not_Final_removeable[Arch_assms]: "\ isFinal cap sl (cteCaps_of s) \ removeable' sl s cap" apply (erule not_FinalE) apply (clarsimp simp: removeable'_def gen_isCap_simps) @@ -440,7 +441,7 @@ lemma not_Final_removeable[Finalise_R_2_assms]: apply fastforce done -lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: +lemma deletedIRQHandler_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ deletedIRQHandler irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -454,7 +455,7 @@ lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: apply (clarsimp simp: valid_refs'_cteCaps valid_cap_sizes_cteCaps ball_ran_eq) done -lemma clearUntypedFreeIndex_valid_global_refs[Finalise_R_2_assms, wp]: +lemma clearUntypedFreeIndex_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ clearUntypedFreeIndex irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -500,7 +501,7 @@ lemma final_matters_mdb_chunked_arch_assms: by (clarsimp simp: mdb_chunked_arch_assms_def isCap_simps final_matters'_def arch_final_matters'_def) -lemma notFinal_prev_or_next[Finalise_R_2_assms]: +lemma notFinal_prev_or_next[Arch_assms]: "\ \ isFinal cap x (cteCaps_of s); mdb_chunked (ctes_of s); valid_dlist (ctes_of s); no_0 (ctes_of s); ctes_of s x = Some (CTE cap node); final_matters' cap \ @@ -547,12 +548,12 @@ lemma notFinal_prev_or_next[Finalise_R_2_assms]: apply (clarsimp simp: sameObjectAs_def3 simp del: isArchFrameCap_capMasterCap) done -lemma sameObjectAs_not_Untyped[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap \ \ \ isUntypedCap cap'" by (clarsimp simp: gen_isCap_simps sameObjectAs_def3) -lemma sameObjectAs_not_Untyped'[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped'[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap' \ \ global.sameObjectAs cap' cap" by (clarsimp simp: isCap_simps sameObjectAs_def3) @@ -604,7 +605,7 @@ lemma (in vmdb) isFinal_untypedParent: context Arch begin arch_global_naming -lemma isFinal_no_descendants[Finalise_R_2_assms]: +lemma isFinal_no_descendants[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); ctes_of s sl = Some (CTE cap n); valid_mdb' s; final_matters' cap \ \ descendants_of' sl (ctes_of s) = {}" @@ -938,7 +939,7 @@ lemma dissociateVCPUTCB_invs'[wp]: lemma vcpuFinalise_invs'[wp]: "vcpuFinalise vcpu \invs'\" unfolding vcpuFinalise_def by wpsimp -lemma arch_finaliseCap_invs[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_invs[Arch_assms, wp]: "\invs' and valid_cap' (ArchObjectCap cap)\ Arch.finaliseCap cap fin \\rv. invs'\" unfolding AARCH64_H.finaliseCap_def Let_def by wpsimp @@ -1041,16 +1042,16 @@ sublocale dissociateVCPUTCB: typ_at_props' "dissociateVCPUTCB v t" by typ_at_props' crunch Arch.finaliseCap, prepareThreadDelete - for irq_node'[Finalise_R_2_assms, wp]: "\s. P (irq_node' s)" + for irq_node'[Arch_assms, wp]: "\s. P (irq_node' s)" (wp: crunch_wps getObject_inv loadObject_default_inv updateObject_default_inv setObject_ksInterrupt simp: crunch_simps o_def) -lemmas Arch_finaliseCap_irq_node'[Finalise_R_2_assms] = ArchRetypeDecls_H_AARCH64_H_finaliseCap_irq_node' +lemmas Arch_finaliseCap_irq_node'[Arch_assms] = ArchRetypeDecls_H_AARCH64_H_finaliseCap_irq_node' crunch prepareThreadDelete - for cte_wp_at'[Finalise_R_2_assms, wp]: "cte_wp_at' P p" - and valid_cap'[Finalise_R_2_assms, wp]: "valid_cap' cap" + for cte_wp_at'[Arch_assms, wp]: "cte_wp_at' P p" + and valid_cap'[Arch_assms, wp]: "valid_cap' cap" lemma unset_vcpu_hyp_unlive[wp]: "\\\ archThreadSet (atcbVCPUPtr_update Map.empty) t \\_. ko_wp_at' (Not \ hyp_live') t\" @@ -1102,7 +1103,7 @@ lemma prepareThreadDelete_hyp_unlive[wp]: done crunch prepareThreadDelete - for invs[Finalise_R_2_assms, wp]: "invs'" + for invs[Arch_assms, wp]: "invs'" (ignore: doMachineOp simp: crunch_simps) lemma archThreadSet_tcbSchedPrevNext[wp]: @@ -1141,35 +1142,36 @@ crunch vcpuFinalise for cte_wp_at'[wp]: "cte_wp_at' P p" (wp: crunch_wps getObject_inv loadObject_default_inv) -lemma arch_finaliseCap_cte_wp_at[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cte_wp_at[Arch_assms, wp]: "\cte_wp_at' P p\ Arch.finaliseCap cap fin \\rv. cte_wp_at' P p\" apply (simp add: AARCH64_H.finaliseCap_def) apply (wpsimp wp: unmapPage_cte_wp_at') done -lemma finaliseCap_valid_cap[Finalise_R_2_assms, wp]: +lemma finaliseCap_valid_cap[Arch_assms, wp]: "\\\ Arch.finaliseCap cap final \\rv. valid_cap' (fst rv)\" by (wpsimp simp: AARCH64_H.finaliseCap_def) -lemma arch_finaliseCap_cases[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cases[Arch_assms, wp]: "\\\ Arch.finaliseCap v0 final \\rv s. fst rv = capability.NullCap \ (snd rv \ capability.NullCap \ final \ arch_cap_has_cleanup' v0 \ snd rv = capability.ArchObjectCap v0)\" by (wpsimp simp: AARCH64_H.finaliseCap_def) -lemmas [Finalise_R_2_assms] = +lemmas [Arch_assms] = cancelAllIPC_cte_wp_at' cancelAllSignals_cte_wp_at' unbindMaybeNotification_cte_wp_at' prepareThreadDelete_cte_wp_at' unbindNotification_cte_wp_at' Arch_postCapDeletion_valid_global_refs Arch_postCapDeletion_valid_arch_state' mdb_empty.vmdb_n mdb_empty.descendants not_Final_removeable +lemmas Finalise_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Finalise_R_2?: Finalise_R_2 arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Finalise_R_2_assms)?)?) qed (* This is the only arch-specific lemma in delete_one_conc_pre so far; @@ -1236,13 +1238,13 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable: context Arch begin arch_global_naming -named_theorems Finalise_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_3 locale *) -lemma finaliseCap_cte_refs[Finalise_R_3_assms]: +lemma finaliseCap_cte_refs[Arch_assms]: "\\s. s \' cap\ finaliseCap cap final flag \\rv s. fst rv \ NullCap \ cte_refs' (fst rv) = cte_refs' cap\" - apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot finaliseCap_def + apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot AARCH64_H.finaliseCap_def cong: if_cong split del: if_split) apply (rule hoare_pre) apply (wp | wpc | simp only: o_def)+ @@ -1255,7 +1257,7 @@ lemma finaliseCap_cte_refs[Finalise_R_3_assms]: apply (fastforce simp: mask_def capAligned_def gen_objBits_simps shiftL_nat) done -lemma emptySlot_invs'[Finalise_R_3_assms, wp]: +lemma emptySlot_invs'[Arch_assms, wp]: "\\s. invs' s \ cte_wp_at' (\cte. removeable' sl s (cteCap cte)) sl s \ (info \ NullCap \ post_cap_delete_pre' info sl (cteCaps_of s))\ emptySlot sl info @@ -1266,7 +1268,7 @@ lemma emptySlot_invs'[Finalise_R_3_assms, wp]: split: capability.split_asm) by auto -lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: +lemma cteDeleteOne_invs[Arch_assms, wp]: "cteDeleteOne ptr \invs'\" apply (simp add: cteDeleteOne_def unless_def split_def finaliseCapTrue_standin_simple_def) @@ -1287,7 +1289,7 @@ lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: apply (fastforce simp: cte_wp_at_ctes_of) done -lemma isFinalCapability_corres'[Finalise_R_3_assms]: +lemma isFinalCapability_corres'[Arch_assms]: "final_matters' (cteCap cte) \ corres (=) (invs and cte_wp_at ((=) cap) ptr) (invs' and cte_wp_at' ((=) cte) (cte_map ptr)) @@ -1383,7 +1385,7 @@ crunch dissociateVCPUTCB, unmapPageTable crunch Arch_finaliseCap, prepareThreadDelete for nosch[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Finalise_R_3_assms, wp]: sch_act_simple + and sch_act_simple[Arch_assms, wp]: sch_act_simple (wp: crunch_wps getObject_inv simp: loadObject_default_def updateObject_default_def rule: AARCH64_H.finaliseCap_def sch_act_simple_lift cong: if_cong) @@ -1418,7 +1420,7 @@ lemma vcpuFinalise_corres[corres]: apply (fastforce elim: vcpu_at_cross) done -lemma arch_finaliseCap_corres[Finalise_R_3_assms]: +lemma arch_finaliseCap_corres[Arch_assms]: "\ final_matters' (ArchObjectCap cap') \ final = final'; acap_relation cap cap' \ \ corres (\r r'. cap_relation (fst r) (fst r') \ cap_relation (snd r) (snd r')) (\s. invs s \ s \ cap.ArchObjectCap cap @@ -1443,14 +1445,15 @@ lemma arch_finaliseCap_corres[Finalise_R_3_assms]: sublocale deleteCallerCap: typ_at_props' "deleteCallerCap receiver" by typ_at_props' +lemmas Finalise_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts post_cap_delete_pre' interpretation Finalise_R_3?: Finalise_R_3 arch_final_matters' arch_cap_has_cleanup' post_cap_delete_pre' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Finalise_R_3_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchInit_R.thy b/proof/refine/AARCH64/ArchInit_R.thy index 8055e80803..f632d0a1f0 100644 --- a/proof/refine/AARCH64/ArchInit_R.thy +++ b/proof/refine/AARCH64/ArchInit_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Init_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Init_R locale *) definition zeroed_arch_abstract_state :: arch_state where "zeroed_arch_abstract_state \ \ @@ -33,23 +33,24 @@ definition zeroed_arch_intermediate_state :: Arch.kernel_state where Map.empty 0 0 None 0 Map.empty None" (* the None maps are a result of unfolding zeroed_main_abstract_state *) -lemma ghost_relation_wrapper_arch_intermediate_state[Init_R_assms]: +lemma ghost_relation_wrapper_arch_intermediate_state[Arch_assms]: "ghost_relation_wrapper_2 (\_. None) (\_. None) (\_. None) zeroed_arch_intermediate_state" unfolding ghost_relation_wrapper_def ghost_relation_def zeroed_arch_intermediate_state_def by simp -lemma non_empty_refine_arch_state_relation[Init_R_assms]: +lemma non_empty_refine_arch_state_relation[Arch_assms]: "(zeroed_arch_abstract_state, zeroed_arch_intermediate_state) \ arch_state_relation Map.empty" unfolding zeroed_arch_abstract_state_def zeroed_arch_intermediate_state_def arch_state_relation_def by (simp add: vmid_for_asid_2'_def obind_def) +lemmas Init_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Init_R?: Init_R AARCH64.zeroed_arch_abstract_state AARCH64.zeroed_arch_intermediate_state proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Init_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Init_R_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchInterrupt_R.thy b/proof/refine/AARCH64/ArchInterrupt_R.thy index 5240d0e969..f22fcc5a17 100644 --- a/proof/refine/AARCH64/ArchInterrupt_R.thy +++ b/proof/refine/AARCH64/ArchInterrupt_R.thy @@ -13,17 +13,17 @@ begin context Arch begin arch_global_naming -named_theorems Interrupt_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R locale *) -lemma maxIRQ_H_ucast_toEnum_eq_irq[Interrupt_R_assms]: +lemma maxIRQ_H_ucast_toEnum_eq_irq[Arch_assms]: "x \ ucast maxIRQ \ toEnum (unat x) = (ucast x :: irq)" for x::machine_word by (simp add: maxIRQ_ucast_toEnum_eq_irq maxIRQ_def) -lemma arch_valid_irq_le_maxIRQ[Interrupt_R_assms]: +lemma arch_valid_irq_le_maxIRQ[Arch_assms]: "arch_valid_irq irq \ irq \ maxIRQ" by simp -lemma arch_valid_irq_valid_IRQHandlerCap[Interrupt_R_assms]: +lemma arch_valid_irq_valid_IRQHandlerCap[Arch_assms]: "arch_valid_irq irq \ valid_cap' (capability.IRQHandlerCap irq) s" by (simp add: valid_cap'_def capAligned_def) @@ -46,7 +46,7 @@ primrec arch_irq_control_inv_valid' :: "Arch.irqcontrol_invocation \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) src_slot and ex_cte_cap_to' sgi_slot and real_cte_at' sgi_slot)" -lemma checkIRQ_corres[Interrupt_R_assms]: +lemma checkIRQ_corres[Arch_assms]: "corres (ser \ dc) \ \ (arch_check_irq irq) (Arch.checkIRQ irq)" unfolding arch_check_irq_def checkIRQ_def by (clarsimp simp: minIRQ_def maxIRQ_def whenE_rangeCheck_eq whenE_def returnOk_def split: if_split) @@ -54,7 +54,7 @@ lemma checkIRQ_corres[Interrupt_R_assms]: lemmas irq_const_defs = minIRQ_def crunch arch_check_irq, checkIRQ - for inv[Interrupt_R_assms]: "P" + for inv[Arch_assms]: "P" (simp: crunch_simps) lemma arch_check_irq_valid: @@ -62,11 +62,11 @@ lemma arch_check_irq_valid: unfolding arch_check_irq_def by (wpsimp simp: validE_R_def not_less word_le_nat_alt maxIRQ_def wp: whenE_throwError_wp) -lemma arch_check_irq_valid'[Interrupt_R_assms]: +lemma arch_check_irq_valid'[Arch_assms]: "\\\ arch_check_irq irq \\_ _. irq \ ucast maxIRQ\, \\_. \\" by (wp arch_check_irq_valid) -lemma checkIRQ_irq_valid[Interrupt_R_assms]: +lemma checkIRQ_irq_valid[Arch_assms]: "\\\ checkIRQ irq \\_ _. arch_valid_irq (toEnum (unat irq))\, -" unfolding checkIRQ_def rangeCheck_def validE_R_def supply hoare_vcg_prop[wp del] @@ -91,7 +91,7 @@ lemma sgi_irq_cast: by (simp flip: sgi_irq_len_def add: ucast_ucast_len sgi_irq_len_val word_le_nat_alt word_less_nat_alt) -lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: +lemma arch_decodeIRQControlInvocation_corres[Arch_assms]: "list_all2 cap_relation caps caps' \ corres (ser \ arch_irq_control_inv_relation) (invs and (\s. \cp \ set caps. s \ cp)) @@ -138,7 +138,7 @@ lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: apply (auto split: arch_invocation_label.splits invocation_label.splits) done -lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: +lemma arch_decode_irq_control_valid'[Arch_assms, wp]: "\\s. invs' s \ (\cap \ set caps. s \' cap) \ (\cap \ set caps. \r \ cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) slot s\ @@ -160,12 +160,12 @@ lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: done crunch Arch.decodeIRQControlInvocation - for inv[Interrupt_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps wp: crunch_wps) -lemmas [Interrupt_R_assms] = arch_check_irq_inv +lemmas [Arch_assms] = arch_check_irq_inv -lemma irq_node_in_global_refs'[Interrupt_R_assms]: +lemma irq_node_in_global_refs'[Arch_assms]: "Invariants_H.irq_node' s + (ucast irq << cteSizeBits) \ global_refs' s" for irq :: irq by (simp add: global_refs'_def) @@ -174,13 +174,13 @@ lemma no_fail_deactivateInterrupt[wp, simp]: unfolding deactivateInterrupt_def by wpsimp -lemma arch_invokeIRQHandler_corres[Interrupt_R_assms]: +lemma arch_invokeIRQHandler_corres[Arch_assms]: "irq_handler_inv_relation i i' \ corres dc \ \ (arch_invoke_irq_handler i) (Arch.invokeIRQHandler i')" by (cases i; clarsimp simp: invokeIRQHandler_def theIRQ_def) (intro conjI impI; rule corres_machine_op, rule corres_Id; simp?) -lemma is_derived'_NotificationCap[Interrupt_R_assms]: +lemma is_derived'_NotificationCap[Arch_assms]: "\isNotificationCap cap; isNotificationCap cap'\ \ is_derived' ctes src cap' cap = badge_derived' cap' cap" by (clarsimp simp add: is_derived'_def gen_isCap_simps) @@ -211,7 +211,7 @@ lemma SGISignalCap_valid[simp, intro!]: "valid_cap' (ArchObjectCap (SGISignalCap irq target)) s" by (simp add: valid_cap'_def capAligned_def word_bits_def) -lemma arch_performIRQControl_corres[Interrupt_R_assms]: +lemma arch_performIRQControl_corres[Arch_assms]: "arch_irq_control_inv_relation ivk ivk' \ corres (dc \ dc) (einvs and arch_irq_control_inv_valid ivk) (invs' and arch_irq_control_inv_valid' ivk') @@ -245,11 +245,11 @@ lemma arch_performIRQControl_corres[Interrupt_R_assms]: apply (rename_tac cte', case_tac cte', simp add: isCap_simps) done -lemma is_simple_cap'_IRQHandlerCap[Interrupt_R_assms]: +lemma is_simple_cap'_IRQHandlerCap[Arch_assms]: "isIRQHandlerCap cap \ is_simple_cap' cap" by (clarsimp simp: isCap_simps is_simple_cap'_def) -lemma sameRegionAs_IRQControl_handler[Interrupt_R_assms, simp]: +lemma sameRegionAs_IRQControl_handler[Arch_assms, simp]: "global.sameRegionAs capability.IRQControlCap (capability.IRQHandlerCap irq)" by (simp add: sameRegionAs_def3 isCap_simps) @@ -262,7 +262,7 @@ lemma dmo_setIRQTrigger_invs'[wp]: apply (wpsimp simp: setIRQTrigger_def machine_op_lift_def machine_rest_lift_def split_def)+ done -lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: +lemma arch_invoke_irq_control_invs'[Arch_assms, wp]: "\invs' and arch_irq_control_inv_valid' i\ Arch.performIRQControl i \\rv. invs'\" apply (simp add: AARCH64_H.performIRQControl_def) apply (rule hoare_pre) @@ -458,7 +458,7 @@ lemma vppiEvent_corres: apply (simp add: tcb_at_invs') done -lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: +lemma handle_reserved_irq_corres[Arch_assms, corres]: "corres dc einvs (\s. invs' s \ (irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)) (handle_reserved_irq irq) (handleReservedIRQ irq)" @@ -472,12 +472,12 @@ lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: apply (fastforce intro: vgic_maintenance_corres simp: unat_arith_simps)+ done -lemma maskIrqSignal_corres[Interrupt_R_assms, corres]: +lemma maskIrqSignal_corres[Arch_assms, corres]: "corres dc \ \ (arch_mask_irq_signal irq) (Arch.maskIrqSignal irq)" unfolding arch_mask_irq_signal_def maskIrqSignal_def when_def by (corres corres: corres_machine_op) -lemma dmo_ackInterrupt_corres[Interrupt_R_assms, corres]: +lemma dmo_ackInterrupt_corres[Arch_assms, corres]: "corres dc \ \ (do_machine_op (ackInterrupt irq)) (doMachineOp (ackInterrupt irq))" by (corres corres: corres_machine_op) @@ -543,10 +543,10 @@ lemma vppiEvent_invs'[wp]: done crunch maskIrqSignal - for invs'[Interrupt_R_assms]: invs' + for invs'[Arch_assms]: invs' (wp: dmo_maskInterrupt_True ignore: doMachineOp) -lemma handleReservedIRQ_invs'[Interrupt_R_assms]: +lemma handleReservedIRQ_invs'[Arch_assms]: "\invs' and (\s. irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)\ handleReservedIRQ irq \\_. invs'\" @@ -555,30 +555,32 @@ lemma handleReservedIRQ_invs'[Interrupt_R_assms]: non_kernel_IRQs_def split_del: if_split) +lemmas Interrupt_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R?: Interrupt_R AARCH64.arch_irq_control_inv_valid' AARCH64.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Interrupt_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Interrupt_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R_2 locale *) -lemma invoke_arch_irq_handler_invs'[Interrupt_R_2_assms, wp]: +lemma invoke_arch_irq_handler_invs'[Arch_assms, wp]: "\invs' and irq_handler_inv_valid' i\ Arch.invokeIRQHandler i \\rv. invs'\" by (cases i; (wpsimp simp: AARCH64_H.invokeIRQHandler_def theIRQ_def | rule conjI)+) +lemmas Interrupt_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R_2?: Interrupt_R_2 AARCH64.arch_irq_control_inv_valid' AARCH64.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Interrupt_R_2_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchInvariantUpdates_H.thy b/proof/refine/AARCH64/ArchInvariantUpdates_H.thy index 49ec1e90a3..2498859ace 100644 --- a/proof/refine/AARCH64/ArchInvariantUpdates_H.thy +++ b/proof/refine/AARCH64/ArchInvariantUpdates_H.thy @@ -10,7 +10,7 @@ begin context Arch begin arch_global_naming -named_theorems InvariantUpdates_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InvariantUpdates_H locale *) lemma valid_arch_state'_vmid_next_update[simp]: "valid_arch_state' (s\ksArchState := armKSNextVMID_update f (ksArchState s)\) = @@ -33,22 +33,23 @@ lemma invs'_gsTypes_update: valid_machine_state'_def valid_arch_state'_def cong: option.case_cong) -lemma valid_arch_state'_interrupt[simp, InvariantUpdates_H_assms]: +lemma valid_arch_state'_interrupt[simp, Arch_assms]: "valid_arch_state' (ksInterruptState_update f s) = valid_arch_state' s" by (simp add: valid_arch_state'_def cong: option.case_cong) (* not generally true for ksInterruptState update *) -lemma global_refs'_intStateIRQTable_update[simp, InvariantUpdates_H_assms]: +lemma global_refs'_intStateIRQTable_update[simp, Arch_assms]: "global_refs' (s\ksInterruptState := intStateIRQTable_update f (ksInterruptState s)\) = global_refs' s" by (simp add: global_refs'_def) -end +lemmas InvariantUpdates_H_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation InvariantUpdates_H?: InvariantUpdates_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact InvariantUpdates_H_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.InvariantUpdates_H_assms)?) qed end diff --git a/proof/refine/AARCH64/ArchInvsLemmas_H.thy b/proof/refine/AARCH64/ArchInvsLemmas_H.thy index a01d075e44..133fb7a330 100644 --- a/proof/refine/AARCH64/ArchInvsLemmas_H.thy +++ b/proof/refine/AARCH64/ArchInvsLemmas_H.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Invariants_H_pspaceI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_pspaceI locale *) (* FIXME arch-split: word_size is available outside of Arch due to Word_Setup, but to provide more guard rails during arch-split we are hiding the Haskell constant definition outside of @@ -34,7 +34,7 @@ lemma frame_at'_pspaceI: "frame_at' p sz d s \ ksPSpace s = ksPSpace s' \ frame_at' p sz d s'" by (simp add: frame_at'_def typ_at'_def ko_wp_at'_def ps_clear_def) -lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_cap'_pspaceI[Arch_assms]: "s \' cap \ ksPSpace s = ksPSpace s' \ s' \' cap" unfolding valid_cap'_def by (cases cap) @@ -44,7 +44,7 @@ lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: simp: vspace_table_at'_defs valid_arch_cap'_def valid_arch_cap_ref'_def split: arch_capability.split zombie_type.split option.splits) -lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_obj'_pspaceI[Arch_assms]: "valid_obj' obj s \ ksPSpace s = ksPSpace s' \ valid_obj' obj s'" unfolding valid_obj'_def by (cases obj) @@ -55,7 +55,7 @@ lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: Structures_H.thread_state.splits ntfn.splits option.splits intro: obj_at'_pspaceI valid_cap'_pspaceI typ_at'_pspaceI) -lemma tcb_space_clear[Invariants_H_pspaceI_assms]: +lemma tcb_space_clear[Arch_assms]: "\ tcb_cte_cases (y - x) = Some (getF, setF); is_aligned x tcbBlockSizeBits; ps_clear x tcbBlockSizeBits s; ksPSpace s x = Some (KOTCB tcb); ksPSpace s y = Some v; @@ -78,7 +78,7 @@ lemma tcb_space_clear[Invariants_H_pspaceI_assms]: apply (simp add: tcb_cte_cases_def cteSizeBits_def split: if_split_asm) done -lemma pspace_in_kernel_mappings'_pspaceI[Invariants_H_pspaceI_assms]: +lemma pspace_in_kernel_mappings'_pspaceI[Arch_assms]: "pspace_in_kernel_mappings' s \ ksPSpace s = ksPSpace s' \ pspace_in_kernel_mappings' s'" unfolding pspace_in_kernel_mappings'_def by simp @@ -122,7 +122,7 @@ proof - by (simp add: canonical_address_mask_eq) qed -lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: +lemma range_cover_canonical_address[Arch_assms]: "\ range_cover ptr sz us n ; p < n ; canonical_address (ptr && ~~ mask sz) ; sz \ maxUntypedSizeBits \ \ canonical_address (ptr + of_nat p * 2 ^ us)" @@ -139,17 +139,18 @@ lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: (* not interesting on this architecture *) lemmas [simp] = pspace_in_kernel_mappings'_pspaceI -end +lemmas Invariants_H_pspaceI_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_pspaceI?: Invariants_H_pspaceI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Invariants_H_pspaceI_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Invariants_H_pspaceI_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Invariants_H_cte_ats_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_cte_ats locale *) (* FIXME arch-split: for proofs which require exact offsets lining up instead of cteSizeBits *) lemma raw_tcb_cte_cases_simps: @@ -159,7 +160,7 @@ lemma raw_tcb_cte_cases_simps: "tcb_cte_cases 128 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)" by (simp add: tcb_cte_cases_def cteSizeBits_def)+ -lemma cte_wp_at_cases'[Invariants_H_cte_ats_assms]: +lemma cte_wp_at_cases'[Arch_assms]: shows "cte_wp_at' P p s = ((\cte. ksPSpace s p = Some (KOCTE cte) \ is_aligned p cte_level_bits \ P cte \ ps_clear p cteSizeBits s) \ @@ -252,7 +253,7 @@ lemma cte_wp_at_cteI': shows "cte_wp_at' P ptr s" using assms by (simp add: cte_wp_at_cases' cte_level_bits_def objBits_defs) -lemma cte_at_typ'[Invariants_H_cte_ats_assms]: +lemma cte_at_typ'[Arch_assms]: "cte_at' c = (\s. typ_at' CTET c s \ (\n. typ_at' TCBT (c - n) s \ n \ dom tcb_cte_cases))" proof - have P: "\ko. (koTypeOf ko = CTET) = (\cte. ko = KOCTE cte)" @@ -276,12 +277,13 @@ lemma tcb_at_cte_at': apply (clarsimp simp add: return_def objBits_simps) done -end +lemmas Invariants_H_cte_ats_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_cte_ats?: Invariants_H_cte_ats proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Invariants_H_cte_ats_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.Invariants_H_cte_ats_assms)?) qed @@ -395,7 +397,7 @@ lemma is_physical_cases: | _ \ True)" by (simp split: capability.splits arch_capability.splits zombie_type.splits) -named_theorems Invariants_H_typ_at_lifts_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_typ_at_lifts locale *) lemma page_table_at'_typ_at_lift_strong: "(\p. f \\s. P (typ_at' (ArchT PTET) p s)\) \ f \\s. P (page_table_at' pt_t p s)\" @@ -423,7 +425,7 @@ lemma vcpu_at'_typ_at_lift_strong: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (vcpu_at' p s)\" by assumption -lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_tcb'_typ_at_lift_strong[Arch_assms]: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (valid_arch_tcb' tcb s)\" unfolding valid_arch_tcb'_def apply (rule bool_to_bool_cases[where f=P]; clarsimp) @@ -431,7 +433,7 @@ lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: | assumption)+ done -lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_cap'_typ_at_lift[Arch_assms]: assumes P: "\P T p. f \\s. P (typ_at' T p s)\" shows "f \\s. valid_arch_cap' cap s\" apply (case_tac cap, @@ -441,12 +443,13 @@ lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: page_table_at'_typ_at_lift_strong frame_at'_typ_at_lift_strong)+ done +lemmas Invariants_H_typ_at_lifts_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) global_interpretation Invariants_H_typ_at_lifts?: Invariants_H_typ_at_lifts proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; unfold_locales; (fact Invariants_H_typ_at_lifts_assms)?) + case 1 show ?case by (intro_locales; unfold_locales; (fact AARCH64.Invariants_H_typ_at_lifts_assms)?) qed context Arch begin arch_global_naming @@ -564,16 +567,19 @@ instance user_data_device :: no_vcpu by intro_classes auto end_qualify +(* FIXME arch-split: koType_asidpool and koType_pte are somehow [simp] even outside Arch on AARCH64 + due to how pre_storable *) + instantiation AARCH64_H.asidpool :: no_vcpu begin -interpretation Arch . -instance by intro_classes auto +instance by intro_classes + (auto simp: AARCH64_H.arch_kernel_object_type.distinct) end instantiation AARCH64_H.pte :: no_vcpu begin -interpretation Arch . -instance by intro_classes auto +instance by intro_classes + (auto simp: AARCH64_H.arch_kernel_object_type.distinct) end end diff --git a/proof/refine/AARCH64/ArchIpcCancel_R.thy b/proof/refine/AARCH64/ArchIpcCancel_R.thy index 1596dd0f06..a4c2880a7e 100644 --- a/proof/refine/AARCH64/ArchIpcCancel_R.thy +++ b/proof/refine/AARCH64/ArchIpcCancel_R.thy @@ -12,20 +12,20 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_R locale *) crunch Arch.postCapDeletion - for pred_tcb_at'[IpcCancel_R_assms, wp]: "pred_tcb_at' proj P t" - and typ_at'[IpcCancel_R_assms, wp]: "\s. P (typ_at' T p s)" + for pred_tcb_at'[Arch_assms, wp]: "pred_tcb_at' proj P t" + and typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" (wp: setCTE_pred_tcb_at') -lemma acapClass_not_ReplyClass[IpcCancel_R_assms]: +lemma acapClass_not_ReplyClass[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) crunch arch_post_cap_deletion - for pspace_aligned[IpcCancel_R_assms, wp]: "pspace_aligned :: det_state \ _" - and pspace_distinct[IpcCancel_R_assms, wp]: "pspace_distinct :: det_state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_state \ _" (simp: crunch_simps wp: crunch_wps) crunch emptySlot @@ -138,7 +138,7 @@ lemma fpuRelease_corres[corres]: corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu) \ (fpu_release t) (fpuRelease t')" by (corres simp: fpu_release_def fpuRelease_def) -lemma prepareThreadDelete_corres[IpcCancel_R_assms, corres]: +lemma prepareThreadDelete_corres[Arch_assms, corres]: "t' = t \ corres dc (invs and tcb_at t) no_0_obj' (prepare_thread_delete t) (prepareThreadDelete t')" @@ -191,12 +191,13 @@ crunch prepareThreadDelete and inactive: "st_tcb_at' ((=) Inactive) t'" (simp: obj_at'_not_comp_fold) +lemmas IpcCancel_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation IpcCancel_R?: IpcCancel_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact IpcCancel_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.IpcCancel_R_assms)?)?) qed (* instantiate locales with assumptions depending on IpcCancel_R instantiation *) diff --git a/proof/refine/AARCH64/ArchIpc_R.thy b/proof/refine/AARCH64/ArchIpc_R.thy index 684fa1c4d6..4e56d621fe 100644 --- a/proof/refine/AARCH64/ArchIpc_R.thy +++ b/proof/refine/AARCH64/ArchIpc_R.thy @@ -11,11 +11,11 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_R locale *) declare word64_minus_one_le[simp] -lemma max_ipc_size_le_2_msg_align_bits[Ipc_R_assms]: +lemma max_ipc_size_le_2_msg_align_bits[Arch_assms]: "max_ipc_words * word_size \ 2 ^ msg_align_bits" by (simp add: max_ipc_words word_size_def msg_align_bits) @@ -28,50 +28,50 @@ lemma maskCapRights_vs_cap_ref'[simp]: simp add: AARCH64_H.maskCapRights_def isCap_simps Let_def) done -lemma is_derived'_Untyped[Ipc_R_assms]: +lemma is_derived'_Untyped[Arch_assms]: "\isUntypedCap cap'\ \ is_derived' m src cap' cap = (isUntypedCap cap \ badge_derived' cap' cap \ descendants_of' src m = {})" by (clarsimp simp add: AARCH64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def) -lemma is_derived'_Reply[Ipc_R_assms]: +lemma is_derived'_Reply[Arch_assms]: "\isReplyCap cap'\ \ is_derived' m src cap' cap = (isReplyCap cap \ capTCBPtr cap = capTCBPtr cap' \ capReplyMaster cap \ \ capReplyMaster cap')" by (clarsimp simp add: AARCH64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def) -lemma arch_maskCapRights_not_null[Ipc_R_assms, simp]: +lemma arch_maskCapRights_not_null[Arch_assms, simp]: "Arch.maskCapRights r acap \ NullCap" by (case_tac acap; simp add: AARCH64_H.maskCapRights_def isCap_simps) -lemma capASID_gen_cap[Ipc_R_assms]: +lemma capASID_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ capASID cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_asid_base'_gen_cap[Ipc_R_assms]: +lemma cap_asid_base'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_asid_base' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_vptr'_gen_cap[Ipc_R_assms]: +lemma cap_vptr'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_vptr' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemmas transferCapsToSlots_pspace_in_kernel_mappings'[Ipc_R_assms, wp] = +lemmas transferCapsToSlots_pspace_in_kernel_mappings'[Arch_assms, wp] = pspace_in_kernel_mappings'_inv[where f="transferCapsToSlots _ _ _ _ _ _"] crunch makeArchFaultMessage - for sch_act[Ipc_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for sch_act[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma is_derived'_IRQHandlerCap[Ipc_R_assms]: +lemma is_derived'_IRQHandlerCap[Arch_assms]: "\isIRQHandlerCap cap'\ \ is_derived' (ctes_of (s::kernel_state)) src cap' cap = (isIRQHandlerCap cap \ badge_derived' cap' cap)" by (clarsimp simp add: AARCH64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def) (* variant of storeWord_um_inv which does not expose architecture-specific information *) -lemma storeWord_um_inv'[Ipc_R_assms]: +lemma storeWord_um_inv'[Arch_assms]: "\\s. underlying_memory s = um\ storeWord a v \\_ s. is_aligned a word_size_bits @@ -85,7 +85,7 @@ lemma storeWord_um_inv'[Ipc_R_assms]: apply (auto simp add: unat_plus_simple[THEN iffD1] word_plus_mono_right2 mask_def) done -lemma isArchObjectCap_maskCapRights[Ipc_R_assms]: +lemma isArchObjectCap_maskCapRights[Arch_assms]: "isArchObjectCap (Arch.maskCapRights R acap)" by (cases acap; simp add: AARCH64_H.maskCapRights_def isCap_simps) @@ -96,17 +96,17 @@ lemma isFrameCap_maskCapRights[simp]: apply (case_tac arch_capability; simp add: isCap_simps AARCH64_H.maskCapRights_def) done -lemma arch_updateCapData_ordering[Ipc_R_assms]: +lemma arch_updateCapData_ordering[Arch_assms]: "\ (x, arch_capBadge acap) \ capBadge_ordering P; Arch.updateCapData p d acap \ NullCap \ \ (x, capBadge (Arch.updateCapData p d acap)) \ capBadge_ordering P" by (cases acap; simp add: AARCH64_H.updateCapData_def) fastforce -lemma ArchUpdateCapData_noReply[Ipc_R_assms]: +lemma ArchUpdateCapData_noReply[Arch_assms]: "Arch.updateCapData p d acap \ capability.ReplyCap x y z" by (cases acap; simp add: AARCH64_H.updateCapData_def) -lemma ArchUpdateCapData_noIRQControl[Ipc_R_assms]: +lemma ArchUpdateCapData_noIRQControl[Arch_assms]: "Arch.updateCapData p d acap \ IRQControlCap" by (cases acap; simp add: AARCH64_H.updateCapData_def) @@ -127,14 +127,14 @@ lemma isFrameCap_updateCapData[simp]: apply (clarsimp split:capability.splits simp:Let_def) done -lemma badgeRegister_badge_register[Ipc_R_assms]: +lemma badgeRegister_badge_register[Arch_assms]: "badgeRegister = badge_register" by (simp add: badge_register_def badgeRegister_def) -lemmas copyMRs__pspace_in_kernel_mappings'[Ipc_R_assms, wp] = +lemmas copyMRs__pspace_in_kernel_mappings'[Arch_assms, wp] = pspace_in_kernel_mappings'_inv[where f="copyMRs _ _ _ _ _"] -lemma makeArchFaultMessage_corres[Ipc_R_assms]: +lemma makeArchFaultMessage_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (make_arch_fault_msg f t) (makeArchFaultMessage (arch_fault_map f) t)" @@ -145,20 +145,20 @@ lemma makeArchFaultMessage_corres[Ipc_R_assms]: apply (wp+, auto) done -lemma syscallMessage_def'[Ipc_R_assms]: +lemma syscallMessage_def'[Arch_assms]: "FaultHandler_H.syscallMessage \ MachineExports.syscallMessage" by (simp add: syscallMessage_def) -lemma exceptionMessage_def'[Ipc_R_assms]: +lemma exceptionMessage_def'[Arch_assms]: "FaultHandler_H.exceptionMessage \ MachineExports.exceptionMessage" by (simp add: exceptionMessage_def) -lemma makeArchFaultMessage_inv[Ipc_R_assms, wp]: +lemma makeArchFaultMessage_inv[Arch_assms, wp]: "makeArchFaultMessage ft t \P\" unfolding makeArchFaultMessage_def by (wpsimp wp: asUser_inv getRestartPC_inv split: arch_fault.split) -lemma lookupIPCBuffer_valid_ipc_buffer[Ipc_R_assms, wp]: +lemma lookupIPCBuffer_valid_ipc_buffer[Arch_assms, wp]: "\valid_objs'\ VSpace_H.lookupIPCBuffer b s \case_option \ valid_ipc_buffer_ptr'\" unfolding lookupIPCBuffer_def supply raw_tcb_cte_cases_simps[simp] (* FIXME arch-split: legacy, try use tcb_cte_cases_neqs *) @@ -205,7 +205,7 @@ lemma lookupIPCBuffer_Some_0: "\\\ lookupIPCBuffer w t \\rv s. rv \ Some 0\" by (wpsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv) -lemma arch_getSanitiseRegisterInfo_corres[Ipc_R_assms]: +lemma arch_getSanitiseRegisterInfo_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (arch_get_sanitise_register_info t) (getSanitiseRegisterInfo t)" @@ -216,24 +216,24 @@ crunch getSanitiseRegisterInfo for tcb_at'[wp]: "tcb_at' t" crunch arch_get_sanitise_register_info - for pspace_distinct[Ipc_R_assms, wp]: pspace_distinct - and pspace_aligned[Ipc_R_assms, wp]: pspace_aligned + for pspace_distinct[Arch_assms, wp]: pspace_distinct + and pspace_aligned[Arch_assms, wp]: pspace_aligned -lemma sanitiseRegister_sanitise_register[Ipc_R_assms]: +lemma sanitiseRegister_sanitise_register[Arch_assms]: "sanitiseRegister = sanitise_register" by (rule ext)+ (clarsimp simp add: sanitiseRegister_def sanitise_register_def cong: register.case_cong) -lemma handleArchFaultReply_corres[Ipc_R_assms]: +lemma handleArchFaultReply_corres[Arch_assms]: "corres (=) \ \ (handle_arch_fault_reply ft t label msg) (handleArchFaultReply (arch_fault_map ft) t label msg)" by (clarsimp simp: handle_arch_fault_reply_def handleArchFaultReply_def split: arch_fault.split) crunch getSanitiseRegisterInfo, handleArchFaultReply, handle_arch_fault_reply - for inv[Ipc_R_assms, wp]: P + for inv[Arch_assms, wp]: P -lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: +lemma ctes_of_mdbNext_parentOf[Arch_assms]: "\ ctes_of s' \ cte_map cptr \ cte_map slot; ctes_of s' (cte_map cptr) = Some (CTE (capability.ReplyCap t master rights) n); ctes_of s' (mdbNext (cteMDBNode cte)) = Some (CTE (capability.ReplyCap t master' rights') n'); @@ -243,15 +243,16 @@ lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: (erule subtree.cases; clarsimp simp: parentOf_def isMDBParentOf_CTE) crunch debugPrint - for inv[Ipc_R_assms, wp]: P - and (no_fail) no_fail[Ipc_R_assms, intro!, wp, simp] + for inv[Arch_assms, wp]: P + and (no_fail) no_fail[Arch_assms, intro!, wp, simp] + +lemmas Ipc_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Ipc_R?: Ipc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Ipc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Ipc_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/AARCH64/ArchKHeap_R.thy b/proof/refine/AARCH64/ArchKHeap_R.thy index 6d48e2641d..e569e4dfaf 100644 --- a/proof/refine/AARCH64/ArchKHeap_R.thy +++ b/proof/refine/AARCH64/ArchKHeap_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems KHeap_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R locale *) lemma getObject_inv_vcpu[wp]: "\P\ getObject l \\_::ArchStructures_H.vcpu. P\" @@ -80,12 +80,12 @@ lemma getObject_vcpu_corres: apply (clarsimp simp: other_aobj_relation_def) done -lemma koType_objBitsKO[KHeap_R_assms]: +lemma koType_objBitsKO[Arch_assms]: "koTypeOf k = koTypeOf k' \ objBitsKO k = objBitsKO k'" by (auto simp: objBitsKO_def archObjSize_def split: kernel_object.splits arch_kernel_object.splits) -lemma pspace_dom_update[KHeap_R_assms]: +lemma pspace_dom_update[Arch_assms]: "\ ps ptr = Some x; a_type x = a_type v \ \ pspace_dom (ps(ptr \ v)) = pspace_dom ps" apply (simp add: pspace_dom_def dom_fun_upd2 del: dom_fun_upd) apply (rule SUP_cong [OF refl]) @@ -93,7 +93,7 @@ lemma pspace_dom_update[KHeap_R_assms]: apply (simp add: obj_relation_cuts_def3) done -lemma cte_wp_at_ctes_of[KHeap_R_assms]: +lemma cte_wp_at_ctes_of[Arch_assms]: "cte_wp_at' P p s = (\cte. ctes_of s p = Some cte \ P cte)" supply diff_neg_mask[simp del] apply (simp add: cte_wp_at_cases' map_to_ctes_def Let_def @@ -126,7 +126,7 @@ lemma cte_wp_at_ctes_of[KHeap_R_assms]: word_bw_assocs) done -lemma ctes_of_canonical[KHeap_R_assms]: +lemma ctes_of_canonical[Arch_assms]: assumes canonical: "pspace_canonical' s" assumes ctes_of: "ctes_of s p = Some cte" shows "canonical_address p" @@ -139,9 +139,9 @@ proof - elim: cte_wp_atE' canonical_address_add) qed -lemma valid_updateCapDataI[KHeap_R_assms]: +lemma valid_updateCapDataI[Arch_assms]: "s \' c \ s \' updateCapData b x c" - unfolding global.updateCapData_def Let_def updateCapData_def + unfolding global.updateCapData_def Let_def AARCH64_H.updateCapData_def by (cases c, auto simp: gen_isCap_defs valid_cap'_def global.capUntypedPtr_def gen_isCap_simps capAligned_def word_size word_bits_def word_bw_assocs split: capability.splits arch_capability.splits) @@ -349,7 +349,7 @@ lemma setObject_not_asidpool_corres: done -lemmas [KHeap_R_assms] = +lemmas [Arch_assms] = setObject_other_corres[where 'a=endpoint] setObject_other_corres[where 'a=notification] @@ -368,11 +368,11 @@ lemma pspace_in_kernel_mappings'_inv: "f \pspace_in_kernel_mappings'\" by wp -lemma setEndpoint_pspace_in_kernel_mappings'[KHeap_R_assms]: +lemma setEndpoint_pspace_in_kernel_mappings'[Arch_assms]: "setEndpoint p ko \pspace_in_kernel_mappings'\" by wp -lemma setNotification_pspace_in_kernel_mappings'[KHeap_R_assms]: +lemma setNotification_pspace_in_kernel_mappings'[Arch_assms]: "setNotification p ko \pspace_in_kernel_mappings'\" by wp @@ -421,27 +421,28 @@ lemma set_ep_hyp[wp]: by (wpsimp wp: setObject_ko_wp_at simp: objBits_simps', rule refl, simp) (clarsimp simp: is_vcpu'_def ko_wp_at'_def obj_at'_def) -lemma idle_is_global[KHeap_R_assms, intro!]: +lemma idle_is_global[Arch_assms, intro!]: "ksIdleThread s \ global_refs' s" by (simp add: global_refs'_def) -end +lemmas KHeap_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R?: KHeap_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.KHeap_R_assms)?) qed context Arch begin arch_global_naming -named_theorems KHeap_R_assms_2 +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R_2 locale *) -lemmas setEndpoint_valid_globals[KHeap_R_assms_2, wp] +lemmas setEndpoint_valid_globals[Arch_assms, wp] = valid_global_refs_lift'[OF set_ep_ctes_of set_ep_arch' setEndpoint_it setEndpoint_ksInterruptState] -lemma set_ntfn_global_refs'[KHeap_R_assms_2, wp]: +lemma set_ntfn_global_refs'[Arch_assms, wp]: "\valid_global_refs'\ setNotification ptr val \\_. valid_global_refs'\" by (rule valid_global_refs_lift'; wp) @@ -462,7 +463,7 @@ lemma setObject_ko_wp_at': objBits_def[symmetric] ps_clear_upd in_magnitude_check v) -lemmas [KHeap_R_assms_2] = setEndpoint_valid_arch' setNotification_valid_arch' +lemmas [Arch_assms] = setEndpoint_valid_arch' setNotification_valid_arch' sublocale setObject: typ_at_props' "setObject p v" by typ_at_props' @@ -473,12 +474,13 @@ sublocale doMachineOp: typ_at_props' "doMachineOp mop" sublocale setEndpoint: typ_at_props' "setEndpoint ptr val" by typ_at_props' -end +lemmas KHeap_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R_2?: KHeap_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms_2)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.KHeap_R_2_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/AARCH64/ArchMachine_R.thy b/proof/refine/AARCH64/ArchMachine_R.thy index 602960c02b..867447c783 100644 --- a/proof/refine/AARCH64/ArchMachine_R.thy +++ b/proof/refine/AARCH64/ArchMachine_R.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems Machine_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Machine_R locale *) -lemma dmo_getirq_inv[Machine_R_assms, wp]: +lemma dmo_getirq_inv[Arch_assms, wp]: "irq_state_independent_H P \ \P\ doMachineOp (getActiveIRQ in_kernel) \\rv. P\" apply (simp add: getActiveIRQ_def doMachineOp_def split_def exec_gets select_f_select[simplified liftM_def] @@ -33,7 +33,7 @@ lemma getActiveIRQ_masked: apply (clarsimp simp: valid_irq_masks'_def) done -lemma dmo_maskInterrupt[Machine_R_assms]: +lemma dmo_maskInterrupt[Arch_assms]: "\\s. P (ksMachineState_update (irq_masks_update (\t. t (irq := m))) s)\ doMachineOp (maskInterrupt m irq) \\_. P\" apply (simp add: doMachineOp_def split_def) @@ -51,7 +51,7 @@ lemma dmo_maskInterrupt_True: ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) done -lemma setIRQState_irq_states'[Machine_R_assms, wp]: +lemma setIRQState_irq_states'[Arch_assms, wp]: "setIRQState state irq \valid_irq_states'\" apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def) apply (wp dmo_maskInterrupt) @@ -67,7 +67,7 @@ lemma getActiveIRQ_le_maxIRQ: apply (simp add: irqs_masked'_def valid_irq_states'_def maxIRQ_def)+ done -lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: +lemma doMachineOp_getActiveIRQ_non_kernel[Arch_assms, wp]: "\\\ doMachineOp (getActiveIRQ True) \\rv s. \irq. rv = Some irq \ irq \ non_kernel_IRQs \ P irq s\" unfolding doMachineOp_def @@ -76,24 +76,25 @@ lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: apply clarsimp done -lemma frameRegisters_def'[Machine_R_assms]: +lemma frameRegisters_def'[Arch_assms]: "frameRegisters = MachineExports.frameRegisters" by (simp add: frameRegisters_def) -lemma gpRegisters_def'[Machine_R_assms]: +lemma gpRegisters_def'[Arch_assms]: "gpRegisters = MachineExports.gpRegisters" by (simp add: gpRegisters_def) -lemma tlsBaseRegister_def'[Machine_R_assms]: +lemma tlsBaseRegister_def'[Arch_assms]: "tlsBaseRegister = MachineExports.tlsBaseRegister" by (simp add: tlsBaseRegister_def) -end +lemmas Machine_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Machine_R?: Machine_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Machine_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.Machine_R_assms)?) qed end diff --git a/proof/refine/AARCH64/ArchRefine.thy b/proof/refine/AARCH64/ArchRefine.thy index 4af618c90d..bf18131bdd 100644 --- a/proof/refine/AARCH64/ArchRefine.thy +++ b/proof/refine/AARCH64/ArchRefine.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems Refine_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Refine locale *) text \User memory content is the same on both levels\ lemma typ_at_AUserDataI: @@ -134,7 +134,7 @@ lemma p_and_not_mask_pbfs_add_mask_pbfs_eq: add: shiftr_shiftl1 mask_out_add_aligned is_aligned_neg_mask pbfs_atleast_pageBits word_plus_and_or_coroll2 add.commute) -lemma pointerInUserData_relation[Refine_assms]: +lemma pointerInUserData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInUserData p s' = in_user_frame p s" apply (simp add: pointerInUserData_def in_user_frame_def) @@ -148,7 +148,7 @@ lemma pointerInUserData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma pointerInDeviceData_relation[Refine_assms]: +lemma pointerInDeviceData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInDeviceData p s' = in_device_frame p s" apply (simp add: pointerInDeviceData_def in_device_frame_def) @@ -162,31 +162,31 @@ lemma pointerInDeviceData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma user_mem_relation[Refine_assms]: +lemma user_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ user_mem' s' = user_mem s" by (rule ext) (clarsimp simp: user_mem_def user_mem'_def pointerInUserData_relation pointerInDeviceData_relation state_relation_def) -lemma device_mem_relation[Refine_assms]: +lemma device_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ device_mem' s' = device_mem s" by (rule ext) (clarsimp simp: device_mem_def device_mem'_def pointerInUserData_relation pointerInDeviceData_relation) -lemma arch_activate_thread_sched_act[Refine_assms]: +lemma arch_activate_thread_sched_act[Arch_assms]: "\ct_in_state activatable and (\s. P (scheduler_action s))\ arch_activate_idle_thread t \\rs s. P (scheduler_action (s::det_state))\" by (wpsimp simp: arch_activate_idle_thread_def) -lemma valid_list_init[Refine_assms, simp]: +lemma valid_list_init[Arch_assms, simp]: "valid_list init_A_st" by (simp add: valid_list_2_def init_A_st_def ext_init_def init_cdt_def) -lemma valid_sched_init[Refine_assms, simp]: +lemma valid_sched_init[Arch_assms, simp]: "valid_sched init_A_st" apply (simp add: valid_sched_def init_A_st_def ext_init_def) apply (clarsimp simp: init_kheap_def st_tcb_at_kh_def obj_at_kh_def @@ -198,15 +198,15 @@ lemma valid_sched_init[Refine_assms, simp]: etcb_at'_def etcbs_of'_def) done -lemma valid_domain_list_init[Refine_assms, simp]: +lemma valid_domain_list_init[Arch_assms, simp]: "valid_domain_list init_A_st" by (simp add: init_A_st_def ext_init_def valid_domain_list_def) -lemma valid_domain_time_init[Refine_assms, simp]: +lemma valid_domain_time_init[Arch_assms, simp]: "0 < domain_time init_A_st" by (simp add: init_A_st_def) -lemma sched_act_init[Refine_assms, simp]: +lemma sched_act_init[Arch_assms, simp]: "scheduler_action init_A_st = resume_cur_thread" by (simp add: init_A_st_def) @@ -215,7 +215,7 @@ defs fastpathKernelAssertions_def: (\asid_high ap. armKSASIDTable (ksArchState s) asid_high = Some ap \ asid_pool_at' ap s)" -lemma fastpathKernelAssertions_cross[Refine_assms]: +lemma fastpathKernelAssertions_cross[Arch_assms]: "\ (s,s') \ state_relation; invs s; valid_arch_state' s'\ \ fastpathKernelAssertions s'" unfolding fastpathKernelAssertions_def apply clarsimp @@ -229,7 +229,7 @@ lemma fastpathKernelAssertions_cross[Refine_assms]: done (* interface lemma, no vs duplicates on this architecture *) -lemma callKernel_valid_duplicates'[Refine_assms]: +lemma callKernel_valid_duplicates'[Arch_assms]: "\invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and (\s. e \ Interrupt \ ct_running' s)\ @@ -238,42 +238,43 @@ lemma callKernel_valid_duplicates'[Refine_assms]: by wpsimp (* interface lemma, no vs duplicates on this architecture *) -lemma doUserOp_valid_duplicates'[Refine_assms]: +lemma doUserOp_valid_duplicates'[Arch_assms]: "doUserOp f tc \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp (* interface lemma, no vs duplicates on this architecture *) -lemma checkActiveIRQ_valid_duplicates'[Refine_assms]: +lemma checkActiveIRQ_valid_duplicates'[Arch_assms]: "checkActiveIRQ \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp -lemma tcb_hyp_refs'_atcbContextSet[Refine_assms, simp]: +lemma tcb_hyp_refs'_atcbContextSet[Arch_assms, simp]: "tcb_hyp_refs' (atcbContextSet tc atcb) = tcb_hyp_refs' atcb" by (simp add: atcbContextSet_def) -lemma ptable_lift_abs_state[Refine_assms, simp]: +lemma ptable_lift_abs_state[Arch_assms, simp]: "ptable_lift t (abs_state s) = ptable_lift t s" by (simp add: ptable_lift_def abs_state_def) -lemma ptable_rights_abs_state[Refine_assms, simp]: +lemma ptable_rights_abs_state[Arch_assms, simp]: "ptable_rights t (abs_state s) = ptable_rights t s" by (simp add: ptable_rights_def abs_state_def) -lemma arch_tcb_relation_arch_context_set[Refine_assms]: +lemma arch_tcb_relation_arch_context_set[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_relation (arch_tcb_context_set tc atcb) (atcbContextSet tc atcb')" by (simp add: arch_tcb_relation_def arch_tcb_context_set_def atcbContextSet_def) -lemma arch_tcb_relation_arch_context_get[Refine_assms]: +lemma arch_tcb_relation_arch_context_get[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_context_get atcb = atcbContextGet atcb'" by (simp add: arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) +lemmas Refine_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Refine?: Refine proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Refine_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Refine_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchRetype_R.thy b/proof/refine/AARCH64/ArchRetype_R.thy index 1c9e51cd4f..e40dd377d9 100644 --- a/proof/refine/AARCH64/ArchRetype_R.thy +++ b/proof/refine/AARCH64/ArchRetype_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Retype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R locale *) -lemma toAPIType_Some[Retype_R_assms, simp]: +lemma toAPIType_Some[Arch_assms, simp]: "(toAPIType ty = Some x) = (ty = APIObjectType x)" by (cases ty; auto simp: toAPIType_def) @@ -35,19 +35,19 @@ definition APIType_map2 :: "kernel_object + AARCH64_H.object_type \ (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_map2_def = APIType_map2_raw_def[simplified APIType_map2_gen_def] -lemma APIType_map2_Untyped[Retype_R_assms, simp]: +lemma APIType_map2_Untyped[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.Untyped) = (tp = Inr (APIObjectType ArchTypes_H.Untyped))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_TCBObject[Retype_R_assms, simp]: +lemma APIType_map2_TCBObject[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.TCBObject) = (tp = Inr (APIObjectType ArchTypes_H.TCBObject))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_generic[Retype_R_assms, simp]: +lemma APIType_map2_generic[Arch_assms, simp]: "APIType_map2 (Inr (APIObjectType api)) = APIType_map2_gen api" by (simp add: APIType_map2_raw_def) @@ -65,11 +65,11 @@ definition APIType_capBits :: "AARCH64_H.object_type \ nat \ domain \ (kernel_obje (* inside of Arch, we don't need to isolate generic component *) lemmas makeObjectKO_def = makeObjectKO_raw_def[simplified makeObjectKO_gen_def] -lemma makeObjectKO_generic[Retype_R_assms, simp]: +lemma makeObjectKO_generic[Arch_assms, simp]: "makeObjectKO dev d (Inr (APIObjectType api)) = makeObjectKO_gen d api" by (simp add: makeObjectKO_raw_def) text \makeObject etc. lemmas\ -lemma valid_arch_tcb'_newArchTCB[Retype_R_assms, simp]: +lemma valid_arch_tcb'_newArchTCB[Arch_assms, simp]: "valid_arch_tcb' newArchTCB s" unfolding valid_arch_tcb'_def newArchTCB_def by simp @@ -124,7 +124,7 @@ text \On the abstract side\ text \Lemmas for createNewObjects etc.\ -lemma makeObjectKO_eq[Retype_R_assms]: +lemma makeObjectKO_eq[Arch_assms]: assumes x: "makeObjectKO dev d tp = Some v" shows "(v = KOCTE cte) = @@ -136,7 +136,7 @@ lemma makeObjectKO_eq[Retype_R_assms]: split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm AARCH64_H.object_type.split_asm arch_kernel_object.split_asm)+ -lemma objBits_le_obj_bits_api[Retype_R_assms]: +lemma objBits_le_obj_bits_api[Arch_assms]: "makeObjectKO dev d ty = Some ko \ objBitsKO ko \ obj_bits_api (APIType_map2 ty) us" (* FIXME: work around warning due to vcpuBits_def being in both bit_simps and objBits_simps' *) supply vcpuBits_def[bit_simps del] @@ -147,7 +147,7 @@ lemma objBits_le_obj_bits_api[Retype_R_assms]: Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits) done -lemma obj_relation_retype_other_obj[Retype_R_assms]: +lemma obj_relation_retype_other_obj[Arch_assms]: "\ is_other_obj_relation_type (a_type ko); other_obj_relation ko ko' \ \ obj_relation_retype ko ko'" apply (simp add: obj_relation_retype_def) @@ -178,7 +178,7 @@ definition update_gs :: "Structures_A.apiobject_type \ nat \as. gsPTTypes_update (\pt_types x. if x \ ptrs then Some VSRootPT_T else pt_types x) as) | _ \ id" -lemma ksPSpace_update_gs_eq[Retype_R_assms, simp]: +lemma ksPSpace_update_gs_eq[Arch_assms, simp]: "ksPSpace (update_gs ty us ptrs s) = ksPSpace s" by (simp add: update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) @@ -199,12 +199,12 @@ lemma update_gs_ksMachineState_update_swap: by (simp add: update_gs_def split: aobject_type.splits Structures_A.apiobject_type.splits) -lemma update_gs_id[Retype_R_assms]: +lemma update_gs_id[Arch_assms]: "tp \ no_gs_types \ update_gs tp us addrs = id" by (simp add: no_gs_types_def update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) -lemma no_gs_types_CapTableObject[Retype_R_assms]: +lemma no_gs_types_CapTableObject[Arch_assms]: "Structures_A.apiobject_type.CapTableObject \ no_gs_types" by (simp add: no_gs_types_def) @@ -223,7 +223,7 @@ lemma update_gs_simps[simp]: (\as. gsPTTypes_update (\pt_types x. if x \ ptrs then Some VSRootPT_T else pt_types x) as)" by (simp_all add: update_gs_def) -lemma objBitsKO_gt_0[Retype_R_assms]: +lemma objBitsKO_gt_0[Arch_assms]: "0 < objBitsKO ko" apply (case_tac ko) apply (simp_all add: objBits_simps' pageBits_def) @@ -285,7 +285,7 @@ lemma range_cover_canonical_address': apply (frule range_cover_canonical_address[where p="unat p"]; simp?) using unat_less_helper by blast -lemma createNewCaps_valid_cap[Retype_R_assms]: +lemma createNewCaps_valid_cap[Arch_assms]: fixes ptr :: machine_word assumes cover: "range_cover ptr sz (APIType_capBits ty us) n " assumes not_0: "n \ 0" @@ -535,7 +535,7 @@ proof - qed qed -lemma arch_tcb_relation_default[Retype_R_assms]: +lemma arch_tcb_relation_default[Arch_assms]: "arch_tcb_relation default_arch_tcb newArchTCB" by (clarsimp simp: new_context_def newContext_def newFPUState_def initContext_def default_arch_tcb_def newArchTCB_def arch_tcb_relation_def) @@ -577,7 +577,7 @@ lemmas object_splits = AARCH64_H.object_type.split_asm arch_kernel_object.split_asm -lemma valid_arch_badges_not_arch[Retype_R_assms]: +lemma valid_arch_badges_not_arch[Arch_assms]: "\isArchObjectCap cap' \ valid_arch_badges cap cap' node" by (auto simp: isCap_simps valid_arch_badges_def) @@ -585,7 +585,7 @@ lemma valid_arch_badges_NullCap[simp]: "valid_arch_badges cap NullCap node" by (simp add: valid_arch_badges_not_arch gen_isCap_simps) -lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: +lemma valid_untyped'_helper_arch_cap[Arch_assms]: "\pspace_aligned' s; pspace_distinct' s; pspace_no_overlap' ptr sz s; range_cover ptr sz (objBitsKO val) n; valid_arch_cap' acap s \ \ valid_arch_cap' acap @@ -594,7 +594,7 @@ lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: typ_at_to_obj_at_arches frame_at'_def page_table_at'_def split: if_split_asm arch_capability.splits) -lemma retype_in_kernel_mappings'[Retype_R_assms]: +lemma retype_in_kernel_mappings'[Arch_assms]: assumes pc': "pspace_in_kernel_mappings' s'" and cover: "range_cover ptr sz (objBitsKO ko) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -605,7 +605,7 @@ lemma retype_in_kernel_mappings'[Retype_R_assms]: (is "pspace_in_kernel_mappings' (s'\ksPSpace := ?ps\)") by simp -lemma createNewCaps_cte_wp_at2[Retype_R_assms]: +lemma createNewCaps_cte_wp_at2[Arch_assms]: "\\s. P (cte_wp_at' P' p s) \ \ P' makeObject \ n \ 0 \ range_cover ptr sz (APIType_capBits ty objsz) n @@ -628,7 +628,7 @@ lemma createNewCaps_cte_wp_at2[Retype_R_assms]: | simp add: objBits_simps' field_simps mult_2_right)+ done -lemma createNewCaps_cte_wp_at'[Retype_R_assms]: +lemma createNewCaps_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -653,7 +653,7 @@ lemma createNewCaps_cte_wp_at'[Retype_R_assms]: (* example of arch-split attempt of this kind of proof; unfortunately splitting off the arch-specific part doesn't actually save space, so we will leave these in Arch *) -lemma createNewCaps_state_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -681,7 +681,7 @@ lemma createNewCaps_state_refs_of'[Retype_R_assms]: apply (force simp: gen_objBits_simps split: ArchTypes_H.apiobject_type.splits) done -lemma createNewCaps_state_hyp_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_hyp_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -718,7 +718,7 @@ lemma arch_live'_KOVCPU[simp]: "arch_live' (KOVCPU makeObject) = False" by (simp add: makeObject_vcpu makeVCPUObject_def arch_live'_def) -lemma createNewCaps_iflive'[Retype_R_assms, wp]: +lemma createNewCaps_iflive'[Arch_assms, wp]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -750,31 +750,31 @@ crunch createNewCaps for qs[wp]: "\s. P (ksReadyQueues s)" and qsL1[wp]: "\s. P (ksReadyQueuesL1Bitmap s)" and qsL2[wp]: "\s. P (ksReadyQueuesL2Bitmap s)" - and ct[Retype_R_assms, wp]: "\s. P (ksCurThread s)" - and ksCurDomain[Retype_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksInterrupt[Retype_R_assms, wp]: "\s. P (ksInterruptState s)" - and nosch[Retype_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and it[Retype_R_assms, wp]: "\s. P (ksIdleThread s)" + and ct[Arch_assms, wp]: "\s. P (ksCurThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksInterrupt[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and it[Arch_assms, wp]: "\s. P (ksIdleThread s)" and asid_table[wp]: "\s. P (armKSASIDTable (ksArchState s))" and vmid_table[wp]: "\s. P (armKSVMIDTable (ksArchState s))" and cur_vcpu[wp]: "\s. P (armHSCurVCPU (ksArchState s))" and num_list_regs[wp]: "\s. P (armKSGICVCPUNumListRegs (ksArchState s))" and global_ksArch[wp]: "\s. P (armKSGlobalUserVSpace (ksArchState s))" and gsMaxObjectSize[wp]: "\s. P (gsMaxObjectSize s)" - and irq_states'[Retype_R_assms, wp]: valid_irq_states' - and ksDomSchedule[Retype_R_assms, wp]: "\s. P (ksDomSchedule s)" - and ksDomScheduleIdx[Retype_R_assms, wp]: "\s. P (ksDomScheduleIdx s)" - and ksDomScheduleStart[Retype_R_assms, wp]: "\s. P (ksDomScheduleStart s)" - and gsUntypedZeroRanges[Retype_R_assms, wp]: "\s. P (gsUntypedZeroRanges s)" + and irq_states'[Arch_assms, wp]: valid_irq_states' + and ksDomSchedule[Arch_assms, wp]: "\s. P (ksDomSchedule s)" + and ksDomScheduleIdx[Arch_assms, wp]: "\s. P (ksDomScheduleIdx s)" + and ksDomScheduleStart[Arch_assms, wp]: "\s. P (ksDomScheduleStart s)" + and gsUntypedZeroRanges[Arch_assms, wp]: "\s. P (gsUntypedZeroRanges s)" (simp: crunch_simps unless_def wp: mapM_x_wp' setObject_ksInterrupt updateObject_default_inv crunch_wps no_irq no_irq_clearMemory) -lemma createNewCaps_arch_ko_type_pre_non_arch[Retype_R_assms]: +lemma createNewCaps_arch_ko_type_pre_non_arch[Arch_assms]: "(case ty of ArchT _ \ False | _ \ True) \ createNewCaps_arch_ko_type_pre ty" by simp -lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: +lemma createNewCaps_ko_wp_atQ'[Arch_assms]: "\(\s. P (ko_wp_at' P' p s) \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -802,7 +802,7 @@ lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: | split if_split_asm)+ done -lemma createNewCaps_global_refs'[Retype_R_assms]: +lemma createNewCaps_global_refs'[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ valid_global_refs' s @@ -826,7 +826,7 @@ lemma createNewCaps_global_refs'[Retype_R_assms]: apply (auto simp: linorder_not_less ball_ran_eq) done -lemma createNewCaps_valid_bitmaps[Retype_R_assms]: +lemma createNewCaps_valid_bitmaps[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_bitmaps s\ createNewCaps ty ptr n us dev \\_. valid_bitmaps\" @@ -842,7 +842,7 @@ lemma createNewCaps_valid_bitmaps[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: +lemma createNewCaps_valid_sched_pointers[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_sched_pointers s\ createNewCaps ty ptr n us dev \\_. valid_sched_pointers\" @@ -857,7 +857,7 @@ lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_vms[Retype_R_assms]: +lemma createNewCaps_vms[Arch_assms]: "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ 0 < n) and valid_machine_state'\ @@ -882,7 +882,7 @@ lemma createNewCaps_vms[Retype_R_assms]: field_simps mult_2_right) done -lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: +lemma createNewCaps_pspace_domain_valid[Arch_assms, wp]: "\pspace_domain_valid and K ({ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \ kernel_data_refs = {} \ range_cover ptr sz (APIType_capBits ty us) n \ 0 < n)\ @@ -901,10 +901,12 @@ lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: (* safe for generic context, and we can't requalify object_type.inject as that would result in it being named "inject" *) -lemma object_type_inject[Retype_R_assms]: +lemma object_type_inject[Arch_assms]: "(APIObjectType x = APIObjectType y) = (x = y)" by simp +lemmas Retype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -915,8 +917,7 @@ arch_requalify_consts interpretation Retype_R?: Retype_R makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Retype_R_assms)?)?) qed locale Arch_retype_mdb = retype_mdb + Arch @@ -945,18 +946,18 @@ end (* Arch_retype_mdb *) context Arch begin arch_global_naming -named_theorems Retype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_2 locale *) (* drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [Retype_R_2_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] +lemmas [Arch_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] (* FIXME arch-split: currently only the gen_ version is used *) lemmas valid_obj_makeObject_rules = gen_valid_obj_makeObject_rules valid_obj_makeObject_pte valid_obj_makeObject_asid_pool valid_obj_makeObject_vcpu -lemma retype_state_relation[Retype_R_2_assms]: +lemma retype_state_relation[Arch_assms]: notes data_map_insert_def[simp del] assumes sr: "(s, s') \ state_relation" and vs: "valid_pspace s" "valid_mdb s" @@ -1241,7 +1242,7 @@ lemma retype_state_relation[Retype_R_2_assms]: split: Structures_A.apiobject_type.splits aobject_type.splits) qed -lemma createObjects_valid_objs'[Retype_R_2_assms]: +lemma createObjects_valid_objs'[Arch_assms]: assumes mko: "makeObjectKO dev d ty = Some val" and max_d: "ty = Inr (APIObjectType TCBObject) \ d \ maxDomain" and vo: "valid_objs' s" @@ -1327,7 +1328,7 @@ proof - done qed -lemma createNewCaps_idle'[Retype_R_2_assms, wp]: +lemma createNewCaps_idle'[Arch_assms, wp]: "\valid_idle' and valid_pspace' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ createNewCaps ty ptr n us d @@ -1353,7 +1354,7 @@ lemma createNewCaps_idle'[Retype_R_2_assms, wp]: | intro conjI impI)+ done -lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: +lemma createNewCaps_valid_arch_state[Arch_assms]: "\(\s. valid_arch_state' s \ valid_pspace' s \ pspace_no_overlap' ptr sz s \ (tp = APIObjectType ArchTypes_H.CapTableObject \ us > 0)) and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ @@ -1367,7 +1368,7 @@ lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: apply (fastforce simp: pred_conj_def valid_pspace'_def o_def is_vcpu'_def) done -lemma createNewCaps_sched_queues[Retype_R_2_assms]: +lemma createNewCaps_sched_queues[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" assumes not_0: "n \ 0" shows @@ -1391,7 +1392,7 @@ lemma createNewCaps_sched_queues[Retype_R_2_assms]: split_del: if_split, fastforce simp add: mult_2 add_ac)+ -lemma createNewCaps_null_filter'[Retype_R_2_assms]: +lemma createNewCaps_null_filter'[Arch_assms]: "\(\s. P (null_filter' (ctes_of s))) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0) \ @@ -1415,7 +1416,7 @@ lemma createNewCaps_null_filter'[Retype_R_2_assms]: | fastforce)+ done -lemma createObjects_no_cte_valid_global[Retype_R_2_assms]: +lemma createObjects_no_cte_valid_global[Arch_assms]: assumes no_cte: "\c. projectKO_opt val \ Some (c::cte)" assumes no_tcb: "\t. projectKO_opt val \ Some (t::tcb)" shows "\\s. pspace_aligned' s \ pspace_distinct' s \ @@ -1457,7 +1458,7 @@ lemma createObjects_valid_arch: apply (fastforce simp: pred_conj_def valid_pspace'_def o_def is_vcpu'_def) done -lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: +lemma createObjects_untyped_ranges_zero'[Arch_assms]: assumes moKO: "makeObjectKO dev d ty = Some val" shows "\ct_active' and valid_pspace' and pspace_no_overlap' ptr sz @@ -1483,18 +1484,19 @@ lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: apply (simp add: makeObject_cte untypedZeroRange_def) done +lemmas Retype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_2?: Retype_R_2 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Retype_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Retype_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_3 locale *) lemma createObjects_no_cte_invs: assumes moKO: "makeObjectKO dev d ty = Some val" @@ -1583,7 +1585,7 @@ proof - split: option.splits kernel_object.splits) qed -lemma createNewCaps_valid_pspace[Retype_R_3_assms]: +lemma createNewCaps_valid_pspace[Arch_assms]: assumes not_0: "n \ 0" and cover: "range_cover ptr sz (APIType_capBits ty us) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -1631,7 +1633,7 @@ lemma init_arch_objects_APIType_map2_VCPU_noop: apply (simp add: init_arch_objects_def APIType_map2_def) done -lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: +lemma corres_retype_region_createNewCaps[Arch_assms]: "corres ((\r r'. length r = length r' \ list_all2 cap_relation r r') \ map (\ref. default_cap (APIType_map2 (Inr ty)) ref us dev)) (\s. valid_pspace s \ valid_mdb s \ valid_list s \ valid_arch_state s @@ -1864,13 +1866,14 @@ lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: objBits_simps APIType_map2_def arch_default_cap_def) done +lemmas Retype_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_3?: Retype_R_3 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Retype_R_3_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchSchedule_R.thy b/proof/refine/AARCH64/ArchSchedule_R.thy index 5bb6bf43d1..40dea54811 100644 --- a/proof/refine/AARCH64/ArchSchedule_R.thy +++ b/proof/refine/AARCH64/ArchSchedule_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R locale *) lemma vs_lookup_pages_vcpu_update: "typ_at (AArch AVCPU) vcpuPtr s \ @@ -197,7 +197,7 @@ crunch set_vm_root, vcpu_switch (simp: crunch_simps wp: crunch_wps) crunch tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue - for state_hyp_refs_of'[Schedule_R_assms, wp]: "\s. P (state_hyp_refs_of' s)" + for state_hyp_refs_of'[Arch_assms, wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp) crunch vcpuEnable, vcpuDisable, vcpuSave, vcpuRestore, lazyFpuRestore, saveFpuState @@ -245,21 +245,21 @@ proof - by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_AARCH64_H_switchToThread_typ_at' pos]) qed -lemmas Arch_switchToThread_st_tcb_at'[Schedule_R_assms] = +lemmas Arch_switchToThread_st_tcb_at'[Arch_assms] = Arch_switchToThread_pred_tcb'[where proj=itcbState] crunch storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread, Arch.switchToIdleThread for ksQ[wp]: "\s. P (ksReadyQueues s)" - and ksIdleThread[Schedule_R_assms, wp]: "\s. P (ksIdleThread s)" - and sym_heap_sched_pointers[Schedule_R_assms, wp]: sym_heap_sched_pointers - and valid_objs'[Schedule_R_assms, wp]: valid_objs' + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and sym_heap_sched_pointers[Arch_assms, wp]: sym_heap_sched_pointers + and valid_objs'[Arch_assms, wp]: valid_objs' (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp simp: crunch_simps obj_at'_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread - for pspace_aligned[Schedule_R_assms, wp]: pspace_aligned - and pspace_distinct[Schedule_R_assms, wp]: pspace_distinct - and ready_queues[Schedule_R_assms, wp]: "\s. P (ready_queues s)" + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct + and ready_queues[Arch_assms, wp]: "\s. P (ready_queues s)" and ready_qs_distinct[wp]: ready_qs_distinct (wp: ready_qs_distinct_lift crunch_wps simp: crunch_simps) @@ -294,7 +294,7 @@ lemma arch_switchToThread_corres: done (* use superset of arch_switchToThread_corres preconditions across the architectures as interface *) -lemma arch_switchToThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and valid_objs and valid_asid_map and valid_arch_caps and pspace_aligned and pspace_distinct and valid_global_objs and (\s. sym_refs (state_hyp_refs_of s)) @@ -329,7 +329,7 @@ lemma arch_switchToIdleThread_corres: done (* use superset of arch_switchToIdleThread_corres preconditions across the architectures as interface *) -lemma arch_switchToIdleThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToIdleThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and pspace_aligned and pspace_distinct and valid_asid_map and valid_idle and valid_arch_caps and valid_global_objs and valid_vspace_objs and valid_objs) @@ -359,14 +359,14 @@ lemma lazyFpuRestore_invs[wp]: unfolding lazyFpuRestore_def by (wpsimp wp: threadGet_wp) -lemma Arch_switchToThread_invs[Schedule_R_assms, wp]: +lemma Arch_switchToThread_invs[Arch_assms, wp]: "\invs' and tcb_at' t\ Arch.switchToThread t \\rv. invs'\" unfolding AARCH64_H.switchToThread_def by (wpsimp wp: getObject_tcb_hyp_sym_refs) crunch "Arch.switchToThread" - for ksCurDomain[Schedule_R_assms, wp]: "\s. P (ksCurDomain s)" - and tcbDomain[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" - and tcbState[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" + for ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and tcbDomain[Arch_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" + and tcbState[Arch_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" (simp: crunch_simps wp: crunch_wps getASID_wp) crunch vcpuSwitch, setVMRoot @@ -430,7 +430,7 @@ crunch lazyFpuRestore for invs_no_cicd'[wp]: invs_no_cicd' (ignore: doMachineOp modifyArchState) -lemma Arch_switchToThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToThread_invs_no_cicd'[Arch_assms]: "Arch.switchToThread t \invs_no_cicd'\" by (wpsimp wp: getObject_tcb_hyp_sym_refs setVMRoot_invs_no_cicd' simp: AARCH64_H.switchToThread_def) (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def) @@ -460,7 +460,7 @@ crunch "ThreadDecls_H.switchToThread" for ksCurDomain[wp]: "\s. P (ksCurDomain s)" (* neater unfold, actual unfold is really ugly *) -lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: +lemma bitmapQ_lookupBitmapPriority_simp[Arch_assms]: "\ ksReadyQueuesL1Bitmap s d \ 0 ; valid_bitmapQ s ; bitmapQ_no_L1_orphans s \ \ bitmapQ d (lookupBitmapPriority d s) s = (ksReadyQueuesL1Bitmap s d !! word_log2 (ksReadyQueuesL1Bitmap s d) \ @@ -485,7 +485,7 @@ lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: apply (fastforce intro: word_of_nat_less simp: wordRadix_def' unat_of_nat word_size)+ done -lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToIdleThread_invs_no_cicd'[Arch_assms]: "Arch.switchToIdleThread \invs_no_cicd'\" unfolding switchToIdleThread_def by (wpsimp wp: setCurThread_invs_no_cicd'_idle_thread setVMRoot_invs_no_cicd' vcpuSwitch_it') @@ -493,29 +493,30 @@ lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: crunch Arch.switchToIdleThread for obj_at'[wp]: "obj_at' (P :: ('a :: no_vcpu) \ bool) t" -lemmas Arch_switchToIdleThread_not_queued'[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_not_queued'[Arch_assms] = ArchThreadDecls_H_AARCH64_H_switchToIdleThread_obj_at'[where P="Not \ tcbQueued"] -lemmas Arch_switchToIdleThread_tcbState[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_tcbState[Arch_assms] = ArchThreadDecls_H_AARCH64_H_switchToIdleThread_obj_at'[where P="P \ tcbState" for P] -lemmas [Schedule_R_assms] = +lemmas [Arch_assms] = (* part of DetSchedSchedule_AI_assms but not interfaced (AARCH64 only) *) arch_switch_to_thread_valid_idle +lemmas Schedule_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Schedule_R?: Schedule_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Schedule_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_2 locale *) -lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: +lemma bitmapL1_highest_lookup[Arch_assms]: "\ valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; bitmapQ d p s \ \ p \ lookupBitmapPriority d s" apply (subgoal_tac "ksReadyQueuesL1Bitmap s d \ 0") @@ -561,7 +562,7 @@ lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: apply (erule word_log2_maximum) done -lemma guarded_switch_to_chooseThread_fragment_corres[Schedule_R_2_assms]: +lemma guarded_switch_to_chooseThread_fragment_corres[Arch_assms]: "corres dc (P and st_tcb_at runnable t and invs and valid_sched) (P' and invs_no_cicd') @@ -632,19 +633,20 @@ crunch prepareNextDomain and nosch[wp]: "\s. P (ksSchedulerAction s)" crunch tcb_sched_action - for valid_vs_lookup[Schedule_R_2_assms, wp]: valid_vs_lookup + for valid_vs_lookup[Arch_assms, wp]: valid_vs_lookup + +lemmas Schedule_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R_2?: Schedule_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Schedule_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_3 locale *) lemma scheduleChooseNewThread_fragment_corres: "corres dc (invs and valid_domain_list and valid_sched and @@ -668,7 +670,7 @@ lemma scheduleChooseNewThread_fragment_corres: apply (auto simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def) done -lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_corres[Arch_assms]: "corres dc (\s. invs s \ valid_domain_list s \ valid_sched s \ scheduler_action s = choose_new_thread) (\s. invs' s \ ksSchedulerAction s = ChooseNewThread) @@ -681,7 +683,7 @@ lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: apply (wpsimp simp: getDomainTime_def)+ done -lemma scheduleChooseNewThread_invs'[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_invs'[Arch_assms]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \ \_ s. invs' s \" @@ -711,7 +713,7 @@ lemma stit_nosch[wp]: apply (wp setCurThread_nosch | simp add: getIdleThread_def)+ done -lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: +lemma scheduleChooseNewThread_ct_activatable'[Arch_assms, wp]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \\_. ct_in_state' activatable'\" @@ -722,12 +724,13 @@ lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: | (rule hoare_lift_Pf[where f=ksCurThread], solves wp) | strengthen invs'_invs_no_cicd)+ +lemmas Schedule_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Schedule_R_3?: Schedule_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Schedule_R_3_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchStateRelationLemmas.thy b/proof/refine/AARCH64/ArchStateRelationLemmas.thy index ceb779792f..d7bbd893d4 100644 --- a/proof/refine/AARCH64/ArchStateRelationLemmas.thy +++ b/proof/refine/AARCH64/ArchStateRelationLemmas.thy @@ -15,7 +15,7 @@ begin context Arch begin arch_global_naming -named_theorems StateRelation_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for StateRelation_R locale *) lemma obj_relation_cuts_def2: "obj_relation_cuts ko x = @@ -75,7 +75,7 @@ lemma obj_relation_cutsE: AARCH64_A.arch_kernel_obj.splits) done -lemma is_other_obj_relation_type_gen[simp, StateRelation_R_assms]: +lemma is_other_obj_relation_type_gen[simp, Arch_assms]: "\n. \ is_other_obj_relation_type (ACapTable n)" "\ is_other_obj_relation_type ATCB" "is_other_obj_relation_type AEndpoint" @@ -95,7 +95,7 @@ lemma is_other_obj_relation_type_DeviceData: "\ is_other_obj_relation_type (AArch (ADeviceData sz))" unfolding is_other_obj_relation_type_def by simp -lemma obj_relation_cuts_trivial[StateRelation_R_assms]: +lemma obj_relation_cuts_trivial[Arch_assms]: "ptr \ fst ` obj_relation_cuts ty ptr" apply (case_tac ty) apply (rename_tac sz cs) @@ -163,7 +163,7 @@ lemma ghost_relation_wrapper_lift': apply wp done -lemma ghost_relation_wrapper_genD[StateRelation_R_assms]: +lemma ghost_relation_wrapper_genD[Arch_assms]: "ghost_relation_wrapper s s' \ ups_of_heap (kheap s) = gsUserPages s' \ cns_of_heap (kheap s) = gsCNodes s'" by (simp add: ghost_relation_of_heap) @@ -205,11 +205,11 @@ lemma other_aobj_relation_aobj: unfolding other_aobj_relation_def is_ArchObj_def by (clarsimp split: Structures_A.kernel_object.splits) -lemma msgLabelBits_msg_label_bits[StateRelation_R_assms]: +lemma msgLabelBits_msg_label_bits[Arch_assms]: "msgLabelBits = msg_label_bits" by (simp add: msgLabelBits_def) -lemma msgInfoRegister_msg_info_register[StateRelation_R_assms]: +lemma msgInfoRegister_msg_info_register[Arch_assms]: "msgInfoRegister = msg_info_register" by (simp add: msg_info_register_def msgInfoRegister_def) @@ -218,12 +218,13 @@ lemma virqType_eq[simp]: unfolding virqType_def virq_type_def virq_type_shift_def virqTypeShift_def by simp -end +lemmas StateRelation_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation StateRelation_R?: StateRelation_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact StateRelation_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact AARCH64.StateRelation_R_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/AARCH64/ArchSyscall_R.thy b/proof/refine/AARCH64/ArchSyscall_R.thy index 150ba24976..dab706e8a3 100644 --- a/proof/refine/AARCH64/ArchSyscall_R.thy +++ b/proof/refine/AARCH64/ArchSyscall_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_R locale *) lemma vcpuFlushIfCurrent_corres[corres]: "corres dc (pspace_aligned and pspace_distinct and valid_arch_state and tcb_at tptr) @@ -25,7 +25,7 @@ lemma vcpuFlushIfCurrent_corres[corres]: crunch vcpu_flush_if_current for valid_cur_fpu[wp]: valid_cur_fpu -lemma prepareSetDomain_corres[Syscall_R_assms, corres]: +lemma prepareSetDomain_corres[Arch_assms, corres]: "corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu and valid_arch_state and tcb_at tptr) (pspace_aligned' and pspace_distinct' and no_0_obj') (arch_prepare_set_domain tptr new_dom) (prepareSetDomain tptr new_dom)" @@ -33,19 +33,19 @@ lemma prepareSetDomain_corres[Syscall_R_assms, corres]: by corres crunch prepareSetDomain - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' and ksSchedulerAction[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Syscall_R_assms, wp]: sch_act_simple - and tcb_at'[Syscall_R_assms, wp]: "tcb_at' p" + and sch_act_simple[Arch_assms, wp]: sch_act_simple + and tcb_at'[Arch_assms, wp]: "tcb_at' p" and ksCurThread[wp]: "\s. P (ksCurThread s)" and pred_tcb_at'[wp]: "pred_tcb_at' proj P t" - and ct_in_state'[Syscall_R_assms, wp]: "ct_in_state' P" + and ct_in_state'[Arch_assms, wp]: "ct_in_state' P" (wp: sch_act_simple_lift ct_in_state_thread_state_lift' crunch_wps) crunch postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler - for typ_at'[Syscall_R_assms, wp]: "\s. P (typ_at' T p s)" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" -lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: +lemma setThreadState_irq_control_inv_valid'[Arch_assms, wp]: "setThreadState st t \irq_control_inv_valid' irqcontrol_invocation\" apply (case_tac irqcontrol_invocation; simp) apply (rename_tac archirq_inv) @@ -54,11 +54,11 @@ lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: done (* FIXME arch-split: consider moving to where other msgRegisters stuff goes... Tcb_R? Ipc_R? AInvs? *) -lemma len_msg_registes_le_max_length[Syscall_R_assms]: +lemma len_msg_registes_le_max_length[Arch_assms]: "length msg_registers \ msg_max_length" by (simp add: msg_max_length_def msgRegisters_unfold) -lemma capRegister_cap_register[Syscall_R_assms]: +lemma capRegister_cap_register[Arch_assms]: "capRegister = cap_register" by (simp add: cap_register_def capRegister_def) @@ -84,7 +84,7 @@ lemma getFAR_invs'[wp]: "doMachineOp getFAR \invs'\" by (simp add: getFAR_def doMachineOp_def split_def select_f_returns | wp)+ -lemma hv_invs'[Syscall_R_assms, wp]: +lemma hv_invs'[Arch_assms, wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" apply (simp add: AARCH64_H.handleVMFault_def cong: vmfault_type.case_cong) @@ -93,13 +93,13 @@ lemma hv_invs'[Syscall_R_assms, wp]: done crunch handleVMFault - for nosch[Syscall_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma handleSpuriousIRQ_corres[Syscall_R_assms, corres]: +lemma handleSpuriousIRQ_corres[Arch_assms, corres]: "corres dc \ \ handle_spurious_irq handleSpuriousIRQ" by (simp add: handle_spurious_irq_def handleSpuriousIRQ_def) -lemma handleHypervisorFault_corres[Syscall_R_assms]: +lemma handleHypervisorFault_corres[Arch_assms]: "corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread) (invs' and sch_act_not thread and st_tcb_at' simple' thread and ex_nonz_cap_to' thread) @@ -108,7 +108,7 @@ lemma handleHypervisorFault_corres[Syscall_R_assms]: apply (corres corres: handleFault_corres simp: valid_fault_def) done -lemma hvmf_invs_lift[Syscall_R_assms]: +lemma hvmf_invs_lift[Arch_assms]: "(\s m. P (s\ksMachineState := ksMachineState s\machine_state_rest := m\\) = P s) \ \P\ handleVMFault t flt \\_ _. True\, \\_. P\" unfolding handleVMFault_def @@ -117,16 +117,16 @@ lemma hvmf_invs_lift[Syscall_R_assms]: curVCPUActive_def doMachineOp_bind getRestartPC_def getRegister_def) crunch handleVMFault - for st_tcb_at'[Syscall_R_assms, wp]: "st_tcb_at' P t" - and ex_nonz_cap_to'[Syscall_R_assms, wp]: "ex_nonz_cap_to' t" - and norq[Syscall_R_assms, wp]: "\s. P (ksReadyQueues s)" - and ksit[Syscall_R_assms, wp]: "\s. P (ksIdleThread s)" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" + and ex_nonz_cap_to'[Arch_assms, wp]: "ex_nonz_cap_to' t" + and norq[Arch_assms, wp]: "\s. P (ksReadyQueues s)" + and ksit[Arch_assms, wp]: "\s. P (ksIdleThread s)" crunch handleHypervisorFault for ksit[wp]: "\s. P (ksIdleThread s)" (wp: undefined_valid haskell_assert_inv simp: isFpuEnable_def) -lemma hh_invs'[Syscall_R_assms, wp]: +lemma hh_invs'[Arch_assms, wp]: "\invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p and (\s. p \ ksIdleThread s)\ handleHypervisorFault p t \\_. invs'\" @@ -134,24 +134,25 @@ lemma hh_invs'[Syscall_R_assms, wp]: by (cases t; wpsimp simp: AARCH64_H.handleHypervisorFault_def isFpuEnable_def) crunch handleSpuriousIRQ - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' (ignore: doMachineOp) -lemma arch_performInvocation_inv[Syscall_R_assms]: +lemma arch_performInvocation_inv[Arch_assms]: "\\\ Arch.performInvocation invocation -, \P\" by (wpsimp simp: performARMMMUInvocation_def AARCH64_H.performInvocation_def) -lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: +lemma Arch_performIRQControl_inv_EE[Arch_assms]: "\\\ Arch.performIRQControl irqc -, \P\" unfolding AARCH64_H.performIRQControl_def by wpsimp +lemmas Syscall_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Syscall_R?: Syscall_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Syscall_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Syscall_R_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchTcbAcc_R.thy b/proof/refine/AARCH64/ArchTcbAcc_R.thy index 87c9d961b4..eea1a416f6 100644 --- a/proof/refine/AARCH64/ArchTcbAcc_R.thy +++ b/proof/refine/AARCH64/ArchTcbAcc_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R locale *) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_loadWord_bits[TcbAcc_R_assms, wp]: +lemma no_fail_loadWord_bits[Arch_assms, wp]: "no_fail (\_. is_aligned p word_size_bits) (loadWord p)" by (wpsimp simp: loadWord_def is_aligned_mask[symmetric] word_size_bits_def) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_storeWord_bits[TcbAcc_R_assms]: +lemma no_fail_storeWord_bits[Arch_assms]: "no_fail (\_. is_aligned p word_size_bits) (storeWord p w)" by (wpsimp simp: storeWord_def is_aligned_mask[symmetric] word_size_bits_def) -lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: +lemma prioToL1Index_l1IndexToPrio_or_id[Arch_assms]: "\ unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \ \ prioToL1Index ((l1IndexToPrio w) || w') = w" unfolding l1IndexToPrio_def prioToL1Index_def @@ -33,12 +33,12 @@ lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: apply (subst unat_of_nat_eq, simp_all add: word_size) done -lemma l1IndexToPrio_wordRadix_mask[TcbAcc_R_assms, simp]: +lemma l1IndexToPrio_wordRadix_mask[Arch_assms, simp]: "l1IndexToPrio i && mask wordRadix = 0" unfolding l1IndexToPrio_def by (simp add: wordRadix_def') -lemma st_tcb_at_coerce_abstract[TcbAcc_R_assms]: +lemma st_tcb_at_coerce_abstract[Arch_assms]: assumes t: "st_tcb_at' P t c" assumes sr: "(a, c) \ state_relation" shows "st_tcb_at (\st. \st'. thread_state_relation st st' \ P st') t a" @@ -62,7 +62,7 @@ lemma tcb_at'_cross: other_obj_relation_def pte_relation_def is_tcb_def split: Structures_A.kernel_object.split_asm if_split_asm arch_kernel_obj.split_asm) -lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: +lemma setObject_update_TCB_corres'[Arch_assms]: assumes tcbs: "tcb_relation tcb tcb' \ tcb_relation new_tcb new_tcb'" assumes tables: "\(getF, v) \ ran tcb_cap_cases. getF new_tcb = getF tcb" assumes tables': "\(getF, v) \ ran tcb_cte_cases. getF new_tcb' = getF tcb'" @@ -134,13 +134,13 @@ lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: apply (fastforce simp: opt_map_def) by (clarsimp simp: ready_queue_relation_def opt_pred_def opt_map_def split: option.splits) -lemma setObject_tcb_valid_arch'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_valid_arch'[Arch_assms, wp]: "\valid_arch_state'\ setObject t (v :: tcb) \\rv. valid_arch_state'\" by (wpsimp wp: valid_arch_state_lift' setObject_typ_at' setObject_ko_wp_at simp: objBits_simps', rule refl; simp add: pred_conj_def) (clarsimp simp: is_vcpu'_def ko_wp_at'_def obj_at'_def) -lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_refs'[Arch_assms, wp]: "\\s. P (global_refs' s)\ setObject t (v::tcb) \\rv s. P (global_refs' s)\" apply (clarsimp simp: setObject_def split_def updateObject_default_def) apply wp @@ -157,7 +157,7 @@ lemma threadSet_state_hyp_refs_of'_vcpu: elim!: rsubst[where P=P] del: ext intro!: ext)+ done -lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: +lemma threadSet_state_hyp_refs_of'[Arch_assms]: assumes y: "\tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb)" shows "\\s. P (state_hyp_refs_of' s)\ threadSet F t \\rv s. P (state_hyp_refs_of' s)\" apply (rule threadSet_state_hyp_refs_of'_vcpu) @@ -166,7 +166,7 @@ lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: apply (metis empty_not_insert ex_in_conv mem_Sigma_iff option.set_cases set_empty_eq) done -lemma threadSet_iflive'T[TcbAcc_R_assms]: +lemma threadSet_iflive'T[Arch_assms]: assumes x: "\tcb. \(getF, setF) \ ran tcb_cte_cases. getF (F tcb) = getF tcb" shows "\\s. if_live_then_nonz_cap' s @@ -200,14 +200,14 @@ lemma threadSet_iflive'T[TcbAcc_R_assms]: sublocale threadSet: typ_at_props' "threadSet tptr f" by typ_at_props' -lemma zobj_refs'_capRange[TcbAcc_R_assms]: +lemma zobj_refs'_capRange[Arch_assms]: "s \' cap \ zobj_refs' cap \ capRange cap" apply (cases cap; simp add: valid_cap'_def capAligned_def capRange_def is_aligned_no_overflow) apply (rename_tac aobj_cap) apply (case_tac aobj_cap; clarsimp dest!: is_aligned_no_overflow) done -lemma capAligned_zobj_refs'_capRange[TcbAcc_R_assms]: +lemma capAligned_zobj_refs'_capRange[Arch_assms]: "capAligned c \ zobj_refs' c \ capRange c" apply (cases c; simp add: capAligned_def capRange_def is_aligned_no_overflow) apply (rename_tac ac) @@ -244,7 +244,7 @@ schematic_goal l2BitmapSize_def': (* arch specific consequence *) "l2BitmapSize = numeral ?X" by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def) -lemma prioToL1Index_size[TcbAcc_R_assms, simp]: +lemma prioToL1Index_size[Arch_assms, simp]: "prioToL1Index w < l2BitmapSize" unfolding prioToL1Index_def wordRadix_def l2BitmapSize_def' by (fastforce simp: shiftr_div_2n' nat_divide_less_eq @@ -255,12 +255,12 @@ lemma prioToL1Index_max: unfolding prioToL1Index_def wordRadix_def by (insert unat_lt2p[where x=p], simp add: shiftr_div_2n') -lemma prioToL1Index_bit_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_set[Arch_assms]: "((2 :: machine_word) ^ prioToL1Index p) !! prioToL1Index p" using l2BitmapSize_def' by (fastforce simp: nth_w2p_same intro: order_less_le_trans[OF prioToL1Index_size]) -lemma prioL2Index_bit_set[TcbAcc_R_assms]: +lemma prioL2Index_bit_set[Arch_assms]: fixes p :: priority shows "((2::machine_word) ^ unat (ucast p && (mask wordRadix :: machine_word))) !! unat (p && mask wordRadix)" apply (simp add: nth_w2p wordRadix_def ucast_and_mask[symmetric] unat_ucast_upcast is_up) @@ -279,25 +279,25 @@ lemma prioToL1Index_bits_low_high_eq: unfolding prioToL1Index_def by (fastforce simp: nth_w2p wordRadix_def is_up bits_low_high_eq) -lemma prioToL1Index_bit_not_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_not_set[Arch_assms]: "\ (~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" apply (subst word_ops_nth_size, simp_all add: prioToL1Index_bit_set del: bit_exp_iff) apply (fastforce simp: prioToL1Index_def wordRadix_def word_size intro: order_less_le_trans[OF word_shiftr_lt]) done -lemma prioToL1Index_complement_nth_w2p[TcbAcc_R_assms]: +lemma prioToL1Index_complement_nth_w2p[Arch_assms]: fixes p p' :: priority shows "(~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p' = (prioToL1Index p \ prioToL1Index p')" by (fastforce simp: complement_nth_w2p prioToL1Index_lt wordRadix_def word_size)+ -lemma invertL1Index_eq_cancelD[TcbAcc_R_assms]: +lemma invertL1Index_eq_cancelD[Arch_assms]: "\ invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \ \ i = j" by (simp add: invertL1Index_def l2BitmapSize_def') -lemma pspace_dom_dom[TcbAcc_R_assms]: +lemma pspace_dom_dom[Arch_assms]: "dom ps \ pspace_dom ps" unfolding pspace_dom_def apply clarsimp @@ -315,7 +315,7 @@ lemma pspace_dom_dom[TcbAcc_R_assms]: apply (simp add: pageBitsForSize_def bit_simps split: vmpage_size.split) done -lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: +lemma less_max_ipc_words_less_2p_msg_align_bits[Arch_assms]: assumes y: "y < unat max_ipc_words" shows "word_of_nat y * (word_size :: machine_word) < 2 ^ msg_align_bits" apply (simp add: word_size_def word_size_bits_def) @@ -324,37 +324,38 @@ lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: apply (simp add: msg_align_bits max_ipc_words)+ done -lemma is_aligned_word_size_bits_less_max_ipc_words[TcbAcc_R_assms]: +lemma is_aligned_word_size_bits_less_max_ipc_words[Arch_assms]: "y < unat max_ipc_words \ is_aligned (word_of_nat y * word_size) word_size_bits" by (simp add: word_size_def word_size_bits_def) (rule is_aligned_mult_triv2[where n=3, simplified]) -lemma msg_align_bits_le_pageBitsForSize[TcbAcc_R_assms]: +lemma msg_align_bits_le_pageBitsForSize[Arch_assms]: "msg_align_bits \ pageBitsForSize sz" by (simp add: msg_align_bits pageBitsForSize_def bit_simps split: vmpage_size.split) -lemmas [TcbAcc_R_assms] = +lemmas [Arch_assms] = dmo_getirq_inv getActiveIRQ_masked tcb_at'_cross pspace_relation_update_tcbs +lemmas TcbAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R?: TcbAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.TcbAcc_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_2 locale *) sublocale asUser: typ_at_props' "asUser tptr f" by typ_at_props' -lemma tcb_hyp_refs'_valid_arch_tcb'_eq[TcbAcc_R_2_assms]: +lemma tcb_hyp_refs'_valid_arch_tcb'_eq[Arch_assms]: "tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ valid_arch_tcb' (tcbArch (F tcb)) s = valid_arch_tcb' (tcbArch tcb) s" by (auto simp: valid_arch_tcb'_def tcb_vcpu_refs'_def) @@ -435,14 +436,14 @@ lemma asUser_corres: apply (simp add: invs'_def valid_state'_def valid_pspace'_def) done -lemma asUser_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_getRegister_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (getRegister r)) (asUser t (getRegister r))" apply (rule asUser_corres') apply (clarsimp simp: getRegister_def) done -lemma user_getreg_inv'[TcbAcc_R_2_assms, wp]: +lemma user_getreg_inv'[Arch_assms, wp]: "\P\ asUser t (getRegister r) \\x. P\" apply (rule asUser_inv) apply (simp_all add: getRegister_def) @@ -476,7 +477,7 @@ lemma asUser_iflive'[wp]: unfolding asUser_def by (wpsimp wp: threadSet_iflive' hoare_drop_imps, auto) -lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_setRegister_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (setRegister r v)) (asUser t (setRegister r v))" @@ -485,7 +486,7 @@ lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: apply (rule corres_modify'; simp) done -lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs apply (wp | simp add: bitmap_fun_defs bitmapQ_no_L1_orphans_def)+ @@ -493,7 +494,7 @@ lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: prioToL1Index_complement_nth_w2p) done -lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L2_orphans[Arch_assms, wp]: "\ bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L2_orphans \" @@ -505,7 +506,7 @@ lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: apply metis done -lemma removeFromBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma removeFromBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p \ removeFromBitmap d p \\_. valid_bitmapQ_except d p \" @@ -556,7 +557,7 @@ proof - done qed -lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma addToBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ addToBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs bitmapQ_defs using word_unat_mask_lt[where w=p and m=wordRadix] @@ -566,7 +567,7 @@ lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: wordBits_def numPriorities_def) done -lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma addToBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p and bitmapQ_no_L2_orphans \ addToBitmap d p \\_. valid_bitmapQ_except d p \" @@ -578,7 +579,7 @@ lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: dest: prioToL1Index_bits_low_high_eq) done -lemma in_user_frame_eq[TcbAcc_R_2_assms]: +lemma in_user_frame_eq[Arch_assms]: assumes y: "y < unat max_ipc_words" and al: "is_aligned a msg_align_bits" shows "in_user_frame (a + of_nat y * word_size) s = in_user_frame a s" @@ -605,15 +606,15 @@ lemma thread_get_registers: apply (clarsimp simp: map_upd_triv select_f_def image_def return_def) done -lemma msgRegisters_msg_registers[TcbAcc_R_2_assms]: +lemma msgRegisters_msg_registers[Arch_assms]: "msgRegisters = msg_registers" by (simp add: msgRegisters_unfold) -lemma suc_len_msg_registers_less_2p_word_bits[TcbAcc_R_2_assms]: +lemma suc_len_msg_registers_less_2p_word_bits[Arch_assms]: "Suc (length msg_registers) < 2 ^ word_bits" by (simp add: msgRegisters_unfold word_bits_def) -lemma asUser_mapM_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_mapM_getRegister_corres[Arch_assms]: "corres (\con regs. regs = map con msg_registers) (tcb_at t and pspace_aligned and pspace_distinct) \ (thread_get (arch_tcb_get_registers o tcb_arch) t) @@ -650,7 +651,7 @@ lemma UserContext_fold: lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split] -lemma lookupIPCBuffer_corres'[TcbAcc_R_2_assms]: +lemma lookupIPCBuffer_corres'[Arch_assms]: "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct) (valid_objs' and no_0_obj') @@ -707,7 +708,7 @@ crunch rescheduleRequired for hyp_refs_of'[wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps wp: threadSet_state_hyp_refs_of' ignore: threadSet) -lemmas [TcbAcc_R_2_assms] = +lemmas [Arch_assms] = getThreadBufferSlot_inv lookupIPCBuffer_inv rescheduleRequired_hyp_refs_of' @@ -718,7 +719,7 @@ lemma archThreadGet_wp: unfolding archThreadGet_def by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def) -lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setThreadState_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P ((state_hyp_refs_of' s))\ setThreadState st t \\rv s. P (state_hyp_refs_of' s)\" @@ -726,14 +727,14 @@ lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: | wp threadSet_state_hyp_refs_of' hoare_drop_imps)+ done -lemma setBoundNotification_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setBoundNotification_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P (state_hyp_refs_of' s)\ setBoundNotification ntfn t \\rv s. P (state_hyp_refs_of' s)\" by (simp add: setBoundNotification_def fun_upd_def | wp threadSet_state_hyp_refs_of')+ -lemma storeWord_invs'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs'[Arch_assms, wp]: "\pointerInUserData p and invs'\ doMachineOp (storeWord p w) \\rv. invs'\" proof - have aligned_offset_ignore: @@ -758,7 +759,7 @@ proof - done qed -lemma storeWord_invs_no_cicd'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs_no_cicd'[Arch_assms, wp]: "\pointerInUserData p and invs_no_cicd'\ doMachineOp (storeWord p w) \\rv. invs_no_cicd'\" proof - have aligned_offset_ignore: @@ -783,27 +784,28 @@ proof - done qed -lemma tcbSchedAppend_pspace_in_kernel_mappings'[TcbAcc_R_2_assms]: +lemma tcbSchedAppend_pspace_in_kernel_mappings'[Arch_assms]: "tcbSchedAppend t \pspace_in_kernel_mappings'\" by wpsimp (* FIXME: the code assumes that it is word_t, so length_type should be defined generically in ASpec, not per architecture *) -lemmas [TcbAcc_R_2_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] +lemmas [Arch_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] + +lemmas TcbAcc_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation TcbAcc_R_2?: TcbAcc_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.TcbAcc_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_3 locale *) -lemma setMRs_corres[TcbAcc_R_3_assms]: +lemma setMRs_corres[Arch_assms]: assumes m: "mrs' = mrs" shows "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \ in_user_frame buf) @@ -875,7 +877,7 @@ lemma asUser_invs[wp]: crunch storeWordUser for pred_tcb_at'[wp]: "\s. pred_tcb_at' proj P p s" -lemma set_mrs_invs'[TcbAcc_R_3_assms, wp]: +lemma set_mrs_invs'[Arch_assms, wp]: "\ invs' and tcb_at' receiver \ setMRs receiver recv_buf mrs \\rv. invs' \" apply (simp add: setMRs_def) apply (wp dmo_invs' no_irq_mapM no_irq_storeWord crunch_wps| @@ -894,12 +896,13 @@ sublocale setThreadState: typ_at_props' "setThreadState st p" sublocale setBoundNotification: typ_at_props' "setBoundNotification v p" by typ_at_props' +lemmas TcbAcc_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R_3?: TcbAcc_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.TcbAcc_R_3_assms)?)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/AARCH64/ArchTcb_R.thy b/proof/refine/AARCH64/ArchTcb_R.thy index f7279548a0..46efa16328 100644 --- a/proof/refine/AARCH64/ArchTcb_R.thy +++ b/proof/refine/AARCH64/ArchTcb_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R locale *) -lemma activateIdleThread_corres[Tcb_R_assms]: +lemma activateIdleThread_corres[Arch_assms]: "corres dc (st_tcb_at idle t) (st_tcb_at' idle' t) (arch_activate_idle_thread t) (activateIdleThread t)" by (simp add: arch_activate_idle_thread_def activateIdleThread_def) crunch arch_post_modify_registers - for pspace_aligned[Tcb_R_assms, wp]: pspace_aligned - and pspace_distinct[Tcb_R_assms, wp]: pspace_distinct + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct (wp: crunch_wps simp: crunch_simps) -lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: +lemma asUser_postModifyRegisters_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' t and tcb_at' ct) (arch_post_modify_registers ct t) (asUser t $ postModifyRegisters ct t)" @@ -37,7 +37,7 @@ lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: (* formulation of threadSet_state_hyp_refs_of' varies based on whether VCPU is present; use this as interface, but keep original lemma name for use outside of Arch *) -lemmas threadSet_state_hyp_refs_of'_interface[Tcb_R_assms] = threadSet_state_hyp_refs_of' +lemmas threadSet_state_hyp_refs_of'_interface[Arch_assms] = threadSet_state_hyp_refs_of' sublocale setPriority: typ_at_props' "setPriority t prio" by typ_at_props' @@ -45,7 +45,7 @@ sublocale setPriority: typ_at_props' "setPriority t prio" sublocale setMCPriority: typ_at_props' "setMCPriority t prio" by typ_at_props' -lemma sameObject_corres2[Tcb_R_assms]: +lemma sameObject_corres2[Arch_assms]: "\ cap_relation c c'; cap_relation d d' \ \ same_object_as c d = sameObjectAs c' d'" apply (frule(1) same_region_as_relation[symmetric, where c=c and c'=d]) @@ -66,7 +66,7 @@ definition ArchObjectCap (PageTableCap _ _ (Some (asid, _))) \ Some asid | _ \ None" -lemma untyped_derived_eq_from_sameObjectAs[Tcb_R_assms]: +lemma untyped_derived_eq_from_sameObjectAs[Arch_assms]: "sameObjectAs cap cap2 \ untyped_derived_eq cap cap2" by (clarsimp simp: untyped_derived_eq_def sameObjectAs_def2 gen_isCap_Master) @@ -82,8 +82,8 @@ lemma isValidVTableRootD: option.split_asm) crunch prepare_thread_delete, arch_finalise_cap - for pspace_aligned[Tcb_R_assms, wp]: "pspace_aligned :: det_ext state \ _" - and pspace_distinct[Tcb_R_assms, wp]: "pspace_distinct :: det_ext state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_ext state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_ext state \ _" (simp: crunch_simps preemption_point_def wp: crunch_wps OR_choiceE_weak_wp) lemma is_valid_vtable_root_simp: @@ -93,7 +93,7 @@ lemma is_valid_vtable_root_simp: split: cap.splits arch_cap.splits option.splits pt_type.splits) (* FIXME: move after checked_insert_tcb_invs in ArchTcb_AI, and consolidate redundancy there *) -lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: +lemma checked_insert_tcb_invs_gen[Arch_assms]: "\invs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and K (is_cnode_or_valid_arch new_cap) and valid_cap new_cap and tcb_cap_valid new_cap (target, ref) @@ -108,37 +108,37 @@ lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: apply (clarsimp dest!: is_cnode_or_valid_arch_cap_asid) done -lemma is_valid_vtable_root_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_valid_vtable_root_is_cnode_or_valid_arch[Arch_assms]: "is_valid_vtable_root cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def is_valid_vtable_root_simp is_cap_simps) -lemma is_cnode_cap_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_cnode_cap_is_cnode_or_valid_arch[Arch_assms]: "is_cnode_cap cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def) -lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Tcb_R_assms]: +lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Arch_assms]: "\valid_ipc_buffer_cap cap buf; is_arch_cap cap\ \ is_nondevice_page_cap cap" by (clarsimp simp: is_cap_simps valid_ipc_buffer_cap_def) -lemma cte_at_tcb_at_2p_cteSizeBits[Tcb_R_assms]: +lemma cte_at_tcb_at_2p_cteSizeBits[Arch_assms]: "tcb_at' t s \ cte_at' (t + 2 ^ cteSizeBits) s" by (simp add: cte_at'_obj_at' tcb_cte_cases_def cteSizeBits_def) (* arch_capBadge may involve SMC caps on some architectures, but not page tables *) -lemma isValidVTableRootD_arch[Tcb_R_assms]: +lemma isValidVTableRootD_arch[Arch_assms]: "isValidVTableRoot cap \ isArchObjectCap cap \ arch_capBadge (capCap cap) = None" by (drule isValidVTableRootD; clarsimp simp: arch_capBadge_def isCap_simps) (* FIXME FPU: when the FPU being enabled is properly configurable for the proofs then this shouldn't need to unfold config_HAVE_FPU. *) -lemma postSetFlags_corres[Tcb_R_assms, corres]: +lemma postSetFlags_corres[Arch_assms, corres]: "flags = word_to_tcb_flags flags' \ corres dc (cur_tcb and pspace_aligned and pspace_distinct and valid_cur_fpu) \ (arch_post_set_flags t flags) (postSetFlags t flags')" unfolding arch_post_set_flags_def postSetFlags_def by (corres simp: Kernel_Config.config_HAVE_FPU_def cur_tcb_def) -lemma postSetFlags_invs'[Tcb_R_assms, wp]: +lemma postSetFlags_invs'[Arch_assms, wp]: "postSetFlags t flags \invs'\" unfolding postSetFlags_def by wpsimp @@ -149,11 +149,11 @@ lemma copyregsets_map_only[simp]: (* there are no extra registers on any architecture so far, and while it is theoretically possible in the design spec, the abstract invariant proof assumes this *) -lemma decodeTransfer_def'[Tcb_R_assms]: +lemma decodeTransfer_def'[Arch_assms]: "decodeTransfer w = returnOk (copyregsets_map ArchDefaultExtraRegisters)" by (simp add: decodeTransfer_def) -lemma checkValidIPCBuffer_corres[Tcb_R_assms]: +lemma checkValidIPCBuffer_corres[Arch_assms]: "cap_relation cap cap' \ corres (ser \ dc) \ \ (check_valid_ipc_buffer vptr cap) @@ -170,7 +170,7 @@ lemma checkValidIPCBuffer_corres[Tcb_R_assms]: apply (auto simp add: returnOk_def) done -lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: +lemma checkValidIPCBuffer_ArchObject_wp[Arch_assms]: "\\s. isArchObjectCap cap \ capBadge cap = None \ is_aligned p msg_align_bits \ P s\ checkValidIPCBuffer p cap \\rv s. P s\,-" @@ -184,27 +184,28 @@ lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: done crunch checkValidIPCBuffer - for inv[Tcb_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps) -lemma isValidVTableRoot_eq[Tcb_R_assms]: +lemma isValidVTableRoot_eq[Arch_assms]: "cap_relation cap cap' \ isValidVTableRoot cap' = is_valid_vtable_root cap" apply (cases cap; simp add: isValidVTableRoot_def isVTableRoot_def is_valid_vtable_root_simp) apply (rename_tac acap, case_tac acap; simp) apply (auto split: pt_type.splits simp: mdata_map_def) done +lemmas Tcb_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R?: Tcb_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Tcb_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Tcb_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R_2 locale *) lemma checkCapAt_cteInsert_corres': "cap_relation new_cap newCap \ @@ -258,7 +259,7 @@ lemma checkCapAt_cteInsert_corres': apply fastforce done -lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: +lemma checkCapAt_cteInsert_corres[Arch_assms]: "cap_relation new_cap newCap \ corres dc (einvs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and cte_at slot and K (is_cnode_or_valid_arch new_cap) @@ -279,12 +280,13 @@ lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: apply fastforce done +lemmas Tcb_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R_2?: Tcb_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Tcb_R_2_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchUntyped_R.thy b/proof/refine/AARCH64/ArchUntyped_R.thy index 54e7ab1d5d..e62078a069 100644 --- a/proof/refine/AARCH64/ArchUntyped_R.thy +++ b/proof/refine/AARCH64/ArchUntyped_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R locale *) -lemma APIType_map2_CapTable[Untyped_R_assms, simp]: +lemma APIType_map2_CapTable[Arch_assms, simp]: "(APIType_map2 ty = Structures_A.CapTableObject) = (ty = Inr (APIObjectType ArchTypes_H.CapTableObject))" by (simp add: APIType_map2_def @@ -25,13 +25,13 @@ lemma APIType_map2_CapTable[Untyped_R_assms, simp]: lemmas is_frame_type_defs = is_frame_type_def isFrameType_def arch_is_frame_type_def -lemma is_frame_type_isFrameType_eq[Untyped_R_assms, simp]: +lemma is_frame_type_isFrameType_eq[Arch_assms, simp]: "(is_frame_type (APIType_map2 (Inr (toEnum (unat arg0))))) = (isFrameType (toEnum (unat arg0)))" by (simp add: APIType_map2_def is_frame_type_defs split: apiobject_type.splits object_type.splits)+ (* object_type enum (arch-specific) is extension of apiobject_type enum (generic) *) -lemma nth_enum_object_type_gen_eq[Untyped_R_assms]: +lemma nth_enum_object_type_gen_eq[Arch_assms]: assumes "n < length (enum :: apiobject_type list)" shows "((enum :: object_type list) ! n) = APIObjectType ((enum :: apiobject_type list) ! n)" proof - @@ -45,36 +45,36 @@ proof - (simp flip: nth_map[where f=APIObjectType]) qed -lemma length_enum_apiobject_less_enum_object_type[Untyped_R_assms]: +lemma length_enum_apiobject_less_enum_object_type[Arch_assms]: "length (enum :: apiobject_type list) < length (enum :: object_type list)" unfolding enum_apiobject_type enum_object_type by simp crunch freeMemory (* FIXME arch-split: clearMemory is already handled in ArchRetype_AI *) - for irq_masks_inv[wp, Untyped_R_assms]: "\s. P (irq_masks s)" + for irq_masks_inv[wp, Arch_assms]: "\s. P (irq_masks s)" (wp: crunch_wps) crunch updateFreeIndex, deleteGhost - for valid_irq_states'[Untyped_R_assms, wp]: "valid_irq_states'" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" - and gsMaxObjectSize[Untyped_R_assms, wp]: "\s. P (gsMaxObjectSize s)" - and ksIdleThread[Untyped_R_assms, wp]: "\s. P (ksIdleThread s)" - and ksCurDomain[Untyped_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksCurThread[Untyped_R_assms, wp]: "\s. P (ksCurThread s)" + for valid_irq_states'[Arch_assms, wp]: "valid_irq_states'" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and gsMaxObjectSize[Arch_assms, wp]: "\s. P (gsMaxObjectSize s)" + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksCurThread[Arch_assms, wp]: "\s. P (ksCurThread s)" (wp: crunch_wps) -lemma arch_data_to_obj_type_invalid[Untyped_R_assms]: +lemma arch_data_to_obj_type_invalid[Arch_assms]: "\ n \ length (enum :: object_type list) \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) = None" by (auto simp: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) -lemma arch_data_to_obj_type_valid[Untyped_R_assms]: +lemma arch_data_to_obj_type_valid[Arch_assms]: "\ n < length (enum :: object_type list); length (enum :: apiobject_type list) \ n \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) \ None" by (simp add: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) arith -lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: +lemma APIType_map2_arch_data_to_obj_type[Arch_assms]: defines [simp]: "object_types \ enum :: object_type list" defines [simp]: "apiobject_types \ enum :: apiobject_type list" shows @@ -89,7 +89,7 @@ lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: apply arith done -lemma obj_bits_api_APIType_map2[Untyped_R_assms]: +lemma obj_bits_api_APIType_map2[Arch_assms]: "obj_bits_api (APIType_map2 (Inr x)) y = getObjectSize x y" supply vcpuBits_def[bit_simps del] (* FIXME arch-split: suppress warning *) apply (clarsimp simp:obj_bits_api_def APIType_map2_def getObjectSize_def simp del: objSize_eq_capBits) @@ -100,11 +100,11 @@ lemma obj_bits_api_APIType_map2[Untyped_R_assms]: apply (simp_all add: apiGetObjectSize_def slot_bits_def objBits_simps' bit_simps) done -lemma length_nat_to_cref[Untyped_R_assms]: +lemma length_nat_to_cref[Arch_assms]: "bits < word_bits \ length (nat_to_cref bits x) = bits" by (simp add: nat_to_cref_def word_bits_conv) -lemma ctes_of_ko_arch[Untyped_R_assms]: +lemma ctes_of_ko_arch[Arch_assms]: "\ valid_cap' cap s; isArchObjectCap cap \ \ \ptr\capRange cap. \optr ko. ksPSpace s optr = Some ko \ ptr \ obj_range' optr ko" apply (case_tac cap; simp add: gen_isCap_simps capRange_def) @@ -167,11 +167,11 @@ lemma ctes_of_ko_arch[Untyped_R_assms]: apply (clarsimp simp: valid_cap'_def) done -lemma irq_nodes_global[Untyped_R_assms]: +lemma irq_nodes_global[Arch_assms]: "irq_node' s + (ucast (irq :: irq) << cteSizeBits) \ global_refs' s" by (simp add: global_refs'_def) -lemma untyped_inc_mdbD[Untyped_R_assms]: +lemma untyped_inc_mdbD[Arch_assms]: "\ sameRegionAs cap cap'; isUntypedCap cap; ctes p = Some (CTE cap node); ctes p' = Some (CTE cap' node'); untyped_inc' ctes; untyped_mdb' ctes; no_loops ctes \ @@ -197,16 +197,16 @@ lemma untyped_inc_mdbD[Untyped_R_assms]: apply (clarsimp simp: gen_isCap_simps) done -lemma mdb_chunked_arch_assms_non_arch[Untyped_R_assms]: +lemma mdb_chunked_arch_assms_non_arch[Arch_assms]: "\ isArchObjectCap cap \ mdb_chunked_arch_assms cap" by (simp add: mdb_chunked_arch_assms_def isCap_simps) -lemma sameRegionAs_def_untyped[Untyped_R_assms]: +lemma sameRegionAs_def_untyped[Arch_assms]: "\ isUntypedCap cap \ \ sameRegionAs cap cap' = (capRange cap' \ {} \ capRange cap' \ capRange cap)" by (clarsimp simp add: sameRegionAs_def3 isCap_simps) -lemma createNewCaps_range_helper[Untyped_R_assms]: +lemma createNewCaps_range_helper[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits tp us) n \ 0 < n\ createNewCaps tp ptr n us d \\rv s. \capfn. @@ -277,7 +277,7 @@ defs archOverlap_def: (\is_aligned p (pt_bits pt_t) \ ({p .. p + 2 ^ pt_bits pt_t - 1} \ {p. inRange p} \ {}))" -lemma archNoOverlap[Untyped_R_assms]: +lemma archNoOverlap[Arch_assms]: notes Int_atLeastAtMost[simp del] shows "corres dc (\s. \cref. cte_wp_at (\cap. is_untyped_cap cap @@ -307,35 +307,35 @@ lemma archNoOverlap[Untyped_R_assms]: apply wp+ done -lemma word_size_bits_le_untyped_min_bits[Untyped_R_assms]: +lemma word_size_bits_le_untyped_min_bits[Arch_assms]: "word_size_bits \ untyped_min_bits" by (simp add: word_size_bits_def untyped_min_bits_def) -lemma minUntypedSizeBits_le_resetChunkBits[Untyped_R_assms]: +lemma minUntypedSizeBits_le_resetChunkBits[Arch_assms]: "minUntypedSizeBits \ resetChunkBits" by (simp add: minUntypedSizeBits_def Kernel_Config.resetChunkBits_def) -lemma maxUntypedSizeBits_less_word_bits[Untyped_R_assms]: +lemma maxUntypedSizeBits_less_word_bits[Arch_assms]: "maxUntypedSizeBits < word_bits" by (simp add: maxUntypedSizeBits_def word_bits_def) (* FIXME arch-split: candidate for Kernel_Config lemmas *) -lemma word_size_bits_le_resetChunkBits[Untyped_R_assms]: +lemma word_size_bits_le_resetChunkBits[Arch_assms]: "word_size_bits \ resetChunkBits" by (simp add: word_size_bits_def Kernel_Config.resetChunkBits_def) -lemma resetChunkBits_le_word_bits[Untyped_R_assms]: +lemma resetChunkBits_le_word_bits[Arch_assms]: "resetChunkBits < word_bits" by (simp add: Kernel_Config.resetChunkBits_def word_bits_def) -lemma APIType_capBits_lower_bound[Untyped_R_assms]: +lemma APIType_capBits_lower_bound[Arch_assms]: "\tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \ minUntypedSizeBits \ us\ \ minUntypedSizeBits \ APIType_capBits tp us" supply vcpuBits_def[bit_simps del] (* FIXME arch-split: suppress warning *) by (simp add: APIType_capBits_def objBits_simps' bit_simps minUntypedSizeBits_def split: object_type.split apiobject_type.split) -lemma dmo_freeMemory_clear_um[Untyped_R_assms]: +lemma dmo_freeMemory_clear_um[Arch_assms]: "\word_size_bits \ sz; sz \ word_bits; is_aligned ptr sz\ \ (do_machine_op (freeMemory ptr sz) :: (det_state, unit) nondet_monad) = modify (clear_um {ptr..ptr + 2 ^ sz - 1})" @@ -346,15 +346,16 @@ lemma dmo_freeMemory_clear_um[Untyped_R_assms]: done crunch createObject - for nosch[Untyped_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + +lemmas Untyped_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Untyped_R?: Untyped_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Untyped_R_assms)?)?) qed locale Arch_mdb_insert_again_all = mdb_insert_again_all + Arch @@ -414,21 +415,22 @@ end (* invokeUntyped_proofs *) context Arch begin arch_global_naming -named_theorems Untyped_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R_2 locale *) -lemmas [Untyped_R_2_assms] = +lemmas [Arch_assms] = mdb_insert_again_all.valid_n' invokeUntyped_proofs.descendants_range invokeUntyped_proofs.ex_cte_no_overlap' invokeUntyped_proofs.cref_inv invokeUntyped_proofs.slots_invD +lemmas Untyped_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R_2?: Untyped_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.Untyped_R_2_assms)?)?) qed end diff --git a/proof/refine/AARCH64/ArchVSpace_R.thy b/proof/refine/AARCH64/ArchVSpace_R.thy index 3f7c8ea93f..d43487dd51 100644 --- a/proof/refine/AARCH64/ArchVSpace_R.thy +++ b/proof/refine/AARCH64/ArchVSpace_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems VSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for VSpace_R locale *) definition "vspace_at_asid' vs asid \ \s. \ap pool entry. @@ -1257,7 +1257,7 @@ lemma handleVMFault_corres': done (* interface lemma, superset of all architecture preconditions *) -lemma handleVMFault_corres[VSpace_R_assms]: +lemma handleVMFault_corres[Arch_assms]: "corres (fr \ dc) (tcb_at thread and pspace_aligned and pspace_distinct) (tcb_at' thread) (handle_vm_fault thread fault) (handleVMFault thread fault)" by (corres corres: handleVMFault_corres') @@ -2966,12 +2966,13 @@ lemma perform_aci_invs [wp]: wellformed_mapdata'_def) done +lemmas VSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation VSpace_R?: VSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact VSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact AARCH64.VSpace_R_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchADT_H.thy b/proof/refine/ARM/ArchADT_H.thy index a27cc5add3..9d2d2125e8 100644 --- a/proof/refine/ARM/ArchADT_H.thy +++ b/proof/refine/ARM/ArchADT_H.thy @@ -13,14 +13,14 @@ begin context Arch begin arch_global_naming -named_theorems ADT_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H locale *) definition vm_rights_of :: "vmrights \ rights set" where "vm_rights_of x \ case x of VMKernelOnly \ vm_kernel_only | VMReadOnly \ vm_read_only | VMReadWrite \ vm_read_write" -lemma vm_rights_of_vmrights_map_id[ADT_H_assms, simp]: +lemma vm_rights_of_vmrights_map_id[Arch_assms, simp]: "rs \ valid_vm_rights \ vm_rights_of (vmrights_map rs) = rs" by (auto simp: vm_rights_of_def vmrights_map_def valid_vm_rights_def vm_read_write_def vm_read_only_def vm_kernel_only_def) @@ -92,14 +92,14 @@ fun ArchCapabilityMap :: "arch_capability \ cap" where | "ArchCapabilityMap (arch_capability.SGISignalCap irq target) = cap.ArchObjectCap (arch_cap.SGISignalCap (ucast irq) (ucast target))" -lemma acap_relation_imp_ArchCapabilityMap[ADT_H_assms]: +lemma acap_relation_imp_ArchCapabilityMap[Arch_assms]: "\wellformed_acap ac; acap_relation ac ac'\ \ ArchCapabilityMap ac' = cap.ArchObjectCap ac" by (case_tac ac; simp add: wellformed_acap_simps ucast_down_ucast_id is_down) primrec ArchFaultMap :: "Fault_H.arch_fault \ ExceptionTypes_A.arch_fault" where "ArchFaultMap (ARM_H.VMFault p m) = ARM_A.VMFault p m" -lemma ArchFaultMap_arch_fault_map[ADT_H_assms]: +lemma ArchFaultMap_arch_fault_map[Arch_assms]: "ArchFaultMap (arch_fault_map f) = f" by (cases f; simp add: ArchFaultMap_def arch_fault_map_def) @@ -123,7 +123,7 @@ definition absArchState :: arm_asid_map = am, arm_global_pd = gpd, arm_global_pts = gpts, arm_kernel_vspace = kvspace\" -lemma absArchState_correct[ADT_H_assms]: +lemma absArchState_correct[Arch_assms]: "(s,s') \ state_relation \ absArchState (ksArchState s') (aobjs_of' s') = arch_state s" apply (prop_tac "(arch_state s, ksArchState s') \ arch_state_relation (aobjs_of' s')") apply (simp add: state_relation_def) @@ -131,19 +131,20 @@ lemma absArchState_correct[ADT_H_assms]: split: ARM_H.kernel_state.splits) done +lemmas ADT_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState interpretation ADT_H?: ADT_H vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.ADT_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems ADT_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H_2 locale *) (* Due to DataPage, current FPU owner and gsPPTypes this can't be made generic. In order to unify the type across architectures, we use the arch kernel state. *) @@ -182,7 +183,7 @@ lemma unaligned_page_offsets_helper: apply (frule_tac i=n and k="0x1000" in word_mult_less_mono1, simp+)+ done -lemma absHeap_correct[ADT_H_2_assms]: +lemma absHeap_correct[Arch_assms]: fixes s' :: kernel_state assumes pspace_aligned: "pspace_aligned s" assumes pspace_distinct: "pspace_distinct s" @@ -519,6 +520,8 @@ proof - done qed +lemmas ADT_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts absHeap @@ -526,8 +529,7 @@ arch_requalify_consts absHeap interpretation ADT_H_2?: ADT_H_2 vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState absHeap proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.ADT_H_2_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchArchAcc_R.thy b/proof/refine/ARM/ArchArchAcc_R.thy index afdbe882e4..312f1ea290 100644 --- a/proof/refine/ARM/ArchArchAcc_R.thy +++ b/proof/refine/ARM/ArchArchAcc_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems ArchAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ArchAcc_R locale *) lemma asid_pool_at_ko: "asid_pool_at p s \ \pool. ko_at (ArchObj (ARM_A.ASIDPool pool)) p s" @@ -1006,7 +1006,7 @@ crunch copyGlobalMappings sublocale copyGlobalMappings: typ_at_props' "copyGlobalMappings newPT" by typ_at_props' -lemma arch_cap_rights_update[ArchAcc_R_assms]: +lemma arch_cap_rights_update[Arch_assms]: "acap_relation c c' \ cap_relation (cap.ArchObjectCap (acap_rights_update (acap_rights c \ msk) c)) (Arch.maskCapRights (rights_mask_map msk) c')" @@ -1036,7 +1036,7 @@ lemma arch_deriveCap_valid: apply (rule hoare_pre, wp undefined_validE_R) apply (cases arch_cap, simp_all add: isCap_defs) apply (simp add: valid_cap'_def capAligned_def - global.capUntypedPtr_def capUntypedPtr_def) + global.capUntypedPtr_def ARM_H.capUntypedPtr_def) done lemma arch_deriveCap_corres [corres]: @@ -1346,7 +1346,7 @@ lemma setObject_ASID_ctes_of'[wp]: \\rv s. P (ctes_of s)\" by (rule ctes_of_from_cte_wp_at [where Q=\, simplified]) wp -lemma pspace_aligned_cross[ArchAcc_R_assms]: +lemma pspace_aligned_cross[Arch_assms]: "\ pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_aligned' s'" apply (clarsimp simp: pspace_aligned'_def pspace_aligned_def pspace_relation_def) apply (rename_tac p' ko') @@ -1426,7 +1426,7 @@ lemma obj_relation_cuts_range_limit: apply fastforce+ done -lemma obj_relation_cuts_range_mask_range[ArchAcc_R_assms]: +lemma obj_relation_cuts_range_mask_range[Arch_assms]: "\ (p', P) \ obj_relation_cuts ko p; P ko ko'; is_aligned p (obj_bits ko) \ \ p' \ mask_range p (obj_bits ko)" apply (drule (1) obj_relation_cuts_range_limit, clarsimp) @@ -1448,7 +1448,7 @@ lemma obj_relation_cuts_obj_bits: split: kernel_object.splits arch_kernel_object.splits) done -lemma pspace_distinct_cross[ArchAcc_R_assms]: +lemma pspace_distinct_cross[Arch_assms]: "\ pspace_distinct s; pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_distinct' s'" apply (frule (1) pspace_aligned_cross) @@ -1494,12 +1494,13 @@ lemma pspace_distinct_cross[ArchAcc_R_assms]: apply (erule (2) in_empty_interE) done -end +lemmas ArchAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation ArchAcc_R?: ArchAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact ArchAcc_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.ArchAcc_R_assms)?) qed end diff --git a/proof/refine/ARM/ArchArch_R.thy b/proof/refine/ARM/ArchArch_R.thy index 8c6809acff..bd72af6cbd 100644 --- a/proof/refine/ARM/ArchArch_R.thy +++ b/proof/refine/ARM/ArchArch_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Arch_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Arch_R locale *) definition "asid_ci_map i \ @@ -353,7 +353,7 @@ crunch decodeARMMMUInvocation simp: crunch_simps) crunch Arch.decodeInvocation - for inv[Arch_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (wp: crunch_wps mapME_x_inv_wp getASID_wp simp: crunch_simps) @@ -672,7 +672,7 @@ lemma resolve_vaddr_valid_mapping_size: split: if_split_asm) done -lemma arch_decodeInvocation_corres[Arch_R_assms]: +lemma arch_decodeInvocation_corres[Arch_assms]: notes check_vp_inv[wp del] check_vp_wpR[wp] (* FIXME: check_vp_inv shadowed check_vp_wpR. Instead, check_vp_wpR should probably be generalised to replace check_vp_inv. *) @@ -1030,7 +1030,7 @@ shows apply clarsimp done -lemma arch_performInvocation_corres[Arch_R_assms]: +lemma arch_performInvocation_corres[Arch_assms]: "archinv_relation ai ai' \ corres (dc \ (=)) (einvs and ct_active and valid_arch_inv ai and schact_is_rct) @@ -1120,7 +1120,7 @@ lemma performASIDControlInvocation_tcb_at': crunch performSGISignalGenerate for tcb_at'[wp]: "\s. P (tcb_at' t s)" -lemma invokeArch_tcb_at'[Arch_R_assms]: +lemma invokeArch_tcb_at'[Arch_assms]: "\invs' and valid_arch_inv' ai and ct_active' and st_tcb_at' active' p\ Arch.performInvocation ai \\rv. tcb_at' p\" @@ -1199,7 +1199,7 @@ crunch for vs_entry_align[wp]: "ko_wp_at' (\ko. P (vs_entry_align ko)) p" (wp: crunch_wps simp: crunch_simps) -lemma sts_valid_arch_inv'[Arch_R_assms]: +lemma sts_valid_arch_inv'[Arch_assms]: "\valid_arch_inv' ai\ setThreadState st t \\rv. valid_arch_inv' ai\" apply (cases ai, simp_all add: valid_arch_inv'_def) apply (clarsimp simp: valid_pti'_def split: page_table_invocation.splits) @@ -1654,7 +1654,7 @@ lemma arch_decodeInvocation_wf[wp]: apply wp done -lemma arch_decodeInvocation_wf_interface[Arch_R_assms]: +lemma arch_decodeInvocation_wf_interface[Arch_assms]: "\invs' and valid_cap' (ArchObjectCap arch_cap) 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 @@ -1809,7 +1809,7 @@ lemma performSGISignalInvocation_invs[wp]: unfolding performSGISignalGenerate_def by (wpsimp wp: dmo_invs'_simple simp: no_irq_sendSGI) -lemma arch_performInvocation_invs'[Arch_R_assms]: +lemma arch_performInvocation_invs'[Arch_assms]: "\invs' and ct_active' and valid_arch_inv' invocation\ Arch.performInvocation invocation \\rv. invs'\" @@ -1818,7 +1818,7 @@ lemma arch_performInvocation_invs'[Arch_R_assms]: simp_all add: performARMMMUInvocation_def valid_arch_inv'_def, (wp|simp)+) -lemma setObject_TCB_valid_duplicates'[Arch_R_assms, wp]: +lemma setObject_TCB_valid_duplicates'[Arch_assms, wp]: "setObject p (tcb::tcb) \\s. vs_valid_duplicates' (ksPSpace s)\" apply (clarsimp simp: setObject_def split_def valid_def in_monad pspace_aligned'_def ps_clear_upd @@ -1843,6 +1843,8 @@ lemma hv_inv_ex': apply simp done +lemmas Arch_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -1851,8 +1853,7 @@ arch_requalify_consts interpretation Arch_R?: Arch_R valid_arch_inv' archinv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Arch_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Arch_R_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchBits_R.thy b/proof/refine/ARM/ArchBits_R.thy index fbae9f35b5..68af6067ed 100644 --- a/proof/refine/ARM/ArchBits_R.thy +++ b/proof/refine/ARM/ArchBits_R.thy @@ -10,30 +10,30 @@ begin context Arch begin arch_global_naming -named_theorems Bits_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Bits_R locale *) crunch_ignore (add: setCurrentPD sendSGI) -lemma atcbContext_get_eq[Bits_R_assms, simp]: +lemma atcbContext_get_eq[Arch_assms, simp]: "atcbContextGet (atcbContextSet x atcb) = x" by (simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_eq[Bits_R_assms, simp]: +lemma atcbContext_set_eq[Arch_assms, simp]: "atcbContextSet (atcbContextGet t) t = t" by (cases t, simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_set[Bits_R_assms, simp]: +lemma atcbContext_set_set[Arch_assms, simp]: "atcbContextSet x (atcbContextSet y atcb) = atcbContextSet x atcb" by (cases atcb, simp add: atcbContextSet_def) -lemma objBitsKO_less_word_bits[Bits_R_assms]: +lemma objBitsKO_less_word_bits[Arch_assms]: "objBitsKO ko < word_bits" unfolding objBits_def by (case_tac ko; simp add: pageBits_def pteBits_def pdeBits_def objBits_simps' word_bits_def split: arch_kernel_object.split) -lemma objBitsKO_neq_0[Bits_R_assms]: +lemma objBitsKO_neq_0[Arch_assms]: "objBitsKO ko \ 0" unfolding objBits_def by (case_tac ko; @@ -53,7 +53,7 @@ lemma arch_isCap_simps: (* isArchSGISignalCap_def is already in expanded exists form, so no need to spell it out. *) lemmas isCap_simps = gen_isCap_simps arch_isCap_simps isArchSGISignalCap_def -lemma pageBits_le_maxUntypedSizeBits[Bits_R_assms, simp]: +lemma pageBits_le_maxUntypedSizeBits[Arch_assms, simp]: "pageBits \ maxUntypedSizeBits" by (simp add: pageBits_def maxUntypedSizeBits_def) @@ -87,7 +87,9 @@ lemma projectKO_user_data_device: lemmas arch_projectKOs = projectKO_ASID projectKO_PTE projectKO_PDE projectKO_user_data projectKO_user_data_device -end +lemmas Bits_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) (* for projectKO_opt, we want to export the arch-specific instantiation lemmas *) arch_requalify_facts arch_projectKOs @@ -99,8 +101,7 @@ lemmas projectKOs = gen_projectKOs arch_projectKOs interpretation Bits_R?: Bits_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Bits_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Bits_R_assms)?) qed end diff --git a/proof/refine/ARM/ArchCNodeInv_R.thy b/proof/refine/ARM/ArchCNodeInv_R.thy index 250c819075..aef792aef6 100644 --- a/proof/refine/ARM/ArchCNodeInv_R.thy +++ b/proof/refine/ARM/ArchCNodeInv_R.thy @@ -14,49 +14,49 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_R locale *) definition arch_finalise_prop_stuff :: "(kernel_state \ bool) \ bool" where "arch_finalise_prop_stuff P = True" -lemma arch_finalise_prop_stuff_top[CNodeInv_R_assms, simp]: +lemma arch_finalise_prop_stuff_top[Arch_assms, simp]: "arch_finalise_prop_stuff \" by (simp add: arch_finalise_prop_stuff_def) -lemma acap_relation_arch_update_cap_data_NullCap[CNodeInv_R_assms]: +lemma acap_relation_arch_update_cap_data_NullCap[Arch_assms]: "acap_relation acap acap' \ (arch_update_cap_data P x acap = cap.NullCap) = (Arch.updateCapData P x acap' = NullCap)" unfolding arch_update_cap_data_def ARM_H.updateCapData_def by (cases acap; simp) -lemma cnode_guard_size_bits_wordRadix[CNodeInv_R_assms]: +lemma cnode_guard_size_bits_wordRadix[Arch_assms]: "cnode_guard_size_bits = wordRadix" by (simp add: wordRadix_def) -lemma cteRightsBits_cnode_padding_bits[CNodeInv_R_assms]: +lemma cteRightsBits_cnode_padding_bits[Arch_assms]: "cteRightsBits = cnode_padding_bits" by (simp add: cteRightsBits_def) (* FIXME arch-split: valid_cnode_capI in CNodeInv_AI exposes the value of word_bits, replace with this *) -lemma valid_cnode_capI'[CNodeInv_R_assms]: +lemma valid_cnode_capI'[Arch_assms]: "\cap_table_at n w s; valid_objs s; pspace_aligned s; 0 < n; length g \ word_bits\ \ s \ cap.CNodeCap w n g" by (simp add: word_bits_def valid_cnode_capI) -lemma arch_capBadge_updateCapData_True[CNodeInv_R_assms]: +lemma arch_capBadge_updateCapData_True[Arch_assms]: "Arch.updateCapData True x acap \ NullCap \ capBadge (Arch.updateCapData True x acap) = arch_capBadge acap" unfolding ARM_H.updateCapData_def by (cases acap; simp) crunch prepareThreadDelete - for ctes_of[CNodeInv_R_assms, wp]: "\s. P (ctes_of s)" + for ctes_of[Arch_assms, wp]: "\s. P (ctes_of s)" crunch prepareThreadDelete - for not_recursive_ctes[CNodeInv_R_assms]: "\s. P (not_recursive_ctes s)" + for not_recursive_ctes[Arch_assms]: "\s. P (not_recursive_ctes s)" (simp: prepareThreadDelete_def not_recursive_ctes_def cteCaps_of_def) -lemma in_preempt'[CNodeInv_R_assms]: +lemma in_preempt'[Arch_assms]: "(Inr rv, s') \ fst (preemptionPoint s) \ \f g. s' = ksWorkUnitsCompleted_update f (s \ ksMachineState := ksMachineState s \ irq_state := g (irq_state (ksMachineState s)) \\)" @@ -82,19 +82,19 @@ lemma sameRegionAs_eq_parent: \ sameRegionAs c' cap" by (clarsimp simp: weak_derived'_def sameRegionAs_def2 isCap_simps) -lemma sameRegion_ep[CNodeInv_R_assms]: +lemma sameRegion_ep[Arch_assms]: "\ sameRegionAs cap cap'; isEndpointCap cap \ \ isEndpointCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegion_ntfn[CNodeInv_R_assms]: +lemma sameRegion_ntfn[Arch_assms]: "\ sameRegionAs cap cap'; isNotificationCap cap \ \ isNotificationCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegionAs_Zombie[CNodeInv_R_assms, simp]: +lemma sameRegionAs_Zombie[Arch_assms, simp]: "\ sameRegionAs (Zombie p zb n) cap" by (simp add: sameRegionAs_def3 isCap_simps) -lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: +lemma isFinal_notUntyped_capRange_disjoint[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); cteCaps_of s sl' = Some cap'; sl \ sl'; capUntypedPtr cap = capUntypedPtr cap'; capBits cap = capBits cap'; isThreadCap cap \ isCNodeCap cap; s \' cap; @@ -114,7 +114,7 @@ lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: (clarsimp simp: sameObjectAs_def3 isCap_simps)?)+ done -lemma ztc_sameRegion[CNodeInv_R_assms]: +lemma ztc_sameRegion[Arch_assms]: "\ isCNodeCap cap \ isThreadCap cap \ isZombie cap \ \ sameRegionAs cap cap' = sameObjectAs cap cap'" apply (subgoal_tac "\ isUntypedCap cap \ \ isArchFrameCap cap @@ -123,7 +123,7 @@ lemma ztc_sameRegion[CNodeInv_R_assms]: apply (auto simp: isCap_simps) done -lemma mdb_chunked_update_final[CNodeInv_R_assms]: +lemma mdb_chunked_update_final[Arch_assms]: assumes chunked: "mdb_chunked m" and slot: "m slot = Some (CTE cap node)" and Fin1: "\x cte. m x = Some cte \ x \ slot @@ -182,19 +182,19 @@ proof - done qed -lemma sameRegionAs_ThreadCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_ThreadCap_eq[Arch_assms]: "sameRegionAs (ThreadCap p) (ThreadCap p') = (p = p')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_IRQHandlerCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_IRQHandlerCap_eq[Arch_assms]: "sameRegionAs (IRQHandlerCap irq) (IRQHandlerCap irq') = (irq = irq')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_CNodeCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_CNodeCap_eq[Arch_assms]: "sameRegionAs (CNodeCap p b g gs) (CNodeCap p' b' g' gs') = (p = p' \ b = b')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma ztc_untyped_helper[CNodeInv_R_assms]: +lemma ztc_untyped_helper[Arch_assms]: "\ isCNodeCap cap' \ isThreadCap cap' \ isZombie cap'; sameRegionAs cap cap' \ \ isUntypedCap cap \ sameRegionAs cap' cap" apply (erule sameRegionAsE) @@ -208,12 +208,12 @@ lemma ztc_untyped_helper[CNodeInv_R_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma valid_arch_badges_PhysicalClass[CNodeInv_R_assms]: +lemma valid_arch_badges_PhysicalClass[Arch_assms]: "\ valid_arch_badges cap'' cap' node'; capClass cap'' = PhysicalClass; capClass cap = PhysicalClass \ \ valid_arch_badges cap cap' node'" by (auto simp: valid_arch_badges_def isCap_simps) -lemma isFinal_Zombie[CNodeInv_R_assms]: +lemma isFinal_Zombie[Arch_assms]: "isFinal (Zombie p' b n) p cs" by (simp add: isFinal_def sameObjectAs_def2 gen_isCap_simps) @@ -221,25 +221,25 @@ crunch Arch.postCapDeletion for no_cte_prop[wp]: "no_cte_prop P" (* interface, above crunch does not result in same lemma on all architectures *) -lemma arch_postCapDeletion_no_cte_prop[CNodeInv_R_assms]: +lemma arch_postCapDeletion_no_cte_prop[Arch_assms]: "\no_cte_prop P and K (arch_finalise_prop_stuff P)\ Arch.postCapDeletion t \\_. no_cte_prop P\" by wpsimp -lemma post_cap_delete_pre'_IRQHandlerCap[CNodeInv_R_assms]: +lemma post_cap_delete_pre'_IRQHandlerCap[Arch_assms]: "post_cap_delete_pre' (IRQHandlerCap irq) sl cs = (arch_valid_irq irq \ (\sl'. sl \ sl' \ cs sl' \ Some (IRQHandlerCap irq)))" by (simp add: post_cap_delete_pre'_def) -lemma final_post_cap_delete_pre'_ArchObjectCap[CNodeInv_R_assms]: +lemma final_post_cap_delete_pre'_ArchObjectCap[Arch_assms]: "\ isFinal (ArchObjectCap acap) sl (cteCaps_of s); arch_cap_has_cleanup' acap; valid_arch_cap' acap s\ \ post_cap_delete_pre' (ArchObjectCap acap) sl (cteCaps_of s)" by (clarsimp simp add: post_cap_delete_pre'_def arch_cap_has_cleanup'_def isCap_simps) crunch Arch_finaliseCap, prepareThreadDelete - for st_tcb_at'[CNodeInv_R_assms, wp]: "st_tcb_at' P t" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" (simp: crunch_simps wp: crunch_wps getObject_inv loadObject_default_inv rule: ARM_H.finaliseCap_def) @@ -253,7 +253,7 @@ lemma archThreadSet_rvk_prog': by (wpsimp simp: cteCaps_of_def) crunch prepareThreadDelete, Arch_finaliseCap - for rvk_prog'[CNodeInv_R_assms]: + for rvk_prog'[Arch_assms]: "\s. revoke_progress_ord m (\x. option_map capToRPO (cteCaps_of s x))" (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of getObject_inv loadObject_default_inv @@ -261,13 +261,13 @@ crunch prepareThreadDelete, Arch_finaliseCap ignore: setCTE threadSet rule: ARM_H.finaliseCap_def) -lemma cap_relation_trans[CNodeInv_R_assms]: +lemma cap_relation_trans[Arch_assms]: "\ cap_relation cap cap'; cap_relation cap cap'' \ \ cap' = cap''" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) crunch Arch_finaliseCap, prepareThreadDelete - for irq_states'[CNodeInv_R_assms, wp]: valid_irq_states' + for irq_states'[Arch_assms, wp]: valid_irq_states' (wp: crunch_wps unless_wp getASID_wp no_irq no_irq_invalidateLocalTLB_ASID no_irq_setHardwareASID no_irq_set_current_pd no_irq_invalidateLocalTLB_VAASID @@ -439,18 +439,19 @@ end (* mdb_move *) context Arch begin arch_global_naming -lemmas [CNodeInv_R_assms] = +lemmas [Arch_assms] = mdb_swap.cteSwap_valid_mdb_helper mdb_move.cteMove_valid_mdb_helper +lemmas CNodeInv_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts arch_finalise_prop_stuff interpretation CNodeInv_R?: CNodeInv_R arch_finalise_prop_stuff proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CNodeInv_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CNodeInv_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/ARM/ArchCSpace1_R.thy b/proof/refine/ARM/ArchCSpace1_R.thy index ec5cfe858b..5adf4cb97e 100644 --- a/proof/refine/ARM/ArchCSpace1_R.thy +++ b/proof/refine/ARM/ArchCSpace1_R.thy @@ -13,22 +13,22 @@ begin context Arch begin arch_global_naming -named_theorems CSpace1_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R locale *) -lemma ghost_relation_wrapper_same_abs_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_abs_set_cap[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap cap dest a); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma ghost_relation_wrapper_set_cap_twice[CSpace1_R_assms]: +lemma ghost_relation_wrapper_set_cap_twice[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap dcap src a); ((), a'') \ fst (set_cap scap dest a'); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a'' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma archMDBAssertions_cross[CSpace1_R_assms]: +lemma archMDBAssertions_cross[Arch_assms]: "\ valid_arch_mdb (is_original_cap s) (caps_of_state s); valid_arch_state s; valid_objs s; (s, s') \ state_relation \ \ archMDBAssertions s'" @@ -82,7 +82,7 @@ lemma isMDBParentOf_trans: apply (erule(1) capBadge_ordering_trans) done -lemma parentOf_trans[CSpace1_R_assms]: +lemma parentOf_trans[Arch_assms]: "\ s \ a parentOf b; s \ b parentOf c \ \ s \ a parentOf c" by (auto simp: parentOf_def elim: isMDBParentOf_trans) @@ -98,7 +98,7 @@ lemma is_physical_relation: by (auto simp: is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma obj_ref_of_relation[CSpace1_R_assms]: +lemma obj_ref_of_relation[Arch_assms]: "\ cap_relation c c'; capClass c' = PhysicalClass \ \ obj_ref_of c = capUntypedPtr c'" by (cases c; simp) (rename_tac arch_cap, case_tac arch_cap, auto) @@ -124,7 +124,7 @@ lemma obj_size_relation: pageBits_def ptBits_def pteBits_def pdBits_def pdeBits_def) done -lemma same_region_as_relation[CSpace1_R_assms]: +lemma same_region_as_relation[Arch_assms]: "\ cap_relation c d; cap_relation c' d' \ \ same_region_as c c' = sameRegionAs d d'" apply (cases c) apply clarsimp @@ -152,7 +152,7 @@ lemma acap_relation_SGISignalCapD: acap = arch_cap.SGISignalCap (ucast irq) (ucast target)" by (cases acap) (auto simp: ucast_down_ucast_id is_down) -lemma can_be_is[CSpace1_R_assms]: +lemma can_be_is[Arch_assms]: "\ cap_relation c (cteCap cte); cap_relation c' (cteCap cte'); mdbRevocable (cteMDBNode cte) = r; mdbFirstBadged (cteMDBNode cte') = r' \ \ @@ -181,14 +181,14 @@ lemma maskVMRights_VMNoAccess[simp]: "(maskVMRights vmR R = VMNoAccess) = (vmR = VMNoAccess)" by (simp add: maskVMRights_def split: vmrights.splits bool.splits) -lemma maskCap_valid[CSpace1_R_assms, simp]: +lemma maskCap_valid[Arch_assms, simp]: "s \' global.maskCapRights R cap = s \' cap" by (clarsimp simp: valid_cap'_def global.maskCapRights_def isCap_simps capAligned_def ARM_H.maskCapRights_def split: capability.split arch_capability.split cong: if_cong) -lemma cap_map_update_data[CSpace1_R_assms]: +lemma cap_map_update_data[Arch_assms]: assumes "cap_relation c c'" shows "cap_relation (update_cap_data p x c) (updateCapData p x c')" proof - @@ -234,7 +234,7 @@ qed sublocale setCTE: typ_at_props' "setCTE c cte" by typ_at_props' -lemma arch_updateCapData_Master[CSpace1_R_assms]: +lemma arch_updateCapData_Master[Arch_assms]: "Arch.updateCapData P d acap \ NullCap \ capMasterCap (Arch.updateCapData P d acap) = capMasterCap (ArchObjectCap acap)" by (cases acap; simp add: ARM_H.updateCapData_def split: if_split_asm) @@ -246,28 +246,28 @@ private method updateCapData_cases for c = (rename_tac arch_capability), (case_tac arch_capability; simp add: ARM_H.updateCapData_def isCap_simps Let_def) -lemma capASID_update[CSpace1_R_assms, simp]: +lemma capASID_update[Arch_assms, simp]: "capASID (RetypeDecls_H.updateCapData P x c) = capASID c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_vptr_update'[CSpace1_R_assms, simp]: +lemma cap_vptr_update'[Arch_assms, simp]: "cap_vptr' (RetypeDecls_H.updateCapData P x c) = cap_vptr' c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_asid_base_update'[CSpace1_R_assms, simp]: +lemma cap_asid_base_update'[Arch_assms, simp]: "cap_asid_base' (RetypeDecls_H.updateCapData P x c) = cap_asid_base' c" unfolding cap_asid_base'_def by (updateCapData_cases c) -lemma updateCapData_Reply[CSpace1_R_assms, simp]: +lemma updateCapData_Reply[Arch_assms, simp]: "isReplyCap (updateCapData P x c) = isReplyCap c" by (updateCapData_cases c) end (* context private method *) -lemma capASID_mask[CSpace1_R_assms, simp]: +lemma capASID_mask[Arch_assms, simp]: "capASID (maskCapRights x c) = capASID c" unfolding capASID_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -276,7 +276,7 @@ lemma capASID_mask[CSpace1_R_assms, simp]: simp_all add: ARM_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_vptr_mask'[CSpace1_R_assms, simp]: +lemma cap_vptr_mask'[Arch_assms, simp]: "cap_vptr' (maskCapRights x c) = cap_vptr' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -285,7 +285,7 @@ lemma cap_vptr_mask'[CSpace1_R_assms, simp]: simp_all add: ARM_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_asid_base_mask'[CSpace1_R_assms, simp]: +lemma cap_asid_base_mask'[Arch_assms, simp]: "cap_asid_base' (maskCapRights x c) = cap_asid_base' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -416,7 +416,7 @@ proof - done qed -lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: +lemma set_cap_not_quite_corres_prequel[Arch_assms]: assumes cr: "pspace_relation (kheap s) (ksPSpace s')" "(x,t') \ fst (setCTE p' c' s')" @@ -465,7 +465,7 @@ lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: done (* FIXME: move *) -lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: +lemma pspace_relation_cte_wp_atI'[Arch_assms]: "\ pspace_relation (kheap s) (ksPSpace s'); cte_wp_at' ((=) cte) x s'; valid_objs s \ \ \c slot. cte_wp_at ((=) c) slot s \ cap_relation c (cteCap cte) \ x = cte_map slot" @@ -489,23 +489,23 @@ lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: split: Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm) done -lemma same_region_as_final_matters[CSpace1_R_assms]: +lemma same_region_as_final_matters[Arch_assms]: "\same_region_as c c'; final_matters c\ \ final_matters c'" by (rule ccontr) (simp add: final_matters_def final_matters_arch_def cap_relation_split_asm split: cap.split_asm arch_cap.splits) -lemma same_region_as_arch_gen_refs[CSpace1_R_assms]: +lemma same_region_as_arch_gen_refs[Arch_assms]: "\same_region_as c c'; final_matters c \ \ arch_gen_refs c = arch_gen_refs c'" by (auto simp: final_matters_def cap_relation_split_asm is_cap_simps arch_gen_obj_refs_def split: cap.split_asm arch_cap.splits) -lemma arch_same_region_aobj_ref[CSpace1_R_assms]: +lemma arch_same_region_aobj_ref[Arch_assms]: "\arch_same_region_as ac ac'; final_matters_arch ac; final_matters_arch ac'\ \ aobj_ref ac = aobj_ref ac'" by (simp add: final_matters_arch_def split: ARM_A.arch_cap.splits) -lemma obj_refs_relation_Master[CSpace1_R_assms]: +lemma obj_refs_relation_Master[Arch_assms]: "cap_relation cap cap' \ obj_refs cap = (if capClass (capMasterCap cap') = PhysicalClass \ \ isUntypedCap (capMasterCap cap') then {capUntypedPtr (capMasterCap cap')} @@ -517,13 +517,13 @@ lemma arch_gen_refs_relation_Master: "cap_relation cap cap' \ arch_gen_refs cap = {}" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma arch_gen_refs_cap_relation_Master_eq[CSpace1_R_assms]: +lemma arch_gen_refs_cap_relation_Master_eq[Arch_assms]: "\cap_relation c (cteCap cte); capMasterCap (cteCap cte') = capMasterCap (cteCap cte); cap_relation c' (cteCap cte')\ \ arch_gen_refs c = arch_gen_refs c'" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma descendants_of_update_ztc[CSpace1_R_assms]: +lemma descendants_of_update_ztc[Arch_assms]: assumes c: "\x. \ m \ x \ slot; \ P \ \ \cte'. m x = Some cte' \ capMasterCap (cteCap cte') \ capMasterCap (cteCap cte) @@ -720,7 +720,7 @@ proof (simp add: descendants_of'_def subset_iff, by simp qed -lemma capRange_cap_relation[CSpace1_R_assms]: +lemma capRange_cap_relation[Arch_assms]: "\ cap_relation cap cap'; capClass cap' = PhysicalClass \ \ capRange cap' = {obj_ref_of cap .. obj_ref_of cap + obj_size cap - 1}" by (simp add: capRange_def objBits_simps' cte_level_bits_def @@ -728,23 +728,23 @@ lemma capRange_cap_relation[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm option.split sum.split) -lemma obj_refs_cap_relation_untyped_ptr[CSpace1_R_assms]: +lemma obj_refs_cap_relation_untyped_ptr[Arch_assms]: "\ cap_relation cap cap'; obj_refs cap \ {} \ \ capUntypedPtr cap' \ obj_refs cap" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) -lemma ghost_relation_wrapper_same_concrete_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_concrete_set_cap[Arch_assms]: "\ ghost_relation_wrapper s c; ((), s') \ fst (set_cap cap src s) \ \ ghost_relation_wrapper s' c" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma revokable_plus_orderD[CSpace1_R_assms]: +lemma revokable_plus_orderD[Arch_assms]: "\ isCapRevocable new old; (capBadge old, capBadge new) \ capBadge_ordering P; capMasterCap old = capMasterCap new \ \ (isUntypedCap new \ (\x. capBadge old = Some 0 \ capBadge new = Some x \ x \ 0))" by (clarsimp simp: Retype_H.isCapRevocable_def ARM_H.isCapRevocable_def isCap_simps split: if_split_asm capability.split_asm arch_capability.split_asm) -lemma valid_badges_def2[CSpace1_R_assms]: +lemma valid_badges_def2[Arch_assms]: "valid_badges m = (\p p' cap node cap' node'. m p = Some (CTE cap node) \ @@ -761,7 +761,7 @@ lemma valid_badges_def2[CSpace1_R_assms]: apply (case_tac cap; clarsimp simp: gen_isCap_simps) by (fastforce simp: sameRegionAs_def3 isCap_simps arch_capBadge_def)+ -lemma is_cap_revocable_eq[CSpace1_R_assms]: +lemma is_cap_revocable_eq[Arch_assms]: "\ cap_relation c c'; cap_relation src_cap src_cap'; sameRegionAs src_cap' c'; is_untyped_cap src_cap \ \ is_ep_cap c \ \ is_ntfn_cap c\ \ is_cap_revocable c src_cap = isCapRevocable c' src_cap'" @@ -771,10 +771,10 @@ lemma is_cap_revocable_eq[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm) done -lemmas use_update_ztc_one_descendants[CSpace1_R_assms] = +lemmas use_update_ztc_one_descendants[Arch_assms] = use_update_ztc_one[OF ARM.descendants_of_update_ztc, simplified] -lemma is_derived'_genD[CSpace1_R_assms]: +lemma is_derived'_genD[Arch_assms]: "is_derived' m p cap' cap \ cap' \ NullCap \ \ isZombie cap \ @@ -786,11 +786,11 @@ lemma is_derived'_genD[CSpace1_R_assms]: (isReplyCap cap' \ \ capReplyMaster cap')" by (simp add: ARM.is_derived'_def) -lemma acap_relation_capBadge[CSpace1_R_assms]: +lemma acap_relation_capBadge[Arch_assms]: "acap_relation acap acap' \ arch_capBadge acap' = arch_cap_badge acap" by (simp add: arch_capBadge_def) -lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: +lemma obj_relation_cuts_in_obj_range[Arch_assms]: "\ (y, P) \ obj_relation_cuts ko x; x \ obj_range x ko; kheap s x = Some ko; valid_objs s; pspace_aligned s \ \ y \ obj_range x ko" @@ -843,7 +843,7 @@ lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: apply (simp add: word_bits_def) done -lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: +lemma isMDBParentOf_CTE_gen[Arch_assms]: "\isArchObjectCap cap \ isMDBParentOf (CTE cap node) cte = (\cap' node'. cte = CTE cap' node' \ sameRegionAs cap cap' @@ -851,19 +851,20 @@ lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: \ (capBadge cap, capBadge cap') \ capBadge_ordering (mdbFirstBadged node'))" by (simp add: isMDBParentOf_CTE isCap_simps) +lemmas CSpace1_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R?: CSpace1_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace1_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace1_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_2 locale *) -lemma updateMDB_pspace_relation[CSpace1_R_2_assms]: +lemma updateMDB_pspace_relation[Arch_assms]: assumes "(x, s'') \ fst (updateMDB p f s')" assumes "pspace_relation (kheap s) (ksPSpace s')" assumes "pspace_aligned' s'" "pspace_distinct' s'" @@ -922,7 +923,7 @@ lemma cap_asid_cap_relation: by (auto simp: capASID_def cap_asid_def arch_cap_fun_lift_def split: cap.splits arch_cap.splits option.splits) -lemma is_derived_eq[CSpace1_R_2_assms]: +lemma is_derived_eq[Arch_assms]: "\ cap_relation c c'; cap_relation d d'; cdt_relation (swp cte_at s) (cdt s) (ctes_of s'); cte_at p s \ \ is_derived (cdt s) p c d = is_derived' (ctes_of s') (cte_map p) c' d'" @@ -974,7 +975,7 @@ lemma isMDBParentOf_eq_child: apply (clarsimp simp: sameRegionAs_def2 isCap_simps) done -lemma isMDBParentOf_eq[CSpace1_R_2_assms]: +lemma isMDBParentOf_eq[Arch_assms]: "\ isMDBParentOf c d; weak_derived' (cteCap c) (cteCap c'); mdbRevocable (cteMDBNode c') = mdbRevocable (cteMDBNode c); @@ -1026,11 +1027,11 @@ lemma sameRegionAs_SGISignalCap2[simp]: isIRQControlCapDescendant_def split: if_splits) -lemma arch_mdb_preservation_refl[simp, intro!, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_refl[simp, intro!, Arch_assms]: "arch_mdb_preservation cap cap" by (simp add: arch_mdb_preservation_def) -lemma arch_mdb_preservation_sym[CSpace1_R_2_assms]: +lemma arch_mdb_preservation_sym[Arch_assms]: "arch_mdb_preservation cap cap' = arch_mdb_preservation cap' cap" by (auto simp: arch_mdb_preservation_def) @@ -1038,11 +1039,11 @@ lemma arch_mdb_preservation_non_arch: "\ \isArchObjectCap cap; \isArchObjectCap cap' \ \ arch_mdb_preservation cap cap'" by (simp add: arch_mdb_preservation_def isCap_simps) -lemma arch_mdb_preservation_Untyped[simp, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_Untyped[simp, Arch_assms]: "arch_mdb_preservation (UntypedCap d p sz idx) (UntypedCap d' p' sz' idx')" by (simp add: arch_mdb_preservation_non_arch isCap_simps) -lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: +lemma parentOf_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. \m x = Some cte; m' x = Some cte'\ \ @@ -1084,7 +1085,7 @@ lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: apply blast done -lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: +lemma mdb_chunked_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. @@ -1130,7 +1131,7 @@ lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: apply (clarsimp simp:mdb_next_rel_def node) done -lemma valid_badges_preserve_oneway[CSpace1_R_2_assms]: +lemma valid_badges_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes misc: "\x cte cte'. @@ -1208,12 +1209,13 @@ definition is_simple_cap' :: "capability \ bool" where \ isZombie cap \ \ isArchFrameCap cap" +lemmas CSpace1_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R_2?: CSpace1_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_2_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace1_R_2_assms)?)) qed (* needed to prove dest_no_parent_n in Arch, then export to mdb_insert_der *) @@ -1344,19 +1346,20 @@ end context Arch begin arch_global_naming -named_theorems CSpace1_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_3 locale *) -lemmas [CSpace1_R_3_assms] = +lemmas [Arch_assms] = is_derived_maskedAsFull derived_sameRegionAs maskedAsFull_revokable mdb_insert_der.dest_no_parent_n mdb_insert_sib.src_no_mdb_parent mdb_insert_sib.parent_preserved -end +lemmas CSpace1_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace1_R_3?: CSpace1_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_3_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace1_R_3_assms)?)) qed locale Arch_masterCap = Arch + masterCap diff --git a/proof/refine/ARM/ArchCSpace_I.thy b/proof/refine/ARM/ArchCSpace_I.thy index 6ef8baa6c0..75d5aeb4df 100644 --- a/proof/refine/ARM/ArchCSpace_I.thy +++ b/proof/refine/ARM/ArchCSpace_I.thy @@ -16,7 +16,7 @@ abbreviation (input) context Arch begin arch_global_naming -named_theorems CSpace_I_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I locale *) lemma capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (ARM_H.ASIDPoolCap r asid) = r" @@ -25,14 +25,14 @@ lemma capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (ARM_H.PageDirectoryCap r mapdata3) = r" by (auto simp: ARM_H.capUntypedPtr_def) -lemma maskCapRights_allRights[CSpace_I_assms, simp]: +lemma maskCapRights_allRights[Arch_assms, simp]: "maskCapRights allRights c = c" - unfolding global.maskCapRights_def isCap_defs allRights_def maskCapRights_def maskVMRights_def + unfolding global.maskCapRights_def isCap_defs allRights_def ARM_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma isPhysicalCap[CSpace_I_assms, simp]: +lemma isPhysicalCap[Arch_assms, simp]: "isPhysicalCap cap = (capClass cap = PhysicalClass)" - by (simp add: global.isPhysicalCap_def isPhysicalCap_def + by (simp add: global.isPhysicalCap_def ARM_H.isPhysicalCap_def split: capability.split arch_capability.split) definition arch_capMasterCap :: "arch_capability \ arch_capability" where @@ -49,17 +49,17 @@ definition arch_capMasterCap :: "arch_capability \ arch_capability" lemmas arch_capMasterCap_simps[simp] = arch_capMasterCap_def[split_simps arch_capability.split] -lemma acapClass_arch_capMasterCap[CSpace_I_assms,simp]: +lemma acapClass_arch_capMasterCap[Arch_assms,simp]: "acapClass (arch_capMasterCap acap) = acapClass acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma capUntypedPtr_arch_capMasterCap[CSpace_I_assms, simp]: +lemma capUntypedPtr_arch_capMasterCap[Arch_assms, simp]: "Arch.capUntypedPtr (arch_capMasterCap acap) = Arch.capUntypedPtr acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: +lemma acapBits_arch_capMasterCap[Arch_assms, simp]: "acapBits (arch_capMasterCap acap) = acapBits acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) @@ -67,11 +67,11 @@ lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: lemmas isArchFrameCap_simps[simp] = isArchFrameCap_def[split_simps capability.split arch_capability.split] -lemma isArchFrameCap_arch_capMasterCap[CSpace_I_assms, simp]: +lemma isArchFrameCap_arch_capMasterCap[Arch_assms, simp]: "isArchFrameCap (ArchObjectCap (arch_capMasterCap acap)) = isArchFrameCap (ArchObjectCap acap)" by (simp add: arch_capMasterCap_def split: arch_capability.split) -lemma isArchFrameCap_non_arch[CSpace_I_assms]: +lemma isArchFrameCap_non_arch[Arch_assms]: "\is_ArchObjectCap cap \ isArchFrameCap cap = False" by (simp add: isArchFrameCap_def is_ArchObjectCap_def split: capability.split) @@ -90,18 +90,19 @@ lemma arch_capBadge_def: "arch_capBadge acap = None" by (cases acap; simp) -end +lemmas CSpace_I_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I?: CSpace_I ARM.arch_capMasterCap ARM.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace_I_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_I_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I_2 locale *) (* for the Arch locale we want the fully expanded version covering all cases, but avoiding the capMasterCap_ArchObjectCap rewrite case for an unspecified ArchObjectCap *) @@ -111,7 +112,7 @@ lemmas capMasterCap_simps[simp] = capMasterCap_def[simplified arch_capMasterCap_def, split_simps capability.split arch_capability.split] -lemma isArchFrameCap_capMasterCap[CSpace_I_2_assms, simp]: +lemma isArchFrameCap_capMasterCap[Arch_assms, simp]: "isArchFrameCap (capMasterCap cap) = isArchFrameCap cap" by (simp add: isArchFrameCap_def split: capability.split arch_capability.split) @@ -222,7 +223,7 @@ lemma sameRegionAsE: \ \ R" by (simp add: sameRegionAs_def3, fastforce simp: gen_isCap_Master arch_isCap_Master) -lemma sameObjectAsE[CSpace_I_2_assms]: +lemma sameObjectAsE[Arch_assms]: "\ sameObjectAs cap cap'; \ capMasterCap cap = capMasterCap cap'; \ isNullCap cap; \ isZombie cap; \ isUntypedCap cap; @@ -233,7 +234,7 @@ lemma sameObjectAs_sameRegionAs: "sameObjectAs cap cap' \ sameRegionAs cap cap'" by (clarsimp simp add: sameObjectAs_def2 sameRegionAs_def2 isCap_simps) -lemma sameObjectAs_sym[CSpace_I_2_assms]: +lemma sameObjectAs_sym[Arch_assms]: "sameObjectAs c d = sameObjectAs d c" by (auto simp: sameObjectAs_def2) @@ -243,17 +244,17 @@ lemma sameObject_capRange: apply (clarsimp simp: sameObjectAs_def2) done -lemma sameRegionAs_Null[CSpace_I_2_assms, simp]: +lemma sameRegionAs_Null[Arch_assms, simp]: "sameRegionAs c NullCap = False" "sameRegionAs NullCap c = False" by (simp add: sameRegionAs_def3 capRange_def isCap_simps)+ -lemma sameRegionAs_classes[CSpace_I_2_assms]: +lemma sameRegionAs_classes[Arch_assms]: "sameRegionAs cap cap' \ capClass cap = capClass cap'" by (erule sameRegionAsE, rule master_eqI) (clarsimp simp: capRange_def isCap_simps intro!: capClass_Master split: if_split_asm)+ -lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: +lemma sameRegionAs_capRange_Int[Arch_assms]: "\ sameRegionAs cap cap'; capClass cap = PhysicalClass \ capClass cap' = PhysicalClass; capAligned cap; capAligned cap' \ \ capRange cap' \ capRange cap \ {}" @@ -265,26 +266,26 @@ lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: apply (fastforce simp: capRange_Master isCap_simps)+ done -lemma sameRegionAs_trans[CSpace_I_2_assms]: +lemma sameRegionAs_trans[Arch_assms]: "\ sameRegionAs a b; sameRegionAs b c \ \ sameRegionAs a c" by (simp add: sameRegionAs_def2, elim conjE disjE) (auto simp: isCap_simps capRange_def) (* long *) -lemma capMasterCap_maskCapRights[simp, CSpace_I_2_assms]: +lemma capMasterCap_maskCapRights[simp, Arch_assms]: "capMasterCap (maskCapRights msk cap) = capMasterCap cap" apply (cases cap; simp add: global.maskCapRights_def Let_def isCap_simps capMasterCap_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: ARM_H.maskCapRights_def Let_def isCap_simps) done -lemma capBadge_maskCapRights[simp, CSpace_I_2_assms]: +lemma capBadge_maskCapRights[simp, Arch_assms]: "capBadge (maskCapRights msk cap) = capBadge cap" apply (cases cap; simp add: global.maskCapRights_def Let_def gen_isCap_simps capBadge_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: ARM_H.maskCapRights_def Let_def isCap_simps) done -lemma cte_refs_capRange[CSpace_I_2_assms]: +lemma cte_refs_capRange[Arch_assms]: "\ s \' c; \irq. c \ IRQHandlerCap irq \ \ cte_refs' c x \ capRange c" apply (cases c; simp add: capRange_def gen_isCap_simps) apply (clarsimp dest!: valid_capAligned @@ -355,15 +356,15 @@ lemma cte_refs_capRange[CSpace_I_2_assms]: apply (simp add: word_bits_def) done -lemma capBits_Master[CSpace_I_2_assms]: +lemma capBits_Master[Arch_assms]: "capBits (capMasterCap cap) = capBits cap" by (clarsimp simp: capMasterCap_def split: capability.split arch_capability.split) -lemma capUntyped_Master[CSpace_I_2_assms]: +lemma capUntyped_Master[Arch_assms]: "capUntypedPtr (capMasterCap cap) = capUntypedPtr cap" by (clarsimp simp: capMasterCap_def ARM_H.capUntypedPtr_def split: capability.split arch_capability.split) -lemma distinct_zombies_copyMasterE[CSpace_I_2_assms]: +lemma distinct_zombies_copyMasterE[Arch_assms]: "\ distinct_zombies m; m x = Some cte; capClass (cteCap cte') = PhysicalClass \ capMasterCap (cteCap cte) = capMasterCap (cteCap cte'); @@ -385,19 +386,20 @@ lemmas distinct_zombies_sameMasterE = distinct_zombies_copyMasterE[where x=x and y=x for x, simplified, OF _ _ _] -declare distinct_zombies_sameMasterE[CSpace_I_2_assms] +declare distinct_zombies_sameMasterE[Arch_assms] -lemma cap_table_at_gsCNodes_eq[CSpace_I_2_assms]: +lemma cap_table_at_gsCNodes_eq[Arch_assms]: "(s, s') \ state_relation \ (gsCNodes s' ptr = Some bits) = cap_table_at bits ptr s" by (fastforce simp: state_relation_def ghost_relation_def obj_at_def is_cap_table) -end +lemmas CSpace_I_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I_2?: CSpace_I_2 ARM.arch_capMasterCap ARM.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace_I_2_assms)?)?) qed (* Arch constant definitions required to exist for sane locales in CSpace1_R *) diff --git a/proof/refine/ARM/ArchCSpace_R.thy b/proof/refine/ARM/ArchCSpace_R.thy index d8839d5519..d60db2bd7f 100644 --- a/proof/refine/ARM/ArchCSpace_R.thy +++ b/proof/refine/ARM/ArchCSpace_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R locale *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = arch_deriveCap_corres arch_deriveCap_inv arch_deriveCap_valid (* does not work well as simp rule *) @@ -24,7 +24,7 @@ lemma capMasterCap_isArchSGISignalCap: by (auto simp: capMasterCap_def arch_capMasterCap_def isCap_simps split: capability.splits arch_capability.splits) -lemma capAligned_master[CSpace_R_assms]: +lemma capAligned_master[Arch_assms]: "\capAligned cap; capMasterCap cap = capMasterCap ncap\ \ capAligned ncap" apply (case_tac cap) apply (clarsimp simp: capAligned_def)+ @@ -42,7 +42,7 @@ sublocale updateCap: typ_at_props' "updateCap slot newCap" sublocale cteInsert: typ_at_props' "cteInsert newCap srcSlot destSlot" by typ_at_props' -lemma maskedAsFull_derived'[CSpace_R_assms]: +lemma maskedAsFull_derived'[Arch_assms]: "\m src = Some (CTE s_cap s_node); is_derived' m ptr b c\ \ is_derived' (m(src \ CTE (maskedAsFull s_cap cap) s_node)) ptr b c" apply (subgoal_tac "m(src \ CTE (maskedAsFull s_cap cap) s_node) @@ -57,21 +57,21 @@ lemma maskedAsFull_derived'[CSpace_R_assms]: apply (clarsimp simp:modify_map_def) done -lemma capMaster_capRange[CSpace_R_assms]: +lemma capMaster_capRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ capRange c = capRange c'" by (simp add: capMasterCap_def arch_capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_untypedRange[CSpace_R_assms]: +lemma capMaster_untypedRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ untypedRange c = untypedRange c'" by (simp add: capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_capClass[CSpace_R_assms]: +lemma capMaster_capClass[Arch_assms]: "capMasterCap c = capMasterCap c' \ capClass c = capClass c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma valid_arch_badges_mdbPrev_update[simp, CSpace_R_assms]: +lemma valid_arch_badges_mdbPrev_update[simp, Arch_assms]: "valid_arch_badges cap cap' (mdbPrev_update f node) = valid_arch_badges cap cap' node" by (simp add: valid_arch_badges_def) @@ -80,19 +80,19 @@ lemma valid_arch_badges_master_eq: valid_arch_badges src_cap cap' node = valid_arch_badges cap cap' node" by (auto simp: valid_arch_badges_def isCap_simps) -lemma valid_arch_badges_firstBadged[CSpace_R_assms]: +lemma valid_arch_badges_firstBadged[Arch_assms]: "\ valid_arch_badges cap cap' node; mdbFirstBadged node = mdbFirstBadged node' \ \ valid_arch_badges cap cap' node'" by (simp add: valid_arch_badges_def) -lemma valid_arch_badges_master[CSpace_R_assms]: +lemma valid_arch_badges_master[Arch_assms]: "\capMasterCap src_cap = capMasterCap cap; (capBadge src_cap, capBadge cap) \ capBadge_ordering False; valid_arch_badges src_cap cap' node\ \ valid_arch_badges cap cap' node" by (clarsimp simp: valid_arch_badges_def isCap_simps) -lemma badge_derived'_capRange[CSpace_R_assms]: +lemma badge_derived'_capRange[Arch_assms]: "badge_derived' cap src_cap \ capRange cap = capRange src_cap" apply (clarsimp simp: badge_derived'_def) apply (case_tac cap; clarsimp simp: gen_isCap_simps capRange_def) @@ -100,11 +100,11 @@ lemma badge_derived'_capRange[CSpace_R_assms]: apply (case_tac arch_capability; clarsimp simp: isCap_simps capRange_def) done -lemma valid_arch_badges_non_arch[CSpace_R_assms]: +lemma valid_arch_badges_non_arch[Arch_assms]: "\ \isArchObjectCap c; \isArchObjectCap c' \ \ valid_arch_badges c c' node" by (clarsimp simp add: valid_arch_badges_def isCap_simps) -lemma capMasterCap_valid_arch_badges_isCapRevocable[CSpace_R_assms]: +lemma capMasterCap_valid_arch_badges_isCapRevocable[Arch_assms]: "capMasterCap src_cap = capMasterCap cap \ valid_arch_badges src_cap cap (MDB word1 src (Arch.isCapRevocable cap src_cap) (Arch.isCapRevocable cap src_cap))" @@ -143,11 +143,11 @@ lemma setCTE_ko_at'_pde[wp]: Structures_H.kernel_object.split_asm) done -lemma setCTE_valid_arch[CSpace_R_assms, wp]: +lemma setCTE_valid_arch[Arch_assms, wp]: "setCTE p c \valid_arch_state'\" by (wp valid_arch_state_lift' setCTE_typ_at') -lemma setCTE_global_refs[CSpace_R_assms, wp]: +lemma setCTE_global_refs[Arch_assms, wp]: "setCTE p c \\s. P (global_refs' s)\" apply (simp add: setCTE_def setObject_def split_def updateObject_cte global_refs'_def) apply (wpsimp+; auto) @@ -156,14 +156,14 @@ lemma setCTE_global_refs[CSpace_R_assms, wp]: crunch cteInsert for arch[wp]: "\s. P (ksArchState s)" and ko_at'_pde[wp]: "\s. P (ko_at' (pde::ARM_H.pde) p' s)" - and valid_arch_state'[CSpace_R_assms, wp]: valid_arch_state' + and valid_arch_state'[Arch_assms, wp]: valid_arch_state' (wp: crunch_wps simp: cte_wp_at_ctes_of) -lemma acapClass_not_Reply[CSpace_R_assms]: +lemma acapClass_not_Reply[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) -lemma isArchMDBParentOf_non_arch[CSpace_R_assms]: +lemma isArchMDBParentOf_non_arch[Arch_assms]: "\isArchObjectCap cap \ isArchMDBParentOf cap cap' b" "\isArchObjectCap cap' \ isArchMDBParentOf cap cap' b" by (simp add: isArchMDBParentOf_def2 isCap_simps)+ @@ -332,29 +332,30 @@ context Arch begin arch_global_naming (* since these are not used after this theory, drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = Arch_mdb_insert.chunked_n[simplified Arch_mdb_insert_def] Arch_mdb_insert_sib.untyped_inc_n[simplified Arch_mdb_insert_sib_def] Arch_mdb_move.parent_preserved[simplified Arch_mdb_move_def] Arch_mdb_move.children_preserved[simplified Arch_mdb_move_def] -lemma cteInsert_pspace_in_kernel_mappings'[CSpace_R_assms]: +lemma cteInsert_pspace_in_kernel_mappings'[Arch_assms]: "cteInsert cap src dest \pspace_in_kernel_mappings'\" by wp -end +lemmas CSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R?: CSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_2 locale *) -lemma deriveCap_derived[CSpace_R_2_assms]: +lemma deriveCap_derived[Arch_assms]: "\\s. c'\ capability.NullCap \ cte_wp_at' (\cte. badge_derived' c' (cteCap cte) \ capASID c' = capASID (cteCap cte) \ cap_asid_base' c' = cap_asid_base' (cteCap cte) @@ -384,7 +385,7 @@ lemma deriveCap_derived[CSpace_R_2_assms]: | clarsimp split: option.split_asm)+) done -lemma arch_deriveCap_untyped_derived[CSpace_R_2_assms, wp]: +lemma arch_deriveCap_untyped_derived[Arch_assms, wp]: "\\s. cte_wp_at' (\cte. untyped_derived_eq c' (cteCap cte)) slot s\ ARM_H.deriveCap slot (capCap c') \\rv s. cte_wp_at' (untyped_derived_eq rv o cteCap) slot s\, -" @@ -424,7 +425,7 @@ crunch setupReplyMaster for valid_arch'[wp]: "valid_arch_state'" (wp: crunch_wps simp: crunch_simps) -lemma ex_nonz_tcb_cte_caps'[CSpace_R_2_assms]: +lemma ex_nonz_tcb_cte_caps'[Arch_assms]: "\ex_nonz_cap_to' t s; tcb_at' t s; valid_objs' s; sl \ dom tcb_cte_cases\ \ ex_cte_cap_to' (t + sl) s" apply (clarsimp simp: ex_nonz_cap_to'_def ex_cte_cap_to'_def cte_wp_at_ctes_of) @@ -451,7 +452,7 @@ lemma ex_nonz_cap_not_global': apply (clarsimp simp: ctes_of_valid_cap') done -lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: +lemma setupReplyMaster_invs'[Arch_assms, wp]: "\invs' and tcb_at' t and ex_nonz_cap_to' t\ setupReplyMaster t \\rv. invs'\" @@ -466,7 +467,7 @@ lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: ex_nonz_cap_not_global' dom_def) done -lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: +lemma arch_update_setCTE_mdb[Arch_assms]: "\cte_wp_at' (is_arch_update' cap) p and cte_wp_at' ((=) oldcte) p and valid_mdb'\ setCTE p (cteCap_update (\_. cap) oldcte) \\rv. valid_mdb'\" @@ -590,17 +591,17 @@ lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: apply (clarsimp simp add: is_arch_update'_def isCap_simps) done -lemma capMaster_zobj_refs[CSpace_R_2_assms]: +lemma capMaster_zobj_refs[Arch_assms]: "capMasterCap c = capMasterCap c' \ zobj_refs' c = zobj_refs' c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma zobj_refs_Master[CSpace_R_2_assms]: +lemma zobj_refs_Master[Arch_assms]: "zobj_refs' (capMasterCap cap) = zobj_refs' cap" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.split arch_capability.split) -lemma setCTE_pspace_in_kernel_mappings'[CSpace_R_2_assms]: +lemma setCTE_pspace_in_kernel_mappings'[Arch_assms]: "setCTE ptr val \pspace_in_kernel_mappings'\" by wp @@ -613,7 +614,7 @@ lemma valid_badges_IRQControlD: unfolding valid_badges_def by (fastforce simp: isCap_simps valid_arch_badges_def) -lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: +lemma setUntypedCapAsFull_safe_parent_for'[Arch_assms]: "\\s. safe_parent_for' (ctes_of s) slot a \ cte_wp_at' ((=) srcCTE) slot s\ setUntypedCapAsFull (cteCap srcCTE) c' slot \\rv s. safe_parent_for' (ctes_of s) slot a\" @@ -633,7 +634,7 @@ lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: apply simp done -lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: +lemma maskedAsFull_revokable_safe_parent[Arch_assms]: "\is_simple_cap' c'; safe_parent_for' m p c'; m p = Some cte; cteCap cte = (maskedAsFull src_cap' a)\ \ isCapRevocable c' (maskedAsFull src_cap' a) = isCapRevocable c' src_cap'" @@ -642,12 +643,12 @@ lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: apply (auto simp: isCap_simps is_simple_cap'_def) done -lemma setUntypedCapAsFull_archMDBAssertions[CSpace_R_2_assms, wp]: +lemma setUntypedCapAsFull_archMDBAssertions[Arch_assms, wp]: "setUntypedCapAsFull src_cap cap p \archMDBAssertions\" unfolding archMDBAssertions_def arch_mdb_assert_def by wp -lemma sameRegion_capRange_sub[CSpace_R_2_assms]: +lemma sameRegion_capRange_sub[Arch_assms]: "sameRegionAs cap cap' \ capRange cap' \ capRange cap" apply (clarsimp simp: sameRegionAs_def2 gen_isCap_Master arch_isCap_Master capRange_Master cong: conj_cong) @@ -655,7 +656,7 @@ lemma sameRegion_capRange_sub[CSpace_R_2_assms]: apply (fastforce simp: isCap_simps capRange_def split: if_split_asm) done -lemma capRange_sameRegionAs[CSpace_R_2_assms]: +lemma capRange_sameRegionAs[Arch_assms]: "\ sameRegionAs x y; s \' y; capClass x = PhysicalClass \ capClass y = PhysicalClass \ \ capRange x \ capRange y \ {}" apply (erule sameRegionAsE) @@ -672,7 +673,7 @@ lemma capRange_sameRegionAs[CSpace_R_2_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: +lemma safe_parent_for_capRange_capBits[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ capRange (cteCap cte) \ capBits cap \ capBits (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) @@ -682,7 +683,7 @@ lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: capMasterCap_def capRange_Master objBits_simps split: capability.splits arch_capability.splits) -lemma safe_parent_for_descendants'[CSpace_R_2_assms]: +lemma safe_parent_for_descendants'[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE pcap n); isUntypedCap pcap \ \ descendants_of' p m = {}" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) @@ -694,7 +695,7 @@ lemma safe_parent_not_ntfn': "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ \isNotificationCap src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) -lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_untypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ untypedRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -712,7 +713,7 @@ lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_capUntypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -727,14 +728,14 @@ lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_capClass[CSpace_R_2_assms]: +lemma safe_parent_capClass[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ capClass cap = capClass src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps sameRegionAs_def2 capRange_Master capRange_def capMasterCap_def split: capability.splits arch_capability.splits) (* Generic-only parts of is_simple_cap'. isArchFrameCap appears on all architectures and so is safe. *) -lemma is_simple_cap'_genD[CSpace_R_2_assms]: +lemma is_simple_cap'_genD[Arch_assms]: "is_simple_cap' cap \ cap \ NullCap \ cap \ IRQControlCap \ \ isUntypedCap cap \ \ isReplyCap cap \ \ isEndpointCap cap \ \ isNotificationCap cap \ \ isThreadCap cap \ \ isCNodeCap cap \ @@ -803,14 +804,15 @@ end context Arch begin arch_global_naming -lemmas [CSpace_R_2_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child +lemmas [Arch_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child -end +lemmas CSpace_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_2?: CSpace_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace_R_2_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales @@ -1143,17 +1145,17 @@ end (* Arch_mdb_insert_simple' *) context Arch begin arch_global_naming -named_theorems CSpace_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_3 locale *) (* since mdb_insert_simple' is not used after this theory, drop the Arch assumption directly instead of requalifying *) -lemmas [CSpace_R_3_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] +lemmas [Arch_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] -lemmas [CSpace_R_3_assms] = +lemmas [Arch_assms] = updateCap_valid_arch_state' master_cap_relation -lemma derived'_not_Null[CSpace_R_3_assms, simp]: +lemma derived'_not_Null[Arch_assms, simp]: "\ is_derived' m p c capability.NullCap" "\ is_derived' m p capability.NullCap c" by (clarsimp simp: is_derived'_def badge_derived'_def)+ @@ -1166,7 +1168,7 @@ lemma cte_refs_maskCapRights[simp]: split del: if_split split: arch_capability.split) -lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: +lemma ghost_relation_wrapper_set_cap_setCTE[Arch_assms]: "\ ghost_relation_wrapper a c; ((), c') \ fst (setCTE (cte_map slot) (cteCap_update (\_. cap') rv) c); ((), a') \ fst (set_cap cap slot a)\ @@ -1177,16 +1179,17 @@ lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: apply (frule use_valid[OF _ setCTE_gsCNodes]; simp) done -lemma updateMDB_pspace_in_kernel_mappings'[CSpace_R_3_assms]: +lemma updateMDB_pspace_in_kernel_mappings'[Arch_assms]: "updateMDB x f \pspace_in_kernel_mappings'\" by wp -end +lemmas CSpace_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_3?: CSpace_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.CSpace_R_3_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales diff --git a/proof/refine/ARM/ArchDetype_R.thy b/proof/refine/ARM/ArchDetype_R.thy index 066d3f507d..581d264289 100644 --- a/proof/refine/ARM/ArchDetype_R.thy +++ b/proof/refine/ARM/ArchDetype_R.thy @@ -264,7 +264,7 @@ end (* detype_locale' *) context Arch begin arch_global_naming -named_theorems Detype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R locale *) (* conjunction is used to unify with a single schematic in deleteObjects_corres *) lemma ksASIDMapSafeI: @@ -294,7 +294,7 @@ lemma ksASIDMapSafeI: apply simp done -lemma deleteObjects_corres[Detype_R_assms]: +lemma deleteObjects_corres[Arch_assms]: "\ is_aligned base magnitude; magnitude \ word_size_bits \ \ corres dc (\s. einvs s @@ -478,7 +478,7 @@ context Arch begin arch_global_naming Not all of them need to deal with these arch details, so if the def2/def3 lemmas can be generalised or wrapped, some of the lemmas in this block can become generic. *) -lemma deleteObjects_null_filter[Detype_R_assms]: +lemma deleteObjects_null_filter[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -498,7 +498,7 @@ lemma deleteObjects_null_filter[Detype_R_assms]: apply (unfold_locales, simp_all) done -lemma deleteObjects_invs'[Detype_R_assms]: +lemma deleteObjects_invs'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -530,7 +530,7 @@ proof - done qed -lemma deleteObjects_st_tcb_at'[Detype_R_assms]: +lemma deleteObjects_st_tcb_at'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -585,7 +585,7 @@ lemma deleteObjects_cap_to': apply (simp add: delete_locale_def) done -lemma deleteObject_no_overlap[Detype_R_assms, wp]: +lemma deleteObject_no_overlap[Arch_assms, wp]: "\valid_cap' (UntypedCap d ptr bits idx) and valid_pspace'\ deleteObjects ptr bits \\_ s. pspace_no_overlap' ptr bits s\" @@ -604,7 +604,7 @@ lemma deleteObject_no_overlap[Detype_R_assms, wp]: apply simp done -lemma deleteObjects_cte_wp_at'[Detype_R_assms]: +lemma deleteObjects_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ p \ mask_range ptr bits \ s \' (UntypedCap d ptr bits idx) \ valid_pspace' s\ deleteObjects ptr bits @@ -623,13 +623,13 @@ lemma deleteObjects_cte_wp_at'[Detype_R_assms]: apply (case_tac s, simp) done -lemma deleteObjects_nosch[wp, Detype_R_assms]: +lemma deleteObjects_nosch[wp, Arch_assms]: "deleteObjects ptr sz \\s. P (ksSchedulerAction s)\" by (simp add: deleteObjects_def3 | wp hoare_drop_imp)+ lemmas getObjSize_simps = ARM_H.getObjectSize_def[split_simps ARM_H.object_type.split apiobject_type.split] -lemma createObject_cte_wp_at'[Detype_R_assms]: +lemma createObject_cte_wp_at'[Arch_assms]: "\\s. Types_H.getObjectSize ty us < word_bits \ is_aligned ptr (Types_H.getObjectSize ty us) \ pspace_no_overlap' ptr (Types_H.getObjectSize ty us) s \ @@ -1170,7 +1170,7 @@ lemma placeNewObject_pd_at': apply simp done -lemma createObject_setCTE_commute[Detype_R_assms]: +lemma createObject_setCTE_commute[Arch_assms]: "monad_commute (cte_wp_at' (\_. True) src and pspace_aligned' and pspace_distinct' and @@ -1264,7 +1264,7 @@ lemma copyGlobalMappings_gsUntypedZeroRanges_commute': apply simp done -lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: +lemma createObject_gsUntypedZeroRanges_commute[Arch_assms]: "monad_commute \ (RetypeDecls_H.createObject ty ptr us dev) @@ -1288,24 +1288,25 @@ lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: apply (simp add: curDomain_def monad_commute_def exec_modify exec_gets) done -lemma createNewCaps_not_nc[Detype_R_assms]: +lemma createNewCaps_not_nc[Arch_assms]: "\\\ createNewCaps ty ptr n us d \\r s. (\cap\set r. cap \ capability.NullCap)\" unfolding createNewCaps_def Arch_createNewCaps_def by (wpsimp simp: Arch_createNewCaps_def split_del: if_split)+ +lemmas Detype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R?: Detype_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Detype_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Detype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R_2 locale *) lemma copyGlobalMappings_pspace_no_overlap': "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\ @@ -1317,7 +1318,7 @@ lemma copyGlobalMappings_pspace_no_overlap': apply clarsimp done -lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: +lemma createNewCaps_pspace_no_overlap'[Arch_assms]: "\\s. range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n)) \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ ptr \ 0\ @@ -1372,7 +1373,7 @@ lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: | assumption | clarsimp simp: word_bits_def | intro conjI range_cover_le[where n = "Suc n"] range_cover.aligned)+)[6] -lemma createNewCaps_ret_len[Detype_R_2_assms]: +lemma createNewCaps_ret_len[Arch_assms]: "\K (n < 2 ^ word_bits \ n \ 0)\ createNewCaps ty ptr n us d \\rv s. n = length rv\" @@ -1538,7 +1539,7 @@ lemma placeNewObject_copyGlobalMapping_commute: apply (clarsimp simp: pdeBits_def) done -lemma createNewCaps_Cons[Detype_R_2_assms]: +lemma createNewCaps_Cons[Arch_assms]: assumes cover:"range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n))" and "valid_pspace' s" "valid_arch_state' s" and "pspace_no_overlap' ptr sz s" @@ -1883,7 +1884,7 @@ proof - done qed -lemma createObject_def2[Detype_R_2_assms]: +lemma createObject_def2[Arch_assms]: "(RetypeDecls_H.createObject ty ptr us dev >>= (\x. return [x])) = createNewCaps ty ptr (Suc 0) us dev" apply (clarsimp simp: global.createObject_def createNewCaps_def placeNewObject_def2) @@ -1903,7 +1904,7 @@ lemma createObject_def2[Detype_R_2_assms]: storeWordVM_def)+ done -lemma ArchCreateObject_pspace_no_overlap'[Detype_R_2_assms]: +lemma ArchCreateObject_pspace_no_overlap'[Arch_assms]: "\\s. pspace_no_overlap' (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \ pspace_aligned' s \ pspace_distinct' s \ @@ -1977,12 +1978,13 @@ lemma createObject_pspace_aligned_distinct': split: ARM_H.object_type.splits apiobject_type.splits) done +lemmas Detype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R_2?: Detype_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Detype_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchEmptyFail.thy b/proof/refine/ARM/ArchEmptyFail.thy index 464f988c90..d4e2940fa5 100644 --- a/proof/refine/ARM/ArchEmptyFail.thy +++ b/proof/refine/ARM/ArchEmptyFail.thy @@ -10,21 +10,22 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_R locale *) -lemma empty_fail_lookupIPCBuffer[EmptyFail_R_assms]: +lemma empty_fail_lookupIPCBuffer[Arch_assms]: "empty_fail (lookupIPCBuffer r t)" by (clarsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv split: capability.splits arch_capability.splits | wp | wpc | safe)+ declare setRegister_empty_fail[intro!, simp] (* FIXME: tag original instead *) -end +lemmas EmptyFail_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation EmptyFail_R?: EmptyFail_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact EmptyFail_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.EmptyFail_R_assms)?) qed end diff --git a/proof/refine/ARM/ArchEmptyFail_H.thy b/proof/refine/ARM/ArchEmptyFail_H.thy index 613094a876..7c22808971 100644 --- a/proof/refine/ARM/ArchEmptyFail_H.thy +++ b/proof/refine/ARM/ArchEmptyFail_H.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H locale *) -lemma arch_deriveCap_empty_fail[EmptyFail_H_assms, intro!, wp, simp]: +lemma arch_deriveCap_empty_fail[Arch_assms, intro!, wp, simp]: "empty_fail (Arch.deriveCap x y)" unfolding ARM_H.deriveCap_def by (cases y, auto simp: isCap_simps cong: if_cong) @@ -31,7 +31,7 @@ lemma empty_fail_getObject_pde [intro!, wp, simp]: by (simp add: empty_fail_getObject) crunch decodeARMMMUInvocation, Arch_postCapDeletion, setRegister, prepareThreadDelete - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def wp: empty_fail_catch rule: ARM_H.postCapDeletion_def) @@ -39,7 +39,7 @@ crunch decodeARMMMUInvocation, Arch_postCapDeletion, setRegister, prepareThreadD crunch Arch_finaliseCap, Arch.switchToThread, Arch.switchToIdleThread, prepareNextDomain, getRestartPC, makeArchFaultMessage - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (rule: ARM_H.finaliseCap_def) crunch @@ -49,32 +49,34 @@ crunch handleArchFaultReply, prepareSetDomain, postModifyRegisters, postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler, Arch.performInvocation, handleSpuriousIRQ, maskIrqSignal, handleVMFault, checkIRQ, prepareThreadDelete, Arch.postCapDeletion - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H?: EmptyFail_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.EmptyFail_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems EmptyFail_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H_2 locale *) crunch handleReservedIRQ, handleHypervisorFault - for (empty_fail) empty_fail[EmptyFail_H_2_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H_2?: EmptyFail_H_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.EmptyFail_H_2_assms)?)?) qed crunch callKernel diff --git a/proof/refine/ARM/ArchFinalise_R.thy b/proof/refine/ARM/ArchFinalise_R.thy index 73baa4c180..eadb365d4e 100644 --- a/proof/refine/ARM/ArchFinalise_R.thy +++ b/proof/refine/ARM/ArchFinalise_R.thy @@ -12,13 +12,13 @@ begin context Arch begin arch_global_naming -named_theorems Finalise_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R locale *) lemma isArchSGISignalCap_NullCap[simp]: "\isArchSGISignalCap NullCap" by (simp add: isCap_simps) -lemma arch_postCapDeletion_ksArchState_lift[Finalise_R_assms]: +lemma arch_postCapDeletion_ksArchState_lift[Arch_assms]: "\\s as. P (s\ksArchState := as\) = P s\ \ Arch.postCapDeletion ac \P\" unfolding postCapDeletion_def by wpsimp @@ -27,7 +27,7 @@ sublocale clearUntypedFreeIndex: typ_at_props' "clearUntypedFreeIndex slot" by typ_at_props' crunch setIRQState - for umm[Finalise_R_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" + for umm[Arch_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" (wp: dmo_lift' simp: maskInterrupt_def) (* better crunch names for Arch.postCapDeletion *) @@ -39,7 +39,7 @@ crunch Arch_postCapDeletion and valid_arch_state'[wp]: valid_arch_state' (rule: ARM_H.postCapDeletion_def) -lemma arch_postCapDeletion_corres[Finalise_R_assms]: +lemma arch_postCapDeletion_corres[Arch_assms]: "acap_relation cap cap' \ corres dc \ \ (arch_post_cap_deletion cap) (ARM_H.postCapDeletion cap')" by (clarsimp simp: arch_post_cap_deletion_def ARM_H.postCapDeletion_def) @@ -48,16 +48,16 @@ abbreviation (input) "Arch_finaliseCap \ Arch.finaliseCap" crunch Arch_finaliseCap, prepareThreadDelete, archThreadSet - for typ_at'[Finalise_R_assms, wp]: "\s. P (typ_at' T p s)" - and aligned'[Finalise_R_assms, wp]: "pspace_aligned'" - and distinct'[Finalise_R_assms, wp]: "pspace_distinct'" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" + and aligned'[Arch_assms, wp]: "pspace_aligned'" + and distinct'[Arch_assms, wp]: "pspace_distinct'" (wp: crunch_wps getObject_inv loadObject_default_inv simp: crunch_simps unless_def o_def ignore_del: setObject rule: ARM_H.finaliseCap_def) crunch prepareThreadDelete, Arch_finaliseCap - for it'[Finalise_R_assms, wp]: "\s. P (ksIdleThread s)" + for it'[Arch_assms, wp]: "\s. P (ksIdleThread s)" (wp: hoare_drop_imps mapM_wp simp: crunch_simps updateObject_default_def rule: ARM_H.finaliseCap_def) @@ -78,6 +78,8 @@ definition post_cap_delete_pre' :: "capability \ paddr \ IRQHandlerCap irq \ irq \ maxIRQ \ (\sl'. sl \ sl' \ cs sl' \ Some cap) | _ \ False" +lemmas Finalise_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -420,15 +422,14 @@ end (* mdb_empty *) interpretation Finalise_R?: Finalise_R arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Finalise_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Finalise_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_2 locale *) -lemma not_Final_removeable[Finalise_R_2_assms]: +lemma not_Final_removeable[Arch_assms]: "\ isFinal cap sl (cteCaps_of s) \ removeable' sl s cap" apply (erule not_FinalE) apply (clarsimp simp: removeable'_def gen_isCap_simps) @@ -437,7 +438,7 @@ lemma not_Final_removeable[Finalise_R_2_assms]: apply fastforce done -lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: +lemma deletedIRQHandler_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ deletedIRQHandler irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -451,7 +452,7 @@ lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: apply (clarsimp simp: valid_refs'_cteCaps valid_cap_sizes_cteCaps ball_ran_eq) done -lemma clearUntypedFreeIndex_valid_global_refs[Finalise_R_2_assms, wp]: +lemma clearUntypedFreeIndex_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ clearUntypedFreeIndex irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -497,7 +498,7 @@ lemma final_matters_mdb_chunked_arch_assms: by (clarsimp simp: mdb_chunked_arch_assms_def isCap_simps final_matters'_def arch_final_matters'_def) -lemma notFinal_prev_or_next[Finalise_R_2_assms]: +lemma notFinal_prev_or_next[Arch_assms]: "\ \ isFinal cap x (cteCaps_of s); mdb_chunked (ctes_of s); valid_dlist (ctes_of s); no_0 (ctes_of s); ctes_of s x = Some (CTE cap node); final_matters' cap \ @@ -544,12 +545,12 @@ lemma notFinal_prev_or_next[Finalise_R_2_assms]: apply (clarsimp simp: sameObjectAs_def3 simp del: isArchFrameCap_capMasterCap) done -lemma sameObjectAs_not_Untyped[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap \ \ \ isUntypedCap cap'" by (clarsimp simp: gen_isCap_simps sameObjectAs_def3) -lemma sameObjectAs_not_Untyped'[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped'[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap' \ \ global.sameObjectAs cap' cap" by (clarsimp simp: isCap_simps sameObjectAs_def3) @@ -601,7 +602,7 @@ lemma (in vmdb) isFinal_untypedParent: context Arch begin arch_global_naming -lemma isFinal_no_descendants[Finalise_R_2_assms]: +lemma isFinal_no_descendants[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); ctes_of s sl = Some (CTE cap n); valid_mdb' s; final_matters' cap \ \ descendants_of' sl (ctes_of s) = {}" @@ -885,7 +886,7 @@ lemma archThreadSet_valid_sched_pointers[wp]: "archThreadSet f t \valid_sched_pointers\" by (wp_pre, wps, wp, assumption) -lemma arch_finaliseCap_invs[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_invs[Arch_assms, wp]: "\invs' and valid_cap' (ArchObjectCap cap)\ Arch.finaliseCap cap fin \\rv. invs'\" unfolding ARM_H.finaliseCap_def Let_def by wpsimp @@ -927,16 +928,16 @@ crunch prepareThreadDelete ignore: archThreadSet) crunch Arch.finaliseCap, prepareThreadDelete - for irq_node'[Finalise_R_2_assms, wp]: "\s. P (irq_node' s)" + for irq_node'[Arch_assms, wp]: "\s. P (irq_node' s)" (wp: crunch_wps getObject_inv loadObject_default_inv updateObject_default_inv setObject_ksInterrupt simp: crunch_simps o_def) -lemmas Arch_finaliseCap_irq_node'[Finalise_R_2_assms] = ArchRetypeDecls_H_ARM_H_finaliseCap_irq_node' +lemmas Arch_finaliseCap_irq_node'[Arch_assms] = ArchRetypeDecls_H_ARM_H_finaliseCap_irq_node' crunch prepareThreadDelete - for cte_wp_at'[Finalise_R_2_assms, wp]: "cte_wp_at' P p" - and valid_cap'[Finalise_R_2_assms, wp]: "valid_cap' cap" + for cte_wp_at'[Arch_assms, wp]: "cte_wp_at' P p" + and valid_cap'[Arch_assms, wp]: "valid_cap' cap" lemma prepareThreadDelete_hyp_unlive: "\tcb_at' t\ prepareThreadDelete t \\_. ko_wp_at' (Not \ hyp_live') t\" @@ -945,7 +946,7 @@ lemma prepareThreadDelete_hyp_unlive: (auto simp: ko_wp_at'_def obj_at'_def hyp_live'_def) crunch prepareThreadDelete - for invs[Finalise_R_2_assms, wp]: "invs'" + for invs[Arch_assms, wp]: "invs'" (ignore: doMachineOp simp: crunch_simps) lemma archThreadSet_tcbSchedPrevNext[wp]: @@ -980,34 +981,35 @@ lemma deleteASID_cte_wp_at'[wp]: | wpc)+ done -lemma arch_finaliseCap_cte_wp_at[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cte_wp_at[Arch_assms, wp]: "\cte_wp_at' P p\ Arch.finaliseCap cap fin \\rv. cte_wp_at' P p\" unfolding ARM_H.finaliseCap_def by (wpsimp wp: unmapPage_cte_wp_at'|rule conjI)+ -lemma finaliseCap_valid_cap[Finalise_R_2_assms, wp]: +lemma finaliseCap_valid_cap[Arch_assms, wp]: "\\\ Arch.finaliseCap cap final \\rv. valid_cap' (fst rv)\" by (wpsimp simp: ARM_H.finaliseCap_def split_del: if_split) -lemma arch_finaliseCap_cases[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cases[Arch_assms, wp]: "\\\ Arch.finaliseCap v0 final \\rv s. fst rv = capability.NullCap \ (snd rv \ capability.NullCap \ final \ arch_cap_has_cleanup' v0 \ snd rv = capability.ArchObjectCap v0)\" by (wpsimp simp: ARM_H.finaliseCap_def split_del: if_split) -lemmas [Finalise_R_2_assms] = +lemmas [Arch_assms] = cancelAllIPC_cte_wp_at' cancelAllSignals_cte_wp_at' unbindMaybeNotification_cte_wp_at' prepareThreadDelete_cte_wp_at' unbindNotification_cte_wp_at' Arch_postCapDeletion_valid_global_refs Arch_postCapDeletion_valid_arch_state' mdb_empty.vmdb_n mdb_empty.descendants not_Final_removeable +lemmas Finalise_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Finalise_R_2?: Finalise_R_2 arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Finalise_R_2_assms)?)?) qed (* This is the only arch-specific lemma in delete_one_conc_pre so far; @@ -1075,13 +1077,13 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable: context Arch begin arch_global_naming -named_theorems Finalise_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_3 locale *) -lemma finaliseCap_cte_refs[Finalise_R_3_assms]: +lemma finaliseCap_cte_refs[Arch_assms]: "\\s. s \' cap\ finaliseCap cap final flag \\rv s. fst rv \ NullCap \ cte_refs' (fst rv) = cte_refs' cap\" - apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot finaliseCap_def + apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot ARM_H.finaliseCap_def cong: if_cong split del: if_split) apply (rule hoare_pre) apply (wp | wpc | simp only: o_def)+ @@ -1094,7 +1096,7 @@ lemma finaliseCap_cte_refs[Finalise_R_3_assms]: apply (fastforce simp: mask_def capAligned_def gen_objBits_simps shiftL_nat) done -lemma emptySlot_invs'[Finalise_R_3_assms, wp]: +lemma emptySlot_invs'[Arch_assms, wp]: "\\s. invs' s \ cte_wp_at' (\cte. removeable' sl s (cteCap cte)) sl s \ (info \ NullCap \ post_cap_delete_pre' info sl (cteCaps_of s))\ emptySlot sl info @@ -1105,7 +1107,7 @@ lemma emptySlot_invs'[Finalise_R_3_assms, wp]: split: capability.split_asm) by auto -lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: +lemma cteDeleteOne_invs[Arch_assms, wp]: "cteDeleteOne ptr \invs'\" apply (simp add: cteDeleteOne_def unless_def split_def finaliseCapTrue_standin_simple_def) @@ -1127,7 +1129,7 @@ lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: apply (fastforce simp: cte_wp_at_ctes_of) done -lemma isFinalCapability_corres'[Finalise_R_3_assms]: +lemma isFinalCapability_corres'[Arch_assms]: "final_matters' (cteCap cte) \ corres (=) (invs and cte_wp_at ((=) cap) ptr) (invs' and cte_wp_at' ((=) cte) (cte_map ptr)) @@ -1228,7 +1230,7 @@ crunch unmapPageTable crunch Arch_finaliseCap, prepareThreadDelete for nosch[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Finalise_R_3_assms, wp]: sch_act_simple + and sch_act_simple[Arch_assms, wp]: sch_act_simple (wp: crunch_wps getObject_inv simp: loadObject_default_def updateObject_default_def rule: ARM_H.finaliseCap_def sch_act_simple_lift cong: if_cong) @@ -1239,7 +1241,7 @@ crunch deletingIRQHandler rule: sch_act_simple_lift wp: getObject_inv loadObject_default_inv crunch_wps) -lemma arch_finaliseCap_corres[Finalise_R_3_assms]: +lemma arch_finaliseCap_corres[Arch_assms]: "\ final_matters' (ArchObjectCap cap') \ final = final'; acap_relation cap cap' \ \ corres (\r r'. cap_relation (fst r) (fst r') \ cap_relation (snd r) (snd r')) (\s. invs s \ s \ cap.ArchObjectCap cap @@ -1274,14 +1276,15 @@ lemma arch_finaliseCap_corres[Finalise_R_3_assms]: sublocale deleteCallerCap: typ_at_props' "deleteCallerCap receiver" by typ_at_props' +lemmas Finalise_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts post_cap_delete_pre' interpretation Finalise_R_3?: Finalise_R_3 arch_final_matters' arch_cap_has_cleanup' post_cap_delete_pre' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Finalise_R_3_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchInit_R.thy b/proof/refine/ARM/ArchInit_R.thy index eb88509bc3..e5469d4e76 100644 --- a/proof/refine/ARM/ArchInit_R.thy +++ b/proof/refine/ARM/ArchInit_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Init_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Init_R locale *) definition zeroed_arch_abstract_state :: arch_state where "zeroed_arch_abstract_state \ \ @@ -27,23 +27,24 @@ definition zeroed_arch_intermediate_state :: Arch.kernel_state where "zeroed_arch_intermediate_state \ ARMKernelState Map.empty Map.empty 0 Map.empty 0 [] (K ArmVSpaceUserRegion)" (* the None maps are a result of unfolding zeroed_main_abstract_state *) -lemma ghost_relation_wrapper_arch_intermediate_state[Init_R_assms]: +lemma ghost_relation_wrapper_arch_intermediate_state[Arch_assms]: "ghost_relation_wrapper_2 (\_. None) (\_. None) (\_. None) zeroed_arch_intermediate_state" unfolding ghost_relation_wrapper_def ghost_relation_def zeroed_arch_intermediate_state_def by simp -lemma non_empty_refine_arch_state_relation[Init_R_assms]: +lemma non_empty_refine_arch_state_relation[Arch_assms]: "(zeroed_arch_abstract_state, zeroed_arch_intermediate_state) \ arch_state_relation Map.empty" unfolding zeroed_arch_abstract_state_def zeroed_arch_intermediate_state_def arch_state_relation_def by simp +lemmas Init_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Init_R?: Init_R ARM.zeroed_arch_abstract_state ARM.zeroed_arch_intermediate_state proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Init_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Init_R_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchInterrupt_R.thy b/proof/refine/ARM/ArchInterrupt_R.thy index 8805a5e60f..07bd7d4aca 100644 --- a/proof/refine/ARM/ArchInterrupt_R.thy +++ b/proof/refine/ARM/ArchInterrupt_R.thy @@ -13,17 +13,17 @@ begin context Arch begin arch_global_naming -named_theorems Interrupt_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R locale *) -lemma maxIRQ_H_ucast_toEnum_eq_irq[Interrupt_R_assms]: +lemma maxIRQ_H_ucast_toEnum_eq_irq[Arch_assms]: "x \ ucast maxIRQ \ toEnum (unat x) = (ucast x :: irq)" for x::machine_word by (simp add: maxIRQ_ucast_toEnum_eq_irq maxIRQ_def) -lemma arch_valid_irq_le_maxIRQ[Interrupt_R_assms]: +lemma arch_valid_irq_le_maxIRQ[Arch_assms]: "arch_valid_irq irq \ irq \ maxIRQ" by simp -lemma arch_valid_irq_valid_IRQHandlerCap[Interrupt_R_assms]: +lemma arch_valid_irq_valid_IRQHandlerCap[Arch_assms]: "arch_valid_irq irq \ valid_cap' (capability.IRQHandlerCap irq) s" by (simp add: valid_cap'_def capAligned_def) @@ -46,7 +46,7 @@ primrec arch_irq_control_inv_valid' :: "Arch.irqcontrol_invocation \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) src_slot and ex_cte_cap_to' sgi_slot and real_cte_at' sgi_slot)" -lemma checkIRQ_corres[Interrupt_R_assms]: +lemma checkIRQ_corres[Arch_assms]: "corres (ser \ dc) \ \ (arch_check_irq irq) (Arch.checkIRQ irq)" unfolding arch_check_irq_def checkIRQ_def by (clarsimp simp: minIRQ_def maxIRQ_def whenE_rangeCheck_eq whenE_def returnOk_def split: if_split) @@ -54,7 +54,7 @@ lemma checkIRQ_corres[Interrupt_R_assms]: lemmas irq_const_defs = minIRQ_def crunch arch_check_irq, checkIRQ - for inv[Interrupt_R_assms]: "P" + for inv[Arch_assms]: "P" (simp: crunch_simps) lemma arch_check_irq_valid: @@ -62,11 +62,11 @@ lemma arch_check_irq_valid: unfolding arch_check_irq_def by (wpsimp simp: validE_R_def not_less word_le_nat_alt maxIRQ_def wp: whenE_throwError_wp) -lemma arch_check_irq_valid'[Interrupt_R_assms]: +lemma arch_check_irq_valid'[Arch_assms]: "\\\ arch_check_irq irq \\_ _. irq \ ucast maxIRQ\, \\_. \\" by (wp arch_check_irq_valid) -lemma checkIRQ_irq_valid[Interrupt_R_assms]: +lemma checkIRQ_irq_valid[Arch_assms]: "\\\ checkIRQ irq \\_ _. arch_valid_irq (toEnum (unat irq))\, -" unfolding checkIRQ_def rangeCheck_def validE_R_def supply hoare_vcg_prop[wp del] @@ -99,7 +99,7 @@ lemma sgi_irq_cast: add: ucast_ucast_len sgi_irq_len_val word_le_nat_alt word_less_nat_alt split: if_split_asm) -lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: +lemma arch_decodeIRQControlInvocation_corres[Arch_assms]: "list_all2 cap_relation caps caps' \ corres (ser \ arch_irq_control_inv_relation) (invs and (\s. \cp \ set caps. s \ cp)) @@ -146,7 +146,7 @@ lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: apply (auto split: arch_invocation_label.splits invocation_label.splits) done -lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: +lemma arch_decode_irq_control_valid'[Arch_assms, wp]: "\\s. invs' s \ (\cap \ set caps. s \' cap) \ (\cap \ set caps. \r \ cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) slot s\ @@ -168,12 +168,12 @@ lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: done crunch Arch.decodeIRQControlInvocation - for inv[Interrupt_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps wp: crunch_wps) -lemmas [Interrupt_R_assms] = arch_check_irq_inv +lemmas [Arch_assms] = arch_check_irq_inv -lemma irq_node_in_global_refs'[Interrupt_R_assms]: +lemma irq_node_in_global_refs'[Arch_assms]: "Invariants_H.irq_node' s + (ucast irq << cteSizeBits) \ global_refs' s" for irq :: irq by (simp add: global_refs'_def) @@ -182,13 +182,13 @@ lemma no_fail_deactivateInterrupt[wp, simp]: unfolding deactivateInterrupt_def by wpsimp -lemma arch_invokeIRQHandler_corres[Interrupt_R_assms]: +lemma arch_invokeIRQHandler_corres[Arch_assms]: "irq_handler_inv_relation i i' \ corres dc \ \ (arch_invoke_irq_handler i) (Arch.invokeIRQHandler i')" by (cases i; clarsimp simp: invokeIRQHandler_def theIRQ_def) (intro conjI impI; rule corres_machine_op, rule corres_Id; simp?) -lemma is_derived'_NotificationCap[Interrupt_R_assms]: +lemma is_derived'_NotificationCap[Arch_assms]: "\isNotificationCap cap; isNotificationCap cap'\ \ is_derived' ctes src cap' cap = badge_derived' cap' cap" by (clarsimp simp add: is_derived'_def gen_isCap_simps vsCapRef_def) @@ -219,7 +219,7 @@ lemma SGISignalCap_valid[simp, intro!]: "valid_cap' (ArchObjectCap (SGISignalCap irq target)) s" by (simp add: valid_cap'_def capAligned_def word_bits_def) -lemma arch_performIRQControl_corres[Interrupt_R_assms]: +lemma arch_performIRQControl_corres[Arch_assms]: "arch_irq_control_inv_relation ivk ivk' \ corres (dc \ dc) (einvs and arch_irq_control_inv_valid ivk) (invs' and arch_irq_control_inv_valid' ivk') @@ -251,11 +251,11 @@ lemma arch_performIRQControl_corres[Interrupt_R_assms]: apply (rename_tac cte', case_tac cte', simp add: isCap_simps) done -lemma is_simple_cap'_IRQHandlerCap[Interrupt_R_assms]: +lemma is_simple_cap'_IRQHandlerCap[Arch_assms]: "isIRQHandlerCap cap \ is_simple_cap' cap" by (clarsimp simp: isCap_simps is_simple_cap'_def) -lemma sameRegionAs_IRQControl_handler[Interrupt_R_assms, simp]: +lemma sameRegionAs_IRQControl_handler[Arch_assms, simp]: "global.sameRegionAs capability.IRQControlCap (capability.IRQHandlerCap irq)" by (simp add: sameRegionAs_def3 isCap_simps) @@ -268,7 +268,7 @@ lemma dmo_setIRQTrigger_invs'[wp]: apply (wpsimp simp: setIRQTrigger_def machine_op_lift_def machine_rest_lift_def split_def)+ done -lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: +lemma arch_invoke_irq_control_invs'[Arch_assms, wp]: "\invs' and arch_irq_control_inv_valid' i\ Arch.performIRQControl i \\rv. invs'\" apply (simp add: ARM_H.performIRQControl_def) apply (rule hoare_pre) @@ -281,55 +281,57 @@ lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: simp: invs'_def valid_state'_def IRQ_def) done -lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: +lemma handle_reserved_irq_corres[Arch_assms, corres]: "corres dc einvs (\s. invs' s \ (irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)) (handle_reserved_irq irq) (handleReservedIRQ irq)" unfolding handle_reserved_irq_def handleReservedIRQ_def by corres -lemma maskIrqSignal_corres[Interrupt_R_assms, corres]: +lemma maskIrqSignal_corres[Arch_assms, corres]: "corres dc \ \ (arch_mask_irq_signal irq) (Arch.maskIrqSignal irq)" unfolding arch_mask_irq_signal_def maskIrqSignal_def when_def by (corres corres: corres_machine_op) -lemma dmo_ackInterrupt_corres[Interrupt_R_assms, corres]: +lemma dmo_ackInterrupt_corres[Arch_assms, corres]: "corres dc \ \ (do_machine_op (ackInterrupt irq)) (doMachineOp (ackInterrupt irq))" by (corres corres: corres_machine_op) crunch maskIrqSignal - for invs'[Interrupt_R_assms]: invs' + for invs'[Arch_assms]: invs' (wp: dmo_maskInterrupt_True ignore: doMachineOp) -lemma handleReservedIRQ_invs'[Interrupt_R_assms]: +lemma handleReservedIRQ_invs'[Arch_assms]: "\invs' and (\s. irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)\ handleReservedIRQ irq \\_. invs'\" by (wpsimp simp: handleReservedIRQ_def) +lemmas Interrupt_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R?: Interrupt_R ARM.arch_irq_control_inv_valid' ARM.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Interrupt_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Interrupt_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R_2 locale *) -lemma invoke_arch_irq_handler_invs'[Interrupt_R_2_assms, wp]: +lemma invoke_arch_irq_handler_invs'[Arch_assms, wp]: "\invs' and irq_handler_inv_valid' i\ Arch.invokeIRQHandler i \\rv. invs'\" by (cases i; (wpsimp simp: ARM_H.invokeIRQHandler_def theIRQ_def | rule conjI)+) +lemmas Interrupt_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R_2?: Interrupt_R_2 ARM.arch_irq_control_inv_valid' ARM.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Interrupt_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchInvariantUpdates_H.thy b/proof/refine/ARM/ArchInvariantUpdates_H.thy index 7efc3b0fe7..689a70bdf6 100644 --- a/proof/refine/ARM/ArchInvariantUpdates_H.thy +++ b/proof/refine/ARM/ArchInvariantUpdates_H.thy @@ -10,24 +10,25 @@ begin context Arch begin arch_global_naming -named_theorems InvariantUpdates_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InvariantUpdates_H locale *) -lemma valid_arch_state'_interrupt[simp, InvariantUpdates_H_assms]: +lemma valid_arch_state'_interrupt[simp, Arch_assms]: "valid_arch_state' (ksInterruptState_update f s) = valid_arch_state' s" by (simp add: valid_arch_state'_def cong: option.case_cong) (* not generally true for ksInterruptState update *) -lemma global_refs'_intStateIRQTable_update[simp, InvariantUpdates_H_assms]: +lemma global_refs'_intStateIRQTable_update[simp, Arch_assms]: "global_refs' (s\ksInterruptState := intStateIRQTable_update f (ksInterruptState s)\) = global_refs' s" by (simp add: global_refs'_def) -end +lemmas InvariantUpdates_H_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation InvariantUpdates_H?: InvariantUpdates_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact InvariantUpdates_H_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.InvariantUpdates_H_assms)?) qed end diff --git a/proof/refine/ARM/ArchInvsLemmas_H.thy b/proof/refine/ARM/ArchInvsLemmas_H.thy index 9e5bbb7d89..8b5c2548f6 100644 --- a/proof/refine/ARM/ArchInvsLemmas_H.thy +++ b/proof/refine/ARM/ArchInvsLemmas_H.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Invariants_H_pspaceI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_pspaceI locale *) (* on 32-bit Arm, all addresses are canonical *) lemma pspace_canonical'_top[simp]: @@ -38,7 +38,7 @@ lemmas objBits_simps' = objBits_simps objBits_defs lemmas vspace_bits_defs = pd_bits_def pdeBits_def pt_bits_def pteBits_def pageBits_def ptBits_def pdBits_def -lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_cap'_pspaceI[Arch_assms]: "s \' cap \ ksPSpace s = ksPSpace s' \ s' \' cap" unfolding valid_cap'_def by (cases cap) @@ -48,7 +48,7 @@ lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: simp: vspace_table_at'_defs valid_arch_cap'_def split: arch_capability.split zombie_type.split option.splits)+ -lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_obj'_pspaceI[Arch_assms]: "valid_obj' obj s \ ksPSpace s = ksPSpace s' \ valid_obj' obj s'" unfolding valid_obj'_def by (cases obj) @@ -59,7 +59,7 @@ lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: Structures_H.thread_state.splits ntfn.splits option.splits intro: obj_at'_pspaceI valid_cap'_pspaceI typ_at'_pspaceI) -lemma tcb_space_clear[Invariants_H_pspaceI_assms]: +lemma tcb_space_clear[Arch_assms]: "\ tcb_cte_cases (y - x) = Some (getF, setF); is_aligned x tcbBlockSizeBits; ps_clear x tcbBlockSizeBits s; ksPSpace s x = Some (KOTCB tcb); ksPSpace s y = Some v; @@ -82,12 +82,12 @@ lemma tcb_space_clear[Invariants_H_pspaceI_assms]: apply (simp add: tcb_cte_cases_def cteSizeBits_def split: if_split_asm) done -lemma pspace_in_kernel_mappings'_pspaceI[Invariants_H_pspaceI_assms]: +lemma pspace_in_kernel_mappings'_pspaceI[Arch_assms]: "pspace_in_kernel_mappings' s \ ksPSpace s = ksPSpace s' \ pspace_in_kernel_mappings' s'" unfolding pspace_in_kernel_mappings'_def by simp -lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: +lemma range_cover_canonical_address[Arch_assms]: "\ range_cover ptr sz us n ; p < n ; canonical_address (ptr && ~~ mask sz) ; sz \ maxUntypedSizeBits \ \ canonical_address (ptr + of_nat p * 2 ^ us)" @@ -96,17 +96,18 @@ lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: (* not interesting on this architecture *) lemmas [simp] = pspace_in_kernel_mappings'_pspaceI -end +lemmas Invariants_H_pspaceI_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_pspaceI?: Invariants_H_pspaceI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Invariants_H_pspaceI_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Invariants_H_pspaceI_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Invariants_H_cte_ats_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_cte_ats locale *) (* FIXME arch-split: for proofs which require exact offsets lining up instead of cteSizeBits *) lemma raw_tcb_cte_cases_simps: @@ -117,7 +118,7 @@ lemma raw_tcb_cte_cases_simps: "tcb_cte_cases 64 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)" by (simp add: tcb_cte_cases_def cteSizeBits_def)+ -lemma cte_wp_at_cases'[Invariants_H_cte_ats_assms]: +lemma cte_wp_at_cases'[Arch_assms]: shows "cte_wp_at' P p s = ((\cte. ksPSpace s p = Some (KOCTE cte) \ is_aligned p cte_level_bits \ P cte \ ps_clear p cteSizeBits s) \ @@ -210,7 +211,7 @@ lemma cte_wp_at_cteI': shows "cte_wp_at' P ptr s" using assms by (simp add: cte_wp_at_cases' cte_level_bits_def objBits_defs) -lemma cte_at_typ'[Invariants_H_cte_ats_assms]: +lemma cte_at_typ'[Arch_assms]: "cte_at' c = (\s. typ_at' CTET c s \ (\n. typ_at' TCBT (c - n) s \ n \ dom tcb_cte_cases))" proof - have P: "\ko. (koTypeOf ko = CTET) = (\cte. ko = KOCTE cte)" @@ -234,12 +235,13 @@ lemma tcb_at_cte_at': apply (clarsimp simp add: return_def objBits_simps) done -end +lemmas Invariants_H_cte_ats_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_cte_ats?: Invariants_H_cte_ats proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Invariants_H_cte_ats_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Invariants_H_cte_ats_assms)?) qed @@ -329,7 +331,7 @@ lemma is_physical_cases: | _ \ True)" by (simp split: capability.splits arch_capability.splits zombie_type.splits) -named_theorems Invariants_H_typ_at_lifts_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_typ_at_lifts locale *) lemma page_directory_at'_typ_at_lift_strong: "(\p. f \\s. P (typ_at' (ArchT PDET) p s)\) \ f \\s. P (page_directory_at' p s)\" @@ -353,12 +355,12 @@ lemma asid_at'_typ_at_lift_strong: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (asid_pool_at' p s)\" by assumption -lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_tcb'_typ_at_lift_strong[Arch_assms]: assumes "\T p. f \\s. P (typ_at' T p s)\" shows "f \\s. P (valid_arch_tcb' tcb s)\" by (clarsimp simp: valid_arch_tcb'_def, wp) -lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_cap'_typ_at_lift[Arch_assms]: assumes P: "\P T p. f \\s. P (typ_at' T p s)\" shows "f \\s. valid_arch_cap' cap s\" apply (case_tac cap, @@ -368,12 +370,13 @@ lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: page_directory_at'_typ_at_lift_strong page_table_at'_typ_at_lift_strong)+ done +lemmas Invariants_H_typ_at_lifts_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) global_interpretation Invariants_H_typ_at_lifts?: Invariants_H_typ_at_lifts proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; unfold_locales; (fact Invariants_H_typ_at_lifts_assms)?) + case 1 show ?case by (intro_locales; unfold_locales; (fact ARM.Invariants_H_typ_at_lifts_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/ARM/ArchIpcCancel_R.thy b/proof/refine/ARM/ArchIpcCancel_R.thy index f6eccf9052..643f468ffb 100644 --- a/proof/refine/ARM/ArchIpcCancel_R.thy +++ b/proof/refine/ARM/ArchIpcCancel_R.thy @@ -12,24 +12,24 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_R locale *) (* FIXME: move to Machine_AI *) crunch getRegister, setRegister for (no_fail) no_fail[intro!, wp, simp] crunch Arch.postCapDeletion - for pred_tcb_at'[IpcCancel_R_assms, wp]: "pred_tcb_at' proj P t" - and typ_at'[IpcCancel_R_assms, wp]: "\s. P (typ_at' T p s)" + for pred_tcb_at'[Arch_assms, wp]: "pred_tcb_at' proj P t" + and typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" (wp: setCTE_pred_tcb_at') -lemma acapClass_not_ReplyClass[IpcCancel_R_assms]: +lemma acapClass_not_ReplyClass[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) crunch arch_post_cap_deletion - for pspace_aligned[IpcCancel_R_assms, wp]: "pspace_aligned :: det_state \ _" - and pspace_distinct[IpcCancel_R_assms, wp]: "pspace_distinct :: det_state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_state \ _" (simp: crunch_simps wp: crunch_wps) crunch emptySlot @@ -71,7 +71,7 @@ proof - corres: getObject_TCB_corres setObject_update_TCB_corres') qed -lemma prepareThreadDelete_corres[IpcCancel_R_assms, corres]: +lemma prepareThreadDelete_corres[Arch_assms, corres]: "t' = t \ corres dc (invs and tcb_at t) no_0_obj' (prepare_thread_delete t) (prepareThreadDelete t')" @@ -100,12 +100,13 @@ lemma setEndpoint_pde_mappings'[wp]: apply (clarsimp dest!: updateObject_default_result)+ done +lemmas IpcCancel_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation IpcCancel_R?: IpcCancel_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact IpcCancel_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.IpcCancel_R_assms)?)?) qed (* instantiate locales with assumptions depending on IpcCancel_R instantiation *) diff --git a/proof/refine/ARM/ArchIpc_R.thy b/proof/refine/ARM/ArchIpc_R.thy index a896b9c8e6..66bcc09cab 100644 --- a/proof/refine/ARM/ArchIpc_R.thy +++ b/proof/refine/ARM/ArchIpc_R.thy @@ -11,11 +11,11 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_R locale *) declare word32_minus_one_le[simp] -lemma max_ipc_size_le_2_msg_align_bits[Ipc_R_assms]: +lemma max_ipc_size_le_2_msg_align_bits[Arch_assms]: "max_ipc_words * word_size \ 2 ^ msg_align_bits" by (simp add: max_ipc_words word_size_def msg_align_bits) @@ -32,50 +32,50 @@ lemma vsCapRef_generic: "\ isArchObjectCap cap \ vsCapRef cap = None" by (clarsimp simp add: vsCapRef_def gen_isCap_simps split: capability.splits) -lemma is_derived'_Untyped[Ipc_R_assms]: +lemma is_derived'_Untyped[Arch_assms]: "\isUntypedCap cap'\ \ is_derived' m src cap' cap = (isUntypedCap cap \ badge_derived' cap' cap \ descendants_of' src m = {})" by (clarsimp simp add: ARM.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) -lemma is_derived'_Reply[Ipc_R_assms]: +lemma is_derived'_Reply[Arch_assms]: "\isReplyCap cap'\ \ is_derived' m src cap' cap = (isReplyCap cap \ capTCBPtr cap = capTCBPtr cap' \ capReplyMaster cap \ \ capReplyMaster cap')" by (clarsimp simp add: ARM.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) -lemma arch_maskCapRights_not_null[Ipc_R_assms, simp]: +lemma arch_maskCapRights_not_null[Arch_assms, simp]: "Arch.maskCapRights r acap \ NullCap" by (case_tac acap; simp add: ARM_H.maskCapRights_def isCap_simps) -lemma capASID_gen_cap[Ipc_R_assms]: +lemma capASID_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ capASID cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_asid_base'_gen_cap[Ipc_R_assms]: +lemma cap_asid_base'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_asid_base' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_vptr'_gen_cap[Ipc_R_assms]: +lemma cap_vptr'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_vptr' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemmas transferCapsToSlots_pspace_in_kernel_mappings'[Ipc_R_assms, wp] = +lemmas transferCapsToSlots_pspace_in_kernel_mappings'[Arch_assms, wp] = pspace_in_kernel_mappings'_inv[where f="transferCapsToSlots _ _ _ _ _ _"] crunch makeArchFaultMessage - for sch_act[Ipc_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for sch_act[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma is_derived'_IRQHandlerCap[Ipc_R_assms]: +lemma is_derived'_IRQHandlerCap[Arch_assms]: "\isIRQHandlerCap cap'\ \ is_derived' (ctes_of (s::kernel_state)) src cap' cap = (isIRQHandlerCap cap \ badge_derived' cap' cap)" by (clarsimp simp add: ARM.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) (* variant of storeWord_um_inv which does not expose architecture-specific information *) -lemma storeWord_um_inv'[Ipc_R_assms]: +lemma storeWord_um_inv'[Arch_assms]: "\\s. underlying_memory s = um\ storeWord a v \\_ s. is_aligned a word_size_bits @@ -89,7 +89,7 @@ lemma storeWord_um_inv'[Ipc_R_assms]: apply (auto simp add: unat_plus_simple[THEN iffD1] word_plus_mono_right2 mask_def) done -lemma isArchObjectCap_maskCapRights[Ipc_R_assms]: +lemma isArchObjectCap_maskCapRights[Arch_assms]: "isArchObjectCap (Arch.maskCapRights R acap)" by (cases acap; simp add: ARM_H.maskCapRights_def isCap_simps) @@ -100,16 +100,16 @@ lemma isPageCap_maskCapRights[simp]: apply (case_tac arch_capability; simp add: isCap_simps ARM_H.maskCapRights_def) done -lemma arch_updateCapData_ordering[Ipc_R_assms]: +lemma arch_updateCapData_ordering[Arch_assms]: "\ (x, arch_capBadge acap) \ capBadge_ordering P; Arch.updateCapData p d acap \ NullCap \ \ (x, capBadge (Arch.updateCapData p d acap)) \ capBadge_ordering P" by (cases acap; simp add: ARM_H.updateCapData_def) -lemma ArchUpdateCapData_noReply[Ipc_R_assms]: +lemma ArchUpdateCapData_noReply[Arch_assms]: "Arch.updateCapData p d acap \ capability.ReplyCap x y z" by (cases acap; simp add: ARM_H.updateCapData_def) -lemma ArchUpdateCapData_noIRQControl[Ipc_R_assms]: +lemma ArchUpdateCapData_noIRQControl[Arch_assms]: "Arch.updateCapData p d acap \ IRQControlCap" by (cases acap; simp add: ARM_H.updateCapData_def) @@ -130,14 +130,14 @@ lemma isPageCap_updateCapData[simp]: apply (clarsimp split:capability.splits simp:Let_def) done -lemma badgeRegister_badge_register[Ipc_R_assms]: +lemma badgeRegister_badge_register[Arch_assms]: "badgeRegister = badge_register" by (simp add: badge_register_def badgeRegister_def) -lemmas copyMRs__pspace_in_kernel_mappings'[Ipc_R_assms, wp] = +lemmas copyMRs__pspace_in_kernel_mappings'[Arch_assms, wp] = pspace_in_kernel_mappings'_inv[where f="copyMRs _ _ _ _ _"] -lemma makeArchFaultMessage_corres[Ipc_R_assms]: +lemma makeArchFaultMessage_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (make_arch_fault_msg f t) (makeArchFaultMessage (arch_fault_map f) t)" @@ -148,20 +148,20 @@ lemma makeArchFaultMessage_corres[Ipc_R_assms]: apply (wp+, auto) done -lemma syscallMessage_def'[Ipc_R_assms]: +lemma syscallMessage_def'[Arch_assms]: "FaultHandler_H.syscallMessage \ MachineExports.syscallMessage" by (simp add: syscallMessage_def) -lemma exceptionMessage_def'[Ipc_R_assms]: +lemma exceptionMessage_def'[Arch_assms]: "FaultHandler_H.exceptionMessage \ MachineExports.exceptionMessage" by (simp add: exceptionMessage_def) -lemma makeArchFaultMessage_inv[Ipc_R_assms, wp]: +lemma makeArchFaultMessage_inv[Arch_assms, wp]: "makeArchFaultMessage ft t \P\" unfolding makeArchFaultMessage_def by (wpsimp wp: asUser_inv getRestartPC_inv split: arch_fault.split) -lemma lookupIPCBuffer_valid_ipc_buffer[Ipc_R_assms, wp]: +lemma lookupIPCBuffer_valid_ipc_buffer[Arch_assms, wp]: "\valid_objs'\ VSpace_H.lookupIPCBuffer b s \case_option \ valid_ipc_buffer_ptr'\" unfolding lookupIPCBuffer_def supply tcb_cte_cases_simps(1)[simp del] (* avoid duplicate simp rule warning *) @@ -210,7 +210,7 @@ lemma lookupIPCBuffer_Some_0: "\\\ lookupIPCBuffer w t \\rv s. rv \ Some 0\" by (wpsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv) -lemma arch_getSanitiseRegisterInfo_corres[Ipc_R_assms]: +lemma arch_getSanitiseRegisterInfo_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (arch_get_sanitise_register_info t) (getSanitiseRegisterInfo t)" @@ -221,24 +221,24 @@ crunch getSanitiseRegisterInfo for tcb_at'[wp]: "tcb_at' t" crunch arch_get_sanitise_register_info - for pspace_distinct[Ipc_R_assms, wp]: pspace_distinct - and pspace_aligned[Ipc_R_assms, wp]: pspace_aligned + for pspace_distinct[Arch_assms, wp]: pspace_distinct + and pspace_aligned[Arch_assms, wp]: pspace_aligned -lemma sanitiseRegister_sanitise_register[Ipc_R_assms]: +lemma sanitiseRegister_sanitise_register[Arch_assms]: "sanitiseRegister = sanitise_register" by (rule ext)+ (clarsimp simp add: sanitiseRegister_def sanitise_register_def cong: register.case_cong) -lemma handleArchFaultReply_corres[Ipc_R_assms]: +lemma handleArchFaultReply_corres[Arch_assms]: "corres (=) \ \ (handle_arch_fault_reply ft t label msg) (handleArchFaultReply (arch_fault_map ft) t label msg)" by (clarsimp simp: handle_arch_fault_reply_def handleArchFaultReply_def split: arch_fault.split) crunch getSanitiseRegisterInfo, handleArchFaultReply, handle_arch_fault_reply - for inv[Ipc_R_assms, wp]: P + for inv[Arch_assms, wp]: P -lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: +lemma ctes_of_mdbNext_parentOf[Arch_assms]: "\ ctes_of s' \ cte_map cptr \ cte_map slot; ctes_of s' (cte_map cptr) = Some (CTE (capability.ReplyCap t master rights) n); ctes_of s' (mdbNext (cteMDBNode cte)) = Some (CTE (capability.ReplyCap t master' rights') n'); @@ -248,19 +248,20 @@ lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: (erule subtree.cases; clarsimp simp: parentOf_def isMDBParentOf_CTE) crunch debugPrint - for inv[Ipc_R_assms, wp]: P - and (no_fail) no_fail[Ipc_R_assms, intro!, wp, simp] + for inv[Arch_assms, wp]: P + and (no_fail) no_fail[Arch_assms, intro!, wp, simp] crunch setThreadState, asUser for valid_pde_mappings'[wp]: valid_pde_mappings' (simp: crunch_simps wp: hoare_drop_imps) +lemmas Ipc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Ipc_R?: Ipc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Ipc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Ipc_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/ARM/ArchKHeap_R.thy b/proof/refine/ARM/ArchKHeap_R.thy index 870b0dde7d..935e03bb62 100644 --- a/proof/refine/ARM/ArchKHeap_R.thy +++ b/proof/refine/ARM/ArchKHeap_R.thy @@ -14,7 +14,7 @@ declare a_type_simps[simp] (* FIXME: on RISCV64/AARCH64 this is in ArchInvariant context Arch begin arch_global_naming -named_theorems KHeap_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R locale *) declare aa_type_simps[simp] (* FIXME: on RISCV64/AARCH64 this is in ArchInvariants_AI already *) @@ -41,12 +41,12 @@ lemma no_fail_getPDE[wp]: apply (clarsimp simp del: lookupAround2_same1) done -lemma koType_objBitsKO[KHeap_R_assms]: +lemma koType_objBitsKO[Arch_assms]: "koTypeOf k = koTypeOf k' \ objBitsKO k = objBitsKO k'" by (auto simp: objBitsKO_def archObjSize_def split: kernel_object.splits arch_kernel_object.splits) -lemma pspace_dom_update[KHeap_R_assms]: +lemma pspace_dom_update[Arch_assms]: "\ ps ptr = Some x; a_type x = a_type v \ \ pspace_dom (ps(ptr \ v)) = pspace_dom ps" apply (simp add: pspace_dom_def dom_fun_upd2 del: dom_fun_upd) apply (rule SUP_cong [OF refl]) @@ -54,7 +54,7 @@ lemma pspace_dom_update[KHeap_R_assms]: apply (simp add: obj_relation_cuts_def3) done -lemma cte_wp_at_ctes_of[KHeap_R_assms]: +lemma cte_wp_at_ctes_of[Arch_assms]: "cte_wp_at' P p s = (\cte. ctes_of s p = Some cte \ P cte)" supply diff_neg_mask[simp del] apply (simp add: cte_wp_at_cases' map_to_ctes_def Let_def @@ -87,15 +87,15 @@ lemma cte_wp_at_ctes_of[KHeap_R_assms]: word_bw_assocs) done -lemma ctes_of_canonical[KHeap_R_assms]: +lemma ctes_of_canonical[Arch_assms]: assumes canonical: "pspace_canonical' s" assumes ctes_of: "ctes_of s p = Some cte" shows "canonical_address p" by (simp add: canonical_address_def) -lemma valid_updateCapDataI[KHeap_R_assms]: +lemma valid_updateCapDataI[Arch_assms]: "s \' c \ s \' updateCapData b x c" - apply (unfold global.updateCapData_def Let_def updateCapData_def) + apply (unfold global.updateCapData_def Let_def ARM_H.updateCapData_def) apply (cases c) apply (simp_all add: gen_isCap_defs valid_cap'_def global.capUntypedPtr_def gen_isCap_simps capAligned_def word_size word_bits_def word_bw_assocs @@ -259,7 +259,7 @@ lemma setObject_other_arch_corres: simp split: arch_kernel_obj.split_asm) by (fastforce dest: tcbs_of'_non_tcb_update) -lemmas [KHeap_R_assms] = +lemmas [Arch_assms] = setObject_other_corres[where 'a=endpoint] setObject_other_corres[where 'a=notification] @@ -278,11 +278,11 @@ lemma pspace_in_kernel_mappings'_inv: "f \pspace_in_kernel_mappings'\" by wp -lemma setEndpoint_pspace_in_kernel_mappings'[KHeap_R_assms]: +lemma setEndpoint_pspace_in_kernel_mappings'[Arch_assms]: "setEndpoint p ko \pspace_in_kernel_mappings'\" by wp -lemma setNotification_pspace_in_kernel_mappings'[KHeap_R_assms]: +lemma setNotification_pspace_in_kernel_mappings'[Arch_assms]: "setNotification p ko \pspace_in_kernel_mappings'\" by wp @@ -347,27 +347,28 @@ lemma valid_arch_state_lift'_valid_pde_mappings': solves \wp typs hoare_vcg_conj_lift hoare_vcg_const_Ball_lift\)+ done -lemma idle_is_global[KHeap_R_assms, intro!]: +lemma idle_is_global[Arch_assms, intro!]: "ksIdleThread s \ global_refs' s" by (simp add: global_refs'_def) -end +lemmas KHeap_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R?: KHeap_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.KHeap_R_assms)?) qed context Arch begin arch_global_naming -named_theorems KHeap_R_assms_2 +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R_2 locale *) -lemmas setEndpoint_valid_globals[KHeap_R_assms_2, wp] +lemmas setEndpoint_valid_globals[Arch_assms, wp] = valid_global_refs_lift'[OF set_ep_ctes_of set_ep_arch' setEndpoint_it setEndpoint_ksInterruptState] -lemma set_ntfn_global_refs'[KHeap_R_assms_2, wp]: +lemma set_ntfn_global_refs'[Arch_assms, wp]: "\valid_global_refs'\ setNotification ptr val \\_. valid_global_refs'\" by (rule valid_global_refs_lift'; wp) @@ -398,7 +399,7 @@ lemma setObject_ko_wp_at': objBits_def[symmetric] ps_clear_upd in_magnitude_check v) -lemmas [KHeap_R_assms_2] = setEndpoint_valid_arch' setNotification_valid_arch' +lemmas [Arch_assms] = setEndpoint_valid_arch' setNotification_valid_arch' sublocale setObject: typ_at_props' "setObject p v" by typ_at_props' @@ -409,12 +410,13 @@ sublocale doMachineOp: typ_at_props' "doMachineOp mop" sublocale setEndpoint: typ_at_props' "setEndpoint ptr val" by typ_at_props' -end +lemmas KHeap_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R_2?: KHeap_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms_2)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.KHeap_R_2_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/ARM/ArchMachine_R.thy b/proof/refine/ARM/ArchMachine_R.thy index a7c99f634e..def1a65284 100644 --- a/proof/refine/ARM/ArchMachine_R.thy +++ b/proof/refine/ARM/ArchMachine_R.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems Machine_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Machine_R locale *) -lemma dmo_getirq_inv[Machine_R_assms, wp]: +lemma dmo_getirq_inv[Arch_assms, wp]: "irq_state_independent_H P \ \P\ doMachineOp (getActiveIRQ in_kernel) \\rv. P\" apply (simp add: getActiveIRQ_def doMachineOp_def split_def exec_gets select_f_select[simplified liftM_def] @@ -33,7 +33,7 @@ lemma getActiveIRQ_masked: apply (clarsimp simp: valid_irq_masks'_def) done -lemma dmo_maskInterrupt[Machine_R_assms]: +lemma dmo_maskInterrupt[Arch_assms]: "\\s. P (ksMachineState_update (irq_masks_update (\t. t (irq := m))) s)\ doMachineOp (maskInterrupt m irq) \\_. P\" apply (simp add: doMachineOp_def split_def) @@ -51,7 +51,7 @@ lemma dmo_maskInterrupt_True: ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) done -lemma setIRQState_irq_states'[Machine_R_assms, wp]: +lemma setIRQState_irq_states'[Arch_assms, wp]: "setIRQState state irq \valid_irq_states'\" apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def) apply (wp dmo_maskInterrupt) @@ -72,20 +72,20 @@ lemma sendSGI_underlying_memory[wp]: unfolding sendSGI_def by wp -lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: +lemma doMachineOp_getActiveIRQ_non_kernel[Arch_assms, wp]: "\\\ doMachineOp (getActiveIRQ True) \\rv s. \irq. rv = Some irq \ irq \ non_kernel_IRQs \ P irq s\" by (wpsimp simp: non_kernel_IRQs_def) -lemma frameRegisters_def'[Machine_R_assms]: +lemma frameRegisters_def'[Arch_assms]: "frameRegisters = MachineExports.frameRegisters" by (simp add: frameRegisters_def) -lemma gpRegisters_def'[Machine_R_assms]: +lemma gpRegisters_def'[Arch_assms]: "gpRegisters = MachineExports.gpRegisters" by (simp add: gpRegisters_def) -lemma tlsBaseRegister_def'[Machine_R_assms]: +lemma tlsBaseRegister_def'[Arch_assms]: "tlsBaseRegister = MachineExports.tlsBaseRegister" by (simp add: tlsBaseRegister_def) @@ -98,12 +98,13 @@ crunch setIRQTrigger for (no_fail) no_fail[intro!, wp, simp] (ignore: setIRQTrigger_impl) -end +lemmas Machine_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Machine_R?: Machine_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Machine_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.Machine_R_assms)?) qed end diff --git a/proof/refine/ARM/ArchRefine.thy b/proof/refine/ARM/ArchRefine.thy index 04b2727d51..c32d7f9296 100644 --- a/proof/refine/ARM/ArchRefine.thy +++ b/proof/refine/ARM/ArchRefine.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems Refine_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Refine locale *) text \User memory content is the same on both levels\ lemma typ_at_AUserDataI: @@ -134,7 +134,7 @@ lemma p_and_not_mask_pbfs_add_mask_pbfs_eq: add: shiftr_shiftl1 mask_out_add_aligned is_aligned_neg_mask pbfs_atleast_pageBits word_plus_and_or_coroll2 add.commute) -lemma pointerInUserData_relation[Refine_assms]: +lemma pointerInUserData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInUserData p s' = in_user_frame p s" apply (simp add: pointerInUserData_def in_user_frame_def) @@ -148,7 +148,7 @@ lemma pointerInUserData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma pointerInDeviceData_relation[Refine_assms]: +lemma pointerInDeviceData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInDeviceData p s' = in_device_frame p s" apply (simp add: pointerInDeviceData_def in_device_frame_def) @@ -162,31 +162,31 @@ lemma pointerInDeviceData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma user_mem_relation[Refine_assms]: +lemma user_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ user_mem' s' = user_mem s" by (rule ext) (clarsimp simp: user_mem_def user_mem'_def pointerInUserData_relation pointerInDeviceData_relation state_relation_def) -lemma device_mem_relation[Refine_assms]: +lemma device_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ device_mem' s' = device_mem s" by (rule ext) (clarsimp simp: device_mem_def device_mem'_def pointerInUserData_relation pointerInDeviceData_relation) -lemma arch_activate_thread_sched_act[Refine_assms]: +lemma arch_activate_thread_sched_act[Arch_assms]: "\ct_in_state activatable and (\s. P (scheduler_action s))\ arch_activate_idle_thread t \\rs s. P (scheduler_action (s::det_state))\" by (wpsimp simp: arch_activate_idle_thread_def) -lemma valid_list_init[Refine_assms, simp]: +lemma valid_list_init[Arch_assms, simp]: "valid_list init_A_st" by (simp add: valid_list_2_def init_A_st_def ext_init_def init_cdt_def) -lemma valid_sched_init[Refine_assms, simp]: +lemma valid_sched_init[Arch_assms, simp]: "valid_sched init_A_st" apply (simp add: valid_sched_def init_A_st_def ext_init_def) apply (clarsimp simp: init_kheap_def st_tcb_at_kh_def obj_at_kh_def @@ -198,62 +198,63 @@ lemma valid_sched_init[Refine_assms, simp]: etcb_at'_def etcbs_of'_def) done -lemma valid_domain_list_init[Refine_assms, simp]: +lemma valid_domain_list_init[Arch_assms, simp]: "valid_domain_list init_A_st" by (simp add: init_A_st_def ext_init_def valid_domain_list_def) -lemma valid_domain_time_init[Refine_assms, simp]: +lemma valid_domain_time_init[Arch_assms, simp]: "0 < domain_time init_A_st" by (simp add: init_A_st_def) -lemma sched_act_init[Refine_assms, simp]: +lemma sched_act_init[Arch_assms, simp]: "scheduler_action init_A_st = resume_cur_thread" by (simp add: init_A_st_def) -lemma fastpathKernelAssertions_cross[Refine_assms]: +lemma fastpathKernelAssertions_cross[Arch_assms]: "\ (s,s') \ state_relation; invs s; valid_arch_state' s'\ \ fastpathKernelAssertions s'" unfolding fastpathKernelAssertions_def by simp (* vs duplicate interface lemma *) -lemmas [Refine_assms] = callKernel_valid_duplicates' +lemmas [Arch_assms] = callKernel_valid_duplicates' -lemma doUserOp_valid_duplicates'[Refine_assms]: +lemma doUserOp_valid_duplicates'[Arch_assms]: "doUserOp f tc \\s. vs_valid_duplicates' (ksPSpace s)\" by (simp add: doUserOp_def split_def) (wpsimp wp: dmo_invs') -lemma checkActiveIRQ_valid_duplicates'[Refine_assms]: +lemma checkActiveIRQ_valid_duplicates'[Arch_assms]: "checkActiveIRQ \\s. vs_valid_duplicates' (ksPSpace s)\" by (wpsimp simp: checkActiveIRQ_def) -lemma tcb_hyp_refs'_atcbContextSet[Refine_assms, simp]: +lemma tcb_hyp_refs'_atcbContextSet[Arch_assms, simp]: "tcb_hyp_refs' (atcbContextSet tc atcb) = tcb_hyp_refs' atcb" by (simp add: atcbContextSet_def) -lemma ptable_lift_abs_state[Refine_assms, simp]: +lemma ptable_lift_abs_state[Arch_assms, simp]: "ptable_lift t (abs_state s) = ptable_lift t s" by (simp add: ptable_lift_def abs_state_def) -lemma ptable_rights_abs_state[Refine_assms, simp]: +lemma ptable_rights_abs_state[Arch_assms, simp]: "ptable_rights t (abs_state s) = ptable_rights t s" by (simp add: ptable_rights_def abs_state_def) -lemma arch_tcb_relation_arch_context_set[Refine_assms]: +lemma arch_tcb_relation_arch_context_set[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_relation (arch_tcb_context_set tc atcb) (atcbContextSet tc atcb')" by (simp add: arch_tcb_relation_def arch_tcb_context_set_def atcbContextSet_def) -lemma arch_tcb_relation_arch_context_get[Refine_assms]: +lemma arch_tcb_relation_arch_context_get[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_context_get atcb = atcbContextGet atcb'" by (simp add: arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) +lemmas Refine_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Refine?: Refine proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Refine_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Refine_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchRetype_R.thy b/proof/refine/ARM/ArchRetype_R.thy index a006632ce2..d64027697b 100644 --- a/proof/refine/ARM/ArchRetype_R.thy +++ b/proof/refine/ARM/ArchRetype_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Retype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R locale *) -lemma toAPIType_Some[Retype_R_assms, simp]: +lemma toAPIType_Some[Arch_assms, simp]: "(toAPIType ty = Some x) = (ty = APIObjectType x)" by (cases ty; auto simp: toAPIType_def) @@ -35,19 +35,19 @@ definition APIType_map2 :: "kernel_object + ARM_H.object_type \ Stru (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_map2_def = APIType_map2_raw_def[simplified APIType_map2_gen_def] -lemma APIType_map2_Untyped[Retype_R_assms, simp]: +lemma APIType_map2_Untyped[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.Untyped) = (tp = Inr (APIObjectType ArchTypes_H.Untyped))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_TCBObject[Retype_R_assms, simp]: +lemma APIType_map2_TCBObject[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.TCBObject) = (tp = Inr (APIObjectType ArchTypes_H.TCBObject))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_generic[Retype_R_assms, simp]: +lemma APIType_map2_generic[Arch_assms, simp]: "APIType_map2 (Inr (APIObjectType api)) = APIType_map2_gen api" by (simp add: APIType_map2_raw_def) @@ -65,11 +65,11 @@ definition APIType_capBits :: "ARM_H.object_type \ nat \ (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_capBits_def = APIType_capBits_raw_def[simplified APIType_capBits_gen_def] -lemma APIType_capBits_generic[Retype_R_assms, simp]: +lemma APIType_capBits_generic[Arch_assms, simp]: "APIType_capBits (APIObjectType api) us = APIType_capBits_gen api us" by (simp add: APIType_capBits_raw_def) -lemma objSize_eq_capBits[simp, Retype_R_assms]: +lemma objSize_eq_capBits[simp, Arch_assms]: "Types_H.getObjectSize ty us = APIType_capBits ty us" by (cases ty; clarsimp simp: getObjectSize_def objBits_simps @@ -94,13 +94,13 @@ definition makeObjectKO :: "bool \ domain \ (kernel_obje (* inside of Arch, we don't need to isolate generic component *) lemmas makeObjectKO_def = makeObjectKO_raw_def[simplified makeObjectKO_gen_def] -lemma makeObjectKO_generic[Retype_R_assms, simp]: +lemma makeObjectKO_generic[Arch_assms, simp]: "makeObjectKO dev d (Inr (APIObjectType api)) = makeObjectKO_gen d api" by (simp add: makeObjectKO_raw_def) text \makeObject etc. lemmas\ -lemma valid_arch_tcb'_newArchTCB[Retype_R_assms, simp]: +lemma valid_arch_tcb'_newArchTCB[Arch_assms, simp]: "valid_arch_tcb' newArchTCB s" unfolding valid_arch_tcb'_def newArchTCB_def by simp @@ -122,7 +122,7 @@ text \On the abstract side\ text \Lemmas for createNewObjects etc.\ -lemma makeObjectKO_eq[Retype_R_assms]: +lemma makeObjectKO_eq[Arch_assms]: assumes x: "makeObjectKO dev d tp = Some v" shows "(v = KOCTE cte) = @@ -134,7 +134,7 @@ lemma makeObjectKO_eq[Retype_R_assms]: split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm ARM_H.object_type.split_asm arch_kernel_object.split_asm)+ -lemma objBits_le_obj_bits_api[Retype_R_assms]: +lemma objBits_le_obj_bits_api[Arch_assms]: "makeObjectKO dev d ty = Some ko \ objBitsKO ko \ obj_bits_api (APIType_map2 ty) us" apply (case_tac ty) apply (auto simp: default_arch_object_def vspace_bits_defs @@ -143,7 +143,7 @@ lemma objBits_le_obj_bits_api[Retype_R_assms]: Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits) done -lemma obj_relation_retype_other_obj[Retype_R_assms]: +lemma obj_relation_retype_other_obj[Arch_assms]: "\ is_other_obj_relation_type (a_type ko); other_obj_relation ko ko' \ \ obj_relation_retype ko ko'" apply (simp add: obj_relation_retype_def) @@ -178,7 +178,7 @@ lemma sym_refs_empty[simp]: unfolding sym_refs_def by simp -lemma ksPSpace_update_gs_eq[Retype_R_assms, simp]: +lemma ksPSpace_update_gs_eq[Arch_assms, simp]: "ksPSpace (update_gs ty us ptrs s) = ksPSpace s" by (simp add: update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) @@ -199,12 +199,12 @@ lemma update_gs_ksMachineState_update_swap: by (simp add: update_gs_def split: aobject_type.splits Structures_A.apiobject_type.splits) -lemma update_gs_id[Retype_R_assms]: +lemma update_gs_id[Arch_assms]: "tp \ no_gs_types \ update_gs tp us addrs = id" by (simp add: no_gs_types_def update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) -lemma no_gs_types_CapTableObject[Retype_R_assms]: +lemma no_gs_types_CapTableObject[Arch_assms]: "Structures_A.apiobject_type.CapTableObject \ no_gs_types" by (simp add: no_gs_types_def) @@ -221,7 +221,7 @@ lemma update_gs_simps[simp]: gsUserPages_update (\ups x. if x \ ptrs then Some ARMSuperSection else ups x)" by (simp_all add: update_gs_def) -lemma objBitsKO_gt_0[Retype_R_assms]: +lemma objBitsKO_gt_0[Arch_assms]: "0 < objBitsKO ko" apply (case_tac ko) apply (simp_all add: objBits_simps' pageBits_def) @@ -283,7 +283,7 @@ lemma range_cover_canonical_address': apply (frule range_cover_canonical_address[where p="unat p"]; simp?) using unat_less_helper by blast -lemma createNewCaps_valid_cap[Retype_R_assms]: +lemma createNewCaps_valid_cap[Arch_assms]: fixes ptr :: machine_word assumes cover: "range_cover ptr sz (APIType_capBits ty us) n " assumes not_0: "n \ 0" @@ -507,7 +507,7 @@ proof - qed qed -lemma arch_tcb_relation_default[Retype_R_assms]: +lemma arch_tcb_relation_default[Arch_assms]: "arch_tcb_relation default_arch_tcb newArchTCB" by (clarsimp simp: new_context_def newContext_def initContext_def default_arch_tcb_def newArchTCB_def arch_tcb_relation_def) @@ -626,7 +626,7 @@ lemmas object_splits = ARM_H.object_type.split_asm arch_kernel_object.split_asm -lemma valid_arch_badges_not_arch[Retype_R_assms]: +lemma valid_arch_badges_not_arch[Arch_assms]: "\isArchObjectCap cap' \ valid_arch_badges cap cap' node" by (auto simp: isCap_simps valid_arch_badges_def) @@ -634,7 +634,7 @@ lemma valid_arch_badges_NullCap[simp]: "valid_arch_badges cap NullCap node" by (simp add: valid_arch_badges_not_arch gen_isCap_simps) -lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: +lemma valid_untyped'_helper_arch_cap[Arch_assms]: "\pspace_aligned' s; pspace_distinct' s; pspace_no_overlap' ptr sz s; range_cover ptr sz (objBitsKO val) n; valid_arch_cap' acap s \ \ valid_arch_cap' acap @@ -643,7 +643,7 @@ lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: typ_at_to_obj_at_arches page_directory_at'_def page_table_at'_def split: if_split_asm arch_capability.splits) -lemma retype_in_kernel_mappings'[Retype_R_assms]: +lemma retype_in_kernel_mappings'[Arch_assms]: assumes pc': "pspace_in_kernel_mappings' s'" and cover: "range_cover ptr sz (objBitsKO ko) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -681,7 +681,7 @@ lemma copyGlobalMappings_valid_pspace[wp]: "\valid_pspace'\ copyGlobalMappings pd \\rv. valid_pspace'\" by (simp add: valid_pspace'_def | wp)+ -lemma createNewCaps_cte_wp_at2[Retype_R_assms]: +lemma createNewCaps_cte_wp_at2[Arch_assms]: "\\s. P (cte_wp_at' P' p s) \ \ P' makeObject \ n \ 0 \ range_cover ptr sz (APIType_capBits ty objsz) n @@ -725,7 +725,7 @@ proof (rule hoare_gen_asm) done qed -lemma createNewCaps_cte_wp_at'[Retype_R_assms]: +lemma createNewCaps_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -750,7 +750,7 @@ lemma createNewCaps_cte_wp_at'[Retype_R_assms]: (* example of arch-split attempt of this kind of proof; unfortunately splitting off the arch-specific part doesn't actually save space, so we will leave these in Arch *) -lemma createNewCaps_state_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -778,7 +778,7 @@ lemma createNewCaps_state_refs_of'[Retype_R_assms]: apply (force simp: gen_objBits_simps split: ArchTypes_H.apiobject_type.splits) done -lemma createNewCaps_state_hyp_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_hyp_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -808,7 +808,7 @@ lemma arch_live'_KOPTE[simp]: "arch_live' (KOPTE makeObject) = False" by (simp add: makeObject_pte arch_live'_def) -lemma createNewCaps_iflive'[Retype_R_assms, wp]: +lemma createNewCaps_iflive'[Arch_assms, wp]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -840,28 +840,28 @@ crunch createNewCaps for qs[wp]: "\s. P (ksReadyQueues s)" and qsL1[wp]: "\s. P (ksReadyQueuesL1Bitmap s)" and qsL2[wp]: "\s. P (ksReadyQueuesL2Bitmap s)" - and ct[Retype_R_assms, wp]: "\s. P (ksCurThread s)" - and ksCurDomain[Retype_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksInterrupt[Retype_R_assms, wp]: "\s. P (ksInterruptState s)" - and nosch[Retype_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and it[Retype_R_assms, wp]: "\s. P (ksIdleThread s)" + and ct[Arch_assms, wp]: "\s. P (ksCurThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksInterrupt[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and it[Arch_assms, wp]: "\s. P (ksIdleThread s)" and asid_table[wp]: "\s. P (armKSASIDTable (ksArchState s))" and gsMaxObjectSize[wp]: "\s. P (gsMaxObjectSize s)" - and irq_states'[Retype_R_assms, wp]: valid_irq_states' - and ksDomSchedule[Retype_R_assms, wp]: "\s. P (ksDomSchedule s)" - and ksDomScheduleIdx[Retype_R_assms, wp]: "\s. P (ksDomScheduleIdx s)" - and ksDomScheduleStart[Retype_R_assms, wp]: "\s. P (ksDomScheduleStart s)" - and gsUntypedZeroRanges[Retype_R_assms, wp]: "\s. P (gsUntypedZeroRanges s)" + and irq_states'[Arch_assms, wp]: valid_irq_states' + and ksDomSchedule[Arch_assms, wp]: "\s. P (ksDomSchedule s)" + and ksDomScheduleIdx[Arch_assms, wp]: "\s. P (ksDomScheduleIdx s)" + and ksDomScheduleStart[Arch_assms, wp]: "\s. P (ksDomScheduleStart s)" + and gsUntypedZeroRanges[Arch_assms, wp]: "\s. P (gsUntypedZeroRanges s)" and ksArch[wp]: "\s. P (ksArchState s)" (simp: crunch_simps unless_def wp: mapM_x_wp' setObject_ksInterrupt updateObject_default_inv crunch_wps no_irq no_irq_clearMemory) -lemma createNewCaps_arch_ko_type_pre_non_arch[Retype_R_assms]: +lemma createNewCaps_arch_ko_type_pre_non_arch[Arch_assms]: "(case ty of ArchT _ \ False | _ \ True) \ createNewCaps_arch_ko_type_pre ty" by (clarsimp simp add: createNewCaps_arch_ko_type_pre_def) -lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: +lemma createNewCaps_ko_wp_atQ'[Arch_assms]: "\(\s. P (ko_wp_at' P' p s) \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -890,7 +890,7 @@ lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: | split if_split_asm)+ done -lemma createNewCaps_global_refs'[Retype_R_assms]: +lemma createNewCaps_global_refs'[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ valid_global_refs' s @@ -920,7 +920,7 @@ lemma copyGlobalMappings_ksMachineState[wp]: by (simp add: copyGlobalMappings_def storePDE_def split_def | wp mapM_x_wp_inv setObject_ksMachine updateObject_default_inv)+ -lemma createNewCaps_valid_bitmaps[Retype_R_assms]: +lemma createNewCaps_valid_bitmaps[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_bitmaps s\ createNewCaps ty ptr n us dev \\_. valid_bitmaps\" @@ -936,7 +936,7 @@ lemma createNewCaps_valid_bitmaps[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: +lemma createNewCaps_valid_sched_pointers[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_sched_pointers s\ createNewCaps ty ptr n us dev \\_. valid_sched_pointers\" @@ -951,7 +951,7 @@ lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_vms[Retype_R_assms]: +lemma createNewCaps_vms[Arch_assms]: "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ 0 < n) and valid_machine_state'\ @@ -977,7 +977,7 @@ lemma createNewCaps_vms[Retype_R_assms]: field_simps mult_2_right vspace_bits_defs) done -lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: +lemma createNewCaps_pspace_domain_valid[Arch_assms, wp]: "\pspace_domain_valid and K ({ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \ kernel_data_refs = {} \ range_cover ptr sz (APIType_capBits ty us) n \ 0 < n)\ @@ -996,10 +996,12 @@ lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: (* safe for generic context, and we can't requalify object_type.inject as that would result in it being named "inject" *) -lemma object_type_inject[Retype_R_assms]: +lemma object_type_inject[Arch_assms]: "(APIObjectType x = APIObjectType y) = (x = y)" by simp +lemmas Retype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -1010,8 +1012,7 @@ arch_requalify_consts interpretation Retype_R?: Retype_R makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Retype_R_assms)?)?) qed locale Arch_retype_mdb = retype_mdb + Arch @@ -1040,18 +1041,18 @@ end (* Arch_retype_mdb *) context Arch begin arch_global_naming -named_theorems Retype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_2 locale *) (* drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [Retype_R_2_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] +lemmas [Arch_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] (* FIXME arch-split: currently only the gen_ version is used *) lemmas valid_obj_makeObject_rules = gen_valid_obj_makeObject_rules valid_obj_makeObject_pte valid_obj_makeObject_asid_pool -lemma retype_state_relation[Retype_R_2_assms]: +lemma retype_state_relation[Arch_assms]: notes data_map_insert_def[simp del] assumes sr: "(s, s') \ state_relation" and vs: "valid_pspace s" "valid_mdb s" @@ -1282,7 +1283,7 @@ lemma retype_state_relation[Retype_R_2_assms]: split: Structures_A.apiobject_type.splits aobject_type.splits) qed -lemma createObjects_valid_objs'[Retype_R_2_assms]: +lemma createObjects_valid_objs'[Arch_assms]: assumes mko: "makeObjectKO dev d ty = Some val" and max_d: "ty = Inr (APIObjectType TCBObject) \ d \ maxDomain" and vo: "valid_objs' s" @@ -1368,7 +1369,7 @@ proof - done qed -lemma createNewCaps_idle'[Retype_R_2_assms, wp]: +lemma createNewCaps_idle'[Arch_assms, wp]: "\valid_idle' and valid_pspace' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ createNewCaps ty ptr n us d @@ -1514,7 +1515,7 @@ lemma createNewCaps_obj_at'': apply (clarsimp simp: project_koType project_inject) done -lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: +lemma createNewCaps_valid_arch_state[Arch_assms]: "\(\s. valid_arch_state' s \ valid_pspace' s \ pspace_no_overlap' ptr sz s \ (tp = APIObjectType ArchTypes_H.CapTableObject \ us > 0)) and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ @@ -1543,7 +1544,7 @@ lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: typ_at_to_obj_at_arches comp_def) done -lemma createNewCaps_sched_queues[Retype_R_2_assms]: +lemma createNewCaps_sched_queues[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" assumes not_0: "n \ 0" shows @@ -1567,7 +1568,7 @@ lemma createNewCaps_sched_queues[Retype_R_2_assms]: split_del: if_split, fastforce simp add: mult_2 add_ac vspace_bits_defs)+ -lemma createNewCaps_null_filter'[Retype_R_2_assms]: +lemma createNewCaps_null_filter'[Arch_assms]: "\(\s. P (null_filter' (ctes_of s))) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0) \ @@ -1591,7 +1592,7 @@ lemma createNewCaps_null_filter'[Retype_R_2_assms]: | fastforce)+ done -lemma createObjects_no_cte_valid_global[Retype_R_2_assms]: +lemma createObjects_no_cte_valid_global[Arch_assms]: assumes no_cte: "\c. projectKO_opt val \ Some (c::cte)" assumes no_tcb: "\t. projectKO_opt val \ Some (t::tcb)" shows "\\s. pspace_aligned' s \ pspace_distinct' s \ @@ -1636,7 +1637,7 @@ lemma createObjects_valid_arch: apply auto done -lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: +lemma createObjects_untyped_ranges_zero'[Arch_assms]: assumes moKO: "makeObjectKO dev d ty = Some val" shows "\ct_active' and valid_pspace' and pspace_no_overlap' ptr sz @@ -1662,18 +1663,19 @@ lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: apply (simp add: makeObject_cte untypedZeroRange_def) done +lemmas Retype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_2?: Retype_R_2 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Retype_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Retype_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_3 locale *) lemma createObjects_no_cte_invs: assumes moKO: "makeObjectKO dev d ty = Some val" @@ -1758,7 +1760,7 @@ proof - split: option.splits kernel_object.splits) qed -lemma createNewCaps_valid_pspace[Retype_R_3_assms]: +lemma createNewCaps_valid_pspace[Arch_assms]: assumes not_0: "n \ 0" and cover: "range_cover ptr sz (APIType_capBits ty us) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -1801,7 +1803,7 @@ lemma data_page_relation_retype: apply (clarsimp simp: image_def)+ done -lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: +lemma corres_retype_region_createNewCaps[Arch_assms]: "corres ((\r r'. length r = length r' \ list_all2 cap_relation r r') \ map (\ref. default_cap (APIType_map2 (Inr ty)) ref us dev)) (\s. valid_pspace s \ valid_mdb s \ valid_list s \ valid_arch_state s @@ -2088,13 +2090,14 @@ lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: pd_bits_def fromIntegral_def toInteger_nat fromInteger_nat makeObject_pde) done +lemmas Retype_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_3?: Retype_R_3 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Retype_R_3_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchSchedule_R.thy b/proof/refine/ARM/ArchSchedule_R.thy index 54b3902391..237fafcc05 100644 --- a/proof/refine/ARM/ArchSchedule_R.thy +++ b/proof/refine/ARM/ArchSchedule_R.thy @@ -11,10 +11,10 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R locale *) crunch tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue - for state_hyp_refs_of'[Schedule_R_assms, wp]: "\s. P (state_hyp_refs_of' s)" + for state_hyp_refs_of'[Arch_assms, wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp) lemma arch_switch_thread_tcb_at'[wp]: @@ -38,21 +38,21 @@ proof - by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_ARM_H_switchToThread_typ_at' pos]) qed -lemmas Arch_switchToThread_st_tcb_at'[Schedule_R_assms] = +lemmas Arch_switchToThread_st_tcb_at'[Arch_assms] = Arch_switchToThread_pred_tcb'[where proj=itcbState] crunch storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread, Arch.switchToIdleThread for ksQ[wp]: "\s. P (ksReadyQueues s)" - and ksIdleThread[Schedule_R_assms, wp]: "\s. P (ksIdleThread s)" - and sym_heap_sched_pointers[Schedule_R_assms, wp]: sym_heap_sched_pointers - and valid_objs'[Schedule_R_assms, wp]: valid_objs' + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and sym_heap_sched_pointers[Arch_assms, wp]: sym_heap_sched_pointers + and valid_objs'[Arch_assms, wp]: valid_objs' (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp simp: crunch_simps obj_at'_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread - for pspace_aligned[Schedule_R_assms, wp]: pspace_aligned - and pspace_distinct[Schedule_R_assms, wp]: pspace_distinct - and ready_queues[Schedule_R_assms, wp]: "\s. P (ready_queues s)" + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct + and ready_queues[Arch_assms, wp]: "\s. P (ready_queues s)" and ready_qs_distinct[wp]: ready_qs_distinct (wp: ready_qs_distinct_lift crunch_wps simp: crunch_simps) @@ -73,7 +73,7 @@ lemma arch_switchToThread_corres: done (* use superset of arch_switchToThread_corres preconditions across the architectures as interface *) -lemma arch_switchToThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and valid_objs and valid_asid_map and valid_arch_caps and pspace_aligned and pspace_distinct and valid_global_objs and (\s. sym_refs (state_hyp_refs_of s)) @@ -98,7 +98,7 @@ lemma arch_switchToIdleThread_corres: done (* use superset of arch_switchToIdleThread_corres preconditions across the architectures as interface *) -lemma arch_switchToIdleThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToIdleThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and pspace_aligned and pspace_distinct and valid_asid_map and valid_idle and valid_arch_caps and valid_global_objs and valid_vspace_objs and valid_objs) @@ -114,14 +114,14 @@ lemma clearExMonitor_invs'[wp]: in_monad select_f_def) done -lemma Arch_switchToThread_invs[Schedule_R_assms, wp]: +lemma Arch_switchToThread_invs[Arch_assms, wp]: "\invs' and tcb_at' t\ Arch.switchToThread t \\rv. invs'\" by (wpsimp simp: ARM_H.switchToThread_def) crunch "Arch.switchToThread" - for ksCurDomain[Schedule_R_assms, wp]: "\s. P (ksCurDomain s)" - and tcbDomain[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" - and tcbState[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" + for ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and tcbDomain[Arch_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" + and tcbState[Arch_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" (simp: crunch_simps wp: crunch_wps getASID_wp) lemma threadSet_invs_no_cicd'_trivialT: @@ -178,7 +178,7 @@ lemma clearExMonitor_invs_no_cicd'[wp]: done -lemma Arch_switchToThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToThread_invs_no_cicd'[Arch_assms]: "Arch.switchToThread t \invs_no_cicd'\" by (wpsimp wp: setVMRoot_invs_no_cicd' simp: ARM_H.switchToThread_def) @@ -194,7 +194,7 @@ crunch "ThreadDecls_H.switchToThread" for ksCurDomain[wp]: "\s. P (ksCurDomain s)" (* neater unfold, actual unfold is really ugly *) -lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: +lemma bitmapQ_lookupBitmapPriority_simp[Arch_assms]: "\ ksReadyQueuesL1Bitmap s d \ 0 ; valid_bitmapQ s ; bitmapQ_no_L1_orphans s \ \ bitmapQ d (lookupBitmapPriority d s) s = (ksReadyQueuesL1Bitmap s d !! word_log2 (ksReadyQueuesL1Bitmap s d) \ @@ -220,7 +220,7 @@ lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: apply (fastforce intro: word_of_nat_less simp: wordRadix_def' unat_of_nat word_size)+ done -lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToIdleThread_invs_no_cicd'[Arch_assms]: "Arch.switchToIdleThread \invs_no_cicd'\" unfolding switchToIdleThread_def by (wpsimp wp: setCurThread_invs_no_cicd'_idle_thread setVMRoot_invs_no_cicd') @@ -228,28 +228,29 @@ lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: crunch Arch.switchToIdleThread for obj_at'[wp]: "obj_at' P t" -lemmas Arch_switchToIdleThread_not_queued'[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_not_queued'[Arch_assms] = ArchThreadDecls_H_ARM_H_switchToIdleThread_obj_at'[where P="Not \ tcbQueued"] -lemmas Arch_switchToIdleThread_tcbState[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_tcbState[Arch_assms] = ArchThreadDecls_H_ARM_H_switchToIdleThread_obj_at'[where P="P \ tcbState" for P] crunch arch_switch_to_thread, handle_spurious_irq - for valid_idle[Schedule_R_assms, wp]: valid_idle + for valid_idle[Arch_assms, wp]: valid_idle + +lemmas Schedule_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R?: Schedule_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Schedule_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_2 locale *) -lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: +lemma bitmapL1_highest_lookup[Arch_assms]: "\ valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; bitmapQ d p s \ \ p \ lookupBitmapPriority d s" apply (subgoal_tac "ksReadyQueuesL1Bitmap s d \ 0") @@ -295,7 +296,7 @@ lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: apply (erule word_log2_maximum) done -lemma guarded_switch_to_chooseThread_fragment_corres[Schedule_R_2_assms]: +lemma guarded_switch_to_chooseThread_fragment_corres[Arch_assms]: "corres dc (P and st_tcb_at runnable t and invs and valid_sched) (P' and invs_no_cicd') @@ -331,19 +332,20 @@ crunch prepareNextDomain and nosch[wp]: "\s. P (ksSchedulerAction s)" crunch tcb_sched_action - for valid_vs_lookup[Schedule_R_2_assms, wp]: valid_vs_lookup + for valid_vs_lookup[Arch_assms, wp]: valid_vs_lookup + +lemmas Schedule_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R_2?: Schedule_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Schedule_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_3 locale *) lemma scheduleChooseNewThread_fragment_corres: "corres dc (invs and valid_domain_list and valid_sched and @@ -367,7 +369,7 @@ lemma scheduleChooseNewThread_fragment_corres: apply (auto simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def) done -lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_corres[Arch_assms]: "corres dc (\s. invs s \ valid_domain_list s \ valid_sched s \ scheduler_action s = choose_new_thread) (\s. invs' s \ ksSchedulerAction s = ChooseNewThread) @@ -380,7 +382,7 @@ lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: apply (wpsimp simp: getDomainTime_def)+ done -lemma scheduleChooseNewThread_invs'[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_invs'[Arch_assms]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \ \_ s. invs' s \" @@ -407,7 +409,7 @@ lemma stit_nosch[wp]: apply (wp setCurThread_nosch | simp add: getIdleThread_def)+ done -lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: +lemma scheduleChooseNewThread_ct_activatable'[Arch_assms, wp]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \\_. ct_in_state' activatable'\" @@ -418,12 +420,13 @@ lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: | (rule hoare_lift_Pf[where f=ksCurThread], solves wp) | strengthen invs'_invs_no_cicd)+ +lemmas Schedule_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Schedule_R_3?: Schedule_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Schedule_R_3_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchStateRelationLemmas.thy b/proof/refine/ARM/ArchStateRelationLemmas.thy index f6e96b14aa..5bb5888a15 100644 --- a/proof/refine/ARM/ArchStateRelationLemmas.thy +++ b/proof/refine/ARM/ArchStateRelationLemmas.thy @@ -15,7 +15,7 @@ begin context Arch begin arch_global_naming -named_theorems StateRelation_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for StateRelation_R locale *) lemma obj_relation_cuts_def2: "obj_relation_cuts ko x = @@ -82,7 +82,7 @@ lemma obj_relation_cutsE: force simp: cte_relation_def pte_relation_def pde_relation_def)+)[5] done -lemma is_other_obj_relation_type_gen[simp, StateRelation_R_assms]: +lemma is_other_obj_relation_type_gen[simp, Arch_assms]: "\n. \ is_other_obj_relation_type (ACapTable n)" "\ is_other_obj_relation_type ATCB" "is_other_obj_relation_type AEndpoint" @@ -102,7 +102,7 @@ lemma is_other_obj_relation_type_DeviceData: "\ is_other_obj_relation_type (AArch (ADeviceData sz))" unfolding is_other_obj_relation_type_def by simp -lemma obj_relation_cuts_trivial[StateRelation_R_assms]: +lemma obj_relation_cuts_trivial[Arch_assms]: "ptr \ fst ` obj_relation_cuts ty ptr" apply (case_tac ty) apply (rename_tac sz cs) @@ -176,7 +176,7 @@ lemma ghost_relation_wrapper_lift': apply wp done -lemma ghost_relation_wrapper_genD[StateRelation_R_assms]: +lemma ghost_relation_wrapper_genD[Arch_assms]: "ghost_relation_wrapper s s' \ ups_of_heap (kheap s) = gsUserPages s' \ cns_of_heap (kheap s) = gsCNodes s'" by (simp add: ghost_relation_of_heap) @@ -217,20 +217,21 @@ lemma other_aobj_relation_aobj: unfolding other_aobj_relation_def is_ArchObj_def by (clarsimp split: Structures_A.kernel_object.splits) -lemma msgLabelBits_msg_label_bits[StateRelation_R_assms]: +lemma msgLabelBits_msg_label_bits[Arch_assms]: "msgLabelBits = msg_label_bits" by (simp add: msgLabelBits_def) -lemma msgInfoRegister_msg_info_register[StateRelation_R_assms]: +lemma msgInfoRegister_msg_info_register[Arch_assms]: "msgInfoRegister = msg_info_register" by (simp add: msg_info_register_def msgInfoRegister_def) -end +lemmas StateRelation_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation StateRelation_R?: StateRelation_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact StateRelation_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM.StateRelation_R_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/ARM/ArchSyscall_R.thy b/proof/refine/ARM/ArchSyscall_R.thy index a160ebfdcb..01e51fbf7b 100644 --- a/proof/refine/ARM/ArchSyscall_R.thy +++ b/proof/refine/ARM/ArchSyscall_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_R locale *) -lemma prepareSetDomain_corres[Syscall_R_assms, corres]: +lemma prepareSetDomain_corres[Arch_assms, corres]: "corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu and valid_arch_state and tcb_at tptr) (pspace_aligned' and pspace_distinct' and no_0_obj') (arch_prepare_set_domain tptr new_dom) (prepareSetDomain tptr new_dom)" @@ -23,19 +23,19 @@ lemma prepareSetDomain_corres[Syscall_R_assms, corres]: by corres crunch prepareSetDomain - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' and ksSchedulerAction[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Syscall_R_assms, wp]: sch_act_simple - and tcb_at'[Syscall_R_assms, wp]: "tcb_at' p" + and sch_act_simple[Arch_assms, wp]: sch_act_simple + and tcb_at'[Arch_assms, wp]: "tcb_at' p" and ksCurThread[wp]: "\s. P (ksCurThread s)" and pred_tcb_at'[wp]: "pred_tcb_at' proj P t" - and ct_in_state'[Syscall_R_assms, wp]: "ct_in_state' P" + and ct_in_state'[Arch_assms, wp]: "ct_in_state' P" (wp: sch_act_simple_lift ct_in_state_thread_state_lift' crunch_wps) crunch postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler - for typ_at'[Syscall_R_assms, wp]: "\s. P (typ_at' T p s)" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" -lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: +lemma setThreadState_irq_control_inv_valid'[Arch_assms, wp]: "setThreadState st t \irq_control_inv_valid' irqcontrol_invocation\" apply (case_tac irqcontrol_invocation; simp) apply (rename_tac archirq_inv) @@ -44,11 +44,11 @@ lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: done (* FIXME arch-split: consider moving to where other msgRegisters stuff goes... Tcb_R? Ipc_R? *) -lemma len_msg_registes_le_max_length[Syscall_R_assms]: +lemma len_msg_registes_le_max_length[Arch_assms]: "length msg_registers \ msg_max_length" by (simp add: msg_max_length_def msgRegisters_unfold) -lemma capRegister_cap_register[Syscall_R_assms]: +lemma capRegister_cap_register[Arch_assms]: "capRegister = cap_register" by (simp add: cap_register_def capRegister_def) @@ -64,7 +64,7 @@ lemma getFAR_invs'[wp]: "doMachineOp getFAR \invs'\" by (simp add: getFAR_def doMachineOp_def split_def select_f_returns | wp)+ -lemma hv_invs'[Syscall_R_assms, wp]: +lemma hv_invs'[Arch_assms, wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" apply (simp add: ARM_H.handleVMFault_def cong: vmfault_type.case_cong) @@ -73,21 +73,21 @@ lemma hv_invs'[Syscall_R_assms, wp]: done crunch handleVMFault - for nosch[Syscall_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma handleSpuriousIRQ_corres[Syscall_R_assms, corres]: +lemma handleSpuriousIRQ_corres[Arch_assms, corres]: "corres dc \ \ handle_spurious_irq handleSpuriousIRQ" unfolding handle_spurious_irq_def handleSpuriousIRQ_def by (corres corres: corres_machine_op) -lemma handleHypervisorFault_corres[Syscall_R_assms]: +lemma handleHypervisorFault_corres[Arch_assms]: "corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread) (invs' and sch_act_not thread and st_tcb_at' simple' thread and ex_nonz_cap_to' thread) (handle_hypervisor_fault thread fault) (handleHypervisorFault thread fault)" by (cases fault; clarsimp simp: handleHypervisorFault_def split del: if_split) -lemma hvmf_invs_lift[Syscall_R_assms]: +lemma hvmf_invs_lift[Arch_assms]: "(\s m. P (s\ksMachineState := ksMachineState s\machine_state_rest := m\\) = P s) \ \P\ handleVMFault t flt \\_ _. True\, \\_. P\" unfolding handleVMFault_def @@ -96,16 +96,16 @@ lemma hvmf_invs_lift[Syscall_R_assms]: doMachineOp_bind getRestartPC_def getRegister_def) crunch handleVMFault - for st_tcb_at'[Syscall_R_assms, wp]: "st_tcb_at' P t" - and ex_nonz_cap_to'[Syscall_R_assms, wp]: "ex_nonz_cap_to' t" - and norq[Syscall_R_assms, wp]: "\s. P (ksReadyQueues s)" - and ksit[Syscall_R_assms, wp]: "\s. P (ksIdleThread s)" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" + and ex_nonz_cap_to'[Arch_assms, wp]: "ex_nonz_cap_to' t" + and norq[Arch_assms, wp]: "\s. P (ksReadyQueues s)" + and ksit[Arch_assms, wp]: "\s. P (ksIdleThread s)" crunch handleHypervisorFault for ksit[wp]: "\s. P (ksIdleThread s)" (wp: undefined_valid haskell_assert_inv) -lemma hh_invs'[Syscall_R_assms, wp]: +lemma hh_invs'[Arch_assms, wp]: "\invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p and (\s. p \ ksIdleThread s)\ handleHypervisorFault p t \\_. invs'\" @@ -113,14 +113,14 @@ lemma hh_invs'[Syscall_R_assms, wp]: by (cases t; wpsimp simp: ARM_H.handleHypervisorFault_def) crunch handleSpuriousIRQ - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' (ignore: doMachineOp wp: dmo_invs'_simple) -lemma arch_performInvocation_inv[Syscall_R_assms]: +lemma arch_performInvocation_inv[Arch_assms]: "\\\ Arch.performInvocation invocation -, \P\" by (wpsimp simp: performARMMMUInvocation_def ARM_H.performInvocation_def) -lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: +lemma Arch_performIRQControl_inv_EE[Arch_assms]: "\\\ Arch.performIRQControl irqc -, \P\" unfolding ARM_H.performIRQControl_def by wpsimp @@ -128,12 +128,13 @@ lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: (* FIXME arch-split: move to ArchInvariants_AI on this arch *) lemmas pageBitsForSize_bounded = pbfs_less_wb' +lemmas Syscall_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Syscall_R?: Syscall_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Syscall_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Syscall_R_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchTcbAcc_R.thy b/proof/refine/ARM/ArchTcbAcc_R.thy index c8805631f0..3f496bc13d 100644 --- a/proof/refine/ARM/ArchTcbAcc_R.thy +++ b/proof/refine/ARM/ArchTcbAcc_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R locale *) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_loadWord_bits[TcbAcc_R_assms, wp]: +lemma no_fail_loadWord_bits[Arch_assms, wp]: "no_fail (\_. is_aligned p word_size_bits) (loadWord p)" by (wpsimp simp: loadWord_def is_aligned_mask[symmetric] word_size_bits_def) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_storeWord_bits[TcbAcc_R_assms]: +lemma no_fail_storeWord_bits[Arch_assms]: "no_fail (\_. is_aligned p word_size_bits) (storeWord p w)" by (wpsimp simp: storeWord_def is_aligned_mask[symmetric] word_size_bits_def) -lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: +lemma prioToL1Index_l1IndexToPrio_or_id[Arch_assms]: "\ unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \ \ prioToL1Index ((l1IndexToPrio w) || w') = w" unfolding l1IndexToPrio_def prioToL1Index_def @@ -33,12 +33,12 @@ lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: apply (subst unat_of_nat_eq, simp_all add: word_size) done -lemma l1IndexToPrio_wordRadix_mask[TcbAcc_R_assms, simp]: +lemma l1IndexToPrio_wordRadix_mask[Arch_assms, simp]: "l1IndexToPrio i && mask wordRadix = 0" unfolding l1IndexToPrio_def by (simp add: wordRadix_def') -lemma st_tcb_at_coerce_abstract[TcbAcc_R_assms]: +lemma st_tcb_at_coerce_abstract[Arch_assms]: assumes t: "st_tcb_at' P t c" assumes sr: "(a, c) \ state_relation" shows "st_tcb_at (\st. \st'. thread_state_relation st st' \ P st') t a" @@ -62,7 +62,7 @@ lemma tcb_at'_cross: other_obj_relation_def pte_relation_def pde_relation_def is_tcb_def split: Structures_A.kernel_object.split_asm if_split_asm arch_kernel_obj.split_asm) -lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: +lemma setObject_update_TCB_corres'[Arch_assms]: assumes tcbs: "tcb_relation tcb tcb' \ tcb_relation new_tcb new_tcb'" assumes tables: "\(getF, v) \ ran tcb_cap_cases. getF new_tcb = getF tcb" assumes tables': "\(getF, v) \ ran tcb_cte_cases. getF new_tcb' = getF tcb'" @@ -138,11 +138,11 @@ lemma setObject_tcb_ko_at'_pde[wp]: "setObject p (v::tcb) \ \s. P (ko_at' (pde::pde) p' s) \" by (clarsimp intro!: obj_at_setObject2 simp: updateObject_default_def in_monad) -lemma setObject_tcb_valid_arch'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_valid_arch'[Arch_assms, wp]: "\valid_arch_state'\ setObject t (v :: tcb) \\rv. valid_arch_state'\" by (wp valid_arch_state_lift' setObject_typ_at') -lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_refs'[Arch_assms, wp]: "\\s. P (global_refs' s)\ setObject t (v::tcb) \\rv s. P (global_refs' s)\" apply (clarsimp simp: setObject_def split_def updateObject_default_def) apply wp @@ -150,7 +150,7 @@ lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: done (* assumption not needed on this architecture, but used in generic interface *) -lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: +lemma threadSet_state_hyp_refs_of'[Arch_assms]: assumes y: "\tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb)" shows "\\s. P (state_hyp_refs_of' s)\ threadSet F t \\rv s. P (state_hyp_refs_of' s)\" apply (simp add: threadSet_def) @@ -158,7 +158,7 @@ lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: simp: gen_objBits_simps obj_at'_def state_hyp_refs_of'_def) done -lemma threadSet_iflive'T[TcbAcc_R_assms]: +lemma threadSet_iflive'T[Arch_assms]: assumes x: "\tcb. \(getF, setF) \ ran tcb_cte_cases. getF (F tcb) = getF tcb" shows "\\s. if_live_then_nonz_cap' s @@ -199,11 +199,11 @@ lemma setObject_tcb_pde_mappings'[wp]: apply (auto dest: updateObject_default_result) done -lemma zobj_refs'_capRange[TcbAcc_R_assms]: +lemma zobj_refs'_capRange[Arch_assms]: "s \' cap \ zobj_refs' cap \ capRange cap" by (cases cap; simp add: valid_cap'_def capAligned_def capRange_def is_aligned_no_overflow) -lemma capAligned_zobj_refs'_capRange[TcbAcc_R_assms]: +lemma capAligned_zobj_refs'_capRange[Arch_assms]: "capAligned c \ zobj_refs' c \ capRange c" by (cases c; simp add: capAligned_def capRange_def is_aligned_no_overflow) @@ -230,7 +230,7 @@ schematic_goal l2BitmapSize_def': (* arch specific consequence *) "l2BitmapSize = numeral ?X" by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def) -lemma prioToL1Index_size[TcbAcc_R_assms, simp]: +lemma prioToL1Index_size[Arch_assms, simp]: "prioToL1Index w < l2BitmapSize" unfolding prioToL1Index_def wordRadix_def l2BitmapSize_def' by (fastforce simp: shiftr_div_2n' nat_divide_less_eq @@ -241,12 +241,12 @@ lemma prioToL1Index_max: unfolding prioToL1Index_def wordRadix_def by (insert unat_lt2p[where x=p], simp add: shiftr_div_2n') -lemma prioToL1Index_bit_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_set[Arch_assms]: "((2 :: machine_word) ^ prioToL1Index p) !! prioToL1Index p" using l2BitmapSize_def' by (fastforce simp: nth_w2p_same intro: order_less_le_trans[OF prioToL1Index_size]) -lemma prioL2Index_bit_set[TcbAcc_R_assms]: +lemma prioL2Index_bit_set[Arch_assms]: fixes p :: priority shows "((2::machine_word) ^ unat (ucast p && (mask wordRadix :: machine_word))) !! unat (p && mask wordRadix)" apply (simp add: nth_w2p wordRadix_def ucast_and_mask[symmetric] unat_ucast_upcast is_up) @@ -265,25 +265,25 @@ lemma prioToL1Index_bits_low_high_eq: unfolding prioToL1Index_def by (fastforce simp: nth_w2p wordRadix_def is_up bits_low_high_eq) -lemma prioToL1Index_bit_not_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_not_set[Arch_assms]: "\ (~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" apply (subst word_ops_nth_size, simp_all add: prioToL1Index_bit_set del: bit_exp_iff) apply (fastforce simp: prioToL1Index_def wordRadix_def word_size intro: order_less_le_trans[OF word_shiftr_lt]) done -lemma prioToL1Index_complement_nth_w2p[TcbAcc_R_assms]: +lemma prioToL1Index_complement_nth_w2p[Arch_assms]: fixes p p' :: priority shows "(~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p' = (prioToL1Index p \ prioToL1Index p')" by (fastforce simp: complement_nth_w2p prioToL1Index_lt wordRadix_def word_size)+ -lemma invertL1Index_eq_cancelD[TcbAcc_R_assms]: +lemma invertL1Index_eq_cancelD[Arch_assms]: "\ invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \ \ i = j" by (simp add: invertL1Index_def l2BitmapSize_def') -lemma pspace_dom_dom[TcbAcc_R_assms]: +lemma pspace_dom_dom[Arch_assms]: "dom ps \ pspace_dom ps" unfolding pspace_dom_def apply clarsimp @@ -301,7 +301,7 @@ lemma pspace_dom_dom[TcbAcc_R_assms]: apply (case_tac vmpage_size, simp_all add: pageBits_def) done -lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: +lemma less_max_ipc_words_less_2p_msg_align_bits[Arch_assms]: assumes y: "y < unat max_ipc_words" shows "word_of_nat y * (word_size :: machine_word) < 2 ^ msg_align_bits" apply (simp add: word_size_def word_size_bits_def) @@ -310,37 +310,38 @@ lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: apply (simp add: msg_align_bits max_ipc_words)+ done -lemma is_aligned_word_size_bits_less_max_ipc_words[TcbAcc_R_assms]: +lemma is_aligned_word_size_bits_less_max_ipc_words[Arch_assms]: "y < unat max_ipc_words \ is_aligned (word_of_nat y * word_size) word_size_bits" by (simp add: word_size_def word_size_bits_def) (rule is_aligned_mult_triv2[where n=2, simplified]) -lemma msg_align_bits_le_pageBitsForSize[TcbAcc_R_assms]: +lemma msg_align_bits_le_pageBitsForSize[Arch_assms]: "msg_align_bits \ pageBitsForSize sz" by (simp add: msg_align_bits pageBitsForSize_def split: vmpage_size.split) -lemmas [TcbAcc_R_assms] = +lemmas [Arch_assms] = dmo_getirq_inv getActiveIRQ_masked tcb_at'_cross pspace_relation_update_tcbs +lemmas TcbAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R?: TcbAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.TcbAcc_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_2 locale *) sublocale asUser: typ_at_props' "asUser tptr f" by typ_at_props' -lemma tcb_hyp_refs'_valid_arch_tcb'_eq[TcbAcc_R_2_assms]: +lemma tcb_hyp_refs'_valid_arch_tcb'_eq[Arch_assms]: "tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ valid_arch_tcb' (tcbArch (F tcb)) s = valid_arch_tcb' (tcbArch tcb) s" by (auto simp: valid_arch_tcb'_def) @@ -415,14 +416,14 @@ lemma asUser_corres: apply (simp add: invs'_def valid_state'_def valid_pspace'_def) done -lemma asUser_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_getRegister_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (getRegister r)) (asUser t (getRegister r))" apply (rule asUser_corres') apply (clarsimp simp: getRegister_def) done -lemma user_getreg_inv'[TcbAcc_R_2_assms, wp]: +lemma user_getreg_inv'[Arch_assms, wp]: "\P\ asUser t (getRegister r) \\x. P\" apply (rule asUser_inv) apply (simp_all add: getRegister_def) @@ -456,7 +457,7 @@ lemma asUser_iflive'[wp]: unfolding asUser_def by (wpsimp wp: threadSet_iflive' hoare_drop_imps, auto) -lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_setRegister_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (setRegister r v)) (asUser t (setRegister r v))" @@ -465,7 +466,7 @@ lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: apply (rule corres_modify'; simp) done -lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs apply (wp | simp add: bitmap_fun_defs bitmapQ_no_L1_orphans_def)+ @@ -473,7 +474,7 @@ lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: prioToL1Index_complement_nth_w2p) done -lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L2_orphans[Arch_assms, wp]: "\ bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L2_orphans \" @@ -485,7 +486,7 @@ lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: apply metis done -lemma removeFromBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma removeFromBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p \ removeFromBitmap d p \\_. valid_bitmapQ_except d p \" @@ -536,7 +537,7 @@ proof - done qed -lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma addToBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ addToBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs bitmapQ_defs using word_unat_mask_lt[where w=p and m=wordRadix] @@ -546,7 +547,7 @@ lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: wordBits_def numPriorities_def) done -lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma addToBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p and bitmapQ_no_L2_orphans \ addToBitmap d p \\_. valid_bitmapQ_except d p \" @@ -558,7 +559,7 @@ lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: dest: prioToL1Index_bits_low_high_eq) done -lemma in_user_frame_eq[TcbAcc_R_2_assms]: +lemma in_user_frame_eq[Arch_assms]: assumes y: "y < unat max_ipc_words" and al: "is_aligned a msg_align_bits" shows "in_user_frame (a + of_nat y * word_size) s = in_user_frame a s" @@ -585,15 +586,15 @@ lemma thread_get_registers: apply (clarsimp simp: map_upd_triv select_f_def image_def return_def) done -lemma msgRegisters_msg_registers[TcbAcc_R_2_assms]: +lemma msgRegisters_msg_registers[Arch_assms]: "msgRegisters = msg_registers" by (simp add: msgRegisters_unfold) -lemma suc_len_msg_registers_less_2p_word_bits[TcbAcc_R_2_assms]: +lemma suc_len_msg_registers_less_2p_word_bits[Arch_assms]: "Suc (length msg_registers) < 2 ^ word_bits" by (simp add: msgRegisters_unfold word_bits_def) -lemma asUser_mapM_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_mapM_getRegister_corres[Arch_assms]: "corres (\con regs. regs = map con msg_registers) (tcb_at t and pspace_aligned and pspace_distinct) \ (thread_get (arch_tcb_get_registers o tcb_arch) t) @@ -633,7 +634,7 @@ lemma cte_at_tcb_at_16': (* FIXME arch-split: can't be generic with this 16 *) lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split] -lemma lookupIPCBuffer_corres'[TcbAcc_R_2_assms]: +lemma lookupIPCBuffer_corres'[Arch_assms]: "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct) (valid_objs' and no_0_obj') @@ -690,7 +691,7 @@ crunch rescheduleRequired, tcbSchedEnqueue for hyp_refs_of'[wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps wp: threadSet_state_hyp_refs_of' ignore: threadSet) -lemmas [TcbAcc_R_2_assms] = +lemmas [Arch_assms] = getThreadBufferSlot_inv lookupIPCBuffer_inv rescheduleRequired_hyp_refs_of' @@ -701,7 +702,7 @@ lemma archThreadGet_wp: unfolding archThreadGet_def by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def) -lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setThreadState_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P ((state_hyp_refs_of' s))\ setThreadState st t \\rv s. P (state_hyp_refs_of' s)\" @@ -709,14 +710,14 @@ lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: | wp threadSet_state_hyp_refs_of')+ done -lemma setBoundNotification_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setBoundNotification_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P (state_hyp_refs_of' s)\ setBoundNotification ntfn t \\rv s. P (state_hyp_refs_of' s)\" by (simp add: setBoundNotification_def fun_upd_def | wp threadSet_state_hyp_refs_of')+ -lemma storeWord_invs'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs'[Arch_assms, wp]: "\pointerInUserData p and invs'\ doMachineOp (storeWord p w) \\rv. invs'\" proof - have aligned_offset_ignore: @@ -741,7 +742,7 @@ proof - done qed -lemma storeWord_invs_no_cicd'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs_no_cicd'[Arch_assms, wp]: "\pointerInUserData p and invs_no_cicd'\ doMachineOp (storeWord p w) \\rv. invs_no_cicd'\" proof - have aligned_offset_ignore: @@ -766,27 +767,28 @@ proof - done qed -lemma tcbSchedAppend_pspace_in_kernel_mappings'[TcbAcc_R_2_assms]: +lemma tcbSchedAppend_pspace_in_kernel_mappings'[Arch_assms]: "tcbSchedAppend t \pspace_in_kernel_mappings'\" by wpsimp (* FIXME: the code assumes that it is word_t, so length_type should be defined generically in ASpec, not per architecture *) -lemmas [TcbAcc_R_2_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] +lemmas [Arch_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] + +lemmas TcbAcc_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation TcbAcc_R_2?: TcbAcc_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.TcbAcc_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_3 locale *) -lemma setMRs_corres[TcbAcc_R_3_assms]: +lemma setMRs_corres[Arch_assms]: assumes m: "mrs' = mrs" shows "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \ in_user_frame buf) @@ -858,7 +860,7 @@ lemma asUser_invs[wp]: crunch storeWordUser for pred_tcb_at'[wp]: "\s. pred_tcb_at' proj P p s" -lemma set_mrs_invs'[TcbAcc_R_3_assms, wp]: +lemma set_mrs_invs'[Arch_assms, wp]: "\ invs' and tcb_at' receiver \ setMRs receiver recv_buf mrs \\rv. invs' \" apply (simp add: setMRs_def) apply (wp dmo_invs' no_irq_mapM no_irq_storeWord crunch_wps| @@ -877,12 +879,13 @@ sublocale setThreadState: typ_at_props' "setThreadState st p" sublocale setBoundNotification: typ_at_props' "setBoundNotification v p" by typ_at_props' +lemmas TcbAcc_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R_3?: TcbAcc_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.TcbAcc_R_3_assms)?)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/ARM/ArchTcb_R.thy b/proof/refine/ARM/ArchTcb_R.thy index 48fb4e63e2..0cb887547c 100644 --- a/proof/refine/ARM/ArchTcb_R.thy +++ b/proof/refine/ARM/ArchTcb_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R locale *) -lemma activateIdleThread_corres[Tcb_R_assms]: +lemma activateIdleThread_corres[Arch_assms]: "corres dc (st_tcb_at idle t) (st_tcb_at' idle' t) (arch_activate_idle_thread t) (activateIdleThread t)" by (simp add: arch_activate_idle_thread_def activateIdleThread_def) crunch arch_post_modify_registers - for pspace_aligned[Tcb_R_assms, wp]: pspace_aligned - and pspace_distinct[Tcb_R_assms, wp]: pspace_distinct + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct (wp: crunch_wps simp: crunch_simps) -lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: +lemma asUser_postModifyRegisters_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' t and tcb_at' ct) (arch_post_modify_registers ct t) (asUser t $ postModifyRegisters ct t)" @@ -37,7 +37,7 @@ lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: (* formulation of threadSet_state_hyp_refs_of' varies based on whether VCPU is present; use this as interface, but keep original lemma name for use outside of Arch *) -lemma threadSet_state_hyp_refs_of'_interface[Tcb_R_assms]: +lemma threadSet_state_hyp_refs_of'_interface[Arch_assms]: "\ \tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ \ threadSet F t \\s. P (state_hyp_refs_of' s)\ " by (wpsimp simp: threadSet_state_hyp_refs_of') @@ -48,7 +48,7 @@ sublocale setPriority: typ_at_props' "setPriority t prio" sublocale setMCPriority: typ_at_props' "setMCPriority t prio" by typ_at_props' -lemma sameObject_corres2[Tcb_R_assms]: +lemma sameObject_corres2[Arch_assms]: "\ cap_relation c c'; cap_relation d d' \ \ same_object_as c d = sameObjectAs c' d'" apply (frule(1) same_region_as_relation[symmetric, where c=c and c'=d]) @@ -64,7 +64,7 @@ lemma sameObject_corres2[Tcb_R_assms]: split: arch_cap.splits) by (fastforce simp: global.sameRegionAs_def isCap_simps split: arch_cap.splits) -lemma untyped_derived_eq_from_sameObjectAs[Tcb_R_assms]: +lemma untyped_derived_eq_from_sameObjectAs[Arch_assms]: "sameObjectAs cap cap2 \ untyped_derived_eq cap cap2" by (clarsimp simp: untyped_derived_eq_def sameObjectAs_def2 gen_isCap_Master) @@ -77,8 +77,8 @@ lemma isValidVTableRootD: option.split_asm) crunch prepare_thread_delete, arch_finalise_cap - for pspace_aligned[Tcb_R_assms, wp]: "pspace_aligned :: det_ext state \ _" - and pspace_distinct[Tcb_R_assms, wp]: "pspace_distinct :: det_ext state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_ext state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_ext state \ _" (simp: crunch_simps preemption_point_def wp: crunch_wps OR_choiceE_weak_wp) lemma is_valid_vtable_root_simp: @@ -88,7 +88,7 @@ lemma is_valid_vtable_root_simp: split: cap.splits arch_cap.splits option.splits) (* FIXME: move after checked_insert_tcb_invs in ArchTcb_AI, and consolidate redundancy there *) -lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: +lemma checked_insert_tcb_invs_gen[Arch_assms]: "\invs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and K (is_cnode_or_valid_arch new_cap) and valid_cap new_cap and tcb_cap_valid new_cap (target, ref) @@ -103,40 +103,40 @@ lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: apply (clarsimp dest!: is_cnode_or_valid_arch_cap_asid) done -lemma is_valid_vtable_root_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_valid_vtable_root_is_cnode_or_valid_arch[Arch_assms]: "is_valid_vtable_root cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def is_valid_vtable_root_simp is_cap_simps arch_cap_fun_lift_simps) -lemma is_cnode_cap_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_cnode_cap_is_cnode_or_valid_arch[Arch_assms]: "is_cnode_cap cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def) -lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Tcb_R_assms]: +lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Arch_assms]: "\valid_ipc_buffer_cap cap buf; is_arch_cap cap\ \ is_nondevice_page_cap cap" by (clarsimp simp: is_cap_simps valid_ipc_buffer_cap_def is_nondevice_page_cap_def is_nondevice_page_cap_arch_def arch_cap_fun_lift_simps split: arch_cap.splits bool.splits) -lemma cte_at_tcb_at_2p_cteSizeBits[Tcb_R_assms]: +lemma cte_at_tcb_at_2p_cteSizeBits[Arch_assms]: "tcb_at' t s \ cte_at' (t + 2 ^ cteSizeBits) s" by (simp add: cte_at'_obj_at' tcb_cte_cases_def cteSizeBits_def) (* arch_capBadge may involve SMC caps on some architectures, but not page tables *) -lemma isValidVTableRootD_arch[Tcb_R_assms]: +lemma isValidVTableRootD_arch[Arch_assms]: "isValidVTableRoot cap \ isArchObjectCap cap \ arch_capBadge (capCap cap) = None" by (drule isValidVTableRootD; clarsimp simp: arch_capBadge_def isCap_simps) (* FIXME FPU: when the FPU being enabled is properly configurable for the proofs then this shouldn't need to unfold config_HAVE_FPU. *) -lemma postSetFlags_corres[Tcb_R_assms, corres]: +lemma postSetFlags_corres[Arch_assms, corres]: "flags = word_to_tcb_flags flags' \ corres dc (cur_tcb and pspace_aligned and pspace_distinct and valid_cur_fpu) \ (arch_post_set_flags t flags) (postSetFlags t flags')" unfolding arch_post_set_flags_def postSetFlags_def by (corres simp: Kernel_Config.config_HAVE_FPU_def cur_tcb_def) -lemma postSetFlags_invs'[Tcb_R_assms, wp]: +lemma postSetFlags_invs'[Arch_assms, wp]: "postSetFlags t flags \invs'\" unfolding postSetFlags_def by wpsimp @@ -147,11 +147,11 @@ lemma copyregsets_map_only[simp]: (* there are no extra registers on any architecture so far, and while it is theoretically possible in the design spec, the abstract invariant proof assumes this *) -lemma decodeTransfer_def'[Tcb_R_assms]: +lemma decodeTransfer_def'[Arch_assms]: "decodeTransfer w = returnOk (copyregsets_map ArchDefaultExtraRegisters)" by (simp add: decodeTransfer_def) -lemma checkValidIPCBuffer_corres[Tcb_R_assms]: +lemma checkValidIPCBuffer_corres[Arch_assms]: "cap_relation cap cap' \ corres (ser \ dc) \ \ (check_valid_ipc_buffer vptr cap) @@ -168,7 +168,7 @@ lemma checkValidIPCBuffer_corres[Tcb_R_assms]: apply (auto simp add: returnOk_def) done -lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: +lemma checkValidIPCBuffer_ArchObject_wp[Arch_assms]: "\\s. isArchObjectCap cap \ capBadge cap = None \ is_aligned p msg_align_bits \ P s\ checkValidIPCBuffer p cap \\rv s. P s\,-" @@ -182,27 +182,28 @@ lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: done crunch checkValidIPCBuffer - for inv[Tcb_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps) -lemma isValidVTableRoot_eq[Tcb_R_assms]: +lemma isValidVTableRoot_eq[Arch_assms]: "cap_relation cap cap' \ isValidVTableRoot cap' = is_valid_vtable_root cap" apply (cases cap; simp add: isValidVTableRoot_def is_valid_vtable_root_simp) apply (rename_tac acap, case_tac acap; simp) apply (auto split: option.split) done +lemmas Tcb_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R?: Tcb_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Tcb_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Tcb_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R_2 locale *) lemma checkCapAt_cteInsert_corres': "cap_relation new_cap newCap \ @@ -256,7 +257,7 @@ lemma checkCapAt_cteInsert_corres': apply fastforce done -lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: +lemma checkCapAt_cteInsert_corres[Arch_assms]: "cap_relation new_cap newCap \ corres dc (einvs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and cte_at slot and K (is_cnode_or_valid_arch new_cap) @@ -277,12 +278,13 @@ lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: apply fastforce done +lemmas Tcb_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R_2?: Tcb_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Tcb_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchUntyped_R.thy b/proof/refine/ARM/ArchUntyped_R.thy index cd303bbe76..9009c744f9 100644 --- a/proof/refine/ARM/ArchUntyped_R.thy +++ b/proof/refine/ARM/ArchUntyped_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R locale *) -lemma APIType_map2_CapTable[Untyped_R_assms, simp]: +lemma APIType_map2_CapTable[Arch_assms, simp]: "(APIType_map2 ty = Structures_A.CapTableObject) = (ty = Inr (APIObjectType ArchTypes_H.CapTableObject))" by (simp add: APIType_map2_def @@ -25,13 +25,13 @@ lemma APIType_map2_CapTable[Untyped_R_assms, simp]: lemmas is_frame_type_defs = is_frame_type_def isFrameType_def arch_is_frame_type_def -lemma is_frame_type_isFrameType_eq[Untyped_R_assms, simp]: +lemma is_frame_type_isFrameType_eq[Arch_assms, simp]: "(is_frame_type (APIType_map2 (Inr (toEnum (unat arg0))))) = (isFrameType (toEnum (unat arg0)))" by (simp add: APIType_map2_def is_frame_type_defs split: apiobject_type.splits object_type.splits)+ (* object_type enum (arch-specific) is extension of apiobject_type enum (generic) *) -lemma nth_enum_object_type_gen_eq[Untyped_R_assms]: +lemma nth_enum_object_type_gen_eq[Arch_assms]: assumes "n < length (enum :: apiobject_type list)" shows "((enum :: object_type list) ! n) = APIObjectType ((enum :: apiobject_type list) ! n)" proof - @@ -45,36 +45,36 @@ proof - (simp flip: nth_map[where f=APIObjectType]) qed -lemma length_enum_apiobject_less_enum_object_type[Untyped_R_assms]: +lemma length_enum_apiobject_less_enum_object_type[Arch_assms]: "length (enum :: apiobject_type list) < length (enum :: object_type list)" unfolding enum_apiobject_type enum_object_type by simp crunch freeMemory (* FIXME arch-split: clearMemory is already handled in ArchRetype_AI *) - for irq_masks_inv[wp, Untyped_R_assms]: "\s. P (irq_masks s)" + for irq_masks_inv[wp, Arch_assms]: "\s. P (irq_masks s)" (wp: crunch_wps) crunch updateFreeIndex, deleteGhost - for valid_irq_states'[Untyped_R_assms, wp]: "valid_irq_states'" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" - and gsMaxObjectSize[Untyped_R_assms, wp]: "\s. P (gsMaxObjectSize s)" - and ksIdleThread[Untyped_R_assms, wp]: "\s. P (ksIdleThread s)" - and ksCurDomain[Untyped_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksCurThread[Untyped_R_assms, wp]: "\s. P (ksCurThread s)" + for valid_irq_states'[Arch_assms, wp]: "valid_irq_states'" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and gsMaxObjectSize[Arch_assms, wp]: "\s. P (gsMaxObjectSize s)" + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksCurThread[Arch_assms, wp]: "\s. P (ksCurThread s)" (wp: crunch_wps) -lemma arch_data_to_obj_type_invalid[Untyped_R_assms]: +lemma arch_data_to_obj_type_invalid[Arch_assms]: "\ n \ length (enum :: object_type list) \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) = None" by (auto simp: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) -lemma arch_data_to_obj_type_valid[Untyped_R_assms]: +lemma arch_data_to_obj_type_valid[Arch_assms]: "\ n < length (enum :: object_type list); length (enum :: apiobject_type list) \ n \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) \ None" by (simp add: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) arith -lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: +lemma APIType_map2_arch_data_to_obj_type[Arch_assms]: defines [simp]: "object_types \ enum :: object_type list" defines [simp]: "apiobject_types \ enum :: apiobject_type list" shows @@ -89,7 +89,7 @@ lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: apply arith done -lemma obj_bits_api_APIType_map2[Untyped_R_assms]: +lemma obj_bits_api_APIType_map2[Arch_assms]: "obj_bits_api (APIType_map2 (Inr x)) y = getObjectSize x y" apply (clarsimp simp:obj_bits_api_def APIType_map2_def getObjectSize_def simp del: objSize_eq_capBits) apply (case_tac x) @@ -99,11 +99,11 @@ lemma obj_bits_api_APIType_map2[Untyped_R_assms]: apply (simp_all add: apiGetObjectSize_def slot_bits_def objBits_simps' vspace_bits_defs) done -lemma length_nat_to_cref[Untyped_R_assms]: +lemma length_nat_to_cref[Arch_assms]: "bits < word_bits \ length (nat_to_cref bits x) = bits" by (simp add: nat_to_cref_def word_bits_conv) -lemma ctes_of_ko_arch[Untyped_R_assms]: +lemma ctes_of_ko_arch[Arch_assms]: "\ valid_cap' cap s; isArchObjectCap cap \ \ \ptr\capRange cap. \optr ko. ksPSpace s optr = Some ko \ ptr \ obj_range' optr ko" apply (case_tac cap; simp add: gen_isCap_simps capRange_def) @@ -167,11 +167,11 @@ lemma ctes_of_ko_arch[Untyped_R_assms]: apply clarsimp done -lemma irq_nodes_global[Untyped_R_assms]: +lemma irq_nodes_global[Arch_assms]: "irq_node' s + (ucast (irq :: irq) << cteSizeBits) \ global_refs' s" by (simp add: global_refs'_def) -lemma untyped_inc_mdbD[Untyped_R_assms]: +lemma untyped_inc_mdbD[Arch_assms]: "\ sameRegionAs cap cap'; isUntypedCap cap; ctes p = Some (CTE cap node); ctes p' = Some (CTE cap' node'); untyped_inc' ctes; untyped_mdb' ctes; no_loops ctes \ @@ -197,16 +197,16 @@ lemma untyped_inc_mdbD[Untyped_R_assms]: apply (clarsimp simp: gen_isCap_simps) done -lemma mdb_chunked_arch_assms_non_arch[Untyped_R_assms]: +lemma mdb_chunked_arch_assms_non_arch[Arch_assms]: "\ isArchObjectCap cap \ mdb_chunked_arch_assms cap" by (simp add: mdb_chunked_arch_assms_def isCap_simps) -lemma sameRegionAs_def_untyped[Untyped_R_assms]: +lemma sameRegionAs_def_untyped[Arch_assms]: "\ isUntypedCap cap \ \ sameRegionAs cap cap' = (capRange cap' \ {} \ capRange cap' \ capRange cap)" by (clarsimp simp add: sameRegionAs_def3 isCap_simps) -lemma createNewCaps_range_helper[Untyped_R_assms]: +lemma createNewCaps_range_helper[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits tp us) n \ 0 < n\ createNewCaps tp ptr n us d \\rv s. \capfn. @@ -276,7 +276,7 @@ defs archOverlap_def: "archOverlap \ \_ _. False" (* trivial on this architecture *) -lemma archNoOverlap[Untyped_R_assms]: +lemma archNoOverlap[Arch_assms]: notes Int_atLeastAtMost[simp del] shows "corres dc (\s. \cref. cte_wp_at (\cap. is_untyped_cap cap @@ -286,34 +286,34 @@ lemma archNoOverlap[Untyped_R_assms]: (return ()) (stateAssert (\s. \ archOverlap s R) [])" by (simp add: archOverlap_def) -lemma word_size_bits_le_untyped_min_bits[Untyped_R_assms]: +lemma word_size_bits_le_untyped_min_bits[Arch_assms]: "word_size_bits \ untyped_min_bits" by (simp add: word_size_bits_def untyped_min_bits_def) -lemma minUntypedSizeBits_le_resetChunkBits[Untyped_R_assms]: +lemma minUntypedSizeBits_le_resetChunkBits[Arch_assms]: "minUntypedSizeBits \ resetChunkBits" by (simp add: minUntypedSizeBits_def Kernel_Config.resetChunkBits_def) -lemma maxUntypedSizeBits_less_word_bits[Untyped_R_assms]: +lemma maxUntypedSizeBits_less_word_bits[Arch_assms]: "maxUntypedSizeBits < word_bits" by (simp add: maxUntypedSizeBits_def word_bits_def) (* FIXME arch-split: candidate for Kernel_Config lemmas *) -lemma word_size_bits_le_resetChunkBits[Untyped_R_assms]: +lemma word_size_bits_le_resetChunkBits[Arch_assms]: "word_size_bits \ resetChunkBits" by (simp add: word_size_bits_def Kernel_Config.resetChunkBits_def) -lemma resetChunkBits_le_word_bits[Untyped_R_assms]: +lemma resetChunkBits_le_word_bits[Arch_assms]: "resetChunkBits < word_bits" by (simp add: Kernel_Config.resetChunkBits_def word_bits_def) -lemma APIType_capBits_lower_bound[Untyped_R_assms]: +lemma APIType_capBits_lower_bound[Arch_assms]: "\tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \ minUntypedSizeBits \ us\ \ minUntypedSizeBits \ APIType_capBits tp us" by (simp add: APIType_capBits_def objBits_simps' minUntypedSizeBits_def split: object_type.split apiobject_type.split) -lemma dmo_freeMemory_clear_um[Untyped_R_assms]: +lemma dmo_freeMemory_clear_um[Arch_assms]: "\word_size_bits \ sz; sz \ word_bits; is_aligned ptr sz\ \ (do_machine_op (freeMemory ptr sz) :: (det_state, unit) nondet_monad) = modify (clear_um {ptr..ptr + 2 ^ sz - 1})" @@ -324,15 +324,16 @@ lemma dmo_freeMemory_clear_um[Untyped_R_assms]: done crunch createObject - for nosch[Untyped_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + +lemmas Untyped_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Untyped_R?: Untyped_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Untyped_R_assms)?)?) qed locale Arch_mdb_insert_again_all = mdb_insert_again_all + Arch @@ -392,21 +393,22 @@ end (* invokeUntyped_proofs *) context Arch begin arch_global_naming -named_theorems Untyped_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R_2 locale *) -lemmas [Untyped_R_2_assms] = +lemmas [Arch_assms] = mdb_insert_again_all.valid_n' invokeUntyped_proofs.descendants_range invokeUntyped_proofs.ex_cte_no_overlap' invokeUntyped_proofs.cref_inv invokeUntyped_proofs.slots_invD +lemmas Untyped_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R_2?: Untyped_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.Untyped_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM/ArchVSpace_R.thy b/proof/refine/ARM/ArchVSpace_R.thy index 35dd9039e5..b5b508767d 100644 --- a/proof/refine/ARM/ArchVSpace_R.thy +++ b/proof/refine/ARM/ArchVSpace_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems VSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for VSpace_R locale *) lemmas store_pte_typ_ats[wp] = store_pte_typ_ats abs_atyp_at_lifts[OF store_pte_typ_at] lemmas store_pde_typ_ats[wp] = store_pde_typ_ats abs_atyp_at_lifts[OF store_pde_typ_at] @@ -526,7 +526,7 @@ lemma handleVMFault_corres': done (* interface lemma, superset of all architecture preconditions *) -lemma handleVMFault_corres[VSpace_R_assms]: +lemma handleVMFault_corres[Arch_assms]: "corres (fr \ dc) (tcb_at thread and pspace_aligned and pspace_distinct) (tcb_at' thread) (handle_vm_fault thread fault) (handleVMFault thread fault)" by (corres corres: handleVMFault_corres') @@ -3423,12 +3423,13 @@ lemma isPDCap_PD : "isPDCap (ArchObjectCap (PageDirectoryCap r m))" by (simp add: isPDCap_def) +lemmas VSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation VSpace_R?: VSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact VSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM.VSpace_R_assms)?)?) qed end diff --git a/proof/refine/ARM/LevityCatch.thy b/proof/refine/ARM/LevityCatch.thy index 493f568615..acb4775202 100644 --- a/proof/refine/ARM/LevityCatch.thy +++ b/proof/refine/ARM/LevityCatch.thy @@ -21,12 +21,6 @@ lemma magnitudeCheck_assert: split: option.split) apply fastforce done -context begin interpretation Arch . (*FIXME: arch-split*) -lemmas makeObject_simps = - makeObject_endpoint makeObject_notification makeObject_cte - makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte - makeObject_asidpool -end lemma projectKO_inv : "\P\ projectKO ko \\rv. P\" by (simp add: projectKO_def fail_def valid_def return_def @@ -59,6 +53,11 @@ lemma updateObject_default_inv: context Arch begin arch_global_naming +lemmas makeObject_simps = + makeObject_endpoint makeObject_notification makeObject_cte + makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte + makeObject_asidpool + lemma to_from_apiType[simp]: "toAPIType (fromAPIType x) = Some x" by (cases x) (auto simp add: fromAPIType_def toAPIType_def) diff --git a/proof/refine/ARM_HYP/ArchADT_H.thy b/proof/refine/ARM_HYP/ArchADT_H.thy index fb105a8553..5e93a63b3c 100644 --- a/proof/refine/ARM_HYP/ArchADT_H.thy +++ b/proof/refine/ARM_HYP/ArchADT_H.thy @@ -13,14 +13,14 @@ begin context Arch begin arch_global_naming -named_theorems ADT_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H locale *) definition vm_rights_of :: "vmrights \ rights set" where "vm_rights_of x \ case x of VMKernelOnly \ vm_kernel_only | VMReadOnly \ vm_read_only | VMReadWrite \ vm_read_write" -lemma vm_rights_of_vmrights_map_id[ADT_H_assms, simp]: +lemma vm_rights_of_vmrights_map_id[Arch_assms, simp]: "rs \ valid_vm_rights \ vm_rights_of (vmrights_map rs) = rs" by (auto simp: vm_rights_of_def vmrights_map_def valid_vm_rights_def vm_read_write_def vm_read_only_def vm_kernel_only_def) @@ -104,7 +104,7 @@ fun ArchCapabilityMap :: "arch_capability \ cap" where | "ArchCapabilityMap (arch_capability.SGISignalCap irq target) = cap.ArchObjectCap (arch_cap.SGISignalCap (ucast irq) (ucast target))" -lemma acap_relation_imp_ArchCapabilityMap[ADT_H_assms]: +lemma acap_relation_imp_ArchCapabilityMap[Arch_assms]: "\wellformed_acap ac; acap_relation ac ac'\ \ ArchCapabilityMap ac' = cap.ArchObjectCap ac" by (case_tac ac; simp add: wellformed_acap_simps ucast_down_ucast_id is_down) @@ -114,7 +114,7 @@ primrec ArchFaultMap :: "Fault_H.arch_fault \ ExceptionTypes_A.arch_ | "ArchFaultMap (ARM_HYP_H.VGICMaintenance m) = ARM_HYP_A.VGICMaintenance m" | "ArchFaultMap (ARM_HYP_H.VPPIEvent irq) = ARM_HYP_A.VPPIEvent irq" -lemma ArchFaultMap_arch_fault_map[ADT_H_assms]: +lemma ArchFaultMap_arch_fault_map[Arch_assms]: "ArchFaultMap (arch_fault_map f) = f" by (cases f; simp add: ArchFaultMap_def arch_fault_map_def) @@ -138,7 +138,7 @@ definition absArchState :: arm_asid_map = am, arm_current_vcpu = curvcpu, arm_gicvcpu_numlistregs = vnumlistregs, arm_kernel_vspace = kvspace, arm_us_global_pd = globalpd\" -lemma absArchState_correct[ADT_H_assms]: +lemma absArchState_correct[Arch_assms]: "(s,s') \ state_relation \ absArchState (ksArchState s') (aobjs_of' s') = arch_state s" apply (prop_tac "(arch_state s, ksArchState s') \ arch_state_relation (aobjs_of' s')") apply (simp add: state_relation_def) @@ -146,19 +146,20 @@ lemma absArchState_correct[ADT_H_assms]: split: ARM_HYP_H.kernel_state.splits) done +lemmas ADT_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState interpretation ADT_H?: ADT_H vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.ADT_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems ADT_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H_2 locale *) (* Due to DataPage, current FPU owner and gsPPTypes this can't be made generic. In order to unify the type across architectures, we use the arch kernel state. *) @@ -197,7 +198,7 @@ lemma unaligned_page_offsets_helper: apply (frule_tac i=n and k="0x1000" in word_mult_less_mono1, simp+)+ done -lemma absHeap_correct[ADT_H_2_assms]: +lemma absHeap_correct[Arch_assms]: fixes s' :: kernel_state assumes pspace_aligned: "pspace_aligned s" assumes pspace_distinct: "pspace_distinct s" @@ -534,6 +535,8 @@ proof - done qed +lemmas ADT_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts absHeap @@ -541,8 +544,7 @@ arch_requalify_consts absHeap interpretation ADT_H_2?: ADT_H_2 vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState absHeap proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.ADT_H_2_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchArchAcc_R.thy b/proof/refine/ARM_HYP/ArchArchAcc_R.thy index d6aa1bca6d..93eee47b2f 100644 --- a/proof/refine/ARM_HYP/ArchArchAcc_R.thy +++ b/proof/refine/ARM_HYP/ArchArchAcc_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems ArchAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ArchAcc_R locale *) lemma asid_pool_at_ko: "asid_pool_at p s \ \pool. ko_at (ArchObj (ARM_HYP_A.ASIDPool pool)) p s" @@ -1194,7 +1194,7 @@ lemma copy_global_mappings_corres [corres]: apply (simp add: copy_global_mappings_def copyGlobalMappings_def) done -lemma arch_cap_rights_update[ArchAcc_R_assms]: +lemma arch_cap_rights_update[Arch_assms]: "acap_relation c c' \ cap_relation (cap.ArchObjectCap (acap_rights_update (acap_rights c \ msk) c)) (Arch.maskCapRights (rights_mask_map msk) c')" @@ -1224,7 +1224,7 @@ lemma arch_deriveCap_valid: apply (rule hoare_pre, wp undefined_validE_R) apply (cases arch_cap, simp_all add: isCap_defs) apply (simp add: valid_cap'_def capAligned_def - global.capUntypedPtr_def capUntypedPtr_def) + global.capUntypedPtr_def ARM_HYP_H.capUntypedPtr_def) done lemma arch_deriveCap_corres [corres]: @@ -1588,7 +1588,7 @@ lemma setObject_ASID_ctes_of'[wp]: \\rv s. P (ctes_of s)\" by (rule ctes_of_from_cte_wp_at [where Q=\, simplified]) wp -lemma pspace_aligned_cross[ArchAcc_R_assms]: +lemma pspace_aligned_cross[Arch_assms]: "\ pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_aligned' s'" supply option.case_cong[cong] apply (clarsimp simp: pspace_aligned'_def pspace_aligned_def pspace_relation_def) @@ -1669,7 +1669,7 @@ lemma obj_relation_cuts_range_limit: apply fastforce+ done -lemma obj_relation_cuts_range_mask_range[ArchAcc_R_assms]: +lemma obj_relation_cuts_range_mask_range[Arch_assms]: "\ (p', P) \ obj_relation_cuts ko p; P ko ko'; is_aligned p (obj_bits ko) \ \ p' \ mask_range p (obj_bits ko)" apply (drule (1) obj_relation_cuts_range_limit, clarsimp) @@ -1691,7 +1691,7 @@ lemma obj_relation_cuts_obj_bits: split: kernel_object.splits arch_kernel_object.splits) done -lemma pspace_distinct_cross[ArchAcc_R_assms]: +lemma pspace_distinct_cross[Arch_assms]: "\ pspace_distinct s; pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_distinct' s'" apply (frule (1) pspace_aligned_cross) @@ -1739,12 +1739,13 @@ lemma pspace_distinct_cross[ArchAcc_R_assms]: apply (erule (2) in_empty_interE) done -end +lemmas ArchAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation ArchAcc_R?: ArchAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact ArchAcc_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.ArchAcc_R_assms)?) qed end diff --git a/proof/refine/ARM_HYP/ArchArch_R.thy b/proof/refine/ARM_HYP/ArchArch_R.thy index 85ad8cfd35..0b1821a1fb 100644 --- a/proof/refine/ARM_HYP/ArchArch_R.thy +++ b/proof/refine/ARM_HYP/ArchArch_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Arch_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Arch_R locale *) definition "asid_ci_map i \ @@ -389,7 +389,7 @@ lemma decodeVCPUInjectIRQ_inv[wp]: "\P\ decodeVCPUInjectIRQ a b by (wpsimp simp: decodeVCPUInjectIRQ_def Let_def wp: whenE_wp getVCPU_wp | rule conjI)+ crunch Arch.decodeInvocation - for inv[Arch_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (wp: crunch_wps mapME_x_inv_wp getASID_wp simp: crunch_simps ARMMMU_improve_cases) @@ -792,7 +792,7 @@ lemma decodeARMVCPUInvocation_corres: lemmas vmsz_aligned_imp_aligned = vmsz_aligned_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN is_aligned_weaken] -lemma arch_decodeInvocation_corres[Arch_R_assms]: +lemma arch_decodeInvocation_corres[Arch_assms]: notes check_vp_inv[wp del] check_vp_wpR[wp] [[goals_limit = 1]] (* FIXME: check_vp_inv shadowed check_vp_wpR. Instead, check_vp_wpR should probably be generalised to replace check_vp_inv. *) @@ -1298,7 +1298,7 @@ lemma performSGIInvocation_corres: apply (corres corres: corres_machine_op) done -lemma arch_performInvocation_corres[Arch_R_assms]: +lemma arch_performInvocation_corres[Arch_assms]: assumes "archinv_relation ai ai'" shows "corres (dc \ (=)) (einvs and ct_active and valid_arch_inv ai and schact_is_rct) @@ -1367,7 +1367,7 @@ lemma performASIDControlInvocation_tcb_at': crunch writeVCPUReg, readVCPUReg, performARMVCPUInvocation, performSGISignalGenerate for tcb_at'[wp]: "tcb_at' p" -lemma invokeArch_tcb_at'[Arch_R_assms]: +lemma invokeArch_tcb_at'[Arch_assms]: "\invs' and valid_arch_inv' ai and ct_active' and st_tcb_at' active' p\ Arch.performInvocation ai \\rv. tcb_at' p\" @@ -1447,7 +1447,7 @@ crunch for vs_entry_align[wp]: "ko_wp_at' (\ko. P (vs_entry_align ko)) p" (wp: crunch_wps simp: crunch_simps) -lemma sts_valid_arch_inv'[Arch_R_assms]: +lemma sts_valid_arch_inv'[Arch_assms]: "\valid_arch_inv' ai\ setThreadState st t \\rv. valid_arch_inv' ai\" apply (cases ai, simp_all add: valid_arch_inv'_def) apply (clarsimp simp: valid_pti'_def split: page_table_invocation.splits) @@ -1916,7 +1916,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (drule_tac t="cteCap cte" in sym, simp) by fastforce -lemma arch_decodeInvocation_wf_interface[Arch_R_assms]: +lemma arch_decodeInvocation_wf_interface[Arch_assms]: "\invs' and valid_cap' (ArchObjectCap arch_cap) 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 @@ -2277,7 +2277,7 @@ lemma performSGISignalInvocation_invs[wp]: unfolding performSGISignalGenerate_def by (wpsimp wp: dmo_invs'_simple no_irq_sendSGI) -lemma arch_performInvocation_invs'[Arch_R_assms]: +lemma arch_performInvocation_invs'[Arch_assms]: "\invs' and ct_active' and valid_arch_inv' invocation\ Arch.performInvocation invocation \\rv. invs'\" @@ -2286,7 +2286,7 @@ lemma arch_performInvocation_invs'[Arch_R_assms]: simp_all add: performARMMMUInvocation_def valid_arch_inv'_def, (wp|simp)+) -lemma setObject_TCB_valid_duplicates'[Arch_R_assms, wp]: +lemma setObject_TCB_valid_duplicates'[Arch_assms, wp]: "setObject p (tcb::tcb) \\s. vs_valid_duplicates' (ksPSpace s)\" apply (clarsimp simp: setObject_def split_def valid_def in_monad pspace_aligned'_def ps_clear_upd @@ -2300,6 +2300,8 @@ lemma setObject_TCB_valid_duplicates'[Arch_R_assms, wp]: apply (erule valid_duplicates'_non_pd_pt_I[rotated 3], simp+)+ done +lemmas Arch_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -2308,8 +2310,7 @@ arch_requalify_consts interpretation Arch_R?: Arch_R valid_arch_inv' archinv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Arch_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Arch_R_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchBits_R.thy b/proof/refine/ARM_HYP/ArchBits_R.thy index 293067ee7b..cd5d0e8d7b 100644 --- a/proof/refine/ARM_HYP/ArchBits_R.thy +++ b/proof/refine/ARM_HYP/ArchBits_R.thy @@ -10,30 +10,30 @@ begin context Arch begin arch_global_naming -named_theorems Bits_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Bits_R locale *) crunch_ignore (add: setCurrentPD) -lemma atcbContext_get_eq[Bits_R_assms, simp]: +lemma atcbContext_get_eq[Arch_assms, simp]: "atcbContextGet (atcbContextSet x atcb) = x" by (simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_eq[Bits_R_assms, simp]: +lemma atcbContext_set_eq[Arch_assms, simp]: "atcbContextSet (atcbContextGet t) t = t" by (cases t, simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_set[Bits_R_assms, simp]: +lemma atcbContext_set_set[Arch_assms, simp]: "atcbContextSet x (atcbContextSet y atcb) = atcbContextSet x atcb" by (cases atcb, simp add: atcbContextSet_def) -lemma objBitsKO_less_word_bits[Bits_R_assms]: +lemma objBitsKO_less_word_bits[Arch_assms]: "objBitsKO ko < word_bits" unfolding objBits_def by (case_tac ko; simp add: objBits_simps' pageBits_def pte_bits_def pde_bits_def vcpu_bits_def word_bits_def split: arch_kernel_object.split) -lemma objBitsKO_neq_0[Bits_R_assms]: +lemma objBitsKO_neq_0[Arch_assms]: "objBitsKO ko \ 0" unfolding objBits_def by (case_tac ko; @@ -54,7 +54,7 @@ lemma arch_isCap_simps: (* isArchSGISignalCap_def is already in expanded exists form, so no need to spell it out. *) lemmas isCap_simps = gen_isCap_simps arch_isCap_simps isArchSGISignalCap_def -lemma pageBits_le_maxUntypedSizeBits[Bits_R_assms, simp]: +lemma pageBits_le_maxUntypedSizeBits[Arch_assms, simp]: "pageBits \ maxUntypedSizeBits" by (simp add: pageBits_def maxUntypedSizeBits_def) @@ -94,7 +94,9 @@ lemmas arch_projectKOs = projectKO_ASID projectKO_PTE projectKO_PDE projectKO_VCPU projectKO_user_data projectKO_user_data_device -end +lemmas Bits_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) (* for projectKO_opt, we want to export the arch-specific instantiation lemmas *) arch_requalify_facts arch_projectKOs @@ -106,8 +108,7 @@ lemmas projectKOs = gen_projectKOs arch_projectKOs interpretation Bits_R?: Bits_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Bits_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Bits_R_assms)?) qed end diff --git a/proof/refine/ARM_HYP/ArchCNodeInv_R.thy b/proof/refine/ARM_HYP/ArchCNodeInv_R.thy index debe46ebf3..ba1ac8de4d 100644 --- a/proof/refine/ARM_HYP/ArchCNodeInv_R.thy +++ b/proof/refine/ARM_HYP/ArchCNodeInv_R.thy @@ -14,49 +14,49 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_R locale *) definition arch_finalise_prop_stuff :: "(kernel_state \ bool) \ bool" where "arch_finalise_prop_stuff P = True" -lemma arch_finalise_prop_stuff_top[CNodeInv_R_assms, simp]: +lemma arch_finalise_prop_stuff_top[Arch_assms, simp]: "arch_finalise_prop_stuff \" by (simp add: arch_finalise_prop_stuff_def) -lemma acap_relation_arch_update_cap_data_NullCap[CNodeInv_R_assms]: +lemma acap_relation_arch_update_cap_data_NullCap[Arch_assms]: "acap_relation acap acap' \ (arch_update_cap_data P x acap = cap.NullCap) = (Arch.updateCapData P x acap' = NullCap)" unfolding arch_update_cap_data_def ARM_HYP_H.updateCapData_def by (cases acap; simp) -lemma cnode_guard_size_bits_wordRadix[CNodeInv_R_assms]: +lemma cnode_guard_size_bits_wordRadix[Arch_assms]: "cnode_guard_size_bits = wordRadix" by (simp add: wordRadix_def) -lemma cteRightsBits_cnode_padding_bits[CNodeInv_R_assms]: +lemma cteRightsBits_cnode_padding_bits[Arch_assms]: "cteRightsBits = cnode_padding_bits" by (simp add: cteRightsBits_def) (* FIXME arch-split: valid_cnode_capI in CNodeInv_AI exposes the value of word_bits, replace with this *) -lemma valid_cnode_capI'[CNodeInv_R_assms]: +lemma valid_cnode_capI'[Arch_assms]: "\cap_table_at n w s; valid_objs s; pspace_aligned s; 0 < n; length g \ word_bits\ \ s \ cap.CNodeCap w n g" by (simp add: word_bits_def valid_cnode_capI) -lemma arch_capBadge_updateCapData_True[CNodeInv_R_assms]: +lemma arch_capBadge_updateCapData_True[Arch_assms]: "Arch.updateCapData True x acap \ NullCap \ capBadge (Arch.updateCapData True x acap) = arch_capBadge acap" unfolding ARM_HYP_H.updateCapData_def by (cases acap; simp) crunch prepareThreadDelete - for ctes_of[CNodeInv_R_assms, wp]: "\s. P (ctes_of s)" + for ctes_of[Arch_assms, wp]: "\s. P (ctes_of s)" crunch prepareThreadDelete - for not_recursive_ctes[CNodeInv_R_assms]: "\s. P (not_recursive_ctes s)" + for not_recursive_ctes[Arch_assms]: "\s. P (not_recursive_ctes s)" (simp: prepareThreadDelete_def not_recursive_ctes_def cteCaps_of_def) -lemma in_preempt'[CNodeInv_R_assms]: +lemma in_preempt'[Arch_assms]: "(Inr rv, s') \ fst (preemptionPoint s) \ \f g. s' = ksWorkUnitsCompleted_update f (s \ ksMachineState := ksMachineState s \ irq_state := g (irq_state (ksMachineState s)) \\)" @@ -82,19 +82,19 @@ lemma sameRegionAs_eq_parent: \ sameRegionAs c' cap" by (clarsimp simp: weak_derived'_def sameRegionAs_def2 isCap_simps) -lemma sameRegion_ep[CNodeInv_R_assms]: +lemma sameRegion_ep[Arch_assms]: "\ sameRegionAs cap cap'; isEndpointCap cap \ \ isEndpointCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegion_ntfn[CNodeInv_R_assms]: +lemma sameRegion_ntfn[Arch_assms]: "\ sameRegionAs cap cap'; isNotificationCap cap \ \ isNotificationCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegionAs_Zombie[CNodeInv_R_assms, simp]: +lemma sameRegionAs_Zombie[Arch_assms, simp]: "\ sameRegionAs (Zombie p zb n) cap" by (simp add: sameRegionAs_def3 isCap_simps) -lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: +lemma isFinal_notUntyped_capRange_disjoint[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); cteCaps_of s sl' = Some cap'; sl \ sl'; capUntypedPtr cap = capUntypedPtr cap'; capBits cap = capBits cap'; isThreadCap cap \ isCNodeCap cap; s \' cap; @@ -114,7 +114,7 @@ lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: (clarsimp simp: sameObjectAs_def3 isCap_simps)?)+ done -lemma ztc_sameRegion[CNodeInv_R_assms]: +lemma ztc_sameRegion[Arch_assms]: "\ isCNodeCap cap \ isThreadCap cap \ isZombie cap \ \ sameRegionAs cap cap' = sameObjectAs cap cap'" apply (subgoal_tac "\ isUntypedCap cap \ \ isArchFrameCap cap @@ -123,7 +123,7 @@ lemma ztc_sameRegion[CNodeInv_R_assms]: apply (auto simp: isCap_simps) done -lemma mdb_chunked_update_final[CNodeInv_R_assms]: +lemma mdb_chunked_update_final[Arch_assms]: assumes chunked: "mdb_chunked m" and slot: "m slot = Some (CTE cap node)" and Fin1: "\x cte. m x = Some cte \ x \ slot @@ -182,19 +182,19 @@ proof - done qed -lemma sameRegionAs_ThreadCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_ThreadCap_eq[Arch_assms]: "sameRegionAs (ThreadCap p) (ThreadCap p') = (p = p')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_IRQHandlerCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_IRQHandlerCap_eq[Arch_assms]: "sameRegionAs (IRQHandlerCap irq) (IRQHandlerCap irq') = (irq = irq')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_CNodeCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_CNodeCap_eq[Arch_assms]: "sameRegionAs (CNodeCap p b g gs) (CNodeCap p' b' g' gs') = (p = p' \ b = b')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma ztc_untyped_helper[CNodeInv_R_assms]: +lemma ztc_untyped_helper[Arch_assms]: "\ isCNodeCap cap' \ isThreadCap cap' \ isZombie cap'; sameRegionAs cap cap' \ \ isUntypedCap cap \ sameRegionAs cap' cap" apply (erule sameRegionAsE) @@ -208,12 +208,12 @@ lemma ztc_untyped_helper[CNodeInv_R_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma valid_arch_badges_PhysicalClass[CNodeInv_R_assms]: +lemma valid_arch_badges_PhysicalClass[Arch_assms]: "\ valid_arch_badges cap'' cap' node'; capClass cap'' = PhysicalClass; capClass cap = PhysicalClass \ \ valid_arch_badges cap cap' node'" by (auto simp: valid_arch_badges_def isCap_simps) -lemma isFinal_Zombie[CNodeInv_R_assms]: +lemma isFinal_Zombie[Arch_assms]: "isFinal (Zombie p' b n) p cs" by (simp add: isFinal_def sameObjectAs_def2 gen_isCap_simps) @@ -221,25 +221,25 @@ crunch Arch.postCapDeletion for no_cte_prop[wp]: "no_cte_prop P" (* interface, above crunch does not result in same lemma on all architectures *) -lemma arch_postCapDeletion_no_cte_prop[CNodeInv_R_assms]: +lemma arch_postCapDeletion_no_cte_prop[Arch_assms]: "\no_cte_prop P and K (arch_finalise_prop_stuff P)\ Arch.postCapDeletion t \\_. no_cte_prop P\" by wpsimp -lemma post_cap_delete_pre'_IRQHandlerCap[CNodeInv_R_assms]: +lemma post_cap_delete_pre'_IRQHandlerCap[Arch_assms]: "post_cap_delete_pre' (IRQHandlerCap irq) sl cs = (arch_valid_irq irq \ (\sl'. sl \ sl' \ cs sl' \ Some (IRQHandlerCap irq)))" by (simp add: post_cap_delete_pre'_def) -lemma final_post_cap_delete_pre'_ArchObjectCap[CNodeInv_R_assms]: +lemma final_post_cap_delete_pre'_ArchObjectCap[Arch_assms]: "\ isFinal (ArchObjectCap acap) sl (cteCaps_of s); arch_cap_has_cleanup' acap; valid_arch_cap' acap s\ \ post_cap_delete_pre' (ArchObjectCap acap) sl (cteCaps_of s)" by (clarsimp simp add: post_cap_delete_pre'_def arch_cap_has_cleanup'_def isCap_simps) crunch Arch_finaliseCap, prepareThreadDelete - for st_tcb_at'[CNodeInv_R_assms, wp]: "st_tcb_at' P t" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" (simp: crunch_simps wp: crunch_wps getObject_inv loadObject_default_inv rule: ARM_HYP_H.finaliseCap_def) @@ -269,7 +269,7 @@ lemma archThreadSet_rvk_prog': by (wpsimp simp: cteCaps_of_def) crunch prepareThreadDelete, Arch_finaliseCap - for rvk_prog'[CNodeInv_R_assms]: + for rvk_prog'[Arch_assms]: "\s. revoke_progress_ord m (\x. option_map capToRPO (cteCaps_of s x))" (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of getObject_inv loadObject_default_inv @@ -277,7 +277,7 @@ crunch prepareThreadDelete, Arch_finaliseCap ignore: setCTE threadSet rule: ARM_HYP_H.finaliseCap_def) -lemma cap_relation_trans[CNodeInv_R_assms]: +lemma cap_relation_trans[Arch_assms]: "\ cap_relation cap cap'; cap_relation cap cap'' \ \ cap' = cap''" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) @@ -322,7 +322,7 @@ crunch ignore: saveVirtTimer) crunch Arch_finaliseCap, prepareThreadDelete - for irq_states'[CNodeInv_R_assms, wp]: valid_irq_states' + for irq_states'[Arch_assms, wp]: valid_irq_states' (wp: crunch_wps unless_wp getASID_wp no_irq no_irq_invalidateLocalTLB_ASID no_irq_setHardwareASID no_irq_setCurrentPD no_irq_invalidateLocalTLB_VAASID @@ -494,18 +494,19 @@ end (* mdb_move *) context Arch begin arch_global_naming -lemmas [CNodeInv_R_assms] = +lemmas [Arch_assms] = mdb_swap.cteSwap_valid_mdb_helper mdb_move.cteMove_valid_mdb_helper +lemmas CNodeInv_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts arch_finalise_prop_stuff interpretation CNodeInv_R?: CNodeInv_R arch_finalise_prop_stuff proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CNodeInv_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CNodeInv_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/ARM_HYP/ArchCSpace1_R.thy b/proof/refine/ARM_HYP/ArchCSpace1_R.thy index 82d130fd4c..70de0bea0f 100644 --- a/proof/refine/ARM_HYP/ArchCSpace1_R.thy +++ b/proof/refine/ARM_HYP/ArchCSpace1_R.thy @@ -13,22 +13,22 @@ begin context Arch begin arch_global_naming -named_theorems CSpace1_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R locale *) -lemma ghost_relation_wrapper_same_abs_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_abs_set_cap[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap cap dest a); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma ghost_relation_wrapper_set_cap_twice[CSpace1_R_assms]: +lemma ghost_relation_wrapper_set_cap_twice[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap dcap src a); ((), a'') \ fst (set_cap scap dest a'); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a'' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma archMDBAssertions_cross[CSpace1_R_assms]: +lemma archMDBAssertions_cross[Arch_assms]: "\ valid_arch_mdb (is_original_cap s) (caps_of_state s); valid_arch_state s; valid_objs s; (s, s') \ state_relation \ \ archMDBAssertions s'" @@ -82,7 +82,7 @@ lemma isMDBParentOf_trans: apply (erule(1) capBadge_ordering_trans) done -lemma parentOf_trans[CSpace1_R_assms]: +lemma parentOf_trans[Arch_assms]: "\ s \ a parentOf b; s \ b parentOf c \ \ s \ a parentOf c" by (auto simp: parentOf_def elim: isMDBParentOf_trans) @@ -98,7 +98,7 @@ lemma is_physical_relation: by (auto simp: is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma obj_ref_of_relation[CSpace1_R_assms]: +lemma obj_ref_of_relation[Arch_assms]: "\ cap_relation c c'; capClass c' = PhysicalClass \ \ obj_ref_of c = capUntypedPtr c'" by (cases c; simp) (rename_tac arch_cap, case_tac arch_cap, auto) @@ -124,7 +124,7 @@ lemma obj_size_relation: pageBits_def) done -lemma same_region_as_relation[CSpace1_R_assms]: +lemma same_region_as_relation[Arch_assms]: "\ cap_relation c d; cap_relation c' d' \ \ same_region_as c c' = sameRegionAs d d'" apply (cases c) apply clarsimp @@ -152,7 +152,7 @@ lemma acap_relation_SGISignalCapD: acap = arch_cap.SGISignalCap (ucast irq) (ucast target)" by (cases acap) (auto simp: ucast_down_ucast_id is_down) -lemma can_be_is[CSpace1_R_assms]: +lemma can_be_is[Arch_assms]: "\ cap_relation c (cteCap cte); cap_relation c' (cteCap cte'); mdbRevocable (cteMDBNode cte) = r; mdbFirstBadged (cteMDBNode cte') = r' \ \ @@ -181,14 +181,14 @@ lemma maskVMRights_VMNoAccess[simp]: "(maskVMRights vmR R = VMNoAccess) = (vmR = VMNoAccess)" by (simp add: maskVMRights_def split: vmrights.splits bool.splits) -lemma maskCap_valid[CSpace1_R_assms, simp]: +lemma maskCap_valid[Arch_assms, simp]: "s \' global.maskCapRights R cap = s \' cap" by (clarsimp simp: valid_cap'_def global.maskCapRights_def isCap_simps capAligned_def ARM_HYP_H.maskCapRights_def split: capability.split arch_capability.split cong: if_cong) -lemma cap_map_update_data[CSpace1_R_assms]: +lemma cap_map_update_data[Arch_assms]: assumes "cap_relation c c'" shows "cap_relation (update_cap_data p x c) (updateCapData p x c')" proof - @@ -234,7 +234,7 @@ qed sublocale setCTE: typ_at_props' "setCTE c cte" by typ_at_props' -lemma arch_updateCapData_Master[CSpace1_R_assms]: +lemma arch_updateCapData_Master[Arch_assms]: "Arch.updateCapData P d acap \ NullCap \ capMasterCap (Arch.updateCapData P d acap) = capMasterCap (ArchObjectCap acap)" by (cases acap; simp add: ARM_HYP_H.updateCapData_def split: if_split_asm) @@ -246,28 +246,28 @@ private method updateCapData_cases for c = (rename_tac arch_capability), (case_tac arch_capability; simp add: ARM_HYP_H.updateCapData_def isCap_simps Let_def) -lemma capASID_update[CSpace1_R_assms, simp]: +lemma capASID_update[Arch_assms, simp]: "capASID (RetypeDecls_H.updateCapData P x c) = capASID c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_vptr_update'[CSpace1_R_assms, simp]: +lemma cap_vptr_update'[Arch_assms, simp]: "cap_vptr' (RetypeDecls_H.updateCapData P x c) = cap_vptr' c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_asid_base_update'[CSpace1_R_assms, simp]: +lemma cap_asid_base_update'[Arch_assms, simp]: "cap_asid_base' (RetypeDecls_H.updateCapData P x c) = cap_asid_base' c" unfolding cap_asid_base'_def by (updateCapData_cases c) -lemma updateCapData_Reply[CSpace1_R_assms, simp]: +lemma updateCapData_Reply[Arch_assms, simp]: "isReplyCap (updateCapData P x c) = isReplyCap c" by (updateCapData_cases c) end (* context private method *) -lemma capASID_mask[CSpace1_R_assms, simp]: +lemma capASID_mask[Arch_assms, simp]: "capASID (maskCapRights x c) = capASID c" unfolding capASID_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -276,7 +276,7 @@ lemma capASID_mask[CSpace1_R_assms, simp]: simp_all add: ARM_HYP_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_vptr_mask'[CSpace1_R_assms, simp]: +lemma cap_vptr_mask'[Arch_assms, simp]: "cap_vptr' (maskCapRights x c) = cap_vptr' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -285,7 +285,7 @@ lemma cap_vptr_mask'[CSpace1_R_assms, simp]: simp_all add: ARM_HYP_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_asid_base_mask'[CSpace1_R_assms, simp]: +lemma cap_asid_base_mask'[Arch_assms, simp]: "cap_asid_base' (maskCapRights x c) = cap_asid_base' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -416,7 +416,7 @@ proof - done qed -lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: +lemma set_cap_not_quite_corres_prequel[Arch_assms]: assumes cr: "pspace_relation (kheap s) (ksPSpace s')" "(x,t') \ fst (setCTE p' c' s')" @@ -465,7 +465,7 @@ lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: done (* FIXME: move *) -lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: +lemma pspace_relation_cte_wp_atI'[Arch_assms]: "\ pspace_relation (kheap s) (ksPSpace s'); cte_wp_at' ((=) cte) x s'; valid_objs s \ \ \c slot. cte_wp_at ((=) c) slot s \ cap_relation c (cteCap cte) \ x = cte_map slot" @@ -489,23 +489,23 @@ lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: split: Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm) done -lemma same_region_as_final_matters[CSpace1_R_assms]: +lemma same_region_as_final_matters[Arch_assms]: "\same_region_as c c'; final_matters c\ \ final_matters c'" by (rule ccontr) (simp add: final_matters_def final_matters_arch_def cap_relation_split_asm split: cap.split_asm arch_cap.splits) -lemma same_region_as_arch_gen_refs[CSpace1_R_assms]: +lemma same_region_as_arch_gen_refs[Arch_assms]: "\same_region_as c c'; final_matters c \ \ arch_gen_refs c = arch_gen_refs c'" by (auto simp: final_matters_def cap_relation_split_asm is_cap_simps arch_gen_obj_refs_def split: cap.split_asm arch_cap.splits) -lemma arch_same_region_aobj_ref[CSpace1_R_assms]: +lemma arch_same_region_aobj_ref[Arch_assms]: "\arch_same_region_as ac ac'; final_matters_arch ac; final_matters_arch ac'\ \ aobj_ref ac = aobj_ref ac'" by (simp add: final_matters_arch_def split: ARM_HYP_A.arch_cap.splits) -lemma obj_refs_relation_Master[CSpace1_R_assms]: +lemma obj_refs_relation_Master[Arch_assms]: "cap_relation cap cap' \ obj_refs cap = (if capClass (capMasterCap cap') = PhysicalClass \ \ isUntypedCap (capMasterCap cap') then {capUntypedPtr (capMasterCap cap')} @@ -517,13 +517,13 @@ lemma arch_gen_refs_relation_Master: "cap_relation cap cap' \ arch_gen_refs cap = {}" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma arch_gen_refs_cap_relation_Master_eq[CSpace1_R_assms]: +lemma arch_gen_refs_cap_relation_Master_eq[Arch_assms]: "\cap_relation c (cteCap cte); capMasterCap (cteCap cte') = capMasterCap (cteCap cte); cap_relation c' (cteCap cte')\ \ arch_gen_refs c = arch_gen_refs c'" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma descendants_of_update_ztc[CSpace1_R_assms]: +lemma descendants_of_update_ztc[Arch_assms]: assumes c: "\x. \ m \ x \ slot; \ P \ \ \cte'. m x = Some cte' \ capMasterCap (cteCap cte') \ capMasterCap (cteCap cte) @@ -720,7 +720,7 @@ proof (simp add: descendants_of'_def subset_iff, by simp qed -lemma capRange_cap_relation[CSpace1_R_assms]: +lemma capRange_cap_relation[Arch_assms]: "\ cap_relation cap cap'; capClass cap' = PhysicalClass \ \ capRange cap' = {obj_ref_of cap .. obj_ref_of cap + obj_size cap - 1}" by (simp add: capRange_def objBits_simps' cte_level_bits_def @@ -728,23 +728,23 @@ lemma capRange_cap_relation[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm option.split sum.split) -lemma obj_refs_cap_relation_untyped_ptr[CSpace1_R_assms]: +lemma obj_refs_cap_relation_untyped_ptr[Arch_assms]: "\ cap_relation cap cap'; obj_refs cap \ {} \ \ capUntypedPtr cap' \ obj_refs cap" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) -lemma ghost_relation_wrapper_same_concrete_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_concrete_set_cap[Arch_assms]: "\ ghost_relation_wrapper s c; ((), s') \ fst (set_cap cap src s) \ \ ghost_relation_wrapper s' c" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma revokable_plus_orderD[CSpace1_R_assms]: +lemma revokable_plus_orderD[Arch_assms]: "\ isCapRevocable new old; (capBadge old, capBadge new) \ capBadge_ordering P; capMasterCap old = capMasterCap new \ \ (isUntypedCap new \ (\x. capBadge old = Some 0 \ capBadge new = Some x \ x \ 0))" by (clarsimp simp: Retype_H.isCapRevocable_def ARM_HYP_H.isCapRevocable_def isCap_simps split: if_split_asm capability.split_asm arch_capability.split_asm) -lemma valid_badges_def2[CSpace1_R_assms]: +lemma valid_badges_def2[Arch_assms]: "valid_badges m = (\p p' cap node cap' node'. m p = Some (CTE cap node) \ @@ -761,7 +761,7 @@ lemma valid_badges_def2[CSpace1_R_assms]: apply (case_tac cap; clarsimp simp: gen_isCap_simps) by (fastforce simp: sameRegionAs_def3 isCap_simps arch_capBadge_def)+ -lemma is_cap_revocable_eq[CSpace1_R_assms]: +lemma is_cap_revocable_eq[Arch_assms]: "\ cap_relation c c'; cap_relation src_cap src_cap'; sameRegionAs src_cap' c'; is_untyped_cap src_cap \ \ is_ep_cap c \ \ is_ntfn_cap c\ \ is_cap_revocable c src_cap = isCapRevocable c' src_cap'" @@ -771,10 +771,10 @@ lemma is_cap_revocable_eq[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm) done -lemmas use_update_ztc_one_descendants[CSpace1_R_assms] = +lemmas use_update_ztc_one_descendants[Arch_assms] = use_update_ztc_one[OF ARM_HYP.descendants_of_update_ztc, simplified] -lemma is_derived'_genD[CSpace1_R_assms]: +lemma is_derived'_genD[Arch_assms]: "is_derived' m p cap' cap \ cap' \ NullCap \ \ isZombie cap \ @@ -786,11 +786,11 @@ lemma is_derived'_genD[CSpace1_R_assms]: (isReplyCap cap' \ \ capReplyMaster cap')" by (simp add: ARM_HYP.is_derived'_def) -lemma acap_relation_capBadge[CSpace1_R_assms]: +lemma acap_relation_capBadge[Arch_assms]: "acap_relation acap acap' \ arch_capBadge acap' = arch_cap_badge acap" by (simp add: arch_capBadge_def) -lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: +lemma obj_relation_cuts_in_obj_range[Arch_assms]: "\ (y, P) \ obj_relation_cuts ko x; x \ obj_range x ko; kheap s x = Some ko; valid_objs s; pspace_aligned s \ \ y \ obj_range x ko" @@ -843,7 +843,7 @@ lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: apply (simp add: word_bits_def) done -lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: +lemma isMDBParentOf_CTE_gen[Arch_assms]: "\isArchObjectCap cap \ isMDBParentOf (CTE cap node) cte = (\cap' node'. cte = CTE cap' node' \ sameRegionAs cap cap' @@ -851,19 +851,20 @@ lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: \ (capBadge cap, capBadge cap') \ capBadge_ordering (mdbFirstBadged node'))" by (simp add: isMDBParentOf_CTE isCap_simps) +lemmas CSpace1_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R?: CSpace1_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace1_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace1_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_2 locale *) -lemma updateMDB_pspace_relation[CSpace1_R_2_assms]: +lemma updateMDB_pspace_relation[Arch_assms]: assumes "(x, s'') \ fst (updateMDB p f s')" assumes "pspace_relation (kheap s) (ksPSpace s')" assumes "pspace_aligned' s'" "pspace_distinct' s'" @@ -922,7 +923,7 @@ lemma cap_asid_cap_relation: by (auto simp: capASID_def cap_asid_def arch_cap_fun_lift_def split: cap.splits arch_cap.splits option.splits) -lemma is_derived_eq[CSpace1_R_2_assms]: +lemma is_derived_eq[Arch_assms]: "\ cap_relation c c'; cap_relation d d'; cdt_relation (swp cte_at s) (cdt s) (ctes_of s'); cte_at p s \ \ is_derived (cdt s) p c d = is_derived' (ctes_of s') (cte_map p) c' d'" @@ -980,7 +981,7 @@ lemma isMDBParentOf_eq_child: apply (clarsimp simp: sameRegionAs_def2 isCap_simps) done -lemma isMDBParentOf_eq[CSpace1_R_2_assms]: +lemma isMDBParentOf_eq[Arch_assms]: "\ isMDBParentOf c d; weak_derived' (cteCap c) (cteCap c'); mdbRevocable (cteMDBNode c') = mdbRevocable (cteMDBNode c); @@ -1032,11 +1033,11 @@ lemma sameRegionAs_SGISignalCap2[simp]: isIRQControlCapDescendant_def split: if_splits) -lemma arch_mdb_preservation_refl[simp, intro!, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_refl[simp, intro!, Arch_assms]: "arch_mdb_preservation cap cap" by (simp add: arch_mdb_preservation_def) -lemma arch_mdb_preservation_sym[CSpace1_R_2_assms]: +lemma arch_mdb_preservation_sym[Arch_assms]: "arch_mdb_preservation cap cap' = arch_mdb_preservation cap' cap" by (auto simp: arch_mdb_preservation_def) @@ -1044,11 +1045,11 @@ lemma arch_mdb_preservation_non_arch: "\ \isArchObjectCap cap; \isArchObjectCap cap' \ \ arch_mdb_preservation cap cap'" by (simp add: arch_mdb_preservation_def isCap_simps) -lemma arch_mdb_preservation_Untyped[simp, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_Untyped[simp, Arch_assms]: "arch_mdb_preservation (UntypedCap d p sz idx) (UntypedCap d' p' sz' idx')" by (simp add: arch_mdb_preservation_non_arch isCap_simps) -lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: +lemma parentOf_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. \m x = Some cte; m' x = Some cte'\ \ @@ -1090,7 +1091,7 @@ lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: apply blast done -lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: +lemma mdb_chunked_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. @@ -1136,7 +1137,7 @@ lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: apply (clarsimp simp:mdb_next_rel_def node) done -lemma valid_badges_preserve_oneway[CSpace1_R_2_assms]: +lemma valid_badges_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes misc: "\x cte cte'. @@ -1214,12 +1215,13 @@ definition is_simple_cap' :: "capability \ bool" where \ isZombie cap \ \ isArchFrameCap cap" +lemmas CSpace1_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R_2?: CSpace1_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_2_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace1_R_2_assms)?)) qed (* needed to prove dest_no_parent_n in Arch, then export to mdb_insert_der *) @@ -1350,19 +1352,20 @@ end context Arch begin arch_global_naming -named_theorems CSpace1_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_3 locale *) -lemmas [CSpace1_R_3_assms] = +lemmas [Arch_assms] = is_derived_maskedAsFull derived_sameRegionAs maskedAsFull_revokable mdb_insert_der.dest_no_parent_n mdb_insert_sib.src_no_mdb_parent mdb_insert_sib.parent_preserved -end +lemmas CSpace1_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace1_R_3?: CSpace1_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_3_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace1_R_3_assms)?)) qed locale Arch_masterCap = Arch + masterCap diff --git a/proof/refine/ARM_HYP/ArchCSpace_I.thy b/proof/refine/ARM_HYP/ArchCSpace_I.thy index 7c1b0ea433..a93bc5bb1f 100644 --- a/proof/refine/ARM_HYP/ArchCSpace_I.thy +++ b/proof/refine/ARM_HYP/ArchCSpace_I.thy @@ -16,7 +16,7 @@ abbreviation (input) context Arch begin arch_global_naming -named_theorems CSpace_I_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I locale *) lemma capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (ARM_HYP_H.ASIDPoolCap r asid) = r" @@ -26,14 +26,14 @@ lemma capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (ARM_HYP_H.VCPUCap r) = r" by (auto simp: ARM_HYP_H.capUntypedPtr_def) -lemma maskCapRights_allRights[CSpace_I_assms, simp]: +lemma maskCapRights_allRights[Arch_assms, simp]: "maskCapRights allRights c = c" - unfolding global.maskCapRights_def isCap_defs allRights_def maskCapRights_def maskVMRights_def + unfolding global.maskCapRights_def isCap_defs allRights_def ARM_HYP_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma isPhysicalCap[CSpace_I_assms, simp]: +lemma isPhysicalCap[Arch_assms, simp]: "isPhysicalCap cap = (capClass cap = PhysicalClass)" - by (simp add: global.isPhysicalCap_def isPhysicalCap_def + by (simp add: global.isPhysicalCap_def ARM_HYP_H.isPhysicalCap_def split: capability.split arch_capability.split) definition arch_capMasterCap :: "arch_capability \ arch_capability" where @@ -52,17 +52,17 @@ definition arch_capMasterCap :: "arch_capability \ arch_capability" lemmas arch_capMasterCap_simps[simp] = arch_capMasterCap_def[split_simps arch_capability.split] -lemma acapClass_arch_capMasterCap[CSpace_I_assms,simp]: +lemma acapClass_arch_capMasterCap[Arch_assms,simp]: "acapClass (arch_capMasterCap acap) = acapClass acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma capUntypedPtr_arch_capMasterCap[CSpace_I_assms, simp]: +lemma capUntypedPtr_arch_capMasterCap[Arch_assms, simp]: "Arch.capUntypedPtr (arch_capMasterCap acap) = Arch.capUntypedPtr acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: +lemma acapBits_arch_capMasterCap[Arch_assms, simp]: "acapBits (arch_capMasterCap acap) = acapBits acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) @@ -70,11 +70,11 @@ lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: lemmas isArchFrameCap_simps[simp] = isArchFrameCap_def[split_simps capability.split arch_capability.split] -lemma isArchFrameCap_arch_capMasterCap[CSpace_I_assms, simp]: +lemma isArchFrameCap_arch_capMasterCap[Arch_assms, simp]: "isArchFrameCap (ArchObjectCap (arch_capMasterCap acap)) = isArchFrameCap (ArchObjectCap acap)" by (simp add: arch_capMasterCap_def split: arch_capability.split) -lemma isArchFrameCap_non_arch[CSpace_I_assms]: +lemma isArchFrameCap_non_arch[Arch_assms]: "\is_ArchObjectCap cap \ isArchFrameCap cap = False" by (simp add: isArchFrameCap_def is_ArchObjectCap_def split: capability.split) @@ -93,18 +93,19 @@ lemma arch_capBadge_def: "arch_capBadge acap = None" by (cases acap; simp) -end +lemmas CSpace_I_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I?: CSpace_I ARM_HYP.arch_capMasterCap ARM_HYP.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace_I_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_I_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I_2 locale *) (* for the Arch locale we want the fully expanded version covering all cases, but avoiding the capMasterCap_ArchObjectCap rewrite case for an unspecified ArchObjectCap *) @@ -114,7 +115,7 @@ lemmas capMasterCap_simps[simp] = capMasterCap_def[simplified arch_capMasterCap_def, split_simps capability.split arch_capability.split] -lemma isArchFrameCap_capMasterCap[CSpace_I_2_assms, simp]: +lemma isArchFrameCap_capMasterCap[Arch_assms, simp]: "isArchFrameCap (capMasterCap cap) = isArchFrameCap cap" by (simp add: isArchFrameCap_def split: capability.split arch_capability.split) @@ -224,7 +225,7 @@ lemma sameRegionAsE: \ \ R" by (simp add: sameRegionAs_def3, fastforce simp: gen_isCap_Master arch_isCap_Master) -lemma sameObjectAsE[CSpace_I_2_assms]: +lemma sameObjectAsE[Arch_assms]: "\ sameObjectAs cap cap'; \ capMasterCap cap = capMasterCap cap'; \ isNullCap cap; \ isZombie cap; \ isUntypedCap cap; @@ -235,7 +236,7 @@ lemma sameObjectAs_sameRegionAs: "sameObjectAs cap cap' \ sameRegionAs cap cap'" by (clarsimp simp add: sameObjectAs_def2 sameRegionAs_def2 isCap_simps) -lemma sameObjectAs_sym[CSpace_I_2_assms]: +lemma sameObjectAs_sym[Arch_assms]: "sameObjectAs c d = sameObjectAs d c" by (auto simp: sameObjectAs_def2) @@ -245,17 +246,17 @@ lemma sameObject_capRange: apply (clarsimp simp: sameObjectAs_def2) done -lemma sameRegionAs_Null[CSpace_I_2_assms, simp]: +lemma sameRegionAs_Null[Arch_assms, simp]: "sameRegionAs c NullCap = False" "sameRegionAs NullCap c = False" by (simp add: sameRegionAs_def3 capRange_def isCap_simps)+ -lemma sameRegionAs_classes[CSpace_I_2_assms]: +lemma sameRegionAs_classes[Arch_assms]: "sameRegionAs cap cap' \ capClass cap = capClass cap'" by (erule sameRegionAsE, rule master_eqI) (clarsimp simp: capRange_def isCap_simps intro!: capClass_Master split: if_split_asm)+ -lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: +lemma sameRegionAs_capRange_Int[Arch_assms]: "\ sameRegionAs cap cap'; capClass cap = PhysicalClass \ capClass cap' = PhysicalClass; capAligned cap; capAligned cap' \ \ capRange cap' \ capRange cap \ {}" @@ -267,26 +268,26 @@ lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: apply (fastforce simp: capRange_Master isCap_simps)+ done -lemma sameRegionAs_trans[CSpace_I_2_assms]: +lemma sameRegionAs_trans[Arch_assms]: "\ sameRegionAs a b; sameRegionAs b c \ \ sameRegionAs a c" by (simp add: sameRegionAs_def2, elim conjE disjE) (auto simp: isCap_simps capRange_def) (* long *) -lemma capMasterCap_maskCapRights[simp, CSpace_I_2_assms]: +lemma capMasterCap_maskCapRights[simp, Arch_assms]: "capMasterCap (maskCapRights msk cap) = capMasterCap cap" apply (cases cap; simp add: global.maskCapRights_def Let_def isCap_simps capMasterCap_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: ARM_HYP_H.maskCapRights_def Let_def isCap_simps) done -lemma capBadge_maskCapRights[simp, CSpace_I_2_assms]: +lemma capBadge_maskCapRights[simp, Arch_assms]: "capBadge (maskCapRights msk cap) = capBadge cap" apply (cases cap; simp add: global.maskCapRights_def Let_def gen_isCap_simps capBadge_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: ARM_HYP_H.maskCapRights_def Let_def isCap_simps) done -lemma cte_refs_capRange[CSpace_I_2_assms]: +lemma cte_refs_capRange[Arch_assms]: "\ s \' c; \irq. c \ IRQHandlerCap irq \ \ cte_refs' c x \ capRange c" apply (cases c; simp add: capRange_def gen_isCap_simps) apply (clarsimp dest!: valid_capAligned @@ -357,15 +358,15 @@ lemma cte_refs_capRange[CSpace_I_2_assms]: apply (simp add: word_bits_def) done -lemma capBits_Master[CSpace_I_2_assms]: +lemma capBits_Master[Arch_assms]: "capBits (capMasterCap cap) = capBits cap" by (clarsimp simp: capMasterCap_def split: capability.split arch_capability.split) -lemma capUntyped_Master[CSpace_I_2_assms]: +lemma capUntyped_Master[Arch_assms]: "capUntypedPtr (capMasterCap cap) = capUntypedPtr cap" by (clarsimp simp: capMasterCap_def ARM_HYP_H.capUntypedPtr_def split: capability.split arch_capability.split) -lemma distinct_zombies_copyMasterE[CSpace_I_2_assms]: +lemma distinct_zombies_copyMasterE[Arch_assms]: "\ distinct_zombies m; m x = Some cte; capClass (cteCap cte') = PhysicalClass \ capMasterCap (cteCap cte) = capMasterCap (cteCap cte'); @@ -387,19 +388,20 @@ lemmas distinct_zombies_sameMasterE = distinct_zombies_copyMasterE[where x=x and y=x for x, simplified, OF _ _ _] -declare distinct_zombies_sameMasterE[CSpace_I_2_assms] +declare distinct_zombies_sameMasterE[Arch_assms] -lemma cap_table_at_gsCNodes_eq[CSpace_I_2_assms]: +lemma cap_table_at_gsCNodes_eq[Arch_assms]: "(s, s') \ state_relation \ (gsCNodes s' ptr = Some bits) = cap_table_at bits ptr s" by (fastforce simp: state_relation_def ghost_relation_def obj_at_def is_cap_table) -end +lemmas CSpace_I_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I_2?: CSpace_I_2 ARM_HYP.arch_capMasterCap ARM_HYP.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace_I_2_assms)?)?) qed (* Arch constant definitions required to exist for sane locales in CSpace1_R *) diff --git a/proof/refine/ARM_HYP/ArchCSpace_R.thy b/proof/refine/ARM_HYP/ArchCSpace_R.thy index a888b194fd..18ec125c34 100644 --- a/proof/refine/ARM_HYP/ArchCSpace_R.thy +++ b/proof/refine/ARM_HYP/ArchCSpace_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R locale *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = arch_deriveCap_corres arch_deriveCap_inv arch_deriveCap_valid (* does not work well as simp rule *) @@ -24,7 +24,7 @@ lemma capMasterCap_isArchSGISignalCap: by (auto simp: capMasterCap_def arch_capMasterCap_def isCap_simps split: capability.splits arch_capability.splits) -lemma capAligned_master[CSpace_R_assms]: +lemma capAligned_master[Arch_assms]: "\capAligned cap; capMasterCap cap = capMasterCap ncap\ \ capAligned ncap" apply (case_tac cap) apply (clarsimp simp: capAligned_def)+ @@ -42,7 +42,7 @@ sublocale updateCap: typ_at_props' "updateCap slot newCap" sublocale cteInsert: typ_at_props' "cteInsert newCap srcSlot destSlot" by typ_at_props' -lemma maskedAsFull_derived'[CSpace_R_assms]: +lemma maskedAsFull_derived'[Arch_assms]: "\m src = Some (CTE s_cap s_node); is_derived' m ptr b c\ \ is_derived' (m(src \ CTE (maskedAsFull s_cap cap) s_node)) ptr b c" apply (subgoal_tac "m(src \ CTE (maskedAsFull s_cap cap) s_node) @@ -57,21 +57,21 @@ lemma maskedAsFull_derived'[CSpace_R_assms]: apply (clarsimp simp:modify_map_def) done -lemma capMaster_capRange[CSpace_R_assms]: +lemma capMaster_capRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ capRange c = capRange c'" by (simp add: capMasterCap_def arch_capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_untypedRange[CSpace_R_assms]: +lemma capMaster_untypedRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ untypedRange c = untypedRange c'" by (simp add: capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_capClass[CSpace_R_assms]: +lemma capMaster_capClass[Arch_assms]: "capMasterCap c = capMasterCap c' \ capClass c = capClass c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma valid_arch_badges_mdbPrev_update[simp, CSpace_R_assms]: +lemma valid_arch_badges_mdbPrev_update[simp, Arch_assms]: "valid_arch_badges cap cap' (mdbPrev_update f node) = valid_arch_badges cap cap' node" by (simp add: valid_arch_badges_def) @@ -80,19 +80,19 @@ lemma valid_arch_badges_master_eq: valid_arch_badges src_cap cap' node = valid_arch_badges cap cap' node" by (auto simp: valid_arch_badges_def isCap_simps) -lemma valid_arch_badges_firstBadged[CSpace_R_assms]: +lemma valid_arch_badges_firstBadged[Arch_assms]: "\ valid_arch_badges cap cap' node; mdbFirstBadged node = mdbFirstBadged node' \ \ valid_arch_badges cap cap' node'" by (simp add: valid_arch_badges_def) -lemma valid_arch_badges_master[CSpace_R_assms]: +lemma valid_arch_badges_master[Arch_assms]: "\capMasterCap src_cap = capMasterCap cap; (capBadge src_cap, capBadge cap) \ capBadge_ordering False; valid_arch_badges src_cap cap' node\ \ valid_arch_badges cap cap' node" by (clarsimp simp: valid_arch_badges_def isCap_simps) -lemma badge_derived'_capRange[CSpace_R_assms]: +lemma badge_derived'_capRange[Arch_assms]: "badge_derived' cap src_cap \ capRange cap = capRange src_cap" apply (clarsimp simp: badge_derived'_def) apply (case_tac cap; clarsimp simp: gen_isCap_simps capRange_def) @@ -100,11 +100,11 @@ lemma badge_derived'_capRange[CSpace_R_assms]: apply (case_tac arch_capability; clarsimp simp: isCap_simps capRange_def) done -lemma valid_arch_badges_non_arch[CSpace_R_assms]: +lemma valid_arch_badges_non_arch[Arch_assms]: "\ \isArchObjectCap c; \isArchObjectCap c' \ \ valid_arch_badges c c' node" by (clarsimp simp add: valid_arch_badges_def isCap_simps) -lemma capMasterCap_valid_arch_badges_isCapRevocable[CSpace_R_assms]: +lemma capMasterCap_valid_arch_badges_isCapRevocable[Arch_assms]: "capMasterCap src_cap = capMasterCap cap \ valid_arch_badges src_cap cap (MDB word1 src (Arch.isCapRevocable cap src_cap) (Arch.isCapRevocable cap src_cap))" @@ -143,7 +143,7 @@ lemma setCTE_ko_at'_pde[wp]: Structures_H.kernel_object.split_asm) done -lemma setCTE_valid_arch[CSpace_R_assms, wp]: +lemma setCTE_valid_arch[Arch_assms, wp]: "setCTE p c \valid_arch_state'\" apply (wp valid_arch_state_lift' setCTE_typ_at') apply (simp add: setCTE_def) @@ -156,7 +156,7 @@ lemma setCTE_valid_arch[CSpace_R_assms, wp]: apply assumption done -lemma setCTE_global_refs[CSpace_R_assms, wp]: +lemma setCTE_global_refs[Arch_assms, wp]: "setCTE p c \\s. P (global_refs' s)\" apply (simp add: setCTE_def setObject_def split_def updateObject_cte global_refs'_def) apply (wpsimp+; auto) @@ -167,14 +167,14 @@ crunch cteInsert (wp: crunch_wps simp: cte_wp_at_ctes_of) crunch cteInsert - for valid_arch_state'[CSpace_R_assms, wp]: valid_arch_state' + for valid_arch_state'[Arch_assms, wp]: valid_arch_state' (wp: crunch_wps) -lemma acapClass_not_Reply[CSpace_R_assms]: +lemma acapClass_not_Reply[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) -lemma isArchMDBParentOf_non_arch[CSpace_R_assms]: +lemma isArchMDBParentOf_non_arch[Arch_assms]: "\isArchObjectCap cap \ isArchMDBParentOf cap cap' b" "\isArchObjectCap cap' \ isArchMDBParentOf cap cap' b" by (simp add: isArchMDBParentOf_def2 isCap_simps)+ @@ -343,29 +343,30 @@ context Arch begin arch_global_naming (* since these are not used after this theory, drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = Arch_mdb_insert.chunked_n[simplified Arch_mdb_insert_def] Arch_mdb_insert_sib.untyped_inc_n[simplified Arch_mdb_insert_sib_def] Arch_mdb_move.parent_preserved[simplified Arch_mdb_move_def] Arch_mdb_move.children_preserved[simplified Arch_mdb_move_def] -lemma cteInsert_pspace_in_kernel_mappings'[CSpace_R_assms]: +lemma cteInsert_pspace_in_kernel_mappings'[Arch_assms]: "cteInsert cap src dest \pspace_in_kernel_mappings'\" by wp -end +lemmas CSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R?: CSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_2 locale *) -lemma deriveCap_derived[CSpace_R_2_assms]: +lemma deriveCap_derived[Arch_assms]: "\\s. c'\ capability.NullCap \ cte_wp_at' (\cte. badge_derived' c' (cteCap cte) \ capASID c' = capASID (cteCap cte) \ cap_asid_base' c' = cap_asid_base' (cteCap cte) @@ -395,7 +396,7 @@ lemma deriveCap_derived[CSpace_R_2_assms]: | clarsimp split: option.split_asm)+) done -lemma arch_deriveCap_untyped_derived[CSpace_R_2_assms, wp]: +lemma arch_deriveCap_untyped_derived[Arch_assms, wp]: "\\s. cte_wp_at' (\cte. untyped_derived_eq c' (cteCap cte)) slot s\ ARM_HYP_H.deriveCap slot (capCap c') \\rv s. cte_wp_at' (untyped_derived_eq rv o cteCap) slot s\, -" @@ -437,7 +438,7 @@ crunch setupReplyMaster for valid_arch'[wp]: "valid_arch_state'" (wp: crunch_wps simp: crunch_simps) -lemma ex_nonz_tcb_cte_caps'[CSpace_R_2_assms]: +lemma ex_nonz_tcb_cte_caps'[Arch_assms]: "\ex_nonz_cap_to' t s; tcb_at' t s; valid_objs' s; sl \ dom tcb_cte_cases\ \ ex_cte_cap_to' (t + sl) s" apply (clarsimp simp: ex_nonz_cap_to'_def ex_cte_cap_to'_def cte_wp_at_ctes_of) @@ -467,7 +468,7 @@ lemma ex_nonz_cap_not_global': apply (clarsimp simp: ctes_of_valid_cap') done -lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: +lemma setupReplyMaster_invs'[Arch_assms, wp]: "\invs' and tcb_at' t and ex_nonz_cap_to' t\ setupReplyMaster t \\rv. invs'\" @@ -482,7 +483,7 @@ lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: ex_nonz_cap_not_global' dom_def) done -lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: +lemma arch_update_setCTE_mdb[Arch_assms]: "\cte_wp_at' (is_arch_update' cap) p and cte_wp_at' ((=) oldcte) p and valid_mdb'\ setCTE p (cteCap_update (\_. cap) oldcte) \\rv. valid_mdb'\" @@ -606,17 +607,17 @@ lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: apply (clarsimp simp add: is_arch_update'_def isCap_simps) done -lemma capMaster_zobj_refs[CSpace_R_2_assms]: +lemma capMaster_zobj_refs[Arch_assms]: "capMasterCap c = capMasterCap c' \ zobj_refs' c = zobj_refs' c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma zobj_refs_Master[CSpace_R_2_assms]: +lemma zobj_refs_Master[Arch_assms]: "zobj_refs' (capMasterCap cap) = zobj_refs' cap" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.split arch_capability.split) -lemma setCTE_pspace_in_kernel_mappings'[CSpace_R_2_assms]: +lemma setCTE_pspace_in_kernel_mappings'[Arch_assms]: "setCTE ptr val \pspace_in_kernel_mappings'\" by wp @@ -629,7 +630,7 @@ lemma valid_badges_IRQControlD: unfolding valid_badges_def by (fastforce simp: isCap_simps valid_arch_badges_def) -lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: +lemma setUntypedCapAsFull_safe_parent_for'[Arch_assms]: "\\s. safe_parent_for' (ctes_of s) slot a \ cte_wp_at' ((=) srcCTE) slot s\ setUntypedCapAsFull (cteCap srcCTE) c' slot \\rv s. safe_parent_for' (ctes_of s) slot a\" @@ -649,7 +650,7 @@ lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: apply simp done -lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: +lemma maskedAsFull_revokable_safe_parent[Arch_assms]: "\is_simple_cap' c'; safe_parent_for' m p c'; m p = Some cte; cteCap cte = (maskedAsFull src_cap' a)\ \ isCapRevocable c' (maskedAsFull src_cap' a) = isCapRevocable c' src_cap'" @@ -658,12 +659,12 @@ lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: apply (auto simp: isCap_simps is_simple_cap'_def) done -lemma setUntypedCapAsFull_archMDBAssertions[CSpace_R_2_assms, wp]: +lemma setUntypedCapAsFull_archMDBAssertions[Arch_assms, wp]: "setUntypedCapAsFull src_cap cap p \archMDBAssertions\" unfolding archMDBAssertions_def arch_mdb_assert_def by wp -lemma sameRegion_capRange_sub[CSpace_R_2_assms]: +lemma sameRegion_capRange_sub[Arch_assms]: "sameRegionAs cap cap' \ capRange cap' \ capRange cap" apply (clarsimp simp: sameRegionAs_def2 gen_isCap_Master arch_isCap_Master capRange_Master cong: conj_cong) @@ -671,7 +672,7 @@ lemma sameRegion_capRange_sub[CSpace_R_2_assms]: apply (fastforce simp: isCap_simps capRange_def split: if_split_asm) done -lemma capRange_sameRegionAs[CSpace_R_2_assms]: +lemma capRange_sameRegionAs[Arch_assms]: "\ sameRegionAs x y; s \' y; capClass x = PhysicalClass \ capClass y = PhysicalClass \ \ capRange x \ capRange y \ {}" apply (erule sameRegionAsE) @@ -688,7 +689,7 @@ lemma capRange_sameRegionAs[CSpace_R_2_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: +lemma safe_parent_for_capRange_capBits[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ capRange (cteCap cte) \ capBits cap \ capBits (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) @@ -698,7 +699,7 @@ lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: capMasterCap_def capRange_Master objBits_simps split: capability.splits arch_capability.splits) -lemma safe_parent_for_descendants'[CSpace_R_2_assms]: +lemma safe_parent_for_descendants'[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE pcap n); isUntypedCap pcap \ \ descendants_of' p m = {}" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) @@ -710,7 +711,7 @@ lemma safe_parent_not_ntfn': "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ \isNotificationCap src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) -lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_untypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ untypedRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -728,7 +729,7 @@ lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_capUntypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -743,14 +744,14 @@ lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_capClass[CSpace_R_2_assms]: +lemma safe_parent_capClass[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ capClass cap = capClass src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps sameRegionAs_def2 capRange_Master capRange_def capMasterCap_def split: capability.splits arch_capability.splits) (* Generic-only parts of is_simple_cap'. isArchFrameCap appears on all architectures and so is safe. *) -lemma is_simple_cap'_genD[CSpace_R_2_assms]: +lemma is_simple_cap'_genD[Arch_assms]: "is_simple_cap' cap \ cap \ NullCap \ cap \ IRQControlCap \ \ isUntypedCap cap \ \ isReplyCap cap \ \ isEndpointCap cap \ \ isNotificationCap cap \ \ isThreadCap cap \ \ isCNodeCap cap \ @@ -819,14 +820,15 @@ end context Arch begin arch_global_naming -lemmas [CSpace_R_2_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child +lemmas [Arch_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child -end +lemmas CSpace_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_2?: CSpace_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace_R_2_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales @@ -1159,17 +1161,17 @@ end (* Arch_mdb_insert_simple' *) context Arch begin arch_global_naming -named_theorems CSpace_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_3 locale *) (* since mdb_insert_simple' is not used after this theory, drop the Arch assumption directly instead of requalifying *) -lemmas [CSpace_R_3_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] +lemmas [Arch_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] -lemmas [CSpace_R_3_assms] = +lemmas [Arch_assms] = updateCap_valid_arch_state' master_cap_relation -lemma derived'_not_Null[CSpace_R_3_assms, simp]: +lemma derived'_not_Null[Arch_assms, simp]: "\ is_derived' m p c capability.NullCap" "\ is_derived' m p capability.NullCap c" by (clarsimp simp: is_derived'_def badge_derived'_def)+ @@ -1182,7 +1184,7 @@ lemma cte_refs_maskCapRights[simp]: split del: if_split split: arch_capability.split) -lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: +lemma ghost_relation_wrapper_set_cap_setCTE[Arch_assms]: "\ ghost_relation_wrapper a c; ((), c') \ fst (setCTE (cte_map slot) (cteCap_update (\_. cap') rv) c); ((), a') \ fst (set_cap cap slot a)\ @@ -1193,16 +1195,17 @@ lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: apply (frule use_valid[OF _ setCTE_gsCNodes]; simp) done -lemma updateMDB_pspace_in_kernel_mappings'[CSpace_R_3_assms]: +lemma updateMDB_pspace_in_kernel_mappings'[Arch_assms]: "updateMDB x f \pspace_in_kernel_mappings'\" by wp -end +lemmas CSpace_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_3?: CSpace_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.CSpace_R_3_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales diff --git a/proof/refine/ARM_HYP/ArchDetype_R.thy b/proof/refine/ARM_HYP/ArchDetype_R.thy index 5ba7a4b67a..320091df86 100644 --- a/proof/refine/ARM_HYP/ArchDetype_R.thy +++ b/proof/refine/ARM_HYP/ArchDetype_R.thy @@ -312,9 +312,9 @@ lemma ksASIDMapSafeI: apply simp done -named_theorems Detype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R locale *) -lemma deleteObjects_corres[Detype_R_assms]: +lemma deleteObjects_corres[Arch_assms]: "\ is_aligned base magnitude; magnitude \ word_size_bits \ \ corres dc (\s. einvs s @@ -504,7 +504,7 @@ context Arch begin arch_global_naming Not all of them need to deal with these arch details, so if the def2/def3 lemmas can be generalised or wrapped, some of the lemmas in this block can become generic. *) -lemma deleteObjects_null_filter[Detype_R_assms]: +lemma deleteObjects_null_filter[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -524,7 +524,7 @@ lemma deleteObjects_null_filter[Detype_R_assms]: apply (unfold_locales, simp_all) done -lemma deleteObjects_invs'[Detype_R_assms]: +lemma deleteObjects_invs'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -556,7 +556,7 @@ proof - done qed -lemma deleteObjects_st_tcb_at'[Detype_R_assms]: +lemma deleteObjects_st_tcb_at'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -611,7 +611,7 @@ lemma deleteObjects_cap_to': apply (simp add: delete_locale_def) done -lemma deleteObject_no_overlap[Detype_R_assms, wp]: +lemma deleteObject_no_overlap[Arch_assms, wp]: "\valid_cap' (UntypedCap d ptr bits idx) and valid_pspace'\ deleteObjects ptr bits \\_ s. pspace_no_overlap' ptr bits s\" @@ -630,7 +630,7 @@ lemma deleteObject_no_overlap[Detype_R_assms, wp]: apply simp done -lemma deleteObjects_cte_wp_at'[Detype_R_assms]: +lemma deleteObjects_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ p \ mask_range ptr bits \ s \' (UntypedCap d ptr bits idx) \ valid_pspace' s\ deleteObjects ptr bits @@ -649,13 +649,13 @@ lemma deleteObjects_cte_wp_at'[Detype_R_assms]: apply (case_tac s, simp) done -lemma deleteObjects_nosch[wp, Detype_R_assms]: +lemma deleteObjects_nosch[wp, Arch_assms]: "deleteObjects ptr sz \\s. P (ksSchedulerAction s)\" by (simp add: deleteObjects_def3 | wp hoare_drop_imp)+ lemmas getObjSize_simps = ARM_HYP_H.getObjectSize_def[split_simps ARM_HYP_H.object_type.split apiobject_type.split] -lemma createObject_cte_wp_at'[Detype_R_assms]: +lemma createObject_cte_wp_at'[Arch_assms]: "\\s. Types_H.getObjectSize ty us < word_bits \ is_aligned ptr (Types_H.getObjectSize ty us) \ pspace_no_overlap' ptr (Types_H.getObjectSize ty us) s \ @@ -1091,7 +1091,7 @@ lemma placeNewObject_pd_at': apply simp done -lemma createObject_setCTE_commute[Detype_R_assms]: +lemma createObject_setCTE_commute[Arch_assms]: "monad_commute (cte_wp_at' (\_. True) src and pspace_aligned' and pspace_distinct' and @@ -1169,7 +1169,7 @@ lemma copyGlobalMappings_gsUntypedZeroRanges_commute': (modify (\s. s \ gsUntypedZeroRanges := f (gsUntypedZeroRanges s) \ ))" by (simp add: copyGlobalMappings_def monad_commute_guard_imp return_commute) -lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: +lemma createObject_gsUntypedZeroRanges_commute[Arch_assms]: "monad_commute \ (RetypeDecls_H.createObject ty ptr us dev) @@ -1193,24 +1193,25 @@ lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: apply (simp add: curDomain_def monad_commute_def exec_modify exec_gets) done -lemma createNewCaps_not_nc[Detype_R_assms]: +lemma createNewCaps_not_nc[Arch_assms]: "\\\ createNewCaps ty ptr n us d \\r s. (\cap\set r. cap \ capability.NullCap)\" unfolding createNewCaps_def Arch_createNewCaps_def by (wpsimp simp: Arch_createNewCaps_def split_del: if_split)+ +lemmas Detype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R?: Detype_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Detype_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Detype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R_2 locale *) lemma copyGlobalMappings_pspace_no_overlap': "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\ @@ -1222,7 +1223,7 @@ lemma copyGlobalMappings_pspace_no_overlap': apply clarsimp done -lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: +lemma createNewCaps_pspace_no_overlap'[Arch_assms]: "\\s. range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n)) \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ ptr \ 0\ @@ -1284,7 +1285,7 @@ lemma mapM_x_copyGlobalMappings_noop: apply (simp add: mapM_x_Cons copyGlobalMappings_def) done -lemma createNewCaps_ret_len[Detype_R_2_assms]: +lemma createNewCaps_ret_len[Arch_assms]: "\K (n < 2 ^ word_bits \ n \ 0)\ createNewCaps ty ptr n us d \\rv s. n = length rv\" @@ -1338,7 +1339,7 @@ lemma createObjects'_page_directory_at': apply (case_tac arch_kernel_object; simp) done -lemma createNewCaps_Cons[Detype_R_2_assms]: +lemma createNewCaps_Cons[Arch_assms]: assumes cover:"range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n))" and "valid_pspace' s" "valid_arch_state' s" and "pspace_no_overlap' ptr sz s" @@ -1634,7 +1635,7 @@ proof - done qed -lemma createObject_def2[Detype_R_2_assms]: +lemma createObject_def2[Arch_assms]: "(RetypeDecls_H.createObject ty ptr us dev >>= (\x. return [x])) = createNewCaps ty ptr (Suc 0) us dev" apply (clarsimp simp: global.createObject_def createNewCaps_def placeNewObject_def2) @@ -1654,7 +1655,7 @@ lemma createObject_def2[Detype_R_2_assms]: storeWordVM_def)+ done -lemma ArchCreateObject_pspace_no_overlap'[Detype_R_2_assms]: +lemma ArchCreateObject_pspace_no_overlap'[Arch_assms]: "\\s. pspace_no_overlap' (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \ pspace_aligned' s \ pspace_distinct' s \ @@ -1730,12 +1731,13 @@ lemma createObject_pspace_aligned_distinct': split: ARM_HYP_H.object_type.splits apiobject_type.splits) done +lemmas Detype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R_2?: Detype_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Detype_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchEmptyFail.thy b/proof/refine/ARM_HYP/ArchEmptyFail.thy index 464f988c90..15dd66cb39 100644 --- a/proof/refine/ARM_HYP/ArchEmptyFail.thy +++ b/proof/refine/ARM_HYP/ArchEmptyFail.thy @@ -10,21 +10,22 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_R locale *) -lemma empty_fail_lookupIPCBuffer[EmptyFail_R_assms]: +lemma empty_fail_lookupIPCBuffer[Arch_assms]: "empty_fail (lookupIPCBuffer r t)" by (clarsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv split: capability.splits arch_capability.splits | wp | wpc | safe)+ declare setRegister_empty_fail[intro!, simp] (* FIXME: tag original instead *) -end +lemmas EmptyFail_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation EmptyFail_R?: EmptyFail_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact EmptyFail_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.EmptyFail_R_assms)?) qed end diff --git a/proof/refine/ARM_HYP/ArchEmptyFail_H.thy b/proof/refine/ARM_HYP/ArchEmptyFail_H.thy index 6f076650bd..675ed23a63 100644 --- a/proof/refine/ARM_HYP/ArchEmptyFail_H.thy +++ b/proof/refine/ARM_HYP/ArchEmptyFail_H.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H locale *) -lemma arch_deriveCap_empty_fail[EmptyFail_H_assms, intro!, wp, simp]: +lemma arch_deriveCap_empty_fail[Arch_assms, intro!, wp, simp]: "empty_fail (Arch.deriveCap x y)" unfolding ARM_HYP_H.deriveCap_def by (cases y, auto simp: isCap_simps cong: if_cong) @@ -35,7 +35,7 @@ lemma empty_fail_getObject_vcpu[intro!, wp, simp]: by (simp add: empty_fail_getObject) crunch decodeARMMMUInvocation, Arch_postCapDeletion, setRegister, prepareThreadDelete - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def ARMMMU_improve_cases wp: empty_fail_catch rule: ARM_HYP_H.postCapDeletion_def) @@ -47,7 +47,7 @@ crunch vcpuEnable, vcpuRestore crunch Arch_finaliseCap, Arch.switchToThread, Arch.switchToIdleThread, prepareNextDomain, getRestartPC, makeArchFaultMessage - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (rule: ARM_HYP_H.finaliseCap_def ignore: get_gic_vcpu_ctrl_vmcr get_gic_vcpu_ctrl_apr) @@ -58,32 +58,34 @@ crunch handleArchFaultReply, prepareSetDomain, postModifyRegisters, postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler, Arch.performInvocation, handleSpuriousIRQ, maskIrqSignal, handleVMFault, checkIRQ, prepareThreadDelete, Arch.postCapDeletion - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H?: EmptyFail_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.EmptyFail_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems EmptyFail_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H_2 locale *) crunch handleReservedIRQ, handleHypervisorFault - for (empty_fail) empty_fail[EmptyFail_H_2_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H_2?: EmptyFail_H_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.EmptyFail_H_2_assms)?)?) qed crunch callKernel diff --git a/proof/refine/ARM_HYP/ArchFinalise_R.thy b/proof/refine/ARM_HYP/ArchFinalise_R.thy index b2a6741538..d9c92e2a21 100644 --- a/proof/refine/ARM_HYP/ArchFinalise_R.thy +++ b/proof/refine/ARM_HYP/ArchFinalise_R.thy @@ -12,13 +12,13 @@ begin context Arch begin arch_global_naming -named_theorems Finalise_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R locale *) lemma isArchSGISignalCap_NullCap[simp]: "\isArchSGISignalCap NullCap" by (simp add: isCap_simps) -lemma arch_postCapDeletion_ksArchState_lift[Finalise_R_assms]: +lemma arch_postCapDeletion_ksArchState_lift[Arch_assms]: "\\s as. P (s\ksArchState := as\) = P s\ \ Arch.postCapDeletion ac \P\" unfolding postCapDeletion_def by wpsimp @@ -27,7 +27,7 @@ sublocale clearUntypedFreeIndex: typ_at_props' "clearUntypedFreeIndex slot" by typ_at_props' crunch setIRQState - for umm[Finalise_R_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" + for umm[Arch_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" (wp: dmo_lift' simp: maskInterrupt_def) (* better crunch names for Arch.postCapDeletion *) @@ -39,7 +39,7 @@ crunch Arch_postCapDeletion and valid_arch_state'[wp]: valid_arch_state' (rule: ARM_HYP_H.postCapDeletion_def) -lemma arch_postCapDeletion_corres[Finalise_R_assms]: +lemma arch_postCapDeletion_corres[Arch_assms]: "acap_relation cap cap' \ corres dc \ \ (arch_post_cap_deletion cap) (ARM_HYP_H.postCapDeletion cap')" by (clarsimp simp: arch_post_cap_deletion_def ARM_HYP_H.postCapDeletion_def) @@ -48,16 +48,16 @@ abbreviation (input) "Arch_finaliseCap \ Arch.finaliseCap" crunch Arch_finaliseCap, prepareThreadDelete - for typ_at'[Finalise_R_assms, wp]: "\s. P (typ_at' T p s)" - and aligned'[Finalise_R_assms, wp]: "pspace_aligned'" - and distinct'[Finalise_R_assms, wp]: "pspace_distinct'" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" + and aligned'[Arch_assms, wp]: "pspace_aligned'" + and distinct'[Arch_assms, wp]: "pspace_distinct'" (wp: crunch_wps getObject_inv loadObject_default_inv simp: crunch_simps unless_def o_def ignore_del: setObject rule: ARM_HYP_H.finaliseCap_def) crunch prepareThreadDelete, Arch_finaliseCap - for it'[Finalise_R_assms, wp]: "\s. P (ksIdleThread s)" + for it'[Arch_assms, wp]: "\s. P (ksIdleThread s)" (wp: hoare_drop_imps mapM_wp simp: crunch_simps updateObject_default_def rule: ARM_HYP_H.finaliseCap_def) @@ -78,6 +78,8 @@ definition post_cap_delete_pre' :: "capability \ paddr \ IRQHandlerCap irq \ irq \ maxIRQ \ (\sl'. sl \ sl' \ cs sl' \ Some cap) | _ \ False" +lemmas Finalise_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -420,15 +422,14 @@ end (* mdb_empty *) interpretation Finalise_R?: Finalise_R arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Finalise_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Finalise_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_2 locale *) -lemma not_Final_removeable[Finalise_R_2_assms]: +lemma not_Final_removeable[Arch_assms]: "\ isFinal cap sl (cteCaps_of s) \ removeable' sl s cap" apply (erule not_FinalE) apply (clarsimp simp: removeable'_def gen_isCap_simps) @@ -437,7 +438,7 @@ lemma not_Final_removeable[Finalise_R_2_assms]: apply fastforce done -lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: +lemma deletedIRQHandler_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ deletedIRQHandler irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -451,7 +452,7 @@ lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: apply (clarsimp simp: valid_refs'_cteCaps valid_cap_sizes_cteCaps ball_ran_eq) done -lemma clearUntypedFreeIndex_valid_global_refs[Finalise_R_2_assms, wp]: +lemma clearUntypedFreeIndex_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ clearUntypedFreeIndex irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -497,7 +498,7 @@ lemma final_matters_mdb_chunked_arch_assms: by (clarsimp simp: mdb_chunked_arch_assms_def isCap_simps final_matters'_def arch_final_matters'_def) -lemma notFinal_prev_or_next[Finalise_R_2_assms]: +lemma notFinal_prev_or_next[Arch_assms]: "\ \ isFinal cap x (cteCaps_of s); mdb_chunked (ctes_of s); valid_dlist (ctes_of s); no_0 (ctes_of s); ctes_of s x = Some (CTE cap node); final_matters' cap \ @@ -544,12 +545,12 @@ lemma notFinal_prev_or_next[Finalise_R_2_assms]: apply (clarsimp simp: sameObjectAs_def3 simp del: isArchFrameCap_capMasterCap) done -lemma sameObjectAs_not_Untyped[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap \ \ \ isUntypedCap cap'" by (clarsimp simp: gen_isCap_simps sameObjectAs_def3) -lemma sameObjectAs_not_Untyped'[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped'[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap' \ \ global.sameObjectAs cap' cap" by (clarsimp simp: isCap_simps sameObjectAs_def3) @@ -601,7 +602,7 @@ lemma (in vmdb) isFinal_untypedParent: context Arch begin arch_global_naming -lemma isFinal_no_descendants[Finalise_R_2_assms]: +lemma isFinal_no_descendants[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); ctes_of s sl = Some (CTE cap n); valid_mdb' s; final_matters' cap \ \ descendants_of' sl (ctes_of s) = {}" @@ -984,7 +985,7 @@ lemma dissociateVCPUTCB_invs'[wp]: lemma vcpuFinalise_invs'[wp]: "vcpuFinalise vcpu \invs'\" unfolding vcpuFinalise_def by wpsimp -lemma arch_finaliseCap_invs[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_invs[Arch_assms, wp]: "\invs' and valid_cap' (ArchObjectCap cap)\ Arch.finaliseCap cap fin \\rv. invs'\" unfolding ARM_HYP_H.finaliseCap_def Let_def by wpsimp @@ -1092,16 +1093,16 @@ sublocale dissociateVCPUTCB: typ_at_props' "dissociateVCPUTCB vcpu tcb" by typ_at_props' crunch Arch.finaliseCap, prepareThreadDelete - for irq_node'[Finalise_R_2_assms, wp]: "\s. P (irq_node' s)" + for irq_node'[Arch_assms, wp]: "\s. P (irq_node' s)" (wp: crunch_wps getObject_inv loadObject_default_inv updateObject_default_inv setObject_ksInterrupt simp: crunch_simps o_def) -lemmas Arch_finaliseCap_irq_node'[Finalise_R_2_assms] = ArchRetypeDecls_H_ARM_HYP_H_finaliseCap_irq_node' +lemmas Arch_finaliseCap_irq_node'[Arch_assms] = ArchRetypeDecls_H_ARM_HYP_H_finaliseCap_irq_node' crunch prepareThreadDelete - for cte_wp_at'[Finalise_R_2_assms, wp]: "cte_wp_at' P p" - and valid_cap'[Finalise_R_2_assms, wp]: "valid_cap' cap" + for cte_wp_at'[Arch_assms, wp]: "cte_wp_at' P p" + and valid_cap'[Arch_assms, wp]: "valid_cap' cap" lemma unset_vcpu_hyp_unlive[wp]: "\\\ archThreadSet (atcbVCPUPtr_update Map.empty) t \\_. ko_wp_at' (Not \ hyp_live') t\" @@ -1149,7 +1150,7 @@ lemma prepareThreadDelete_hyp_unlive[wp]: done crunch prepareThreadDelete - for invs[Finalise_R_2_assms, wp]: "invs'" + for invs[Arch_assms, wp]: "invs'" (ignore: doMachineOp simp: crunch_simps) lemma archThreadSet_tcbSchedPrevNext[wp]: @@ -1188,34 +1189,35 @@ crunch vcpuFinalise for cte_wp_at'[wp]: "cte_wp_at' P p" (wp: crunch_wps getObject_inv loadObject_default_inv) -lemma arch_finaliseCap_cte_wp_at[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cte_wp_at[Arch_assms, wp]: "\cte_wp_at' P p\ Arch.finaliseCap cap fin \\rv. cte_wp_at' P p\" unfolding ARM_HYP_H.finaliseCap_def by (wpsimp wp: unmapPage_cte_wp_at'|rule conjI)+ -lemma finaliseCap_valid_cap[Finalise_R_2_assms, wp]: +lemma finaliseCap_valid_cap[Arch_assms, wp]: "\\\ Arch.finaliseCap cap final \\rv. valid_cap' (fst rv)\" by (wpsimp simp: ARM_HYP_H.finaliseCap_def split_del: if_split) -lemma arch_finaliseCap_cases[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cases[Arch_assms, wp]: "\\\ Arch.finaliseCap v0 final \\rv s. fst rv = capability.NullCap \ (snd rv \ capability.NullCap \ final \ arch_cap_has_cleanup' v0 \ snd rv = capability.ArchObjectCap v0)\" by (wpsimp simp: ARM_HYP_H.finaliseCap_def split_del: if_split) -lemmas [Finalise_R_2_assms] = +lemmas [Arch_assms] = cancelAllIPC_cte_wp_at' cancelAllSignals_cte_wp_at' unbindMaybeNotification_cte_wp_at' prepareThreadDelete_cte_wp_at' unbindNotification_cte_wp_at' Arch_postCapDeletion_valid_global_refs Arch_postCapDeletion_valid_arch_state' mdb_empty.vmdb_n mdb_empty.descendants not_Final_removeable +lemmas Finalise_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Finalise_R_2?: Finalise_R_2 arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Finalise_R_2_assms)?)?) qed (* This is the only arch-specific lemma in delete_one_conc_pre so far; @@ -1282,13 +1284,13 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable: context Arch begin arch_global_naming -named_theorems Finalise_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_3 locale *) -lemma finaliseCap_cte_refs[Finalise_R_3_assms]: +lemma finaliseCap_cte_refs[Arch_assms]: "\\s. s \' cap\ finaliseCap cap final flag \\rv s. fst rv \ NullCap \ cte_refs' (fst rv) = cte_refs' cap\" - apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot finaliseCap_def + apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot ARM_HYP_H.finaliseCap_def cong: if_cong split del: if_split) apply (rule hoare_pre) apply (wp | wpc | simp only: o_def)+ @@ -1301,7 +1303,7 @@ lemma finaliseCap_cte_refs[Finalise_R_3_assms]: apply (fastforce simp: mask_def capAligned_def gen_objBits_simps shiftL_nat) done -lemma emptySlot_invs'[Finalise_R_3_assms, wp]: +lemma emptySlot_invs'[Arch_assms, wp]: "\\s. invs' s \ cte_wp_at' (\cte. removeable' sl s (cteCap cte)) sl s \ (info \ NullCap \ post_cap_delete_pre' info sl (cteCaps_of s))\ emptySlot sl info @@ -1312,7 +1314,7 @@ lemma emptySlot_invs'[Finalise_R_3_assms, wp]: split: capability.split_asm) by auto -lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: +lemma cteDeleteOne_invs[Arch_assms, wp]: "cteDeleteOne ptr \invs'\" apply (simp add: cteDeleteOne_def unless_def split_def finaliseCapTrue_standin_simple_def) @@ -1333,7 +1335,7 @@ lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: apply (fastforce simp: cte_wp_at_ctes_of) done -lemma isFinalCapability_corres'[Finalise_R_3_assms]: +lemma isFinalCapability_corres'[Arch_assms]: "final_matters' (cteCap cte) \ corres (=) (invs and cte_wp_at ((=) cap) ptr) (invs' and cte_wp_at' ((=) cte) (cte_map ptr)) @@ -1434,7 +1436,7 @@ crunch dissociateVCPUTCB, unmapPageTable crunch Arch_finaliseCap, prepareThreadDelete for nosch[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Finalise_R_3_assms, wp]: sch_act_simple + and sch_act_simple[Arch_assms, wp]: sch_act_simple (wp: crunch_wps getObject_inv simp: loadObject_default_def updateObject_default_def rule: ARM_HYP_H.finaliseCap_def sch_act_simple_lift cong: if_cong) @@ -1468,7 +1470,7 @@ lemma vcpuFinalise_corres[corres]: apply (fastforce elim: vcpu_at_cross) done -lemma arch_finaliseCap_corres[Finalise_R_3_assms]: +lemma arch_finaliseCap_corres[Arch_assms]: "\ final_matters' (ArchObjectCap cap') \ final = final'; acap_relation cap cap' \ \ corres (\r r'. cap_relation (fst r) (fst r') \ cap_relation (snd r) (snd r')) (\s. invs s \ s \ cap.ArchObjectCap cap @@ -1505,14 +1507,15 @@ lemma arch_finaliseCap_corres[Finalise_R_3_assms]: sublocale deleteCallerCap: typ_at_props' "deleteCallerCap receiver" by typ_at_props' +lemmas Finalise_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts post_cap_delete_pre' interpretation Finalise_R_3?: Finalise_R_3 arch_final_matters' arch_cap_has_cleanup' post_cap_delete_pre' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Finalise_R_3_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchInit_R.thy b/proof/refine/ARM_HYP/ArchInit_R.thy index 4c442825cb..a81f61b0c2 100644 --- a/proof/refine/ARM_HYP/ArchInit_R.thy +++ b/proof/refine/ARM_HYP/ArchInit_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Init_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Init_R locale *) definition zeroed_arch_abstract_state :: arch_state where "zeroed_arch_abstract_state \ \ @@ -29,23 +29,24 @@ definition zeroed_arch_intermediate_state :: Arch.kernel_state where ARMKernelState Map.empty Map.empty 0 Map.empty None 0 0 (K ArmVSpaceUserRegion)" (* the None maps are a result of unfolding zeroed_main_abstract_state *) -lemma ghost_relation_wrapper_arch_intermediate_state[Init_R_assms]: +lemma ghost_relation_wrapper_arch_intermediate_state[Arch_assms]: "ghost_relation_wrapper_2 (\_. None) (\_. None) (\_. None) zeroed_arch_intermediate_state" unfolding ghost_relation_wrapper_def ghost_relation_def zeroed_arch_intermediate_state_def by simp -lemma non_empty_refine_arch_state_relation[Init_R_assms]: +lemma non_empty_refine_arch_state_relation[Arch_assms]: "(zeroed_arch_abstract_state, zeroed_arch_intermediate_state) \ arch_state_relation Map.empty" unfolding zeroed_arch_abstract_state_def zeroed_arch_intermediate_state_def arch_state_relation_def by simp +lemmas Init_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Init_R?: Init_R ARM_HYP.zeroed_arch_abstract_state ARM_HYP.zeroed_arch_intermediate_state proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Init_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Init_R_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchInterrupt_R.thy b/proof/refine/ARM_HYP/ArchInterrupt_R.thy index ef6e9f34e5..22eb41ddbe 100644 --- a/proof/refine/ARM_HYP/ArchInterrupt_R.thy +++ b/proof/refine/ARM_HYP/ArchInterrupt_R.thy @@ -13,17 +13,17 @@ begin context Arch begin arch_global_naming -named_theorems Interrupt_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R locale *) -lemma maxIRQ_H_ucast_toEnum_eq_irq[Interrupt_R_assms]: +lemma maxIRQ_H_ucast_toEnum_eq_irq[Arch_assms]: "x \ ucast maxIRQ \ toEnum (unat x) = (ucast x :: irq)" for x::machine_word by (simp add: maxIRQ_ucast_toEnum_eq_irq maxIRQ_def) -lemma arch_valid_irq_le_maxIRQ[Interrupt_R_assms]: +lemma arch_valid_irq_le_maxIRQ[Arch_assms]: "arch_valid_irq irq \ irq \ maxIRQ" by simp -lemma arch_valid_irq_valid_IRQHandlerCap[Interrupt_R_assms]: +lemma arch_valid_irq_valid_IRQHandlerCap[Arch_assms]: "arch_valid_irq irq \ valid_cap' (capability.IRQHandlerCap irq) s" by (simp add: valid_cap'_def capAligned_def) @@ -46,7 +46,7 @@ primrec arch_irq_control_inv_valid' :: "Arch.irqcontrol_invocation \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) src_slot and ex_cte_cap_to' sgi_slot and real_cte_at' sgi_slot)" -lemma checkIRQ_corres[Interrupt_R_assms]: +lemma checkIRQ_corres[Arch_assms]: "corres (ser \ dc) \ \ (arch_check_irq irq) (Arch.checkIRQ irq)" unfolding arch_check_irq_def checkIRQ_def by (clarsimp simp: minIRQ_def maxIRQ_def whenE_rangeCheck_eq whenE_def returnOk_def split: if_split) @@ -54,7 +54,7 @@ lemma checkIRQ_corres[Interrupt_R_assms]: lemmas irq_const_defs = minIRQ_def crunch arch_check_irq, checkIRQ - for inv[Interrupt_R_assms]: "P" + for inv[Arch_assms]: "P" (simp: crunch_simps) lemma arch_check_irq_valid: @@ -62,11 +62,11 @@ lemma arch_check_irq_valid: unfolding arch_check_irq_def by (wpsimp simp: validE_R_def not_less word_le_nat_alt maxIRQ_def wp: whenE_throwError_wp) -lemma arch_check_irq_valid'[Interrupt_R_assms]: +lemma arch_check_irq_valid'[Arch_assms]: "\\\ arch_check_irq irq \\_ _. irq \ ucast maxIRQ\, \\_. \\" by (wp arch_check_irq_valid) -lemma checkIRQ_irq_valid[Interrupt_R_assms]: +lemma checkIRQ_irq_valid[Arch_assms]: "\\\ checkIRQ irq \\_ _. arch_valid_irq (toEnum (unat irq))\, -" unfolding checkIRQ_def rangeCheck_def validE_R_def supply hoare_vcg_prop[wp del] @@ -99,7 +99,7 @@ lemma sgi_irq_cast: add: ucast_ucast_len sgi_irq_len_val word_le_nat_alt word_less_nat_alt split: if_split_asm) -lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: +lemma arch_decodeIRQControlInvocation_corres[Arch_assms]: "list_all2 cap_relation caps caps' \ corres (ser \ arch_irq_control_inv_relation) (invs and (\s. \cp \ set caps. s \ cp)) @@ -146,7 +146,7 @@ lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: apply (auto split: arch_invocation_label.splits invocation_label.splits) done -lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: +lemma arch_decode_irq_control_valid'[Arch_assms, wp]: "\\s. invs' s \ (\cap \ set caps. s \' cap) \ (\cap \ set caps. \r \ cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) slot s\ @@ -168,12 +168,12 @@ lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: done crunch Arch.decodeIRQControlInvocation - for inv[Interrupt_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps wp: crunch_wps) -lemmas [Interrupt_R_assms] = arch_check_irq_inv +lemmas [Arch_assms] = arch_check_irq_inv -lemma irq_node_in_global_refs'[Interrupt_R_assms]: +lemma irq_node_in_global_refs'[Arch_assms]: "Invariants_H.irq_node' s + (ucast irq << cteSizeBits) \ global_refs' s" for irq :: irq by (simp add: global_refs'_def cteSizeBits_def shiftl_t2n) @@ -182,13 +182,13 @@ lemma no_fail_deactivateInterrupt[wp, simp]: unfolding deactivateInterrupt_def by wpsimp -lemma arch_invokeIRQHandler_corres[Interrupt_R_assms]: +lemma arch_invokeIRQHandler_corres[Arch_assms]: "irq_handler_inv_relation i i' \ corres dc \ \ (arch_invoke_irq_handler i) (Arch.invokeIRQHandler i')" by (cases i; clarsimp simp: invokeIRQHandler_def theIRQ_def) (intro conjI impI; rule corres_machine_op, rule corres_Id; simp?) -lemma is_derived'_NotificationCap[Interrupt_R_assms]: +lemma is_derived'_NotificationCap[Arch_assms]: "\isNotificationCap cap; isNotificationCap cap'\ \ is_derived' ctes src cap' cap = badge_derived' cap' cap" by (clarsimp simp add: is_derived'_def gen_isCap_simps vsCapRef_def) @@ -219,7 +219,7 @@ lemma SGISignalCap_valid[simp, intro!]: "valid_cap' (ArchObjectCap (SGISignalCap irq target)) s" by (simp add: valid_cap'_def capAligned_def word_bits_def) -lemma arch_performIRQControl_corres[Interrupt_R_assms]: +lemma arch_performIRQControl_corres[Arch_assms]: "arch_irq_control_inv_relation ivk ivk' \ corres (dc \ dc) (einvs and arch_irq_control_inv_valid ivk) (invs' and arch_irq_control_inv_valid' ivk') @@ -251,11 +251,11 @@ lemma arch_performIRQControl_corres[Interrupt_R_assms]: apply (rename_tac cte', case_tac cte', simp add: isCap_simps) done -lemma is_simple_cap'_IRQHandlerCap[Interrupt_R_assms]: +lemma is_simple_cap'_IRQHandlerCap[Arch_assms]: "isIRQHandlerCap cap \ is_simple_cap' cap" by (clarsimp simp: isCap_simps is_simple_cap'_def) -lemma sameRegionAs_IRQControl_handler[Interrupt_R_assms, simp]: +lemma sameRegionAs_IRQControl_handler[Arch_assms, simp]: "global.sameRegionAs capability.IRQControlCap (capability.IRQHandlerCap irq)" by (simp add: sameRegionAs_def3 isCap_simps) @@ -268,7 +268,7 @@ lemma dmo_setIRQTrigger_invs'[wp]: apply (wpsimp simp: setIRQTrigger_def machine_op_lift_def machine_rest_lift_def split_def)+ done -lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: +lemma arch_invoke_irq_control_invs'[Arch_assms, wp]: "\invs' and arch_irq_control_inv_valid' i\ Arch.performIRQControl i \\rv. invs'\" apply (simp add: ARM_HYP_H.performIRQControl_def) apply (rule hoare_pre) @@ -464,7 +464,7 @@ lemma vppiEvent_corres: apply (simp add: tcb_at_invs') done -lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: +lemma handle_reserved_irq_corres[Arch_assms, corres]: "corres dc einvs (\s. invs' s \ (irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)) (handle_reserved_irq irq) (handleReservedIRQ irq)" @@ -476,12 +476,12 @@ lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: apply (fastforce intro: vgic_maintenance_corres simp: unat_arith_simps)+ done -lemma maskIrqSignal_corres[Interrupt_R_assms, corres]: +lemma maskIrqSignal_corres[Arch_assms, corres]: "corres dc \ \ (arch_mask_irq_signal irq) (Arch.maskIrqSignal irq)" unfolding arch_mask_irq_signal_def maskIrqSignal_def when_def by (corres corres: corres_machine_op) -lemma dmo_ackInterrupt_corres[Interrupt_R_assms, corres]: +lemma dmo_ackInterrupt_corres[Arch_assms, corres]: "corres dc \ \ (do_machine_op (ackInterrupt irq)) (doMachineOp (ackInterrupt irq))" by (corres corres: corres_machine_op) @@ -547,10 +547,10 @@ lemma vppiEvent_invs'[wp]: done crunch maskIrqSignal - for invs'[Interrupt_R_assms]: invs' + for invs'[Arch_assms]: invs' (wp: dmo_maskInterrupt_True ignore: doMachineOp) -lemma handleReservedIRQ_invs'[Interrupt_R_assms]: +lemma handleReservedIRQ_invs'[Arch_assms]: "\invs' and (\s. irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)\ handleReservedIRQ irq \\_. invs'\" @@ -559,30 +559,32 @@ lemma handleReservedIRQ_invs'[Interrupt_R_assms]: non_kernel_IRQs_def split_del: if_split) +lemmas Interrupt_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R?: Interrupt_R ARM_HYP.arch_irq_control_inv_valid' ARM_HYP.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Interrupt_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Interrupt_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R_2 locale *) -lemma invoke_arch_irq_handler_invs'[Interrupt_R_2_assms, wp]: +lemma invoke_arch_irq_handler_invs'[Arch_assms, wp]: "\invs' and irq_handler_inv_valid' i\ Arch.invokeIRQHandler i \\rv. invs'\" by (cases i; (wpsimp simp: ARM_HYP_H.invokeIRQHandler_def theIRQ_def | rule conjI)+) +lemmas Interrupt_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R_2?: Interrupt_R_2 ARM_HYP.arch_irq_control_inv_valid' ARM_HYP.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Interrupt_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchInvariantUpdates_H.thy b/proof/refine/ARM_HYP/ArchInvariantUpdates_H.thy index 7efc3b0fe7..ac52bca64a 100644 --- a/proof/refine/ARM_HYP/ArchInvariantUpdates_H.thy +++ b/proof/refine/ARM_HYP/ArchInvariantUpdates_H.thy @@ -10,24 +10,25 @@ begin context Arch begin arch_global_naming -named_theorems InvariantUpdates_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InvariantUpdates_H locale *) -lemma valid_arch_state'_interrupt[simp, InvariantUpdates_H_assms]: +lemma valid_arch_state'_interrupt[simp, Arch_assms]: "valid_arch_state' (ksInterruptState_update f s) = valid_arch_state' s" by (simp add: valid_arch_state'_def cong: option.case_cong) (* not generally true for ksInterruptState update *) -lemma global_refs'_intStateIRQTable_update[simp, InvariantUpdates_H_assms]: +lemma global_refs'_intStateIRQTable_update[simp, Arch_assms]: "global_refs' (s\ksInterruptState := intStateIRQTable_update f (ksInterruptState s)\) = global_refs' s" by (simp add: global_refs'_def) -end +lemmas InvariantUpdates_H_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation InvariantUpdates_H?: InvariantUpdates_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact InvariantUpdates_H_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.InvariantUpdates_H_assms)?) qed end diff --git a/proof/refine/ARM_HYP/ArchInvsLemmas_H.thy b/proof/refine/ARM_HYP/ArchInvsLemmas_H.thy index c1ab7b427e..c3ff32b4ea 100644 --- a/proof/refine/ARM_HYP/ArchInvsLemmas_H.thy +++ b/proof/refine/ARM_HYP/ArchInvsLemmas_H.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Invariants_H_pspaceI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_pspaceI locale *) (* on 32-bit Arm, all addresses are canonical *) lemma pspace_canonical'_top[simp]: @@ -35,7 +35,7 @@ lemmas untypedBits_defs = minUntypedSizeBits_def maxUntypedSizeBits_def lemmas objBits_simps = objBits_def objBitsKO_def word_size_def archObjSize_def lemmas objBits_simps' = objBits_simps objBits_defs -lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_cap'_pspaceI[Arch_assms]: "s \' cap \ ksPSpace s = ksPSpace s' \ s' \' cap" unfolding valid_cap'_def by (cases cap) @@ -45,7 +45,7 @@ lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: simp: vspace_table_at'_defs valid_arch_cap'_def split: arch_capability.splits zombie_type.split option.splits)+ -lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_obj'_pspaceI[Arch_assms]: "valid_obj' obj s \ ksPSpace s = ksPSpace s' \ valid_obj' obj s'" unfolding valid_obj'_def by (cases obj) @@ -56,7 +56,7 @@ lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: Structures_H.thread_state.splits ntfn.splits option.splits intro: obj_at'_pspaceI valid_cap'_pspaceI typ_at'_pspaceI) -lemma tcb_space_clear[Invariants_H_pspaceI_assms]: +lemma tcb_space_clear[Arch_assms]: "\ tcb_cte_cases (y - x) = Some (getF, setF); is_aligned x tcbBlockSizeBits; ps_clear x tcbBlockSizeBits s; ksPSpace s x = Some (KOTCB tcb); ksPSpace s y = Some v; @@ -79,12 +79,12 @@ lemma tcb_space_clear[Invariants_H_pspaceI_assms]: apply (simp add: tcb_cte_cases_def cteSizeBits_def split: if_split_asm) done -lemma pspace_in_kernel_mappings'_pspaceI[Invariants_H_pspaceI_assms]: +lemma pspace_in_kernel_mappings'_pspaceI[Arch_assms]: "pspace_in_kernel_mappings' s \ ksPSpace s = ksPSpace s' \ pspace_in_kernel_mappings' s'" unfolding pspace_in_kernel_mappings'_def by simp -lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: +lemma range_cover_canonical_address[Arch_assms]: "\ range_cover ptr sz us n ; p < n ; canonical_address (ptr && ~~ mask sz) ; sz \ maxUntypedSizeBits \ \ canonical_address (ptr + of_nat p * 2 ^ us)" @@ -93,17 +93,18 @@ lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: (* not interesting on this architecture *) lemmas [simp] = pspace_in_kernel_mappings'_pspaceI -end +lemmas Invariants_H_pspaceI_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_pspaceI?: Invariants_H_pspaceI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Invariants_H_pspaceI_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Invariants_H_pspaceI_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Invariants_H_cte_ats_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_cte_ats locale *) (* FIXME arch-split: for proofs which require exact offsets lining up instead of cteSizeBits *) lemma raw_tcb_cte_cases_simps: @@ -114,7 +115,7 @@ lemma raw_tcb_cte_cases_simps: "tcb_cte_cases 64 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)" by (simp add: tcb_cte_cases_def cteSizeBits_def)+ -lemma cte_wp_at_cases'[Invariants_H_cte_ats_assms]: +lemma cte_wp_at_cases'[Arch_assms]: shows "cte_wp_at' P p s = ((\cte. ksPSpace s p = Some (KOCTE cte) \ is_aligned p cte_level_bits \ P cte \ ps_clear p cteSizeBits s) \ @@ -207,7 +208,7 @@ lemma cte_wp_at_cteI': shows "cte_wp_at' P ptr s" using assms by (simp add: cte_wp_at_cases' cte_level_bits_def objBits_defs) -lemma cte_at_typ'[Invariants_H_cte_ats_assms]: +lemma cte_at_typ'[Arch_assms]: "cte_at' c = (\s. typ_at' CTET c s \ (\n. typ_at' TCBT (c - n) s \ n \ dom tcb_cte_cases))" proof - have P: "\ko. (koTypeOf ko = CTET) = (\cte. ko = KOCTE cte)" @@ -231,12 +232,13 @@ lemma tcb_at_cte_at': apply (clarsimp simp add: return_def objBits_simps) done -end +lemmas Invariants_H_cte_ats_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_cte_ats?: Invariants_H_cte_ats proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Invariants_H_cte_ats_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Invariants_H_cte_ats_assms)?) qed @@ -362,7 +364,7 @@ lemma is_physical_cases: | _ \ True)" by (simp split: capability.splits arch_capability.splits zombie_type.splits) -named_theorems Invariants_H_typ_at_lifts_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_typ_at_lifts locale *) lemma page_directory_at'_typ_at_lift_strong: "(\p. f \\s. P (typ_at' (ArchT PDET) p s)\) \ f \\s. P (page_directory_at' p s)\" @@ -390,7 +392,7 @@ lemma vcpu_at'_typ_at_lift_strong: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (vcpu_at' p s)\" by assumption -lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_tcb'_typ_at_lift_strong[Arch_assms]: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (valid_arch_tcb' tcb s)\" unfolding valid_arch_tcb'_def apply (rule bool_to_bool_cases[where f=P]; clarsimp) @@ -398,7 +400,7 @@ lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: | assumption)+ done -lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_cap'_typ_at_lift[Arch_assms]: assumes P: "\P T p. f \\s. P (typ_at' T p s)\" shows "f \\s. valid_arch_cap' cap s\" apply (case_tac cap, @@ -408,12 +410,13 @@ lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: page_directory_at'_typ_at_lift_strong page_table_at'_typ_at_lift_strong)+ done +lemmas Invariants_H_typ_at_lifts_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) global_interpretation Invariants_H_typ_at_lifts?: Invariants_H_typ_at_lifts proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; unfold_locales; (fact Invariants_H_typ_at_lifts_assms)?) + case 1 show ?case by (intro_locales; unfold_locales; (fact ARM_HYP.Invariants_H_typ_at_lifts_assms)?) qed context Arch begin arch_global_naming @@ -592,20 +595,20 @@ end_qualify instantiation ARM_HYP_H.asidpool :: no_vcpu begin -interpretation Arch . -instance by intro_classes auto +instance by intro_classes + (auto simp: ARM_HYP_H.arch_kernel_object_type.distinct ARM_HYP_H.koType_asidpool) end instantiation ARM_HYP_H.pde :: no_vcpu begin -interpretation Arch . -instance by intro_classes auto +instance by intro_classes + (auto simp: ARM_HYP_H.arch_kernel_object_type.distinct ARM_HYP_H.koType_pde) end instantiation ARM_HYP_H.pte :: no_vcpu begin -interpretation Arch . -instance by intro_classes auto +instance by intro_classes + (auto simp: ARM_HYP_H.arch_kernel_object_type.distinct ARM_HYP_H.koType_pte) end end diff --git a/proof/refine/ARM_HYP/ArchIpcCancel_R.thy b/proof/refine/ARM_HYP/ArchIpcCancel_R.thy index ab466bbf9d..d2b97d266d 100644 --- a/proof/refine/ARM_HYP/ArchIpcCancel_R.thy +++ b/proof/refine/ARM_HYP/ArchIpcCancel_R.thy @@ -12,24 +12,24 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_R locale *) (* FIXME: move to Machine_AI *) crunch getRegister, setRegister for (no_fail) no_fail[intro!, wp, simp] crunch Arch.postCapDeletion - for pred_tcb_at'[IpcCancel_R_assms, wp]: "pred_tcb_at' proj P t" - and typ_at'[IpcCancel_R_assms, wp]: "\s. P (typ_at' T p s)" + for pred_tcb_at'[Arch_assms, wp]: "pred_tcb_at' proj P t" + and typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" (wp: setCTE_pred_tcb_at') -lemma acapClass_not_ReplyClass[IpcCancel_R_assms]: +lemma acapClass_not_ReplyClass[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) crunch arch_post_cap_deletion - for pspace_aligned[IpcCancel_R_assms, wp]: "pspace_aligned :: det_state \ _" - and pspace_distinct[IpcCancel_R_assms, wp]: "pspace_distinct :: det_state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_state \ _" (simp: crunch_simps wp: crunch_wps) crunch emptySlot @@ -137,7 +137,7 @@ lemma sym_refs_tcb_vcpu: apply (case_tac koa; simp add: vcpu_tcb_refs_def split: option.splits) done -lemma prepareThreadDelete_corres[IpcCancel_R_assms, corres]: +lemma prepareThreadDelete_corres[Arch_assms, corres]: "t' = t \ corres dc (invs and tcb_at t) no_0_obj' (prepare_thread_delete t) (prepareThreadDelete t')" @@ -193,12 +193,13 @@ lemma setEndpoint_pde_mappings'[wp]: apply (clarsimp dest!: updateObject_default_result)+ done +lemmas IpcCancel_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation IpcCancel_R?: IpcCancel_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact IpcCancel_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.IpcCancel_R_assms)?)?) qed (* instantiate locales with assumptions depending on IpcCancel_R instantiation *) diff --git a/proof/refine/ARM_HYP/ArchIpc_R.thy b/proof/refine/ARM_HYP/ArchIpc_R.thy index 41194f5db2..6c3bf0fa5c 100644 --- a/proof/refine/ARM_HYP/ArchIpc_R.thy +++ b/proof/refine/ARM_HYP/ArchIpc_R.thy @@ -11,11 +11,11 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_R locale *) declare word32_minus_one_le[simp] -lemma max_ipc_size_le_2_msg_align_bits[Ipc_R_assms]: +lemma max_ipc_size_le_2_msg_align_bits[Arch_assms]: "max_ipc_words * word_size \ 2 ^ msg_align_bits" by (simp add: max_ipc_words word_size_def msg_align_bits) @@ -32,50 +32,50 @@ lemma vsCapRef_generic: "\ isArchObjectCap cap \ vsCapRef cap = None" by (clarsimp simp add: vsCapRef_def gen_isCap_simps split: capability.splits) -lemma is_derived'_Untyped[Ipc_R_assms]: +lemma is_derived'_Untyped[Arch_assms]: "\isUntypedCap cap'\ \ is_derived' m src cap' cap = (isUntypedCap cap \ badge_derived' cap' cap \ descendants_of' src m = {})" by (clarsimp simp add: ARM_HYP.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) -lemma is_derived'_Reply[Ipc_R_assms]: +lemma is_derived'_Reply[Arch_assms]: "\isReplyCap cap'\ \ is_derived' m src cap' cap = (isReplyCap cap \ capTCBPtr cap = capTCBPtr cap' \ capReplyMaster cap \ \ capReplyMaster cap')" by (clarsimp simp add: ARM_HYP.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) -lemma arch_maskCapRights_not_null[Ipc_R_assms, simp]: +lemma arch_maskCapRights_not_null[Arch_assms, simp]: "Arch.maskCapRights r acap \ NullCap" by (case_tac acap; simp add: ARM_HYP_H.maskCapRights_def isCap_simps) -lemma capASID_gen_cap[Ipc_R_assms]: +lemma capASID_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ capASID cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_asid_base'_gen_cap[Ipc_R_assms]: +lemma cap_asid_base'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_asid_base' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_vptr'_gen_cap[Ipc_R_assms]: +lemma cap_vptr'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_vptr' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemmas transferCapsToSlots_pspace_in_kernel_mappings'[Ipc_R_assms, wp] = +lemmas transferCapsToSlots_pspace_in_kernel_mappings'[Arch_assms, wp] = pspace_in_kernel_mappings'_inv[where f="transferCapsToSlots _ _ _ _ _ _"] crunch makeArchFaultMessage - for sch_act[Ipc_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for sch_act[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma is_derived'_IRQHandlerCap[Ipc_R_assms]: +lemma is_derived'_IRQHandlerCap[Arch_assms]: "\isIRQHandlerCap cap'\ \ is_derived' (ctes_of (s::kernel_state)) src cap' cap = (isIRQHandlerCap cap \ badge_derived' cap' cap)" by (clarsimp simp add: ARM_HYP.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) (* variant of storeWord_um_inv which does not expose architecture-specific information *) -lemma storeWord_um_inv'[Ipc_R_assms]: +lemma storeWord_um_inv'[Arch_assms]: "\\s. underlying_memory s = um\ storeWord a v \\_ s. is_aligned a word_size_bits @@ -89,7 +89,7 @@ lemma storeWord_um_inv'[Ipc_R_assms]: apply (auto simp add: unat_plus_simple[THEN iffD1] word_plus_mono_right2 mask_def) done -lemma isArchObjectCap_maskCapRights[Ipc_R_assms]: +lemma isArchObjectCap_maskCapRights[Arch_assms]: "isArchObjectCap (Arch.maskCapRights R acap)" by (cases acap; simp add: ARM_HYP_H.maskCapRights_def isCap_simps) @@ -100,16 +100,16 @@ lemma isPageCap_maskCapRights[simp]: apply (case_tac arch_capability; simp add: isCap_simps ARM_HYP_H.maskCapRights_def) done -lemma arch_updateCapData_ordering[Ipc_R_assms]: +lemma arch_updateCapData_ordering[Arch_assms]: "\ (x, arch_capBadge acap) \ capBadge_ordering P; Arch.updateCapData p d acap \ NullCap \ \ (x, capBadge (Arch.updateCapData p d acap)) \ capBadge_ordering P" by (cases acap; simp add: ARM_HYP_H.updateCapData_def) -lemma ArchUpdateCapData_noReply[Ipc_R_assms]: +lemma ArchUpdateCapData_noReply[Arch_assms]: "Arch.updateCapData p d acap \ capability.ReplyCap x y z" by (cases acap; simp add: ARM_HYP_H.updateCapData_def) -lemma ArchUpdateCapData_noIRQControl[Ipc_R_assms]: +lemma ArchUpdateCapData_noIRQControl[Arch_assms]: "Arch.updateCapData p d acap \ IRQControlCap" by (cases acap; simp add: ARM_HYP_H.updateCapData_def) @@ -130,14 +130,14 @@ lemma isPageCap_updateCapData[simp]: apply (clarsimp split:capability.splits simp:Let_def) done -lemma badgeRegister_badge_register[Ipc_R_assms]: +lemma badgeRegister_badge_register[Arch_assms]: "badgeRegister = badge_register" by (simp add: badge_register_def badgeRegister_def) -lemmas copyMRs__pspace_in_kernel_mappings'[Ipc_R_assms, wp] = +lemmas copyMRs__pspace_in_kernel_mappings'[Arch_assms, wp] = pspace_in_kernel_mappings'_inv[where f="copyMRs _ _ _ _ _"] -lemma makeArchFaultMessage_corres[Ipc_R_assms]: +lemma makeArchFaultMessage_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (make_arch_fault_msg f t) (makeArchFaultMessage (arch_fault_map f) t)" @@ -148,20 +148,20 @@ lemma makeArchFaultMessage_corres[Ipc_R_assms]: apply (wp+, auto) done -lemma syscallMessage_def'[Ipc_R_assms]: +lemma syscallMessage_def'[Arch_assms]: "FaultHandler_H.syscallMessage \ MachineExports.syscallMessage" by (simp add: syscallMessage_def) -lemma exceptionMessage_def'[Ipc_R_assms]: +lemma exceptionMessage_def'[Arch_assms]: "FaultHandler_H.exceptionMessage \ MachineExports.exceptionMessage" by (simp add: exceptionMessage_def) -lemma makeArchFaultMessage_inv[Ipc_R_assms, wp]: +lemma makeArchFaultMessage_inv[Arch_assms, wp]: "makeArchFaultMessage ft t \P\" unfolding makeArchFaultMessage_def by (wpsimp wp: asUser_inv getRestartPC_inv split: arch_fault.split) -lemma lookupIPCBuffer_valid_ipc_buffer[Ipc_R_assms, wp]: +lemma lookupIPCBuffer_valid_ipc_buffer[Arch_assms, wp]: "\valid_objs'\ VSpace_H.lookupIPCBuffer b s \case_option \ valid_ipc_buffer_ptr'\" unfolding lookupIPCBuffer_def supply tcb_cte_cases_simps(1)[simp del] (* avoid duplicate simp rule warning *) @@ -210,7 +210,7 @@ lemma lookupIPCBuffer_Some_0: "\\\ lookupIPCBuffer w t \\rv s. rv \ Some 0\" by (wpsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv) -lemma arch_getSanitiseRegisterInfo_corres[Ipc_R_assms]: +lemma arch_getSanitiseRegisterInfo_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (arch_get_sanitise_register_info t) (getSanitiseRegisterInfo t)" @@ -221,24 +221,24 @@ crunch getSanitiseRegisterInfo for tcb_at'[wp]: "tcb_at' t" crunch arch_get_sanitise_register_info - for pspace_distinct[Ipc_R_assms, wp]: pspace_distinct - and pspace_aligned[Ipc_R_assms, wp]: pspace_aligned + for pspace_distinct[Arch_assms, wp]: pspace_distinct + and pspace_aligned[Arch_assms, wp]: pspace_aligned -lemma sanitiseRegister_sanitise_register[Ipc_R_assms]: +lemma sanitiseRegister_sanitise_register[Arch_assms]: "sanitiseRegister = sanitise_register" by (rule ext)+ (clarsimp simp add: sanitiseRegister_def sanitise_register_def cong: register.case_cong) -lemma handleArchFaultReply_corres[Ipc_R_assms]: +lemma handleArchFaultReply_corres[Arch_assms]: "corres (=) \ \ (handle_arch_fault_reply ft t label msg) (handleArchFaultReply (arch_fault_map ft) t label msg)" by (clarsimp simp: handle_arch_fault_reply_def handleArchFaultReply_def split: arch_fault.split) crunch getSanitiseRegisterInfo, handleArchFaultReply, handle_arch_fault_reply - for inv[Ipc_R_assms, wp]: P + for inv[Arch_assms, wp]: P -lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: +lemma ctes_of_mdbNext_parentOf[Arch_assms]: "\ ctes_of s' \ cte_map cptr \ cte_map slot; ctes_of s' (cte_map cptr) = Some (CTE (capability.ReplyCap t master rights) n); ctes_of s' (mdbNext (cteMDBNode cte)) = Some (CTE (capability.ReplyCap t master' rights') n'); @@ -248,19 +248,20 @@ lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: (erule subtree.cases; clarsimp simp: parentOf_def isMDBParentOf_CTE) crunch debugPrint - for inv[Ipc_R_assms, wp]: P - and (no_fail) no_fail[Ipc_R_assms, intro!, wp, simp] + for inv[Arch_assms, wp]: P + and (no_fail) no_fail[Arch_assms, intro!, wp, simp] crunch setThreadState, asUser for valid_pde_mappings'[wp]: valid_pde_mappings' (simp: crunch_simps wp: hoare_drop_imps) +lemmas Ipc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Ipc_R?: Ipc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Ipc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Ipc_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/ARM_HYP/ArchKHeap_R.thy b/proof/refine/ARM_HYP/ArchKHeap_R.thy index cb265835e5..d36c1498a8 100644 --- a/proof/refine/ARM_HYP/ArchKHeap_R.thy +++ b/proof/refine/ARM_HYP/ArchKHeap_R.thy @@ -14,7 +14,7 @@ declare a_type_simps[simp] (* FIXME: on RISCV64/AARCH64 this is in ArchInvariant context Arch begin arch_global_naming -named_theorems KHeap_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R locale *) declare aa_type_simps[simp] (* FIXME: on RISCV64/AARCH64 this is in ArchInvariants_AI already *) @@ -98,12 +98,12 @@ lemma getObject_vcpu_corres: apply (clarsimp simp: other_aobj_relation_def) done -lemma koType_objBitsKO[KHeap_R_assms]: +lemma koType_objBitsKO[Arch_assms]: "koTypeOf k = koTypeOf k' \ objBitsKO k = objBitsKO k'" by (auto simp: objBitsKO_def archObjSize_def split: kernel_object.splits arch_kernel_object.splits) -lemma pspace_dom_update[KHeap_R_assms]: +lemma pspace_dom_update[Arch_assms]: "\ ps ptr = Some x; a_type x = a_type v \ \ pspace_dom (ps(ptr \ v)) = pspace_dom ps" apply (simp add: pspace_dom_def dom_fun_upd2 del: dom_fun_upd) apply (rule SUP_cong [OF refl]) @@ -111,7 +111,7 @@ lemma pspace_dom_update[KHeap_R_assms]: apply (simp add: obj_relation_cuts_def3) done -lemma cte_wp_at_ctes_of[KHeap_R_assms]: +lemma cte_wp_at_ctes_of[Arch_assms]: "cte_wp_at' P p s = (\cte. ctes_of s p = Some cte \ P cte)" supply diff_neg_mask[simp del] apply (simp add: cte_wp_at_cases' map_to_ctes_def Let_def @@ -144,15 +144,15 @@ lemma cte_wp_at_ctes_of[KHeap_R_assms]: word_bw_assocs) done -lemma ctes_of_canonical[KHeap_R_assms]: +lemma ctes_of_canonical[Arch_assms]: assumes canonical: "pspace_canonical' s" assumes ctes_of: "ctes_of s p = Some cte" shows "canonical_address p" by (simp add: canonical_address_def) -lemma valid_updateCapDataI[KHeap_R_assms]: +lemma valid_updateCapDataI[Arch_assms]: "s \' c \ s \' updateCapData b x c" - apply (unfold global.updateCapData_def Let_def updateCapData_def) + apply (unfold global.updateCapData_def Let_def ARM_HYP_H.updateCapData_def) apply (cases c) apply (simp_all add: gen_isCap_defs valid_cap'_def global.capUntypedPtr_def gen_isCap_simps capAligned_def word_size word_bits_def word_bw_assocs @@ -317,7 +317,7 @@ lemma setObject_other_arch_corres: simp split: arch_kernel_obj.split_asm) by (fastforce dest: tcbs_of'_non_tcb_update) -lemmas [KHeap_R_assms] = +lemmas [Arch_assms] = setObject_other_corres[where 'a=endpoint] setObject_other_corres[where 'a=notification] @@ -336,11 +336,11 @@ lemma pspace_in_kernel_mappings'_inv: "f \pspace_in_kernel_mappings'\" by wp -lemma setEndpoint_pspace_in_kernel_mappings'[KHeap_R_assms]: +lemma setEndpoint_pspace_in_kernel_mappings'[Arch_assms]: "setEndpoint p ko \pspace_in_kernel_mappings'\" by wp -lemma setNotification_pspace_in_kernel_mappings'[KHeap_R_assms]: +lemma setNotification_pspace_in_kernel_mappings'[Arch_assms]: "setNotification p ko \pspace_in_kernel_mappings'\" by wp @@ -423,27 +423,28 @@ lemma set_ep_hyp[wp]: by (wpsimp wp: setObject_ko_wp_at simp: objBits_simps', rule refl, simp) (clarsimp simp: is_vcpu'_def ko_wp_at'_def obj_at'_def) -lemma idle_is_global[KHeap_R_assms, intro!]: +lemma idle_is_global[Arch_assms, intro!]: "ksIdleThread s \ global_refs' s" by (simp add: global_refs'_def) -end +lemmas KHeap_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R?: KHeap_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.KHeap_R_assms)?) qed context Arch begin arch_global_naming -named_theorems KHeap_R_assms_2 +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R_2 locale *) -lemmas setEndpoint_valid_globals[KHeap_R_assms_2, wp] +lemmas setEndpoint_valid_globals[Arch_assms, wp] = valid_global_refs_lift'[OF set_ep_ctes_of set_ep_arch' setEndpoint_it setEndpoint_ksInterruptState] -lemma set_ntfn_global_refs'[KHeap_R_assms_2, wp]: +lemma set_ntfn_global_refs'[Arch_assms, wp]: "\valid_global_refs'\ setNotification ptr val \\_. valid_global_refs'\" by (rule valid_global_refs_lift'; wp) @@ -474,7 +475,7 @@ lemma setObject_ko_wp_at': objBits_def[symmetric] ps_clear_upd in_magnitude_check v) -lemmas [KHeap_R_assms_2] = setEndpoint_valid_arch' setNotification_valid_arch' +lemmas [Arch_assms] = setEndpoint_valid_arch' setNotification_valid_arch' sublocale setObject: typ_at_props' "setObject p v" by typ_at_props' @@ -485,12 +486,13 @@ sublocale doMachineOp: typ_at_props' "doMachineOp mop" sublocale setEndpoint: typ_at_props' "setEndpoint ptr val" by typ_at_props' -end +lemmas KHeap_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R_2?: KHeap_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms_2)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.KHeap_R_2_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/ARM_HYP/ArchMachine_R.thy b/proof/refine/ARM_HYP/ArchMachine_R.thy index 07a363e33b..a15a54673a 100644 --- a/proof/refine/ARM_HYP/ArchMachine_R.thy +++ b/proof/refine/ARM_HYP/ArchMachine_R.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems Machine_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Machine_R locale *) -lemma dmo_getirq_inv[Machine_R_assms, wp]: +lemma dmo_getirq_inv[Arch_assms, wp]: "irq_state_independent_H P \ \P\ doMachineOp (getActiveIRQ in_kernel) \\rv. P\" apply (simp add: getActiveIRQ_def doMachineOp_def split_def exec_gets select_f_select[simplified liftM_def] @@ -33,7 +33,7 @@ lemma getActiveIRQ_masked: apply (clarsimp simp: valid_irq_masks'_def) done -lemma dmo_maskInterrupt[Machine_R_assms]: +lemma dmo_maskInterrupt[Arch_assms]: "\\s. P (ksMachineState_update (irq_masks_update (\t. t (irq := m))) s)\ doMachineOp (maskInterrupt m irq) \\_. P\" apply (simp add: doMachineOp_def split_def) @@ -51,7 +51,7 @@ lemma dmo_maskInterrupt_True: ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) done -lemma setIRQState_irq_states'[Machine_R_assms, wp]: +lemma setIRQState_irq_states'[Arch_assms, wp]: "setIRQState state irq \valid_irq_states'\" apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def) apply (wp dmo_maskInterrupt) @@ -67,7 +67,7 @@ lemma getActiveIRQ_le_maxIRQ: apply (simp add: irqs_masked'_def valid_irq_states'_def maxIRQ_def)+ done -lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: +lemma doMachineOp_getActiveIRQ_non_kernel[Arch_assms, wp]: "\\\ doMachineOp (getActiveIRQ True) \\rv s. \irq. rv = Some irq \ irq \ non_kernel_IRQs \ P irq s\" unfolding doMachineOp_def @@ -76,15 +76,15 @@ lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: apply clarsimp done -lemma frameRegisters_def'[Machine_R_assms]: +lemma frameRegisters_def'[Arch_assms]: "frameRegisters = MachineExports.frameRegisters" by (simp add: frameRegisters_def) -lemma gpRegisters_def'[Machine_R_assms]: +lemma gpRegisters_def'[Arch_assms]: "gpRegisters = MachineExports.gpRegisters" by (simp add: gpRegisters_def) -lemma tlsBaseRegister_def'[Machine_R_assms]: +lemma tlsBaseRegister_def'[Arch_assms]: "tlsBaseRegister = MachineExports.tlsBaseRegister" by (simp add: tlsBaseRegister_def) @@ -97,12 +97,13 @@ crunch setIRQTrigger for (no_fail) no_fail[intro!, wp, simp] (ignore: setIRQTrigger_impl) -end +lemmas Machine_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Machine_R?: Machine_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Machine_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.Machine_R_assms)?) qed end diff --git a/proof/refine/ARM_HYP/ArchMove_R.thy b/proof/refine/ARM_HYP/ArchMove_R.thy index 762dc7db06..92c8b11b24 100644 --- a/proof/refine/ARM_HYP/ArchMove_R.thy +++ b/proof/refine/ARM_HYP/ArchMove_R.thy @@ -45,7 +45,7 @@ lemma flush_space_vspace_objs[wp]: (* FIXME: move, missing in Ipc_AI on this architecture *) crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for inv[Ipc_AI_2_assms]: P + for inv[Arch_assms]: P (* FIXME arch-split: missing from ArchCSpaceInvPre_AI on this architecture *) lemma set_cap_aobjs_of[wp]: diff --git a/proof/refine/ARM_HYP/ArchRefine.thy b/proof/refine/ARM_HYP/ArchRefine.thy index 29b9bf0ea6..ce5d754977 100644 --- a/proof/refine/ARM_HYP/ArchRefine.thy +++ b/proof/refine/ARM_HYP/ArchRefine.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems Refine_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Refine locale *) text \User memory content is the same on both levels\ lemma typ_at_AUserDataI: @@ -134,7 +134,7 @@ lemma p_and_not_mask_pbfs_add_mask_pbfs_eq: add: shiftr_shiftl1 mask_out_add_aligned is_aligned_neg_mask pbfs_atleast_pageBits word_plus_and_or_coroll2 add.commute) -lemma pointerInUserData_relation[Refine_assms]: +lemma pointerInUserData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInUserData p s' = in_user_frame p s" apply (simp add: pointerInUserData_def in_user_frame_def) @@ -148,7 +148,7 @@ lemma pointerInUserData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma pointerInDeviceData_relation[Refine_assms]: +lemma pointerInDeviceData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInDeviceData p s' = in_device_frame p s" apply (simp add: pointerInDeviceData_def in_device_frame_def) @@ -162,31 +162,31 @@ lemma pointerInDeviceData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma user_mem_relation[Refine_assms]: +lemma user_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ user_mem' s' = user_mem s" by (rule ext) (clarsimp simp: user_mem_def user_mem'_def pointerInUserData_relation pointerInDeviceData_relation state_relation_def) -lemma device_mem_relation[Refine_assms]: +lemma device_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ device_mem' s' = device_mem s" by (rule ext) (clarsimp simp: device_mem_def device_mem'_def pointerInUserData_relation pointerInDeviceData_relation) -lemma arch_activate_thread_sched_act[Refine_assms]: +lemma arch_activate_thread_sched_act[Arch_assms]: "\ct_in_state activatable and (\s. P (scheduler_action s))\ arch_activate_idle_thread t \\rs s. P (scheduler_action (s::det_state))\" by (wpsimp simp: arch_activate_idle_thread_def) -lemma valid_list_init[Refine_assms, simp]: +lemma valid_list_init[Arch_assms, simp]: "valid_list init_A_st" by (simp add: valid_list_2_def init_A_st_def ext_init_def init_cdt_def) -lemma valid_sched_init[Refine_assms, simp]: +lemma valid_sched_init[Arch_assms, simp]: "valid_sched init_A_st" apply (simp add: valid_sched_def init_A_st_def ext_init_def) apply (clarsimp simp: init_kheap_def st_tcb_at_kh_def obj_at_kh_def @@ -198,62 +198,63 @@ lemma valid_sched_init[Refine_assms, simp]: etcb_at'_def etcbs_of'_def) done -lemma valid_domain_list_init[Refine_assms, simp]: +lemma valid_domain_list_init[Arch_assms, simp]: "valid_domain_list init_A_st" by (simp add: init_A_st_def ext_init_def valid_domain_list_def) -lemma valid_domain_time_init[Refine_assms, simp]: +lemma valid_domain_time_init[Arch_assms, simp]: "0 < domain_time init_A_st" by (simp add: init_A_st_def) -lemma sched_act_init[Refine_assms, simp]: +lemma sched_act_init[Arch_assms, simp]: "scheduler_action init_A_st = resume_cur_thread" by (simp add: init_A_st_def) -lemma fastpathKernelAssertions_cross[Refine_assms]: +lemma fastpathKernelAssertions_cross[Arch_assms]: "\ (s,s') \ state_relation; invs s; valid_arch_state' s'\ \ fastpathKernelAssertions s'" unfolding fastpathKernelAssertions_def by simp (* vs duplicate interface lemma *) -lemmas [Refine_assms] = callKernel_valid_duplicates' +lemmas [Arch_assms] = callKernel_valid_duplicates' -lemma doUserOp_valid_duplicates'[Refine_assms]: +lemma doUserOp_valid_duplicates'[Arch_assms]: "doUserOp f tc \\s. vs_valid_duplicates' (ksPSpace s)\" by (simp add: doUserOp_def split_def) (wpsimp wp: dmo_invs') -lemma checkActiveIRQ_valid_duplicates'[Refine_assms]: +lemma checkActiveIRQ_valid_duplicates'[Arch_assms]: "checkActiveIRQ \\s. vs_valid_duplicates' (ksPSpace s)\" by (wpsimp simp: checkActiveIRQ_def) -lemma tcb_hyp_refs'_atcbContextSet[Refine_assms, simp]: +lemma tcb_hyp_refs'_atcbContextSet[Arch_assms, simp]: "tcb_hyp_refs' (atcbContextSet tc atcb) = tcb_hyp_refs' atcb" by (simp add: atcbContextSet_def) -lemma ptable_lift_abs_state[Refine_assms, simp]: +lemma ptable_lift_abs_state[Arch_assms, simp]: "ptable_lift t (abs_state s) = ptable_lift t s" by (simp add: ptable_lift_def abs_state_def) -lemma ptable_rights_abs_state[Refine_assms, simp]: +lemma ptable_rights_abs_state[Arch_assms, simp]: "ptable_rights t (abs_state s) = ptable_rights t s" by (simp add: ptable_rights_def abs_state_def) -lemma arch_tcb_relation_arch_context_set[Refine_assms]: +lemma arch_tcb_relation_arch_context_set[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_relation (arch_tcb_context_set tc atcb) (atcbContextSet tc atcb')" by (simp add: arch_tcb_relation_def arch_tcb_context_set_def atcbContextSet_def) -lemma arch_tcb_relation_arch_context_get[Refine_assms]: +lemma arch_tcb_relation_arch_context_get[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_context_get atcb = atcbContextGet atcb'" by (simp add: arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) +lemmas Refine_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Refine?: Refine proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Refine_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Refine_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchRetype_R.thy b/proof/refine/ARM_HYP/ArchRetype_R.thy index 5793dbee07..3a912c6daf 100644 --- a/proof/refine/ARM_HYP/ArchRetype_R.thy +++ b/proof/refine/ARM_HYP/ArchRetype_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Retype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R locale *) -lemma toAPIType_Some[Retype_R_assms, simp]: +lemma toAPIType_Some[Arch_assms, simp]: "(toAPIType ty = Some x) = (ty = APIObjectType x)" by (cases ty; auto simp: toAPIType_def) @@ -36,19 +36,19 @@ definition APIType_map2 :: "kernel_object + ARM_HYP_H.object_type \ (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_map2_def = APIType_map2_raw_def[simplified APIType_map2_gen_def] -lemma APIType_map2_Untyped[Retype_R_assms, simp]: +lemma APIType_map2_Untyped[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.Untyped) = (tp = Inr (APIObjectType ArchTypes_H.Untyped))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_TCBObject[Retype_R_assms, simp]: +lemma APIType_map2_TCBObject[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.TCBObject) = (tp = Inr (APIObjectType ArchTypes_H.TCBObject))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_generic[Retype_R_assms, simp]: +lemma APIType_map2_generic[Arch_assms, simp]: "APIType_map2 (Inr (APIObjectType api)) = APIType_map2_gen api" by (simp add: APIType_map2_raw_def) @@ -67,11 +67,11 @@ definition APIType_capBits :: "ARM_HYP_H.object_type \ nat \ domain \ (kernel_obje (* inside of Arch, we don't need to isolate generic component *) lemmas makeObjectKO_def = makeObjectKO_raw_def[simplified makeObjectKO_gen_def] -lemma makeObjectKO_generic[Retype_R_assms, simp]: +lemma makeObjectKO_generic[Arch_assms, simp]: "makeObjectKO dev d (Inr (APIObjectType api)) = makeObjectKO_gen d api" by (simp add: makeObjectKO_raw_def) text \makeObject etc. lemmas\ -lemma valid_arch_tcb'_newArchTCB[Retype_R_assms, simp]: +lemma valid_arch_tcb'_newArchTCB[Arch_assms, simp]: "valid_arch_tcb' newArchTCB s" unfolding valid_arch_tcb'_def newArchTCB_def by simp @@ -131,7 +131,7 @@ text \On the abstract side\ text \Lemmas for createNewObjects etc.\ -lemma makeObjectKO_eq[Retype_R_assms]: +lemma makeObjectKO_eq[Arch_assms]: assumes x: "makeObjectKO dev d tp = Some v" shows "(v = KOCTE cte) = @@ -143,7 +143,7 @@ lemma makeObjectKO_eq[Retype_R_assms]: split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm ARM_HYP_H.object_type.split_asm arch_kernel_object.split_asm)+ -lemma objBits_le_obj_bits_api[Retype_R_assms]: +lemma objBits_le_obj_bits_api[Arch_assms]: "makeObjectKO dev d ty = Some ko \ objBitsKO ko \ obj_bits_api (APIType_map2 ty) us" (* FIXME: work around warning due to vcpuBits_def being in both bit_simps and objBits_simps' *) supply vcpuBits_def[bit_simps del] @@ -154,7 +154,7 @@ lemma objBits_le_obj_bits_api[Retype_R_assms]: Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits) done -lemma obj_relation_retype_other_obj[Retype_R_assms]: +lemma obj_relation_retype_other_obj[Arch_assms]: "\ is_other_obj_relation_type (a_type ko); other_obj_relation ko ko' \ \ obj_relation_retype ko ko'" apply (simp add: obj_relation_retype_def) @@ -183,7 +183,7 @@ definition update_gs :: "Structures_A.apiobject_type \ nat \ups x. if x \ ptrs then Some ARMSuperSection else ups x) | _ \ id" -lemma ksPSpace_update_gs_eq[Retype_R_assms, simp]: +lemma ksPSpace_update_gs_eq[Arch_assms, simp]: "ksPSpace (update_gs ty us ptrs s) = ksPSpace s" by (simp add: update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) @@ -204,12 +204,12 @@ lemma update_gs_ksMachineState_update_swap: by (simp add: update_gs_def split: aobject_type.splits Structures_A.apiobject_type.splits) -lemma update_gs_id[Retype_R_assms]: +lemma update_gs_id[Arch_assms]: "tp \ no_gs_types \ update_gs tp us addrs = id" by (simp add: no_gs_types_def update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) -lemma no_gs_types_CapTableObject[Retype_R_assms]: +lemma no_gs_types_CapTableObject[Arch_assms]: "Structures_A.apiobject_type.CapTableObject \ no_gs_types" by (simp add: no_gs_types_def) @@ -226,7 +226,7 @@ lemma update_gs_simps[simp]: gsUserPages_update (\ups x. if x \ ptrs then Some ARMSuperSection else ups x)" by (simp_all add: update_gs_def) -lemma objBitsKO_gt_0[Retype_R_assms]: +lemma objBitsKO_gt_0[Arch_assms]: "0 < objBitsKO ko" apply (case_tac ko) apply (simp_all add: objBits_simps' pageBits_def) @@ -288,7 +288,7 @@ lemma range_cover_canonical_address': apply (frule range_cover_canonical_address[where p="unat p"]; simp?) using unat_less_helper by blast -lemma createNewCaps_valid_cap[Retype_R_assms]: +lemma createNewCaps_valid_cap[Arch_assms]: fixes ptr :: machine_word assumes cover: "range_cover ptr sz (APIType_capBits ty us) n " assumes not_0: "n \ 0" @@ -528,7 +528,7 @@ proof - qed qed -lemma arch_tcb_relation_default[Retype_R_assms]: +lemma arch_tcb_relation_default[Arch_assms]: "arch_tcb_relation default_arch_tcb newArchTCB" by (clarsimp simp: new_context_def newContext_def initContext_def default_arch_tcb_def newArchTCB_def arch_tcb_relation_def) @@ -598,7 +598,7 @@ lemmas object_splits = ARM_HYP_H.object_type.split_asm arch_kernel_object.split_asm -lemma valid_arch_badges_not_arch[Retype_R_assms]: +lemma valid_arch_badges_not_arch[Arch_assms]: "\isArchObjectCap cap' \ valid_arch_badges cap cap' node" by (auto simp: isCap_simps valid_arch_badges_def) @@ -606,7 +606,7 @@ lemma valid_arch_badges_NullCap[simp]: "valid_arch_badges cap NullCap node" by (simp add: valid_arch_badges_not_arch gen_isCap_simps) -lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: +lemma valid_untyped'_helper_arch_cap[Arch_assms]: "\pspace_aligned' s; pspace_distinct' s; pspace_no_overlap' ptr sz s; range_cover ptr sz (objBitsKO val) n; valid_arch_cap' acap s \ \ valid_arch_cap' acap @@ -615,7 +615,7 @@ lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: typ_at_to_obj_at_arches page_directory_at'_def page_table_at'_def split: if_split_asm arch_capability.splits) -lemma retype_in_kernel_mappings'[Retype_R_assms]: +lemma retype_in_kernel_mappings'[Arch_assms]: assumes pc': "pspace_in_kernel_mappings' s'" and cover: "range_cover ptr sz (objBitsKO ko) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -654,7 +654,7 @@ lemma copyGlobalMappings_valid_pspace[wp]: "\valid_pspace'\ copyGlobalMappings pd \\rv. valid_pspace'\" by (simp add: valid_pspace'_def | wp)+ -lemma createNewCaps_cte_wp_at2[Retype_R_assms]: +lemma createNewCaps_cte_wp_at2[Arch_assms]: "\\s. P (cte_wp_at' P' p s) \ \ P' makeObject \ n \ 0 \ range_cover ptr sz (APIType_capBits ty objsz) n @@ -692,7 +692,7 @@ proof (rule hoare_gen_asm) by (simp add: copyGlobalMappings_def storePDE_def) qed -lemma createNewCaps_cte_wp_at'[Retype_R_assms]: +lemma createNewCaps_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -717,7 +717,7 @@ lemma createNewCaps_cte_wp_at'[Retype_R_assms]: (* example of arch-split attempt of this kind of proof; unfortunately splitting off the arch-specific part doesn't actually save space, so we will leave these in Arch *) -lemma createNewCaps_state_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -745,7 +745,7 @@ lemma createNewCaps_state_refs_of'[Retype_R_assms]: apply (force simp: gen_objBits_simps split: ArchTypes_H.apiobject_type.splits) done -lemma createNewCaps_state_hyp_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_hyp_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -783,7 +783,7 @@ lemma arch_live'_KOVCPU[simp]: "arch_live' (KOVCPU makeObject) = False" by (simp add: makeObject_vcpu makeVCPUObject_def arch_live'_def) -lemma createNewCaps_iflive'[Retype_R_assms, wp]: +lemma createNewCaps_iflive'[Arch_assms, wp]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -815,30 +815,30 @@ crunch createNewCaps for qs[wp]: "\s. P (ksReadyQueues s)" and qsL1[wp]: "\s. P (ksReadyQueuesL1Bitmap s)" and qsL2[wp]: "\s. P (ksReadyQueuesL2Bitmap s)" - and ct[Retype_R_assms, wp]: "\s. P (ksCurThread s)" - and ksCurDomain[Retype_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksInterrupt[Retype_R_assms, wp]: "\s. P (ksInterruptState s)" - and nosch[Retype_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and it[Retype_R_assms, wp]: "\s. P (ksIdleThread s)" + and ct[Arch_assms, wp]: "\s. P (ksCurThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksInterrupt[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and it[Arch_assms, wp]: "\s. P (ksIdleThread s)" and asid_table[wp]: "\s. P (armKSASIDTable (ksArchState s))" and cur_vcpu[wp]: "\s. P (armHSCurVCPU (ksArchState s))" and num_list_regs[wp]: "\s. P (armKSGICVCPUNumListRegs (ksArchState s))" and gsMaxObjectSize[wp]: "\s. P (gsMaxObjectSize s)" - and irq_states'[Retype_R_assms, wp]: valid_irq_states' - and ksDomSchedule[Retype_R_assms, wp]: "\s. P (ksDomSchedule s)" - and ksDomScheduleIdx[Retype_R_assms, wp]: "\s. P (ksDomScheduleIdx s)" - and ksDomScheduleStart[Retype_R_assms, wp]: "\s. P (ksDomScheduleStart s)" - and gsUntypedZeroRanges[Retype_R_assms, wp]: "\s. P (gsUntypedZeroRanges s)" + and irq_states'[Arch_assms, wp]: valid_irq_states' + and ksDomSchedule[Arch_assms, wp]: "\s. P (ksDomSchedule s)" + and ksDomScheduleIdx[Arch_assms, wp]: "\s. P (ksDomScheduleIdx s)" + and ksDomScheduleStart[Arch_assms, wp]: "\s. P (ksDomScheduleStart s)" + and gsUntypedZeroRanges[Arch_assms, wp]: "\s. P (gsUntypedZeroRanges s)" and ksArch[wp]: "\s. P (ksArchState s)" (simp: crunch_simps unless_def wp: mapM_x_wp' setObject_ksInterrupt updateObject_default_inv crunch_wps no_irq no_irq_clearMemory) -lemma createNewCaps_arch_ko_type_pre_non_arch[Retype_R_assms]: +lemma createNewCaps_arch_ko_type_pre_non_arch[Arch_assms]: "(case ty of ArchT _ \ False | _ \ True) \ createNewCaps_arch_ko_type_pre ty" by (clarsimp simp add: createNewCaps_arch_ko_type_pre_def) -lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: +lemma createNewCaps_ko_wp_atQ'[Arch_assms]: "\(\s. P (ko_wp_at' P' p s) \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -867,7 +867,7 @@ lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: | split if_split_asm)+ done -lemma createNewCaps_global_refs'[Retype_R_assms]: +lemma createNewCaps_global_refs'[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ valid_global_refs' s @@ -897,7 +897,7 @@ lemma copyGlobalMappings_ksMachineState[wp]: by (simp add: copyGlobalMappings_def storePDE_def split_def | wp mapM_x_wp_inv setObject_ksMachine updateObject_default_inv)+ -lemma createNewCaps_valid_bitmaps[Retype_R_assms]: +lemma createNewCaps_valid_bitmaps[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_bitmaps s\ createNewCaps ty ptr n us dev \\_. valid_bitmaps\" @@ -913,7 +913,7 @@ lemma createNewCaps_valid_bitmaps[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: +lemma createNewCaps_valid_sched_pointers[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_sched_pointers s\ createNewCaps ty ptr n us dev \\_. valid_sched_pointers\" @@ -928,7 +928,7 @@ lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_vms[Retype_R_assms]: +lemma createNewCaps_vms[Arch_assms]: "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ 0 < n) and valid_machine_state'\ @@ -954,7 +954,7 @@ lemma createNewCaps_vms[Retype_R_assms]: field_simps mult_2_right vspace_bits_defs) done -lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: +lemma createNewCaps_pspace_domain_valid[Arch_assms, wp]: "\pspace_domain_valid and K ({ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \ kernel_data_refs = {} \ range_cover ptr sz (APIType_capBits ty us) n \ 0 < n)\ @@ -973,10 +973,12 @@ lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: (* safe for generic context, and we can't requalify object_type.inject as that would result in it being named "inject" *) -lemma object_type_inject[Retype_R_assms]: +lemma object_type_inject[Arch_assms]: "(APIObjectType x = APIObjectType y) = (x = y)" by simp +lemmas Retype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -987,8 +989,7 @@ arch_requalify_consts interpretation Retype_R?: Retype_R makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Retype_R_assms)?)?) qed locale Arch_retype_mdb = retype_mdb + Arch @@ -1017,18 +1018,18 @@ end (* Arch_retype_mdb *) context Arch begin arch_global_naming -named_theorems Retype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_2 locale *) (* drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [Retype_R_2_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] +lemmas [Arch_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] (* FIXME arch-split: currently only the gen_ version is used *) lemmas valid_obj_makeObject_rules = gen_valid_obj_makeObject_rules valid_obj_makeObject_pte valid_obj_makeObject_asid_pool valid_obj_makeObject_vcpu -lemma retype_state_relation[Retype_R_2_assms]: +lemma retype_state_relation[Arch_assms]: notes data_map_insert_def[simp del] assumes sr: "(s, s') \ state_relation" and vs: "valid_pspace s" "valid_mdb s" @@ -1259,7 +1260,7 @@ lemma retype_state_relation[Retype_R_2_assms]: split: Structures_A.apiobject_type.splits aobject_type.splits) qed -lemma createObjects_valid_objs'[Retype_R_2_assms]: +lemma createObjects_valid_objs'[Arch_assms]: assumes mko: "makeObjectKO dev d ty = Some val" and max_d: "ty = Inr (APIObjectType TCBObject) \ d \ maxDomain" and vo: "valid_objs' s" @@ -1345,7 +1346,7 @@ proof - done qed -lemma createNewCaps_idle'[Retype_R_2_assms, wp]: +lemma createNewCaps_idle'[Arch_assms, wp]: "\valid_idle' and valid_pspace' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ createNewCaps ty ptr n us d @@ -1449,7 +1450,7 @@ lemma createNewCaps_pde_mappings'[wp]: makeObject_pde valid_arch_state'_def page_directory_at'_def) done -lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: +lemma createNewCaps_valid_arch_state[Arch_assms]: "\(\s. valid_arch_state' s \ valid_pspace' s \ pspace_no_overlap' ptr sz s \ (tp = APIObjectType ArchTypes_H.CapTableObject \ us > 0)) and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ @@ -1464,7 +1465,7 @@ lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: valid_arch_state'_def valid_asid_table'_def createNewCaps_arch_ko_pre_def) done -lemma createNewCaps_sched_queues[Retype_R_2_assms]: +lemma createNewCaps_sched_queues[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" assumes not_0: "n \ 0" shows @@ -1488,7 +1489,7 @@ lemma createNewCaps_sched_queues[Retype_R_2_assms]: split_del: if_split, fastforce simp add: mult_2 add_ac vspace_bits_defs)+ -lemma createNewCaps_null_filter'[Retype_R_2_assms]: +lemma createNewCaps_null_filter'[Arch_assms]: "\(\s. P (null_filter' (ctes_of s))) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0) \ @@ -1512,7 +1513,7 @@ lemma createNewCaps_null_filter'[Retype_R_2_assms]: | fastforce)+ done -lemma createObjects_no_cte_valid_global[Retype_R_2_assms]: +lemma createObjects_no_cte_valid_global[Arch_assms]: assumes no_cte: "\c. projectKO_opt val \ Some (c::cte)" assumes no_tcb: "\t. projectKO_opt val \ Some (t::tcb)" shows "\\s. pspace_aligned' s \ pspace_distinct' s \ @@ -1553,7 +1554,7 @@ lemma createObjects_valid_arch: apply (simp add: o_def; auto simp: pred_conj_def)+ done -lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: +lemma createObjects_untyped_ranges_zero'[Arch_assms]: assumes moKO: "makeObjectKO dev d ty = Some val" shows "\ct_active' and valid_pspace' and pspace_no_overlap' ptr sz @@ -1579,18 +1580,19 @@ lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: apply (simp add: makeObject_cte untypedZeroRange_def) done +lemmas Retype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_2?: Retype_R_2 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Retype_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Retype_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_3 locale *) lemma createObjects_no_cte_invs: assumes moKO: "makeObjectKO dev d ty = Some val" @@ -1678,7 +1680,7 @@ proof - split: option.splits kernel_object.splits) qed -lemma createNewCaps_valid_pspace[Retype_R_3_assms]: +lemma createNewCaps_valid_pspace[Arch_assms]: assumes not_0: "n \ 0" and cover: "range_cover ptr sz (APIType_capBits ty us) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -1726,7 +1728,7 @@ lemma init_arch_objects_APIType_map2_VCPU_noop: apply (simp add: init_arch_objects_def APIType_map2_def) done -lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: +lemma corres_retype_region_createNewCaps[Arch_assms]: "corres ((\r r'. length r = length r' \ list_all2 cap_relation r r') \ map (\ref. default_cap (APIType_map2 (Inr ty)) ref us dev)) (\s. valid_pspace s \ valid_mdb s \ valid_list s \ valid_arch_state s @@ -2037,13 +2039,14 @@ lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: objBits_simps APIType_map2_def arch_default_cap_def) done +lemmas Retype_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_3?: Retype_R_3 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Retype_R_3_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchSchedule_R.thy b/proof/refine/ARM_HYP/ArchSchedule_R.thy index 63f8ca9055..63ca3e233c 100644 --- a/proof/refine/ARM_HYP/ArchSchedule_R.thy +++ b/proof/refine/ARM_HYP/ArchSchedule_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R locale *) lemma vs_refs_pages_vcpu: "vs_refs_pages (ArchObj (VCPU vcpu)) = {}" @@ -95,7 +95,7 @@ lemma vcpu_at_cross: done crunch tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue - for state_hyp_refs_of'[Schedule_R_assms, wp]: "\s. P (state_hyp_refs_of' s)" + for state_hyp_refs_of'[Arch_assms, wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp) lemma vcpuSwitch_typ_at'[wp]: @@ -123,21 +123,21 @@ proof - by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_ARM_HYP_H_switchToThread_typ_at' pos]) qed -lemmas Arch_switchToThread_st_tcb_at'[Schedule_R_assms] = +lemmas Arch_switchToThread_st_tcb_at'[Arch_assms] = Arch_switchToThread_pred_tcb'[where proj=itcbState] crunch storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread, Arch.switchToIdleThread for ksQ[wp]: "\s. P (ksReadyQueues s)" - and ksIdleThread[Schedule_R_assms, wp]: "\s. P (ksIdleThread s)" - and sym_heap_sched_pointers[Schedule_R_assms, wp]: sym_heap_sched_pointers - and valid_objs'[Schedule_R_assms, wp]: valid_objs' + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and sym_heap_sched_pointers[Arch_assms, wp]: sym_heap_sched_pointers + and valid_objs'[Arch_assms, wp]: valid_objs' (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp simp: crunch_simps obj_at'_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread - for pspace_aligned[Schedule_R_assms, wp]: pspace_aligned - and pspace_distinct[Schedule_R_assms, wp]: pspace_distinct - and ready_queues[Schedule_R_assms, wp]: "\s. P (ready_queues s)" + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct + and ready_queues[Arch_assms, wp]: "\s. P (ready_queues s)" and ready_qs_distinct[wp]: ready_qs_distinct (wp: ready_qs_distinct_lift crunch_wps simp: crunch_simps) @@ -171,7 +171,7 @@ lemma arch_switchToThread_corres: done (* use superset of arch_switchToThread_corres preconditions across the architectures as interface *) -lemma arch_switchToThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and valid_objs and valid_asid_map and valid_arch_caps and pspace_aligned and pspace_distinct and valid_global_objs and (\s. sym_refs (state_hyp_refs_of s)) @@ -204,7 +204,7 @@ lemma arch_switchToIdleThread_corres: done (* use superset of arch_switchToIdleThread_corres preconditions across the architectures as interface *) -lemma arch_switchToIdleThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToIdleThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and pspace_aligned and pspace_distinct and valid_asid_map and valid_idle and valid_arch_caps and valid_global_objs and valid_vspace_objs and valid_objs) @@ -220,14 +220,14 @@ lemma clearExMonitor_invs'[wp]: in_monad select_f_def) done -lemma Arch_switchToThread_invs[Schedule_R_assms, wp]: +lemma Arch_switchToThread_invs[Arch_assms, wp]: "\invs' and tcb_at' t\ Arch.switchToThread t \\rv. invs'\" by (wpsimp simp: ARM_HYP_H.switchToThread_def wp: getObject_tcb_hyp_sym_refs) crunch "Arch.switchToThread" - for ksCurDomain[Schedule_R_assms, wp]: "\s. P (ksCurDomain s)" - and tcbDomain[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" - and tcbState[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" + for ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and tcbDomain[Arch_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" + and tcbState[Arch_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" (simp: crunch_simps wp: crunch_wps getASID_wp) lemma threadSet_invs_no_cicd'_trivialT: @@ -284,7 +284,7 @@ lemma clearExMonitor_invs_no_cicd'[wp]: in_monad select_f_def) done -lemma Arch_switchToThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToThread_invs_no_cicd'[Arch_assms]: "Arch.switchToThread t \invs_no_cicd'\" by (wpsimp wp: getObject_tcb_hyp_sym_refs setVMRoot_invs_no_cicd' simp: ARM_HYP_H.switchToThread_def) (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def) @@ -310,7 +310,7 @@ crunch "ThreadDecls_H.switchToThread" for ksCurDomain[wp]: "\s. P (ksCurDomain s)" (* neater unfold, actual unfold is really ugly *) -lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: +lemma bitmapQ_lookupBitmapPriority_simp[Arch_assms]: "\ ksReadyQueuesL1Bitmap s d \ 0 ; valid_bitmapQ s ; bitmapQ_no_L1_orphans s \ \ bitmapQ d (lookupBitmapPriority d s) s = (ksReadyQueuesL1Bitmap s d !! word_log2 (ksReadyQueuesL1Bitmap s d) \ @@ -336,7 +336,7 @@ lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: apply (fastforce intro: word_of_nat_less simp: wordRadix_def' unat_of_nat word_size)+ done -lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToIdleThread_invs_no_cicd'[Arch_assms]: "Arch.switchToIdleThread \invs_no_cicd'\" unfolding switchToIdleThread_def by (wpsimp wp: setCurThread_invs_no_cicd'_idle_thread setVMRoot_invs_no_cicd' vcpuSwitch_it') @@ -344,28 +344,29 @@ lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: crunch Arch.switchToIdleThread for obj_at'[wp]: "obj_at' (P :: ('a :: no_vcpu) \ bool) t" -lemmas Arch_switchToIdleThread_not_queued'[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_not_queued'[Arch_assms] = ArchThreadDecls_H_ARM_HYP_H_switchToIdleThread_obj_at'[where P="Not \ tcbQueued"] -lemmas Arch_switchToIdleThread_tcbState[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_tcbState[Arch_assms] = ArchThreadDecls_H_ARM_HYP_H_switchToIdleThread_obj_at'[where P="P \ tcbState" for P] crunch arch_switch_to_thread, handle_spurious_irq - for valid_idle[Schedule_R_assms, wp]: valid_idle + for valid_idle[Arch_assms, wp]: valid_idle + +lemmas Schedule_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R?: Schedule_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Schedule_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_2 locale *) -lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: +lemma bitmapL1_highest_lookup[Arch_assms]: "\ valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; bitmapQ d p s \ \ p \ lookupBitmapPriority d s" apply (subgoal_tac "ksReadyQueuesL1Bitmap s d \ 0") @@ -411,7 +412,7 @@ lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: apply (erule word_log2_maximum) done -lemma guarded_switch_to_chooseThread_fragment_corres[Schedule_R_2_assms]: +lemma guarded_switch_to_chooseThread_fragment_corres[Arch_assms]: "corres dc (P and st_tcb_at runnable t and invs and valid_sched) (P' and invs_no_cicd') @@ -479,19 +480,20 @@ crunch prepareNextDomain and nosch[wp]: "\s. P (ksSchedulerAction s)" crunch tcb_sched_action - for valid_vs_lookup[Schedule_R_2_assms, wp]: valid_vs_lookup + for valid_vs_lookup[Arch_assms, wp]: valid_vs_lookup + +lemmas Schedule_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R_2?: Schedule_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Schedule_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_3 locale *) lemma scheduleChooseNewThread_fragment_corres: "corres dc (invs and valid_domain_list and valid_sched and @@ -515,7 +517,7 @@ lemma scheduleChooseNewThread_fragment_corres: apply (auto simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def) done -lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_corres[Arch_assms]: "corres dc (\s. invs s \ valid_domain_list s \ valid_sched s \ scheduler_action s = choose_new_thread) (\s. invs' s \ ksSchedulerAction s = ChooseNewThread) @@ -528,7 +530,7 @@ lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: apply (wpsimp simp: getDomainTime_def)+ done -lemma scheduleChooseNewThread_invs'[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_invs'[Arch_assms]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \ \_ s. invs' s \" @@ -555,7 +557,7 @@ lemma stit_nosch[wp]: apply (wp setCurThread_nosch | simp add: getIdleThread_def)+ done -lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: +lemma scheduleChooseNewThread_ct_activatable'[Arch_assms, wp]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \\_. ct_in_state' activatable'\" @@ -566,12 +568,13 @@ lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: | (rule hoare_lift_Pf[where f=ksCurThread], solves wp) | strengthen invs'_invs_no_cicd)+ +lemmas Schedule_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Schedule_R_3?: Schedule_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Schedule_R_3_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchStateRelationLemmas.thy b/proof/refine/ARM_HYP/ArchStateRelationLemmas.thy index 709a1d8d2f..0f79ce4697 100644 --- a/proof/refine/ARM_HYP/ArchStateRelationLemmas.thy +++ b/proof/refine/ARM_HYP/ArchStateRelationLemmas.thy @@ -15,7 +15,7 @@ begin context Arch begin arch_global_naming -named_theorems StateRelation_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for StateRelation_R locale *) lemma obj_relation_cuts_def2: "obj_relation_cuts ko x = @@ -78,7 +78,7 @@ lemma obj_relation_cutsE: split: Structures_A.kernel_object.splits kernel_object.splits if_splits ARM_HYP_A.arch_kernel_obj.splits) -lemma is_other_obj_relation_type_gen[simp, StateRelation_R_assms]: +lemma is_other_obj_relation_type_gen[simp, Arch_assms]: "\n. \ is_other_obj_relation_type (ACapTable n)" "\ is_other_obj_relation_type ATCB" "is_other_obj_relation_type AEndpoint" @@ -98,7 +98,7 @@ lemma is_other_obj_relation_type_DeviceData: "\ is_other_obj_relation_type (AArch (ADeviceData sz))" unfolding is_other_obj_relation_type_def by simp -lemma obj_relation_cuts_trivial[StateRelation_R_assms]: +lemma obj_relation_cuts_trivial[Arch_assms]: "ptr \ fst ` obj_relation_cuts ty ptr" apply (case_tac ty) apply (rename_tac sz cs) @@ -172,7 +172,7 @@ lemma ghost_relation_wrapper_lift': apply wp done -lemma ghost_relation_wrapper_genD[StateRelation_R_assms]: +lemma ghost_relation_wrapper_genD[Arch_assms]: "ghost_relation_wrapper s s' \ ups_of_heap (kheap s) = gsUserPages s' \ cns_of_heap (kheap s) = gsCNodes s'" by (simp add: ghost_relation_of_heap) @@ -213,20 +213,21 @@ lemma other_aobj_relation_aobj: unfolding other_aobj_relation_def is_ArchObj_def by (clarsimp split: Structures_A.kernel_object.splits) -lemma msgLabelBits_msg_label_bits[StateRelation_R_assms]: +lemma msgLabelBits_msg_label_bits[Arch_assms]: "msgLabelBits = msg_label_bits" by (simp add: msgLabelBits_def) -lemma msgInfoRegister_msg_info_register[StateRelation_R_assms]: +lemma msgInfoRegister_msg_info_register[Arch_assms]: "msgInfoRegister = msg_info_register" by (simp add: msg_info_register_def msgInfoRegister_def) -end +lemmas StateRelation_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation StateRelation_R?: StateRelation_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact StateRelation_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact ARM_HYP.StateRelation_R_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/ARM_HYP/ArchSyscall_R.thy b/proof/refine/ARM_HYP/ArchSyscall_R.thy index 47c70203c5..9db8e48a98 100644 --- a/proof/refine/ARM_HYP/ArchSyscall_R.thy +++ b/proof/refine/ARM_HYP/ArchSyscall_R.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_R locale *) lemma vcpuFlushIfCurrent_corres[corres]: "corres dc (pspace_aligned and pspace_distinct and valid_arch_state and tcb_at tptr) @@ -22,7 +22,7 @@ lemma vcpuFlushIfCurrent_corres[corres]: unfolding vcpu_flush_if_current_def vcpuFlushIfCurrent_def by (corres wp: arch_thread_get_wp archThreadGet_wp) -lemma prepareSetDomain_corres[Syscall_R_assms, corres]: +lemma prepareSetDomain_corres[Arch_assms, corres]: "corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu and valid_arch_state and tcb_at tptr) (pspace_aligned' and pspace_distinct' and no_0_obj') (arch_prepare_set_domain tptr new_dom) (prepareSetDomain tptr new_dom)" @@ -30,19 +30,19 @@ lemma prepareSetDomain_corres[Syscall_R_assms, corres]: by corres crunch prepareSetDomain - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' and ksSchedulerAction[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Syscall_R_assms, wp]: sch_act_simple - and tcb_at'[Syscall_R_assms, wp]: "tcb_at' p" + and sch_act_simple[Arch_assms, wp]: sch_act_simple + and tcb_at'[Arch_assms, wp]: "tcb_at' p" and ksCurThread[wp]: "\s. P (ksCurThread s)" and pred_tcb_at'[wp]: "pred_tcb_at' proj P t" - and ct_in_state'[Syscall_R_assms, wp]: "ct_in_state' P" + and ct_in_state'[Arch_assms, wp]: "ct_in_state' P" (wp: sch_act_simple_lift ct_in_state_thread_state_lift' crunch_wps) crunch postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler - for typ_at'[Syscall_R_assms, wp]: "\s. P (typ_at' T p s)" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" -lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: +lemma setThreadState_irq_control_inv_valid'[Arch_assms, wp]: "setThreadState st t \irq_control_inv_valid' irqcontrol_invocation\" apply (case_tac irqcontrol_invocation; simp) apply (rename_tac archirq_inv) @@ -51,11 +51,11 @@ lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: done (* FIXME arch-split: consider moving to where other msgRegisters stuff goes... Tcb_R? Ipc_R? *) -lemma len_msg_registes_le_max_length[Syscall_R_assms]: +lemma len_msg_registes_le_max_length[Arch_assms]: "length msg_registers \ msg_max_length" by (simp add: msg_max_length_def msgRegisters_unfold) -lemma capRegister_cap_register[Syscall_R_assms]: +lemma capRegister_cap_register[Arch_assms]: "capRegister = cap_register" by (simp add: cap_register_def capRegister_def) @@ -76,7 +76,7 @@ lemma getHDFAR_invs'[wp]: "doMachineOp getHDFAR \invs'\" by (simp add: getHDFAR_def doMachineOp_def split_def select_f_returns | wp)+ -lemma hv_invs'[Syscall_R_assms, wp]: +lemma hv_invs'[Arch_assms, wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" apply (simp add: ARM_HYP_H.handleVMFault_def cong: vmfault_type.case_cong) @@ -85,14 +85,14 @@ lemma hv_invs'[Syscall_R_assms, wp]: done crunch handleVMFault - for nosch[Syscall_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma handleSpuriousIRQ_corres[Syscall_R_assms, corres]: +lemma handleSpuriousIRQ_corres[Arch_assms, corres]: "corres dc \ \ handle_spurious_irq handleSpuriousIRQ" unfolding handle_spurious_irq_def handleSpuriousIRQ_def by (corres corres: corres_machine_op) -lemma handleHypervisorFault_corres[Syscall_R_assms]: +lemma handleHypervisorFault_corres[Arch_assms]: "corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread) (invs' and sch_act_not thread and st_tcb_at' simple' thread and ex_nonz_cap_to' thread) @@ -101,7 +101,7 @@ lemma handleHypervisorFault_corres[Syscall_R_assms]: apply (corres corres: handleFault_corres simp: valid_fault_def) done -lemma hvmf_invs_lift[Syscall_R_assms]: +lemma hvmf_invs_lift[Arch_assms]: "(\s m. P (s\ksMachineState := ksMachineState s\machine_state_rest := m\\) = P s) \ \P\ handleVMFault t flt \\_ _. True\, \\_. P\" unfolding handleVMFault_def @@ -110,16 +110,16 @@ lemma hvmf_invs_lift[Syscall_R_assms]: doMachineOp_bind getRestartPC_def getRegister_def) crunch handleVMFault - for st_tcb_at'[Syscall_R_assms, wp]: "st_tcb_at' P t" - and ex_nonz_cap_to'[Syscall_R_assms, wp]: "ex_nonz_cap_to' t" - and norq[Syscall_R_assms, wp]: "\s. P (ksReadyQueues s)" - and ksit[Syscall_R_assms, wp]: "\s. P (ksIdleThread s)" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" + and ex_nonz_cap_to'[Arch_assms, wp]: "ex_nonz_cap_to' t" + and norq[Arch_assms, wp]: "\s. P (ksReadyQueues s)" + and ksit[Arch_assms, wp]: "\s. P (ksIdleThread s)" crunch handleHypervisorFault for ksit[wp]: "\s. P (ksIdleThread s)" (wp: undefined_valid haskell_assert_inv) -lemma hh_invs'[Syscall_R_assms, wp]: +lemma hh_invs'[Arch_assms, wp]: "\invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p and (\s. p \ ksIdleThread s)\ handleHypervisorFault p t \\_. invs'\" @@ -127,14 +127,14 @@ lemma hh_invs'[Syscall_R_assms, wp]: by (cases t; wpsimp simp: ARM_HYP_H.handleHypervisorFault_def) crunch handleSpuriousIRQ - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' (ignore: doMachineOp wp: dmo_invs'_simple) -lemma arch_performInvocation_inv[Syscall_R_assms]: +lemma arch_performInvocation_inv[Arch_assms]: "\\\ Arch.performInvocation invocation -, \P\" by (wpsimp simp: performARMMMUInvocation_def ARM_HYP_H.performInvocation_def) -lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: +lemma Arch_performIRQControl_inv_EE[Arch_assms]: "\\\ Arch.performIRQControl irqc -, \P\" unfolding ARM_HYP_H.performIRQControl_def by wpsimp @@ -142,12 +142,13 @@ lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: (* FIXME arch-split: move to ArchInvariants_AI on this arch *) lemmas pageBitsForSize_bounded = pbfs_less_wb' +lemmas Syscall_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Syscall_R?: Syscall_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Syscall_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Syscall_R_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchTcbAcc_R.thy b/proof/refine/ARM_HYP/ArchTcbAcc_R.thy index 5f53f566f1..6bd216ec66 100644 --- a/proof/refine/ARM_HYP/ArchTcbAcc_R.thy +++ b/proof/refine/ARM_HYP/ArchTcbAcc_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R locale *) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_loadWord_bits[TcbAcc_R_assms, wp]: +lemma no_fail_loadWord_bits[Arch_assms, wp]: "no_fail (\_. is_aligned p word_size_bits) (loadWord p)" by (wpsimp simp: loadWord_def is_aligned_mask[symmetric] word_size_bits_def) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_storeWord_bits[TcbAcc_R_assms]: +lemma no_fail_storeWord_bits[Arch_assms]: "no_fail (\_. is_aligned p word_size_bits) (storeWord p w)" by (wpsimp simp: storeWord_def is_aligned_mask[symmetric] word_size_bits_def) -lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: +lemma prioToL1Index_l1IndexToPrio_or_id[Arch_assms]: "\ unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \ \ prioToL1Index ((l1IndexToPrio w) || w') = w" unfolding l1IndexToPrio_def prioToL1Index_def @@ -33,12 +33,12 @@ lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: apply (subst unat_of_nat_eq, simp_all add: word_size) done -lemma l1IndexToPrio_wordRadix_mask[TcbAcc_R_assms, simp]: +lemma l1IndexToPrio_wordRadix_mask[Arch_assms, simp]: "l1IndexToPrio i && mask wordRadix = 0" unfolding l1IndexToPrio_def by (simp add: wordRadix_def') -lemma st_tcb_at_coerce_abstract[TcbAcc_R_assms]: +lemma st_tcb_at_coerce_abstract[Arch_assms]: assumes t: "st_tcb_at' P t c" assumes sr: "(a, c) \ state_relation" shows "st_tcb_at (\st. \st'. thread_state_relation st st' \ P st') t a" @@ -62,7 +62,7 @@ lemma tcb_at'_cross: other_obj_relation_def pte_relation_def pde_relation_def is_tcb_def split: Structures_A.kernel_object.split_asm if_split_asm arch_kernel_obj.split_asm) -lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: +lemma setObject_update_TCB_corres'[Arch_assms]: assumes tcbs: "tcb_relation tcb tcb' \ tcb_relation new_tcb new_tcb'" assumes tables: "\(getF, v) \ ran tcb_cap_cases. getF new_tcb = getF tcb" assumes tables': "\(getF, v) \ ran tcb_cte_cases. getF new_tcb' = getF tcb'" @@ -138,13 +138,13 @@ lemma setObject_tcb_ko_at'_pde[wp]: "setObject p (v::tcb) \ \s. P (ko_at' (pde::pde) p' s) \" by (clarsimp intro!: obj_at_setObject2 simp: updateObject_default_def in_monad) -lemma setObject_tcb_valid_arch'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_valid_arch'[Arch_assms, wp]: "\valid_arch_state'\ setObject t (v :: tcb) \\rv. valid_arch_state'\" by (wpsimp wp: valid_arch_state_lift' setObject_typ_at' setObject_ko_wp_at simp: objBits_simps', rule refl; simp add: pred_conj_def) (clarsimp simp: is_vcpu'_def ko_wp_at'_def obj_at'_def) -lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_refs'[Arch_assms, wp]: "\\s. P (global_refs' s)\ setObject t (v::tcb) \\rv s. P (global_refs' s)\" apply (clarsimp simp: setObject_def split_def updateObject_default_def) apply wp @@ -161,7 +161,7 @@ lemma threadSet_state_hyp_refs_of'_vcpu: elim!: rsubst[where P=P] del: ext intro!: ext)+ done -lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: +lemma threadSet_state_hyp_refs_of'[Arch_assms]: assumes y: "\tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb)" shows "\\s. P (state_hyp_refs_of' s)\ threadSet F t \\rv s. P (state_hyp_refs_of' s)\" apply (rule threadSet_state_hyp_refs_of'_vcpu) @@ -170,7 +170,7 @@ lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: apply (metis empty_not_insert ex_in_conv mem_Sigma_iff option.set_cases set_empty_eq) done -lemma threadSet_iflive'T[TcbAcc_R_assms]: +lemma threadSet_iflive'T[Arch_assms]: assumes x: "\tcb. \(getF, setF) \ ran tcb_cte_cases. getF (F tcb) = getF tcb" shows "\\s. if_live_then_nonz_cap' s @@ -211,14 +211,14 @@ lemma setObject_tcb_pde_mappings'[wp]: apply (auto dest: updateObject_default_result) done -lemma zobj_refs'_capRange[TcbAcc_R_assms]: +lemma zobj_refs'_capRange[Arch_assms]: "s \' cap \ zobj_refs' cap \ capRange cap" apply (cases cap; simp add: valid_cap'_def capAligned_def capRange_def is_aligned_no_overflow) apply (rename_tac aobj_cap) apply (case_tac aobj_cap; clarsimp dest!: is_aligned_no_overflow) done -lemma capAligned_zobj_refs'_capRange[TcbAcc_R_assms]: +lemma capAligned_zobj_refs'_capRange[Arch_assms]: "capAligned c \ zobj_refs' c \ capRange c" apply (cases c; simp add: capAligned_def capRange_def is_aligned_no_overflow) apply (rename_tac ac) @@ -255,7 +255,7 @@ schematic_goal l2BitmapSize_def': (* arch specific consequence *) "l2BitmapSize = numeral ?X" by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def) -lemma prioToL1Index_size[TcbAcc_R_assms, simp]: +lemma prioToL1Index_size[Arch_assms, simp]: "prioToL1Index w < l2BitmapSize" unfolding prioToL1Index_def wordRadix_def l2BitmapSize_def' by (fastforce simp: shiftr_div_2n' nat_divide_less_eq @@ -266,12 +266,12 @@ lemma prioToL1Index_max: unfolding prioToL1Index_def wordRadix_def by (insert unat_lt2p[where x=p], simp add: shiftr_div_2n') -lemma prioToL1Index_bit_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_set[Arch_assms]: "((2 :: machine_word) ^ prioToL1Index p) !! prioToL1Index p" using l2BitmapSize_def' by (fastforce simp: nth_w2p_same intro: order_less_le_trans[OF prioToL1Index_size]) -lemma prioL2Index_bit_set[TcbAcc_R_assms]: +lemma prioL2Index_bit_set[Arch_assms]: fixes p :: priority shows "((2::machine_word) ^ unat (ucast p && (mask wordRadix :: machine_word))) !! unat (p && mask wordRadix)" apply (simp add: nth_w2p wordRadix_def ucast_and_mask[symmetric] unat_ucast_upcast is_up) @@ -290,25 +290,25 @@ lemma prioToL1Index_bits_low_high_eq: unfolding prioToL1Index_def by (fastforce simp: nth_w2p wordRadix_def is_up bits_low_high_eq) -lemma prioToL1Index_bit_not_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_not_set[Arch_assms]: "\ (~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" apply (subst word_ops_nth_size, simp_all add: prioToL1Index_bit_set del: bit_exp_iff) apply (fastforce simp: prioToL1Index_def wordRadix_def word_size intro: order_less_le_trans[OF word_shiftr_lt]) done -lemma prioToL1Index_complement_nth_w2p[TcbAcc_R_assms]: +lemma prioToL1Index_complement_nth_w2p[Arch_assms]: fixes p p' :: priority shows "(~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p' = (prioToL1Index p \ prioToL1Index p')" by (fastforce simp: complement_nth_w2p prioToL1Index_lt wordRadix_def word_size)+ -lemma invertL1Index_eq_cancelD[TcbAcc_R_assms]: +lemma invertL1Index_eq_cancelD[Arch_assms]: "\ invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \ \ i = j" by (simp add: invertL1Index_def l2BitmapSize_def') -lemma pspace_dom_dom[TcbAcc_R_assms]: +lemma pspace_dom_dom[Arch_assms]: "dom ps \ pspace_dom ps" unfolding pspace_dom_def apply clarsimp @@ -326,7 +326,7 @@ lemma pspace_dom_dom[TcbAcc_R_assms]: apply (case_tac vmpage_size, simp_all add: pageBits_def) done -lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: +lemma less_max_ipc_words_less_2p_msg_align_bits[Arch_assms]: assumes y: "y < unat max_ipc_words" shows "word_of_nat y * (word_size :: machine_word) < 2 ^ msg_align_bits" apply (simp add: word_size_def word_size_bits_def) @@ -335,37 +335,38 @@ lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: apply (simp add: msg_align_bits max_ipc_words)+ done -lemma is_aligned_word_size_bits_less_max_ipc_words[TcbAcc_R_assms]: +lemma is_aligned_word_size_bits_less_max_ipc_words[Arch_assms]: "y < unat max_ipc_words \ is_aligned (word_of_nat y * word_size) word_size_bits" by (simp add: word_size_def word_size_bits_def) (rule is_aligned_mult_triv2[where n=2, simplified]) -lemma msg_align_bits_le_pageBitsForSize[TcbAcc_R_assms]: +lemma msg_align_bits_le_pageBitsForSize[Arch_assms]: "msg_align_bits \ pageBitsForSize sz" by (simp add: msg_align_bits pageBitsForSize_def split: vmpage_size.split) -lemmas [TcbAcc_R_assms] = +lemmas [Arch_assms] = dmo_getirq_inv getActiveIRQ_masked tcb_at'_cross pspace_relation_update_tcbs +lemmas TcbAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R?: TcbAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.TcbAcc_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_2 locale *) sublocale asUser: typ_at_props' "asUser tptr f" by typ_at_props' -lemma tcb_hyp_refs'_valid_arch_tcb'_eq[TcbAcc_R_2_assms]: +lemma tcb_hyp_refs'_valid_arch_tcb'_eq[Arch_assms]: "tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ valid_arch_tcb' (tcbArch (F tcb)) s = valid_arch_tcb' (tcbArch tcb) s" by (auto simp: valid_arch_tcb'_def tcb_vcpu_refs'_def) @@ -446,14 +447,14 @@ lemma asUser_corres: apply (simp add: invs'_def valid_state'_def valid_pspace'_def) done -lemma asUser_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_getRegister_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (getRegister r)) (asUser t (getRegister r))" apply (rule asUser_corres') apply (clarsimp simp: getRegister_def) done -lemma user_getreg_inv'[TcbAcc_R_2_assms, wp]: +lemma user_getreg_inv'[Arch_assms, wp]: "\P\ asUser t (getRegister r) \\x. P\" apply (rule asUser_inv) apply (simp_all add: getRegister_def) @@ -487,7 +488,7 @@ lemma asUser_iflive'[wp]: unfolding asUser_def by (wpsimp wp: threadSet_iflive' hoare_drop_imps, auto) -lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_setRegister_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (setRegister r v)) (asUser t (setRegister r v))" @@ -496,7 +497,7 @@ lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: apply (rule corres_modify'; simp) done -lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs apply (wp | simp add: bitmap_fun_defs bitmapQ_no_L1_orphans_def)+ @@ -504,7 +505,7 @@ lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: prioToL1Index_complement_nth_w2p) done -lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L2_orphans[Arch_assms, wp]: "\ bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L2_orphans \" @@ -516,7 +517,7 @@ lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: apply metis done -lemma removeFromBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma removeFromBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p \ removeFromBitmap d p \\_. valid_bitmapQ_except d p \" @@ -567,7 +568,7 @@ proof - done qed -lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma addToBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ addToBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs bitmapQ_defs using word_unat_mask_lt[where w=p and m=wordRadix] @@ -577,7 +578,7 @@ lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: wordBits_def numPriorities_def) done -lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma addToBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p and bitmapQ_no_L2_orphans \ addToBitmap d p \\_. valid_bitmapQ_except d p \" @@ -589,7 +590,7 @@ lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: dest: prioToL1Index_bits_low_high_eq) done -lemma in_user_frame_eq[TcbAcc_R_2_assms]: +lemma in_user_frame_eq[Arch_assms]: assumes y: "y < unat max_ipc_words" and al: "is_aligned a msg_align_bits" shows "in_user_frame (a + of_nat y * word_size) s = in_user_frame a s" @@ -616,15 +617,15 @@ lemma thread_get_registers: apply (clarsimp simp: map_upd_triv select_f_def image_def return_def) done -lemma msgRegisters_msg_registers[TcbAcc_R_2_assms]: +lemma msgRegisters_msg_registers[Arch_assms]: "msgRegisters = msg_registers" by (simp add: msgRegisters_unfold) -lemma suc_len_msg_registers_less_2p_word_bits[TcbAcc_R_2_assms]: +lemma suc_len_msg_registers_less_2p_word_bits[Arch_assms]: "Suc (length msg_registers) < 2 ^ word_bits" by (simp add: msgRegisters_unfold word_bits_def) -lemma asUser_mapM_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_mapM_getRegister_corres[Arch_assms]: "corres (\con regs. regs = map con msg_registers) (tcb_at t and pspace_aligned and pspace_distinct) \ (thread_get (arch_tcb_get_registers o tcb_arch) t) @@ -664,7 +665,7 @@ lemma cte_at_tcb_at_16': (* FIXME arch-split: can't be generic with this 16 *) lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split] -lemma lookupIPCBuffer_corres'[TcbAcc_R_2_assms]: +lemma lookupIPCBuffer_corres'[Arch_assms]: "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct) (valid_objs' and no_0_obj') @@ -721,7 +722,7 @@ crunch rescheduleRequired for hyp_refs_of'[wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps wp: threadSet_state_hyp_refs_of' ignore: threadSet) -lemmas [TcbAcc_R_2_assms] = +lemmas [Arch_assms] = getThreadBufferSlot_inv lookupIPCBuffer_inv rescheduleRequired_hyp_refs_of' @@ -732,7 +733,7 @@ lemma archThreadGet_wp: unfolding archThreadGet_def by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def) -lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setThreadState_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P ((state_hyp_refs_of' s))\ setThreadState st t \\rv s. P (state_hyp_refs_of' s)\" @@ -740,14 +741,14 @@ lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: | wp threadSet_state_hyp_refs_of' hoare_drop_imps)+ done -lemma setBoundNotification_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setBoundNotification_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P (state_hyp_refs_of' s)\ setBoundNotification ntfn t \\rv s. P (state_hyp_refs_of' s)\" by (simp add: setBoundNotification_def fun_upd_def | wp threadSet_state_hyp_refs_of')+ -lemma storeWord_invs'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs'[Arch_assms, wp]: "\pointerInUserData p and invs'\ doMachineOp (storeWord p w) \\rv. invs'\" proof - have aligned_offset_ignore: @@ -772,7 +773,7 @@ proof - done qed -lemma storeWord_invs_no_cicd'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs_no_cicd'[Arch_assms, wp]: "\pointerInUserData p and invs_no_cicd'\ doMachineOp (storeWord p w) \\rv. invs_no_cicd'\" proof - have aligned_offset_ignore: @@ -797,27 +798,28 @@ proof - done qed -lemma tcbSchedAppend_pspace_in_kernel_mappings'[TcbAcc_R_2_assms]: +lemma tcbSchedAppend_pspace_in_kernel_mappings'[Arch_assms]: "tcbSchedAppend t \pspace_in_kernel_mappings'\" by wpsimp (* FIXME: the code assumes that it is word_t, so length_type should be defined generically in ASpec, not per architecture *) -lemmas [TcbAcc_R_2_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] +lemmas [Arch_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] + +lemmas TcbAcc_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation TcbAcc_R_2?: TcbAcc_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.TcbAcc_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_3 locale *) -lemma setMRs_corres[TcbAcc_R_3_assms]: +lemma setMRs_corres[Arch_assms]: assumes m: "mrs' = mrs" shows "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \ in_user_frame buf) @@ -889,7 +891,7 @@ lemma asUser_invs[wp]: crunch storeWordUser for pred_tcb_at'[wp]: "\s. pred_tcb_at' proj P p s" -lemma set_mrs_invs'[TcbAcc_R_3_assms, wp]: +lemma set_mrs_invs'[Arch_assms, wp]: "\ invs' and tcb_at' receiver \ setMRs receiver recv_buf mrs \\rv. invs' \" apply (simp add: setMRs_def) apply (wp dmo_invs' no_irq_mapM no_irq_storeWord crunch_wps| @@ -908,12 +910,13 @@ sublocale setThreadState: typ_at_props' "setThreadState st p" sublocale setBoundNotification: typ_at_props' "setBoundNotification v p" by typ_at_props' +lemmas TcbAcc_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R_3?: TcbAcc_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.TcbAcc_R_3_assms)?)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/ARM_HYP/ArchTcb_R.thy b/proof/refine/ARM_HYP/ArchTcb_R.thy index 7dc306042b..be7d42a414 100644 --- a/proof/refine/ARM_HYP/ArchTcb_R.thy +++ b/proof/refine/ARM_HYP/ArchTcb_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R locale *) -lemma activateIdleThread_corres[Tcb_R_assms]: +lemma activateIdleThread_corres[Arch_assms]: "corres dc (st_tcb_at idle t) (st_tcb_at' idle' t) (arch_activate_idle_thread t) (activateIdleThread t)" by (simp add: arch_activate_idle_thread_def activateIdleThread_def) crunch arch_post_modify_registers - for pspace_aligned[Tcb_R_assms, wp]: pspace_aligned - and pspace_distinct[Tcb_R_assms, wp]: pspace_distinct + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct (wp: crunch_wps simp: crunch_simps) -lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: +lemma asUser_postModifyRegisters_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' t and tcb_at' ct) (arch_post_modify_registers ct t) (asUser t $ postModifyRegisters ct t)" @@ -37,7 +37,7 @@ lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: (* formulation of threadSet_state_hyp_refs_of' varies based on whether VCPU is present; use this as interface, but keep original lemma name for use outside of Arch *) -lemmas threadSet_state_hyp_refs_of'_interface[Tcb_R_assms] = threadSet_state_hyp_refs_of' +lemmas threadSet_state_hyp_refs_of'_interface[Arch_assms] = threadSet_state_hyp_refs_of' sublocale setPriority: typ_at_props' "setPriority t prio" by typ_at_props' @@ -45,7 +45,7 @@ sublocale setPriority: typ_at_props' "setPriority t prio" sublocale setMCPriority: typ_at_props' "setMCPriority t prio" by typ_at_props' -lemma sameObject_corres2[Tcb_R_assms]: +lemma sameObject_corres2[Arch_assms]: "\ cap_relation c c'; cap_relation d d' \ \ same_object_as c d = sameObjectAs c' d'" apply (frule(1) same_region_as_relation[symmetric, where c=c and c'=d]) @@ -61,7 +61,7 @@ lemma sameObject_corres2[Tcb_R_assms]: split: arch_cap.splits) by (fastforce simp: global.sameRegionAs_def isCap_simps split: arch_cap.splits) -lemma untyped_derived_eq_from_sameObjectAs[Tcb_R_assms]: +lemma untyped_derived_eq_from_sameObjectAs[Arch_assms]: "sameObjectAs cap cap2 \ untyped_derived_eq cap cap2" by (clarsimp simp: untyped_derived_eq_def sameObjectAs_def2 gen_isCap_Master) @@ -74,8 +74,8 @@ lemma isValidVTableRootD: option.split_asm) crunch prepare_thread_delete, arch_finalise_cap - for pspace_aligned[Tcb_R_assms, wp]: "pspace_aligned :: det_ext state \ _" - and pspace_distinct[Tcb_R_assms, wp]: "pspace_distinct :: det_ext state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_ext state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_ext state \ _" (simp: crunch_simps preemption_point_def wp: crunch_wps OR_choiceE_weak_wp) lemma is_valid_vtable_root_simp: @@ -85,7 +85,7 @@ lemma is_valid_vtable_root_simp: split: cap.splits arch_cap.splits option.splits) (* FIXME: move after checked_insert_tcb_invs in ArchTcb_AI, and consolidate redundancy there *) -lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: +lemma checked_insert_tcb_invs_gen[Arch_assms]: "\invs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and K (is_cnode_or_valid_arch new_cap) and valid_cap new_cap and tcb_cap_valid new_cap (target, ref) @@ -100,40 +100,40 @@ lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: apply (clarsimp dest!: is_cnode_or_valid_arch_cap_asid) done -lemma is_valid_vtable_root_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_valid_vtable_root_is_cnode_or_valid_arch[Arch_assms]: "is_valid_vtable_root cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def is_valid_vtable_root_simp is_cap_simps arch_cap_fun_lift_simps) -lemma is_cnode_cap_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_cnode_cap_is_cnode_or_valid_arch[Arch_assms]: "is_cnode_cap cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def) -lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Tcb_R_assms]: +lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Arch_assms]: "\valid_ipc_buffer_cap cap buf; is_arch_cap cap\ \ is_nondevice_page_cap cap" by (clarsimp simp: is_cap_simps valid_ipc_buffer_cap_def is_nondevice_page_cap_def is_nondevice_page_cap_arch_def arch_cap_fun_lift_simps split: arch_cap.splits bool.splits) -lemma cte_at_tcb_at_2p_cteSizeBits[Tcb_R_assms]: +lemma cte_at_tcb_at_2p_cteSizeBits[Arch_assms]: "tcb_at' t s \ cte_at' (t + 2 ^ cteSizeBits) s" by (simp add: cte_at'_obj_at' tcb_cte_cases_def cteSizeBits_def) (* arch_capBadge may involve SMC caps on some architectures, but not page tables *) -lemma isValidVTableRootD_arch[Tcb_R_assms]: +lemma isValidVTableRootD_arch[Arch_assms]: "isValidVTableRoot cap \ isArchObjectCap cap \ arch_capBadge (capCap cap) = None" by (drule isValidVTableRootD; clarsimp simp: arch_capBadge_def isCap_simps) (* FIXME FPU: when the FPU being enabled is properly configurable for the proofs then this shouldn't need to unfold config_HAVE_FPU. *) -lemma postSetFlags_corres[Tcb_R_assms, corres]: +lemma postSetFlags_corres[Arch_assms, corres]: "flags = word_to_tcb_flags flags' \ corres dc (cur_tcb and pspace_aligned and pspace_distinct and valid_cur_fpu) \ (arch_post_set_flags t flags) (postSetFlags t flags')" unfolding arch_post_set_flags_def postSetFlags_def by (corres simp: Kernel_Config.config_HAVE_FPU_def cur_tcb_def) -lemma postSetFlags_invs'[Tcb_R_assms, wp]: +lemma postSetFlags_invs'[Arch_assms, wp]: "postSetFlags t flags \invs'\" unfolding postSetFlags_def by wpsimp @@ -144,11 +144,11 @@ lemma copyregsets_map_only[simp]: (* there are no extra registers on any architecture so far, and while it is theoretically possible in the design spec, the abstract invariant proof assumes this *) -lemma decodeTransfer_def'[Tcb_R_assms]: +lemma decodeTransfer_def'[Arch_assms]: "decodeTransfer w = returnOk (copyregsets_map ArchDefaultExtraRegisters)" by (simp add: decodeTransfer_def) -lemma checkValidIPCBuffer_corres[Tcb_R_assms]: +lemma checkValidIPCBuffer_corres[Arch_assms]: "cap_relation cap cap' \ corres (ser \ dc) \ \ (check_valid_ipc_buffer vptr cap) @@ -165,7 +165,7 @@ lemma checkValidIPCBuffer_corres[Tcb_R_assms]: apply (auto simp add: returnOk_def) done -lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: +lemma checkValidIPCBuffer_ArchObject_wp[Arch_assms]: "\\s. isArchObjectCap cap \ capBadge cap = None \ is_aligned p msg_align_bits \ P s\ checkValidIPCBuffer p cap \\rv s. P s\,-" @@ -179,27 +179,28 @@ lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: done crunch checkValidIPCBuffer - for inv[Tcb_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps) -lemma isValidVTableRoot_eq[Tcb_R_assms]: +lemma isValidVTableRoot_eq[Arch_assms]: "cap_relation cap cap' \ isValidVTableRoot cap' = is_valid_vtable_root cap" apply (cases cap; simp add: isValidVTableRoot_def is_valid_vtable_root_simp) apply (rename_tac acap, case_tac acap; simp) apply (auto split: option.split) done +lemmas Tcb_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R?: Tcb_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Tcb_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Tcb_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R_2 locale *) lemma checkCapAt_cteInsert_corres': "cap_relation new_cap newCap \ @@ -253,7 +254,7 @@ lemma checkCapAt_cteInsert_corres': apply fastforce done -lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: +lemma checkCapAt_cteInsert_corres[Arch_assms]: "cap_relation new_cap newCap \ corres dc (einvs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and cte_at slot and K (is_cnode_or_valid_arch new_cap) @@ -274,12 +275,13 @@ lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: apply fastforce done +lemmas Tcb_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R_2?: Tcb_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Tcb_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchUntyped_R.thy b/proof/refine/ARM_HYP/ArchUntyped_R.thy index d502efa934..c778b8bb03 100644 --- a/proof/refine/ARM_HYP/ArchUntyped_R.thy +++ b/proof/refine/ARM_HYP/ArchUntyped_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R locale *) -lemma APIType_map2_CapTable[Untyped_R_assms, simp]: +lemma APIType_map2_CapTable[Arch_assms, simp]: "(APIType_map2 ty = Structures_A.CapTableObject) = (ty = Inr (APIObjectType ArchTypes_H.CapTableObject))" by (simp add: APIType_map2_def @@ -25,13 +25,13 @@ lemma APIType_map2_CapTable[Untyped_R_assms, simp]: lemmas is_frame_type_defs = is_frame_type_def isFrameType_def arch_is_frame_type_def -lemma is_frame_type_isFrameType_eq[Untyped_R_assms, simp]: +lemma is_frame_type_isFrameType_eq[Arch_assms, simp]: "(is_frame_type (APIType_map2 (Inr (toEnum (unat arg0))))) = (isFrameType (toEnum (unat arg0)))" by (simp add: APIType_map2_def is_frame_type_defs split: apiobject_type.splits object_type.splits)+ (* object_type enum (arch-specific) is extension of apiobject_type enum (generic) *) -lemma nth_enum_object_type_gen_eq[Untyped_R_assms]: +lemma nth_enum_object_type_gen_eq[Arch_assms]: assumes "n < length (enum :: apiobject_type list)" shows "((enum :: object_type list) ! n) = APIObjectType ((enum :: apiobject_type list) ! n)" proof - @@ -45,36 +45,36 @@ proof - (simp flip: nth_map[where f=APIObjectType]) qed -lemma length_enum_apiobject_less_enum_object_type[Untyped_R_assms]: +lemma length_enum_apiobject_less_enum_object_type[Arch_assms]: "length (enum :: apiobject_type list) < length (enum :: object_type list)" unfolding enum_apiobject_type enum_object_type by simp crunch freeMemory (* FIXME arch-split: clearMemory is already handled in ArchRetype_AI *) - for irq_masks_inv[wp, Untyped_R_assms]: "\s. P (irq_masks s)" + for irq_masks_inv[wp, Arch_assms]: "\s. P (irq_masks s)" (wp: crunch_wps) crunch updateFreeIndex, deleteGhost - for valid_irq_states'[Untyped_R_assms, wp]: "valid_irq_states'" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" - and gsMaxObjectSize[Untyped_R_assms, wp]: "\s. P (gsMaxObjectSize s)" - and ksIdleThread[Untyped_R_assms, wp]: "\s. P (ksIdleThread s)" - and ksCurDomain[Untyped_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksCurThread[Untyped_R_assms, wp]: "\s. P (ksCurThread s)" + for valid_irq_states'[Arch_assms, wp]: "valid_irq_states'" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and gsMaxObjectSize[Arch_assms, wp]: "\s. P (gsMaxObjectSize s)" + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksCurThread[Arch_assms, wp]: "\s. P (ksCurThread s)" (wp: crunch_wps) -lemma arch_data_to_obj_type_invalid[Untyped_R_assms]: +lemma arch_data_to_obj_type_invalid[Arch_assms]: "\ n \ length (enum :: object_type list) \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) = None" by (auto simp: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) -lemma arch_data_to_obj_type_valid[Untyped_R_assms]: +lemma arch_data_to_obj_type_valid[Arch_assms]: "\ n < length (enum :: object_type list); length (enum :: apiobject_type list) \ n \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) \ None" by (simp add: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) arith -lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: +lemma APIType_map2_arch_data_to_obj_type[Arch_assms]: defines [simp]: "object_types \ enum :: object_type list" defines [simp]: "apiobject_types \ enum :: apiobject_type list" shows @@ -89,7 +89,7 @@ lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: apply arith done -lemma obj_bits_api_APIType_map2[Untyped_R_assms]: +lemma obj_bits_api_APIType_map2[Arch_assms]: "obj_bits_api (APIType_map2 (Inr x)) y = getObjectSize x y" apply (clarsimp simp:obj_bits_api_def APIType_map2_def getObjectSize_def simp del: objSize_eq_capBits) apply (case_tac x) @@ -99,11 +99,11 @@ lemma obj_bits_api_APIType_map2[Untyped_R_assms]: apply (simp_all add: apiGetObjectSize_def slot_bits_def objBits_simps') done -lemma length_nat_to_cref[Untyped_R_assms]: +lemma length_nat_to_cref[Arch_assms]: "bits < word_bits \ length (nat_to_cref bits x) = bits" by (simp add: nat_to_cref_def word_bits_conv) -lemma ctes_of_ko_arch[Untyped_R_assms]: +lemma ctes_of_ko_arch[Arch_assms]: "\ valid_cap' cap s; isArchObjectCap cap \ \ \ptr\capRange cap. \optr ko. ksPSpace s optr = Some ko \ ptr \ obj_range' optr ko" apply (case_tac cap; simp add: gen_isCap_simps capRange_def) @@ -180,11 +180,11 @@ lemma ctes_of_ko_arch[Untyped_R_assms]: apply (simp add: field_simps archObjSize_def pde_bits_def shiftl_t2n mask_def) done -lemma irq_nodes_global[Untyped_R_assms]: +lemma irq_nodes_global[Arch_assms]: "irq_node' s + (ucast (irq :: irq) << cteSizeBits) \ global_refs' s" by (simp add: global_refs'_def cteSizeBits_def shiftl_t2n) -lemma untyped_inc_mdbD[Untyped_R_assms]: +lemma untyped_inc_mdbD[Arch_assms]: "\ sameRegionAs cap cap'; isUntypedCap cap; ctes p = Some (CTE cap node); ctes p' = Some (CTE cap' node'); untyped_inc' ctes; untyped_mdb' ctes; no_loops ctes \ @@ -210,16 +210,16 @@ lemma untyped_inc_mdbD[Untyped_R_assms]: apply (clarsimp simp: gen_isCap_simps) done -lemma mdb_chunked_arch_assms_non_arch[Untyped_R_assms]: +lemma mdb_chunked_arch_assms_non_arch[Arch_assms]: "\ isArchObjectCap cap \ mdb_chunked_arch_assms cap" by (simp add: mdb_chunked_arch_assms_def isCap_simps) -lemma sameRegionAs_def_untyped[Untyped_R_assms]: +lemma sameRegionAs_def_untyped[Arch_assms]: "\ isUntypedCap cap \ \ sameRegionAs cap cap' = (capRange cap' \ {} \ capRange cap' \ capRange cap)" by (clarsimp simp add: sameRegionAs_def3 isCap_simps) -lemma createNewCaps_range_helper[Untyped_R_assms]: +lemma createNewCaps_range_helper[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits tp us) n \ 0 < n\ createNewCaps tp ptr n us d \\rv s. \capfn. @@ -289,7 +289,7 @@ defs archOverlap_def: "archOverlap \ \_ _. False" (* trivial on this architecture *) -lemma archNoOverlap[Untyped_R_assms]: +lemma archNoOverlap[Arch_assms]: notes Int_atLeastAtMost[simp del] shows "corres dc (\s. \cref. cte_wp_at (\cap. is_untyped_cap cap @@ -299,34 +299,34 @@ lemma archNoOverlap[Untyped_R_assms]: (return ()) (stateAssert (\s. \ archOverlap s R) [])" by (simp add: archOverlap_def) -lemma word_size_bits_le_untyped_min_bits[Untyped_R_assms]: +lemma word_size_bits_le_untyped_min_bits[Arch_assms]: "word_size_bits \ untyped_min_bits" by (simp add: word_size_bits_def untyped_min_bits_def) -lemma minUntypedSizeBits_le_resetChunkBits[Untyped_R_assms]: +lemma minUntypedSizeBits_le_resetChunkBits[Arch_assms]: "minUntypedSizeBits \ resetChunkBits" by (simp add: minUntypedSizeBits_def Kernel_Config.resetChunkBits_def) -lemma maxUntypedSizeBits_less_word_bits[Untyped_R_assms]: +lemma maxUntypedSizeBits_less_word_bits[Arch_assms]: "maxUntypedSizeBits < word_bits" by (simp add: maxUntypedSizeBits_def word_bits_def) (* FIXME arch-split: candidate for Kernel_Config lemmas *) -lemma word_size_bits_le_resetChunkBits[Untyped_R_assms]: +lemma word_size_bits_le_resetChunkBits[Arch_assms]: "word_size_bits \ resetChunkBits" by (simp add: word_size_bits_def Kernel_Config.resetChunkBits_def) -lemma resetChunkBits_le_word_bits[Untyped_R_assms]: +lemma resetChunkBits_le_word_bits[Arch_assms]: "resetChunkBits < word_bits" by (simp add: Kernel_Config.resetChunkBits_def word_bits_def) -lemma APIType_capBits_lower_bound[Untyped_R_assms]: +lemma APIType_capBits_lower_bound[Arch_assms]: "\tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \ minUntypedSizeBits \ us\ \ minUntypedSizeBits \ APIType_capBits tp us" by (simp add: APIType_capBits_def objBits_simps' minUntypedSizeBits_def vcpu_bits_def pageBits_def split: object_type.split apiobject_type.split) -lemma dmo_freeMemory_clear_um[Untyped_R_assms]: +lemma dmo_freeMemory_clear_um[Arch_assms]: "\word_size_bits \ sz; sz \ word_bits; is_aligned ptr sz\ \ (do_machine_op (freeMemory ptr sz) :: (det_state, unit) nondet_monad) = modify (clear_um {ptr..ptr + 2 ^ sz - 1})" @@ -337,15 +337,16 @@ lemma dmo_freeMemory_clear_um[Untyped_R_assms]: done crunch createObject - for nosch[Untyped_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + +lemmas Untyped_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Untyped_R?: Untyped_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Untyped_R_assms)?)?) qed locale Arch_mdb_insert_again_all = mdb_insert_again_all + Arch @@ -405,21 +406,22 @@ end (* invokeUntyped_proofs *) context Arch begin arch_global_naming -named_theorems Untyped_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R_2 locale *) -lemmas [Untyped_R_2_assms] = +lemmas [Arch_assms] = mdb_insert_again_all.valid_n' invokeUntyped_proofs.descendants_range invokeUntyped_proofs.ex_cte_no_overlap' invokeUntyped_proofs.cref_inv invokeUntyped_proofs.slots_invD +lemmas Untyped_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R_2?: Untyped_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.Untyped_R_2_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/ArchVSpace_R.thy b/proof/refine/ARM_HYP/ArchVSpace_R.thy index a25c06810b..f5a38d54dd 100644 --- a/proof/refine/ARM_HYP/ArchVSpace_R.thy +++ b/proof/refine/ARM_HYP/ArchVSpace_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems VSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for VSpace_R locale *) lemmas store_pte_typ_ats[wp] = store_pte_typ_ats abs_atyp_at_lifts[OF store_pte_typ_at] lemmas store_pde_typ_ats[wp] = store_pde_typ_ats abs_atyp_at_lifts[OF store_pde_typ_at] @@ -645,7 +645,7 @@ lemma handleVMFault_corres': done (* interface lemma, superset of all architecture preconditions *) -lemma handleVMFault_corres[VSpace_R_assms]: +lemma handleVMFault_corres[Arch_assms]: "corres (fr \ dc) (tcb_at thread and pspace_aligned and pspace_distinct) (tcb_at' t) (handle_vm_fault thread fault) (handleVMFault thread fault)" by (corres corres: handleVMFault_corres') @@ -5082,12 +5082,13 @@ lemma isPDCap_PD : "isPDCap (ArchObjectCap (PageDirectoryCap r m))" by (simp add: isPDCap_def) +lemmas VSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation VSpace_R?: VSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact VSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact ARM_HYP.VSpace_R_assms)?)?) qed end diff --git a/proof/refine/ARM_HYP/LevityCatch.thy b/proof/refine/ARM_HYP/LevityCatch.thy index ce04e4e304..eebcd39558 100644 --- a/proof/refine/ARM_HYP/LevityCatch.thy +++ b/proof/refine/ARM_HYP/LevityCatch.thy @@ -21,13 +21,6 @@ lemma magnitudeCheck_assert: split: option.split) apply fastforce done -context begin interpretation Arch . (*FIXME: arch-split*) -lemmas makeObject_simps = - makeObject_endpoint makeObject_notification makeObject_cte - makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte - makeObject_asidpool makeObject_vcpu -end - lemma projectKO_inv : "\P\ projectKO ko \\rv. P\" by (simp add: projectKO_def fail_def valid_def return_def split: option.splits) @@ -59,6 +52,11 @@ lemma updateObject_default_inv: context Arch begin arch_global_naming +lemmas makeObject_simps = + makeObject_endpoint makeObject_notification makeObject_cte + makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte + makeObject_asidpool makeObject_vcpu + lemma to_from_apiType[simp]: "toAPIType (fromAPIType x) = Some x" by (cases x) (auto simp add: fromAPIType_def toAPIType_def) diff --git a/proof/refine/RISCV64/ArchADT_H.thy b/proof/refine/RISCV64/ArchADT_H.thy index 543e87076f..56220d8592 100644 --- a/proof/refine/RISCV64/ArchADT_H.thy +++ b/proof/refine/RISCV64/ArchADT_H.thy @@ -13,14 +13,14 @@ begin context Arch begin arch_global_naming -named_theorems ADT_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H locale *) definition vm_rights_of :: "vmrights \ rights set" where "vm_rights_of x \ case x of VMKernelOnly \ vm_kernel_only | VMReadOnly \ vm_read_only | VMReadWrite \ vm_read_write" -lemma vm_rights_of_vmrights_map_id[ADT_H_assms, simp]: +lemma vm_rights_of_vmrights_map_id[Arch_assms, simp]: "rs \ valid_vm_rights \ vm_rights_of (vmrights_map rs) = rs" by (auto simp: vm_rights_of_def vmrights_map_def valid_vm_rights_def vm_read_write_def vm_read_only_def vm_kernel_only_def) @@ -74,7 +74,7 @@ fun ArchCapabilityMap :: "arch_capability \ cap" where | "ArchCapabilityMap (arch_capability.PageTableCap word data) = cap.ArchObjectCap (arch_cap.PageTableCap word (mdata_map' data))" -lemma acap_relation_imp_ArchCapabilityMap[ADT_H_assms]: +lemma acap_relation_imp_ArchCapabilityMap[Arch_assms]: "\wellformed_acap ac; acap_relation ac ac'\ \ ArchCapabilityMap ac' = cap.ArchObjectCap ac" by (case_tac ac; simp add: wellformed_cap_simps ucast_down_ucast_id is_down) @@ -82,7 +82,7 @@ primrec ArchFaultMap :: "Fault_H.arch_fault \ ExceptionTypes_A.arch_ "ArchFaultMap (ArchFault_H.RISCV64_H.arch_fault.VMFault p m) = Machine_A.RISCV64_A.arch_fault.VMFault p m" -lemma ArchFaultMap_arch_fault_map[ADT_H_assms]: +lemma ArchFaultMap_arch_fault_map[Arch_assms]: "ArchFaultMap (arch_fault_map f) = f" by (cases f; simp add: ArchFaultMap_def arch_fault_map_def) @@ -145,7 +145,7 @@ definition absArchState :: riscv_global_pts = \l. set (gpts (size l)), riscv_kernel_vspace = kvspace\" -lemma absArchState_correct[ADT_H_assms]: +lemma absArchState_correct[Arch_assms]: "(s,s') \ state_relation \ absArchState (ksArchState s') (aobjs_of' s') = arch_state s" apply (prop_tac "(arch_state s, ksArchState s') \ arch_state_relation (aobjs_of' s')") apply (simp add: state_relation_def) @@ -153,19 +153,20 @@ lemma absArchState_correct[ADT_H_assms]: split: RISCV64_H.kernel_state.splits) done +lemmas ADT_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState interpretation ADT_H?: ADT_H vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.ADT_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems ADT_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H_2 locale *) (* Due to DataPage, current FPU owner and gsPPTypes this can't be made generic. In order to unify the type across architectures, we use the arch kernel state. *) @@ -191,7 +192,7 @@ lemma distinct_word_add_inj_ptes: \ p' = p \ off' = off" for off :: pt_index and p :: machine_word by (erule (2) distinct_word_add_ucast_shift_inj; simp add: bit_simps) -lemma absHeap_correct[ADT_H_2_assms]: +lemma absHeap_correct[Arch_assms]: fixes s' :: kernel_state assumes pspace_aligned: "pspace_aligned s" assumes pspace_distinct: "pspace_distinct s" @@ -501,6 +502,8 @@ proof - done qed +lemmas ADT_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts absHeap @@ -508,8 +511,7 @@ arch_requalify_consts absHeap interpretation ADT_H_2?: ADT_H_2 vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState absHeap proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.ADT_H_2_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchArchAcc_R.thy b/proof/refine/RISCV64/ArchArchAcc_R.thy index 2e81808233..64b5d88d07 100644 --- a/proof/refine/RISCV64/ArchArchAcc_R.thy +++ b/proof/refine/RISCV64/ArchArchAcc_R.thy @@ -14,7 +14,7 @@ unbundle l4v_word_context context Arch begin arch_global_naming -named_theorems ArchAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ArchAcc_R locale *) lemma asid_pool_at_ko: "asid_pool_at p s \ \pool. ko_at (ArchObj (RISCV64_A.ASIDPool pool)) p s" @@ -32,7 +32,7 @@ lemma pteBits_pte_bits[simp]: "pteBits = pte_bits" by (simp add: bit_simps pteBits_def) -lemma pspace_aligned_cross[ArchAcc_R_assms]: +lemma pspace_aligned_cross[Arch_assms]: "\ pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_aligned' s'" apply (clarsimp simp: pspace_aligned'_def pspace_aligned_def pspace_relation_def) apply (rename_tac p' ko') @@ -99,7 +99,7 @@ lemma obj_relation_cuts_range_limit: apply fastforce+ done -lemma obj_relation_cuts_range_mask_range[ArchAcc_R_assms]: +lemma obj_relation_cuts_range_mask_range[Arch_assms]: "\ (p', P) \ obj_relation_cuts ko p; P ko ko'; is_aligned p (obj_bits ko) \ \ p' \ mask_range p (obj_bits ko)" apply (drule (1) obj_relation_cuts_range_limit, clarsimp) @@ -124,7 +124,7 @@ lemma obj_relation_cuts_obj_bits: lemmas is_aligned_add_step_le' = is_aligned_add_step_le[simplified mask_2pm1 add_diff_eq] -lemma pspace_distinct_cross[ArchAcc_R_assms]: +lemma pspace_distinct_cross[Arch_assms]: "\ pspace_distinct s; pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_distinct' s'" apply (frule (1) pspace_aligned_cross) @@ -844,7 +844,7 @@ lemma copy_global_mappings_corres [@lift_corres_args, corres]: simp: bit_simps word_le_nat_alt word_less_nat_alt)+ done -lemma arch_cap_rights_update[ArchAcc_R_assms]: +lemma arch_cap_rights_update[Arch_assms]: "acap_relation c c' \ cap_relation (cap.ArchObjectCap (acap_rights_update (acap_rights c \ msk) c)) (Arch.maskCapRights (rights_mask_map msk) c')" @@ -871,7 +871,7 @@ lemma arch_deriveCap_valid: apply (simp add: RISCV64_H.deriveCap_def split del: if_split cong: if_cong) apply (wp undefined_validE_R) apply (cases arch_cap; simp add: isCap_defs) - apply (simp add: valid_cap'_def capAligned_def global.capUntypedPtr_def capUntypedPtr_def) + apply (simp add: valid_cap'_def capAligned_def global.capUntypedPtr_def RISCV64_H.capUntypedPtr_def) done lemma mdata_map_simps[simp]: @@ -1088,12 +1088,13 @@ lemma setObject_ASID_ctes_of'[wp]: \\rv s. P (ctes_of s)\" by (rule ctes_of_from_cte_wp_at [where Q=\, simplified]) wp -end +lemmas ArchAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation ArchAcc_R?: ArchAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact ArchAcc_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.ArchAcc_R_assms)?) qed end diff --git a/proof/refine/RISCV64/ArchArch_R.thy b/proof/refine/RISCV64/ArchArch_R.thy index c3cac7e54c..11351ffc34 100644 --- a/proof/refine/RISCV64/ArchArch_R.thy +++ b/proof/refine/RISCV64/ArchArch_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Arch_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Arch_R locale *) definition "asid_ci_map i \ @@ -626,7 +626,7 @@ lemma decodeX64PageTableInvocation_corres: by (clarsimp split: invocation_label.splits arch_invocation_label.splits) -lemma arch_decodeInvocation_corres[Arch_R_assms]: +lemma arch_decodeInvocation_corres[Arch_assms]: notes check_vp_inv[wp del] check_vp_wpR[wp] (* FIXME: check_vp_inv shadowed check_vp_wpR. Instead, check_vp_wpR should probably be generalised to replace check_vp_inv. *) @@ -805,7 +805,7 @@ shows done -lemma arch_performInvocation_corres[Arch_R_assms]: +lemma arch_performInvocation_corres[Arch_assms]: "archinv_relation ai ai' \ corres (dc \ (=)) (einvs and ct_active and valid_arch_inv ai and schact_is_rct) @@ -889,7 +889,7 @@ lemma performASIDControlInvocation_tcb_at': apply clarsimp done -lemma invokeArch_tcb_at'[Arch_R_assms]: +lemma invokeArch_tcb_at'[Arch_assms]: "\invs' and valid_arch_inv' ai and ct_active' and st_tcb_at' active' p\ Arch.performInvocation ai \\rv. tcb_at' p\" @@ -898,7 +898,7 @@ lemma invokeArch_tcb_at'[Arch_R_assms]: wp: performASIDControlInvocation_tcb_at') done -lemma sts_valid_arch_inv'[Arch_R_assms]: +lemma sts_valid_arch_inv'[Arch_assms]: "\valid_arch_inv' ai\ setThreadState st t \\rv. valid_arch_inv' ai\" apply (cases ai, simp_all add: valid_arch_inv'_def) apply (clarsimp simp: valid_pti'_def split: page_table_invocation.splits) @@ -952,7 +952,7 @@ lemma arch_cap_exhausted: by (cases acap; simp add: isCap_simps) crunch Arch.decodeInvocation - for inv[Arch_R_assms, wp]: P + for inv[Arch_assms, wp]: P (simp: crunch_simps wp: crunch_wps arch_cap_exhausted mapME_x_inv_wp getASID_wp) lemmas arch_decodeInvocation_inv = ArchRetypeDecls_H_RISCV64_H_decodeInvocation_inv @@ -1072,7 +1072,7 @@ lemma arch_decodeInvocation_wf[wp]: apply (wpsimp, simp+) done -lemma arch_decodeInvocation_wf_interface[Arch_R_assms]: +lemma arch_decodeInvocation_wf_interface[Arch_assms]: "\invs' and valid_cap' (ArchObjectCap arch_cap) 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 @@ -1262,14 +1262,14 @@ lemma performASIDControlInvocation_invs' [wp]: null_filter_descendants_of'[OF null_filter_simp'] bit_simps valid_cap_simps' mask_def kernel_mappings_canonical) -lemma arch_performInvocation_invs'[Arch_R_assms]: +lemma arch_performInvocation_invs'[Arch_assms]: "\invs' and ct_active' and valid_arch_inv' invocation\ Arch.performInvocation invocation \\rv. invs'\" unfolding RISCV64_H.performInvocation_def by (cases invocation, simp_all add: performRISCVMMUInvocation_def valid_arch_inv'_def; wpsimp) -lemma setObject_TCB_valid_duplicates'[Arch_R_assms, wp]: +lemma setObject_TCB_valid_duplicates'[Arch_assms, wp]: "setObject p (tcb::tcb) \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp @@ -1284,6 +1284,8 @@ lemma hv_inv_ex': apply simp done +lemmas Arch_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -1292,8 +1294,7 @@ arch_requalify_consts interpretation Arch_R?: Arch_R valid_arch_inv' archinv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Arch_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Arch_R_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchBits_R.thy b/proof/refine/RISCV64/ArchBits_R.thy index ed31d40395..085a6ef5a1 100644 --- a/proof/refine/RISCV64/ArchBits_R.thy +++ b/proof/refine/RISCV64/ArchBits_R.thy @@ -10,30 +10,30 @@ begin context Arch begin arch_global_naming -named_theorems Bits_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Bits_R locale *) crunch_ignore (add: lookupPTSlotFromLevel lookupPTFromLevel) -lemma atcbContext_get_eq[Bits_R_assms, simp]: +lemma atcbContext_get_eq[Arch_assms, simp]: "atcbContextGet (atcbContextSet x atcb) = x" by (simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_eq[Bits_R_assms, simp]: +lemma atcbContext_set_eq[Arch_assms, simp]: "atcbContextSet (atcbContextGet t) t = t" by (cases t, simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_set[Bits_R_assms, simp]: +lemma atcbContext_set_set[Arch_assms, simp]: "atcbContextSet x (atcbContextSet y atcb) = atcbContextSet x atcb" by (cases atcb, simp add: atcbContextSet_def) -lemma objBitsKO_less_word_bits[Bits_R_assms]: +lemma objBitsKO_less_word_bits[Arch_assms]: "objBitsKO ko < word_bits" unfolding objBits_def by (case_tac ko; simp add: pageBits_def pteBits_def objBits_simps' word_bits_def split: arch_kernel_object.split) -lemma objBitsKO_neq_0[Bits_R_assms]: +lemma objBitsKO_neq_0[Arch_assms]: "objBitsKO ko \ 0" unfolding objBits_def by (case_tac ko; @@ -50,7 +50,7 @@ lemma arch_isCap_simps: lemmas isCap_simps = gen_isCap_simps arch_isCap_simps -lemma pageBits_le_maxUntypedSizeBits[Bits_R_assms, simp]: +lemma pageBits_le_maxUntypedSizeBits[Arch_assms, simp]: "pageBits \ maxUntypedSizeBits" by (simp add: pageBits_def maxUntypedSizeBits_def) @@ -79,7 +79,9 @@ lemma projectKO_user_data_device: lemmas arch_projectKOs = projectKO_ASID projectKO_PTE projectKO_user_data projectKO_user_data_device -end +lemmas Bits_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) (* for projectKO_opt, we want to export the arch-specific instantiation lemmas *) arch_requalify_facts arch_projectKOs @@ -91,8 +93,7 @@ lemmas projectKOs = gen_projectKOs arch_projectKOs interpretation Bits_R?: Bits_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Bits_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Bits_R_assms)?) qed end diff --git a/proof/refine/RISCV64/ArchCNodeInv_R.thy b/proof/refine/RISCV64/ArchCNodeInv_R.thy index f015f1f92c..2c81b66fff 100644 --- a/proof/refine/RISCV64/ArchCNodeInv_R.thy +++ b/proof/refine/RISCV64/ArchCNodeInv_R.thy @@ -14,49 +14,49 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_R locale *) definition arch_finalise_prop_stuff :: "(kernel_state \ bool) \ bool" where "arch_finalise_prop_stuff P = True" -lemma arch_finalise_prop_stuff_top[CNodeInv_R_assms, simp]: +lemma arch_finalise_prop_stuff_top[Arch_assms, simp]: "arch_finalise_prop_stuff \" by (simp add: arch_finalise_prop_stuff_def) -lemma acap_relation_arch_update_cap_data_NullCap[CNodeInv_R_assms]: +lemma acap_relation_arch_update_cap_data_NullCap[Arch_assms]: "acap_relation acap acap' \ (arch_update_cap_data P x acap = cap.NullCap) = (Arch.updateCapData P x acap' = NullCap)" unfolding arch_update_cap_data_def RISCV64_H.updateCapData_def by (cases acap; simp) -lemma cnode_guard_size_bits_wordRadix[CNodeInv_R_assms]: +lemma cnode_guard_size_bits_wordRadix[Arch_assms]: "cnode_guard_size_bits = wordRadix" by (simp add: cnode_guard_size_bits_def wordRadix_def) -lemma cteRightsBits_cnode_padding_bits[CNodeInv_R_assms]: +lemma cteRightsBits_cnode_padding_bits[Arch_assms]: "cteRightsBits = cnode_padding_bits" by (simp add: cteRightsBits_def cnode_padding_bits_def) (* FIXME arch-split: valid_cnode_capI in CNodeInv_AI exposes the value of word_bits, replace with this *) -lemma valid_cnode_capI'[CNodeInv_R_assms]: +lemma valid_cnode_capI'[Arch_assms]: "\cap_table_at n w s; valid_objs s; pspace_aligned s; 0 < n; length g \ word_bits\ \ s \ cap.CNodeCap w n g" by (simp add: word_bits_def valid_cnode_capI) -lemma arch_capBadge_updateCapData_True[CNodeInv_R_assms]: +lemma arch_capBadge_updateCapData_True[Arch_assms]: "Arch.updateCapData True x acap \ NullCap \ capBadge (Arch.updateCapData True x acap) = arch_capBadge acap" unfolding RISCV64_H.updateCapData_def by (cases acap; simp) crunch prepareThreadDelete - for ctes_of[CNodeInv_R_assms, wp]: "\s. P (ctes_of s)" + for ctes_of[Arch_assms, wp]: "\s. P (ctes_of s)" crunch prepareThreadDelete - for not_recursive_ctes[CNodeInv_R_assms]: "\s. P (not_recursive_ctes s)" + for not_recursive_ctes[Arch_assms]: "\s. P (not_recursive_ctes s)" (simp: prepareThreadDelete_def not_recursive_ctes_def cteCaps_of_def) -lemma in_preempt'[CNodeInv_R_assms]: +lemma in_preempt'[Arch_assms]: "(Inr rv, s') \ fst (preemptionPoint s) \ \f g. s' = ksWorkUnitsCompleted_update f (s \ ksMachineState := ksMachineState s \ irq_state := g (irq_state (ksMachineState s)) \\)" @@ -82,19 +82,19 @@ lemma sameRegionAs_eq_parent: \ sameRegionAs c' cap" by (clarsimp simp: weak_derived'_def sameRegionAs_def2 isCap_simps) -lemma sameRegion_ep[CNodeInv_R_assms]: +lemma sameRegion_ep[Arch_assms]: "\ sameRegionAs cap cap'; isEndpointCap cap \ \ isEndpointCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegion_ntfn[CNodeInv_R_assms]: +lemma sameRegion_ntfn[Arch_assms]: "\ sameRegionAs cap cap'; isNotificationCap cap \ \ isNotificationCap cap'" by (auto simp: gen_isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegionAs_Zombie[CNodeInv_R_assms, simp]: +lemma sameRegionAs_Zombie[Arch_assms, simp]: "\ sameRegionAs (Zombie p zb n) cap" by (simp add: sameRegionAs_def3 isCap_simps) -lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: +lemma isFinal_notUntyped_capRange_disjoint[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); cteCaps_of s sl' = Some cap'; sl \ sl'; capUntypedPtr cap = capUntypedPtr cap'; capBits cap = capBits cap'; isThreadCap cap \ isCNodeCap cap; s \' cap; @@ -116,7 +116,7 @@ lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: (clarsimp simp: sameObjectAs_def3 isCap_simps)?)+ done -lemma ztc_sameRegion[CNodeInv_R_assms]: +lemma ztc_sameRegion[Arch_assms]: "\ isCNodeCap cap \ isThreadCap cap \ isZombie cap \ \ sameRegionAs cap cap' = sameObjectAs cap cap'" apply (subgoal_tac "\ isUntypedCap cap \ \ isArchFrameCap cap @@ -125,7 +125,7 @@ lemma ztc_sameRegion[CNodeInv_R_assms]: apply (auto simp: isCap_simps) done -lemma mdb_chunked_update_final[CNodeInv_R_assms]: +lemma mdb_chunked_update_final[Arch_assms]: assumes chunked: "mdb_chunked m" and slot: "m slot = Some (CTE cap node)" and Fin1: "\x cte. m x = Some cte \ x \ slot @@ -184,19 +184,19 @@ proof - done qed -lemma sameRegionAs_ThreadCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_ThreadCap_eq[Arch_assms]: "sameRegionAs (ThreadCap p) (ThreadCap p') = (p = p')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_IRQHandlerCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_IRQHandlerCap_eq[Arch_assms]: "sameRegionAs (IRQHandlerCap irq) (IRQHandlerCap irq') = (irq = irq')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_CNodeCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_CNodeCap_eq[Arch_assms]: "sameRegionAs (CNodeCap p b g gs) (CNodeCap p' b' g' gs') = (p = p' \ b = b')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma ztc_untyped_helper[CNodeInv_R_assms]: +lemma ztc_untyped_helper[Arch_assms]: "\ isCNodeCap cap' \ isThreadCap cap' \ isZombie cap'; sameRegionAs cap cap' \ \ isUntypedCap cap \ sameRegionAs cap' cap" apply (erule sameRegionAsE) @@ -210,12 +210,12 @@ lemma ztc_untyped_helper[CNodeInv_R_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma valid_arch_badges_PhysicalClass[CNodeInv_R_assms]: +lemma valid_arch_badges_PhysicalClass[Arch_assms]: "\ valid_arch_badges cap'' cap' node'; capClass cap'' = PhysicalClass; capClass cap = PhysicalClass \ \ valid_arch_badges cap cap' node'" by (auto simp: valid_arch_badges_def isCap_simps) -lemma isFinal_Zombie[CNodeInv_R_assms]: +lemma isFinal_Zombie[Arch_assms]: "isFinal (Zombie p' b n) p cs" by (simp add: isFinal_def sameObjectAs_def2 gen_isCap_simps) @@ -223,25 +223,25 @@ crunch Arch.postCapDeletion for no_cte_prop[wp]: "no_cte_prop P" (* interface, above crunch does not result in same lemma on all architectures *) -lemma arch_postCapDeletion_no_cte_prop[CNodeInv_R_assms]: +lemma arch_postCapDeletion_no_cte_prop[Arch_assms]: "\no_cte_prop P and K (arch_finalise_prop_stuff P)\ Arch.postCapDeletion t \\_. no_cte_prop P\" by wpsimp -lemma post_cap_delete_pre'_IRQHandlerCap[CNodeInv_R_assms]: +lemma post_cap_delete_pre'_IRQHandlerCap[Arch_assms]: "post_cap_delete_pre' (IRQHandlerCap irq) sl cs = (arch_valid_irq irq \ (\sl'. sl \ sl' \ cs sl' \ Some (IRQHandlerCap irq)))" by (simp add: post_cap_delete_pre'_def) -lemma final_post_cap_delete_pre'_ArchObjectCap[CNodeInv_R_assms]: +lemma final_post_cap_delete_pre'_ArchObjectCap[Arch_assms]: "\ isFinal (ArchObjectCap acap) sl (cteCaps_of s); arch_cap_has_cleanup' acap; valid_arch_cap' acap s\ \ post_cap_delete_pre' (ArchObjectCap acap) sl (cteCaps_of s)" by (clarsimp simp add: post_cap_delete_pre'_def arch_cap_has_cleanup'_def isCap_simps) crunch Arch_finaliseCap, prepareThreadDelete - for st_tcb_at'[CNodeInv_R_assms, wp]: "st_tcb_at' P t" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" (simp: crunch_simps pteAtIndex_def wp: crunch_wps getObject_inv loadObject_default_inv rule: RISCV64_H.finaliseCap_def) @@ -254,7 +254,7 @@ lemma archThreadSet_rvk_prog': by (wpsimp simp: cteCaps_of_def) crunch prepareThreadDelete, Arch_finaliseCap - for rvk_prog'[CNodeInv_R_assms]: + for rvk_prog'[Arch_assms]: "\s. revoke_progress_ord m (\x. option_map capToRPO (cteCaps_of s x))" (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of getObject_inv loadObject_default_inv @@ -267,13 +267,13 @@ lemma arch_recycleCap_improve_cases: \ (if isASIDPoolCap cap then v else undefined) = v" by (cases cap, simp_all add: isCap_simps) -lemma cap_relation_trans[CNodeInv_R_assms]: +lemma cap_relation_trans[Arch_assms]: "\ cap_relation cap cap'; cap_relation cap cap'' \ \ cap' = cap''" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) crunch Arch_finaliseCap, prepareThreadDelete - for irq_states'[CNodeInv_R_assms, wp]: valid_irq_states' + for irq_states'[Arch_assms, wp]: valid_irq_states' (wp: crunch_wps unless_wp getASID_wp no_irq_setVSpaceRoot simp: crunch_simps o_def pteAtIndex_def rule: RISCV64_H.finaliseCap_def) @@ -407,18 +407,19 @@ end (* mdb_move *) context Arch begin arch_global_naming -lemmas [CNodeInv_R_assms] = +lemmas [Arch_assms] = mdb_swap.cteSwap_valid_mdb_helper mdb_move.cteMove_valid_mdb_helper +lemmas CNodeInv_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts arch_finalise_prop_stuff interpretation CNodeInv_R?: CNodeInv_R arch_finalise_prop_stuff proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CNodeInv_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CNodeInv_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/RISCV64/ArchCSpace1_R.thy b/proof/refine/RISCV64/ArchCSpace1_R.thy index a566113505..cf965f6926 100644 --- a/proof/refine/RISCV64/ArchCSpace1_R.thy +++ b/proof/refine/RISCV64/ArchCSpace1_R.thy @@ -13,22 +13,22 @@ begin context Arch begin arch_global_naming -named_theorems CSpace1_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R locale *) -lemma ghost_relation_wrapper_same_abs_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_abs_set_cap[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap cap dest a); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma ghost_relation_wrapper_set_cap_twice[CSpace1_R_assms]: +lemma ghost_relation_wrapper_set_cap_twice[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap dcap src a); ((), a'') \ fst (set_cap scap dest a'); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a'' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma archMDBAssertions_cross[CSpace1_R_assms]: +lemma archMDBAssertions_cross[Arch_assms]: "\ valid_arch_mdb (is_original_cap s) (caps_of_state s); valid_arch_state s; valid_objs s; (s, s') \ state_relation \ \ archMDBAssertions s'" @@ -70,7 +70,7 @@ lemma isMDBParentOf_trans: apply (erule(1) capBadge_ordering_trans) done -lemma parentOf_trans[CSpace1_R_assms]: +lemma parentOf_trans[Arch_assms]: "\ s \ a parentOf b; s \ b parentOf c \ \ s \ a parentOf c" by (auto simp: parentOf_def elim: isMDBParentOf_trans) @@ -86,7 +86,7 @@ lemma is_physical_relation: by (auto simp: is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma obj_ref_of_relation[CSpace1_R_assms]: +lemma obj_ref_of_relation[Arch_assms]: "\ cap_relation c c'; capClass c' = PhysicalClass \ \ obj_ref_of c = capUntypedPtr c'" by (cases c; simp) (rename_tac arch_cap, case_tac arch_cap, auto) @@ -101,7 +101,7 @@ lemma obj_size_relation: apply (case_tac arch_cap; simp add: objBits_def RISCV64_H.capUntypedSize_def bit_simps') done -lemma same_region_as_relation[CSpace1_R_assms]: +lemma same_region_as_relation[Arch_assms]: "\ cap_relation c d; cap_relation c' d' \ \ same_region_as c c' = sameRegionAs d d'" apply (cases c) apply clarsimp @@ -122,7 +122,7 @@ lemma same_region_as_relation[CSpace1_R_assms]: clarsimp simp: global.sameRegionAs_def isCap_simps Let_def)+ done -lemma can_be_is[CSpace1_R_assms]: +lemma can_be_is[Arch_assms]: "\ cap_relation c (cteCap cte); cap_relation c' (cteCap cte'); mdbRevocable (cteMDBNode cte) = r; mdbFirstBadged (cteMDBNode cte') = r' \ \ @@ -147,14 +147,14 @@ lemma can_be_is[CSpace1_R_assms]: apply (auto simp: Let_def)[1] done -lemma maskCap_valid[CSpace1_R_assms, simp]: +lemma maskCap_valid[Arch_assms, simp]: "s \' global.maskCapRights R cap = s \' cap" by (clarsimp simp: valid_cap'_def global.maskCapRights_def isCap_simps capAligned_def RISCV64_H.maskCapRights_def split: capability.split arch_capability.split cong: if_cong) -lemma cap_map_update_data[CSpace1_R_assms]: +lemma cap_map_update_data[Arch_assms]: assumes "cap_relation c c'" shows "cap_relation (update_cap_data p x c) (updateCapData p x c')" proof - @@ -200,7 +200,7 @@ qed sublocale setCTE: typ_at_props' "setCTE c cte" by typ_at_props' -lemma arch_updateCapData_Master[CSpace1_R_assms]: +lemma arch_updateCapData_Master[Arch_assms]: "Arch.updateCapData P d acap \ NullCap \ capMasterCap (Arch.updateCapData P d acap) = capMasterCap (ArchObjectCap acap)" by (cases acap; simp add: RISCV64_H.updateCapData_def split: if_split_asm) @@ -212,28 +212,28 @@ private method updateCapData_cases for c = (rename_tac arch_capability), (case_tac arch_capability; simp add: RISCV64_H.updateCapData_def isCap_simps Let_def) -lemma capASID_update[CSpace1_R_assms, simp]: +lemma capASID_update[Arch_assms, simp]: "capASID (RetypeDecls_H.updateCapData P x c) = capASID c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_vptr_update'[CSpace1_R_assms, simp]: +lemma cap_vptr_update'[Arch_assms, simp]: "cap_vptr' (RetypeDecls_H.updateCapData P x c) = cap_vptr' c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_asid_base_update'[CSpace1_R_assms, simp]: +lemma cap_asid_base_update'[Arch_assms, simp]: "cap_asid_base' (RetypeDecls_H.updateCapData P x c) = cap_asid_base' c" unfolding cap_asid_base'_def by (updateCapData_cases c) -lemma updateCapData_Reply[CSpace1_R_assms, simp]: +lemma updateCapData_Reply[Arch_assms, simp]: "isReplyCap (updateCapData P x c) = isReplyCap c" by (updateCapData_cases c) end (* context private method *) -lemma capASID_mask[CSpace1_R_assms, simp]: +lemma capASID_mask[Arch_assms, simp]: "capASID (maskCapRights x c) = capASID c" unfolding capASID_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -242,7 +242,7 @@ lemma capASID_mask[CSpace1_R_assms, simp]: simp_all add: RISCV64_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_vptr_mask'[CSpace1_R_assms, simp]: +lemma cap_vptr_mask'[Arch_assms, simp]: "cap_vptr' (maskCapRights x c) = cap_vptr' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -251,7 +251,7 @@ lemma cap_vptr_mask'[CSpace1_R_assms, simp]: simp_all add: RISCV64_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_asid_base_mask'[CSpace1_R_assms, simp]: +lemma cap_asid_base_mask'[Arch_assms, simp]: "cap_asid_base' (maskCapRights x c) = cap_asid_base' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -382,7 +382,7 @@ proof - done qed -lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: +lemma set_cap_not_quite_corres_prequel[Arch_assms]: assumes cr: "pspace_relation (kheap s) (ksPSpace s')" "(x,t') \ fst (setCTE p' c' s')" @@ -431,7 +431,7 @@ lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: done (* FIXME: move *) -lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: +lemma pspace_relation_cte_wp_atI'[Arch_assms]: "\ pspace_relation (kheap s) (ksPSpace s'); cte_wp_at' ((=) cte) x s'; valid_objs s \ \ \c slot. cte_wp_at ((=) c) slot s \ cap_relation c (cteCap cte) \ x = cte_map slot" @@ -455,23 +455,23 @@ lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: split: Structures_A.kernel_object.split_asm arch_kernel_obj.split_asm) done -lemma same_region_as_final_matters[CSpace1_R_assms]: +lemma same_region_as_final_matters[Arch_assms]: "\same_region_as c c'; final_matters c\ \ final_matters c'" by (rule ccontr) (simp add: final_matters_def final_matters_arch_def cap_relation_split_asm split: cap.split_asm arch_cap.splits) -lemma same_region_as_arch_gen_refs[CSpace1_R_assms]: +lemma same_region_as_arch_gen_refs[Arch_assms]: "\same_region_as c c'; final_matters c \ \ arch_gen_refs c = arch_gen_refs c'" by (auto simp: final_matters_def cap_relation_split_asm is_cap_simps split: cap.split_asm arch_cap.splits) -lemma arch_same_region_aobj_ref[CSpace1_R_assms]: +lemma arch_same_region_aobj_ref[Arch_assms]: "\arch_same_region_as ac ac'; final_matters_arch ac; final_matters_arch ac'\ \ aobj_ref ac = aobj_ref ac'" by (simp add: final_matters_arch_def split: RISCV64_A.arch_cap.splits) -lemma obj_refs_relation_Master[CSpace1_R_assms]: +lemma obj_refs_relation_Master[Arch_assms]: "cap_relation cap cap' \ obj_refs cap = (if capClass (capMasterCap cap') = PhysicalClass \ \ isUntypedCap (capMasterCap cap') then {capUntypedPtr (capMasterCap cap')} @@ -483,13 +483,13 @@ lemma arch_gen_refs_relation_Master: "cap_relation cap cap' \ arch_gen_refs cap = {}" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma arch_gen_refs_cap_relation_Master_eq[CSpace1_R_assms]: +lemma arch_gen_refs_cap_relation_Master_eq[Arch_assms]: "\cap_relation c (cteCap cte); capMasterCap (cteCap cte') = capMasterCap (cteCap cte); cap_relation c' (cteCap cte')\ \ arch_gen_refs c = arch_gen_refs c'" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma descendants_of_update_ztc[CSpace1_R_assms]: +lemma descendants_of_update_ztc[Arch_assms]: assumes c: "\x. \ m \ x \ slot; \ P \ \ \cte'. m x = Some cte' \ capMasterCap (cteCap cte') \ capMasterCap (cteCap cte) @@ -686,7 +686,7 @@ proof (simp add: descendants_of'_def subset_iff, by simp qed -lemma capRange_cap_relation[CSpace1_R_assms]: +lemma capRange_cap_relation[Arch_assms]: "\ cap_relation cap cap'; capClass cap' = PhysicalClass \ \ capRange cap' = {obj_ref_of cap .. obj_ref_of cap + obj_size cap - 1}" by (simp add: capRange_def objBits_simps' cte_level_bits_def @@ -694,23 +694,23 @@ lemma capRange_cap_relation[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm option.split sum.split) -lemma obj_refs_cap_relation_untyped_ptr[CSpace1_R_assms]: +lemma obj_refs_cap_relation_untyped_ptr[Arch_assms]: "\ cap_relation cap cap'; obj_refs cap \ {} \ \ capUntypedPtr cap' \ obj_refs cap" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) -lemma ghost_relation_wrapper_same_concrete_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_concrete_set_cap[Arch_assms]: "\ ghost_relation_wrapper s c; ((), s') \ fst (set_cap cap src s) \ \ ghost_relation_wrapper s' c" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma revokable_plus_orderD[CSpace1_R_assms]: +lemma revokable_plus_orderD[Arch_assms]: "\ isCapRevocable new old; (capBadge old, capBadge new) \ capBadge_ordering P; capMasterCap old = capMasterCap new \ \ (isUntypedCap new \ (\x. capBadge old = Some 0 \ capBadge new = Some x \ x \ 0))" by (clarsimp simp: Retype_H.isCapRevocable_def RISCV64_H.isCapRevocable_def isCap_simps split: if_split_asm capability.split_asm arch_capability.split_asm) -lemma valid_badges_def2[CSpace1_R_assms]: +lemma valid_badges_def2[Arch_assms]: "valid_badges m = (\p p' cap node cap' node'. m p = Some (CTE cap node) \ @@ -727,7 +727,7 @@ lemma valid_badges_def2[CSpace1_R_assms]: apply (case_tac cap; clarsimp simp: gen_isCap_simps) by (fastforce simp: sameRegionAs_def3 isCap_simps arch_capBadge_def)+ -lemma is_cap_revocable_eq[CSpace1_R_assms]: +lemma is_cap_revocable_eq[Arch_assms]: "\ cap_relation c c'; cap_relation src_cap src_cap'; sameRegionAs src_cap' c'; is_untyped_cap src_cap \ \ is_ep_cap c \ \ is_ntfn_cap c\ \ is_cap_revocable c src_cap = isCapRevocable c' src_cap'" @@ -737,10 +737,10 @@ lemma is_cap_revocable_eq[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm) done -lemmas use_update_ztc_one_descendants[CSpace1_R_assms] = +lemmas use_update_ztc_one_descendants[Arch_assms] = use_update_ztc_one[OF RISCV64.descendants_of_update_ztc, simplified] -lemma is_derived'_genD[CSpace1_R_assms]: +lemma is_derived'_genD[Arch_assms]: "is_derived' m p cap' cap \ cap' \ NullCap \ \ isZombie cap \ @@ -752,11 +752,11 @@ lemma is_derived'_genD[CSpace1_R_assms]: (isReplyCap cap' \ \ capReplyMaster cap')" by (simp add: RISCV64.is_derived'_def) -lemma acap_relation_capBadge[CSpace1_R_assms]: +lemma acap_relation_capBadge[Arch_assms]: "acap_relation acap acap' \ arch_capBadge acap' = arch_cap_badge acap" by (simp add: arch_capBadge_def) -lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: +lemma obj_relation_cuts_in_obj_range[Arch_assms]: "\ (y, P) \ obj_relation_cuts ko x; x \ obj_range x ko; kheap s x = Some ko; valid_objs s; pspace_aligned s \ \ y \ obj_range x ko" @@ -797,7 +797,7 @@ lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: apply (simp add: word_bits_def) done -lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: +lemma isMDBParentOf_CTE_gen[Arch_assms]: "\isArchObjectCap cap \ isMDBParentOf (CTE cap node) cte = (\cap' node'. cte = CTE cap' node' \ sameRegionAs cap cap' @@ -805,19 +805,20 @@ lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: \ (capBadge cap, capBadge cap') \ capBadge_ordering (mdbFirstBadged node'))" by (simp add: isMDBParentOf_CTE isCap_simps) +lemmas CSpace1_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R?: CSpace1_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace1_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace1_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_2 locale *) -lemma updateMDB_pspace_relation[CSpace1_R_2_assms]: +lemma updateMDB_pspace_relation[Arch_assms]: assumes "(x, s'') \ fst (updateMDB p f s')" assumes "pspace_relation (kheap s) (ksPSpace s')" assumes "pspace_aligned' s'" "pspace_distinct' s'" @@ -875,7 +876,7 @@ lemma cap_asid_cap_relation: "cap_relation c c' \ capASID c' = map_option ucast (cap_asid c)" by (auto simp: capASID_def cap_asid_def split: cap.splits arch_cap.splits option.splits) -lemma is_derived_eq[CSpace1_R_2_assms]: +lemma is_derived_eq[Arch_assms]: "\ cap_relation c c'; cap_relation d d'; cdt_relation (swp cte_at s) (cdt s) (ctes_of s'); cte_at p s \ \ is_derived (cdt s) p c d = is_derived' (ctes_of s') (cte_map p) c' d'" @@ -928,7 +929,7 @@ lemma isMDBParentOf_eq_child: apply (clarsimp simp: sameRegionAs_def2 isCap_simps) done -lemma isMDBParentOf_eq[CSpace1_R_2_assms]: +lemma isMDBParentOf_eq[Arch_assms]: "\ isMDBParentOf c d; weak_derived' (cteCap c) (cteCap c'); mdbRevocable (cteMDBNode c') = mdbRevocable (cteMDBNode c); @@ -973,11 +974,11 @@ lemma maskedAsFull_revokable: split: arch_capability.splits if_splits) done -lemma arch_mdb_preservation_refl[simp, intro!, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_refl[simp, intro!, Arch_assms]: "arch_mdb_preservation cap cap" by simp -lemma arch_mdb_preservation_sym[CSpace1_R_2_assms]: +lemma arch_mdb_preservation_sym[Arch_assms]: "arch_mdb_preservation cap cap' = arch_mdb_preservation cap' cap" by simp @@ -985,11 +986,11 @@ lemma arch_mdb_preservation_non_arch: "\ \isArchObjectCap cap; \isArchObjectCap cap' \ \ arch_mdb_preservation cap cap'" by simp -lemma arch_mdb_preservation_Untyped[simp, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_Untyped[simp, Arch_assms]: "arch_mdb_preservation (UntypedCap d p sz idx) (UntypedCap d' p' sz' idx')" by (simp add: arch_mdb_preservation_non_arch isCap_simps) -lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: +lemma parentOf_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. \m x = Some cte; m' x = Some cte'\ \ @@ -1031,7 +1032,7 @@ lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: apply blast done -lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: +lemma mdb_chunked_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. @@ -1077,7 +1078,7 @@ lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: apply (clarsimp simp:mdb_next_rel_def node) done -lemma valid_badges_preserve_oneway[CSpace1_R_2_assms]: +lemma valid_badges_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes misc: "\x cte cte'. @@ -1137,12 +1138,13 @@ definition is_simple_cap' :: "capability \ bool" where \ isZombie cap \ \ isArchFrameCap cap" +lemmas CSpace1_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R_2?: CSpace1_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_2_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace1_R_2_assms)?)) qed (* needed to prove dest_no_parent_n in Arch, then export to mdb_insert_der *) @@ -1273,19 +1275,20 @@ end context Arch begin arch_global_naming -named_theorems CSpace1_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_3 locale *) -lemmas [CSpace1_R_3_assms] = +lemmas [Arch_assms] = is_derived_maskedAsFull derived_sameRegionAs maskedAsFull_revokable mdb_insert_der.dest_no_parent_n mdb_insert_sib.src_no_mdb_parent mdb_insert_sib.parent_preserved -end +lemmas CSpace1_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace1_R_3?: CSpace1_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_3_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace1_R_3_assms)?)) qed locale Arch_masterCap = Arch + masterCap diff --git a/proof/refine/RISCV64/ArchCSpace_I.thy b/proof/refine/RISCV64/ArchCSpace_I.thy index dd8c849fb0..602edbf2c9 100644 --- a/proof/refine/RISCV64/ArchCSpace_I.thy +++ b/proof/refine/RISCV64/ArchCSpace_I.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_I_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I locale *) lemma arch_capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (ASIDPoolCap r asid) = r" @@ -20,14 +20,14 @@ lemma arch_capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (PageTableCap r mapdata2) = r" by (auto simp: RISCV64_H.capUntypedPtr_def) -lemma maskCapRights_allRights[CSpace_I_assms, simp]: +lemma maskCapRights_allRights[Arch_assms, simp]: "maskCapRights allRights c = c" - unfolding global.maskCapRights_def isCap_defs allRights_def maskCapRights_def maskVMRights_def + unfolding global.maskCapRights_def isCap_defs allRights_def RISCV64_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma isPhysicalCap[CSpace_I_assms, simp]: +lemma isPhysicalCap[Arch_assms, simp]: "isPhysicalCap cap = (capClass cap = PhysicalClass)" - by (simp add: global.isPhysicalCap_def isPhysicalCap_def + by (simp add: global.isPhysicalCap_def RISCV64_H.isPhysicalCap_def split: capability.split arch_capability.split) definition arch_capMasterCap :: "arch_capability \ arch_capability" where @@ -42,17 +42,17 @@ definition arch_capMasterCap :: "arch_capability \ arch_capability" lemmas arch_capMasterCap_simps[simp] = arch_capMasterCap_def[split_simps arch_capability.split] -lemma acapClass_arch_capMasterCap[CSpace_I_assms,simp]: +lemma acapClass_arch_capMasterCap[Arch_assms,simp]: "acapClass (arch_capMasterCap acap) = acapClass acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma capUntypedPtr_arch_capMasterCap[CSpace_I_assms, simp]: +lemma capUntypedPtr_arch_capMasterCap[Arch_assms, simp]: "Arch.capUntypedPtr (arch_capMasterCap acap) = Arch.capUntypedPtr acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: +lemma acapBits_arch_capMasterCap[Arch_assms, simp]: "acapBits (arch_capMasterCap acap) = acapBits acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) @@ -60,11 +60,11 @@ lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: lemmas isArchFrameCap_simps[simp] = isArchFrameCap_def[split_simps capability.split arch_capability.split] -lemma isArchFrameCap_arch_capMasterCap[CSpace_I_assms, simp]: +lemma isArchFrameCap_arch_capMasterCap[Arch_assms, simp]: "isArchFrameCap (ArchObjectCap (arch_capMasterCap acap)) = isArchFrameCap (ArchObjectCap acap)" by (simp add: arch_capMasterCap_def split: arch_capability.split) -lemma isArchFrameCap_non_arch[CSpace_I_assms]: +lemma isArchFrameCap_non_arch[Arch_assms]: "\is_ArchObjectCap cap \ isArchFrameCap cap = False" by (simp add: isArchFrameCap_def is_ArchObjectCap_def split: capability.split) @@ -83,18 +83,19 @@ lemma arch_capBadge_def: "arch_capBadge acap = None" by (cases acap; simp) -end +lemmas CSpace_I_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I?: CSpace_I RISCV64.arch_capMasterCap RISCV64.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace_I_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_I_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I_2 locale *) (* for the Arch locale we want the fully expanded version covering all cases, but avoiding the capMasterCap_ArchObjectCap rewrite case for an unspecified ArchObjectCap *) @@ -104,7 +105,7 @@ lemmas capMasterCap_simps[simp] = capMasterCap_def[simplified arch_capMasterCap_def, split_simps capability.split arch_capability.split] -lemma isArchFrameCap_capMasterCap[CSpace_I_2_assms, simp]: +lemma isArchFrameCap_capMasterCap[Arch_assms, simp]: "isArchFrameCap (capMasterCap cap) = isArchFrameCap cap" by (simp add: isArchFrameCap_def split: capability.split arch_capability.split) @@ -129,7 +130,7 @@ lemmas arch_capMasterCap_eqDs[dest!] = arch_capMasterCap_eqDs1 arch_capMasterCap lemma capUntypedSize_capBits: "capClass cap = PhysicalClass \ capUntypedSize cap = 2 ^ (capBits cap)" - by (fastforce simp: global.capUntypedSize_def objBits_simps bit_simps' capUntypedSize_def + by (fastforce simp: global.capUntypedSize_def objBits_simps bit_simps' RISCV64_H.capUntypedSize_def split: capability.splits arch_capability.splits zombie_type.splits) (* unused in this architecture *) @@ -205,7 +206,7 @@ lemma sameRegionAsE: \ \ R" by (simp add: sameRegionAs_def3, fastforce simp: gen_isCap_Master) -lemma sameObjectAsE[CSpace_I_2_assms]: +lemma sameObjectAsE[Arch_assms]: "\ sameObjectAs cap cap'; \ capMasterCap cap = capMasterCap cap'; \ isNullCap cap; \ isZombie cap; \ isUntypedCap cap; @@ -216,7 +217,7 @@ lemma sameObjectAs_sameRegionAs: "sameObjectAs cap cap' \ sameRegionAs cap cap'" by (clarsimp simp add: sameObjectAs_def2 sameRegionAs_def2 isCap_simps) -lemma sameObjectAs_sym[CSpace_I_2_assms]: +lemma sameObjectAs_sym[Arch_assms]: "sameObjectAs c d = sameObjectAs d c" by (auto simp: sameObjectAs_def2) @@ -226,17 +227,17 @@ lemma sameObject_capRange: apply (clarsimp simp: sameObjectAs_def2) done -lemma sameRegionAs_Null[CSpace_I_2_assms, simp]: +lemma sameRegionAs_Null[Arch_assms, simp]: "sameRegionAs c NullCap = False" "sameRegionAs NullCap c = False" by (simp add: sameRegionAs_def3 capRange_def isCap_simps)+ -lemma sameRegionAs_classes[CSpace_I_2_assms]: +lemma sameRegionAs_classes[Arch_assms]: "sameRegionAs cap cap' \ capClass cap = capClass cap'" by (erule sameRegionAsE, rule master_eqI) (clarsimp simp: capRange_def isCap_simps intro!: capClass_Master split: if_split_asm)+ -lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: +lemma sameRegionAs_capRange_Int[Arch_assms]: "\ sameRegionAs cap cap'; capClass cap = PhysicalClass \ capClass cap' = PhysicalClass; capAligned cap; capAligned cap' \ \ capRange cap' \ capRange cap \ {}" @@ -248,26 +249,26 @@ lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: apply (fastforce simp: capRange_Master isCap_simps)+ done -lemma sameRegionAs_trans[CSpace_I_2_assms]: +lemma sameRegionAs_trans[Arch_assms]: "\ sameRegionAs a b; sameRegionAs b c \ \ sameRegionAs a c" by (simp add: sameRegionAs_def2, elim conjE disjE) (auto simp: isCap_simps capRange_def) (* long *) -lemma capMasterCap_maskCapRights[simp, CSpace_I_2_assms]: +lemma capMasterCap_maskCapRights[simp, Arch_assms]: "capMasterCap (maskCapRights msk cap) = capMasterCap cap" apply (cases cap; simp add: global.maskCapRights_def Let_def isCap_simps capMasterCap_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: RISCV64_H.maskCapRights_def Let_def isCap_simps) done -lemma capBadge_maskCapRights[simp, CSpace_I_2_assms]: +lemma capBadge_maskCapRights[simp, Arch_assms]: "capBadge (maskCapRights msk cap) = capBadge cap" apply (cases cap; simp add: global.maskCapRights_def Let_def gen_isCap_simps capBadge_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: RISCV64_H.maskCapRights_def Let_def isCap_simps) done -lemma cte_refs_capRange[CSpace_I_2_assms]: +lemma cte_refs_capRange[Arch_assms]: "\ s \' c; \irq. c \ IRQHandlerCap irq \ \ cte_refs' c x \ capRange c" apply (cases c; simp add: capRange_def gen_isCap_simps) apply (clarsimp dest!: valid_capAligned @@ -338,15 +339,15 @@ lemma cte_refs_capRange[CSpace_I_2_assms]: apply (simp add: word_bits_def) done -lemma capBits_Master[CSpace_I_2_assms]: +lemma capBits_Master[Arch_assms]: "capBits (capMasterCap cap) = capBits cap" by (clarsimp simp: capMasterCap_def split: capability.split arch_capability.split) -lemma capUntyped_Master[CSpace_I_2_assms]: +lemma capUntyped_Master[Arch_assms]: "capUntypedPtr (capMasterCap cap) = capUntypedPtr cap" by (clarsimp simp: capMasterCap_def RISCV64_H.capUntypedPtr_def split: capability.split arch_capability.split) -lemma distinct_zombies_copyMasterE[CSpace_I_2_assms]: +lemma distinct_zombies_copyMasterE[Arch_assms]: "\ distinct_zombies m; m x = Some cte; capClass (cteCap cte') = PhysicalClass \ capMasterCap (cteCap cte) = capMasterCap (cteCap cte'); @@ -368,19 +369,20 @@ lemmas distinct_zombies_sameMasterE = distinct_zombies_copyMasterE[where x=x and y=x for x, simplified, OF _ _ _] -declare distinct_zombies_sameMasterE[CSpace_I_2_assms] +declare distinct_zombies_sameMasterE[Arch_assms] -lemma cap_table_at_gsCNodes_eq[CSpace_I_2_assms]: +lemma cap_table_at_gsCNodes_eq[Arch_assms]: "(s, s') \ state_relation \ (gsCNodes s' ptr = Some bits) = cap_table_at bits ptr s" by (fastforce simp: state_relation_def ghost_relation_def obj_at_def is_cap_table) -end +lemmas CSpace_I_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I_2?: CSpace_I_2 RISCV64.arch_capMasterCap RISCV64.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace_I_2_assms)?)?) qed (* Arch constant definitions required to exist for sane locales in CSpace1_R *) diff --git a/proof/refine/RISCV64/ArchCSpace_R.thy b/proof/refine/RISCV64/ArchCSpace_R.thy index 571be66962..314a59b17f 100644 --- a/proof/refine/RISCV64/ArchCSpace_R.thy +++ b/proof/refine/RISCV64/ArchCSpace_R.thy @@ -13,12 +13,12 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R locale *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = arch_deriveCap_corres arch_deriveCap_inv arch_deriveCap_valid -lemma capAligned_master[CSpace_R_assms]: +lemma capAligned_master[Arch_assms]: "\capAligned cap; capMasterCap cap = capMasterCap ncap\ \ capAligned ncap" apply (case_tac cap) apply (clarsimp simp: capAligned_def)+ @@ -36,7 +36,7 @@ sublocale updateCap: typ_at_props' "updateCap slot newCap" sublocale cteInsert: typ_at_props' "cteInsert newCap srcSlot destSlot" by typ_at_props' -lemma maskedAsFull_derived'[CSpace_R_assms]: +lemma maskedAsFull_derived'[Arch_assms]: "\m src = Some (CTE s_cap s_node); is_derived' m ptr b c\ \ is_derived' (m(src \ CTE (maskedAsFull s_cap cap) s_node)) ptr b c" apply (subgoal_tac "m(src \ CTE (maskedAsFull s_cap cap) s_node) @@ -51,21 +51,21 @@ lemma maskedAsFull_derived'[CSpace_R_assms]: apply (clarsimp simp:modify_map_def) done -lemma capMaster_capRange[CSpace_R_assms]: +lemma capMaster_capRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ capRange c = capRange c'" by (simp add: capMasterCap_def arch_capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_untypedRange[CSpace_R_assms]: +lemma capMaster_untypedRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ untypedRange c = untypedRange c'" by (simp add: capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_capClass[CSpace_R_assms]: +lemma capMaster_capClass[Arch_assms]: "capMasterCap c = capMasterCap c' \ capClass c = capClass c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma valid_arch_badges_mdbPrev_update[simp, CSpace_R_assms]: +lemma valid_arch_badges_mdbPrev_update[simp, Arch_assms]: "valid_arch_badges cap cap' (mdbPrev_update f node) = valid_arch_badges cap cap' node" by (simp add: valid_arch_badges_def) @@ -74,19 +74,19 @@ lemma valid_arch_badges_master_eq: valid_arch_badges src_cap cap' node = valid_arch_badges cap cap' node" by (auto simp: valid_arch_badges_def isCap_simps) -lemma valid_arch_badges_firstBadged[CSpace_R_assms]: +lemma valid_arch_badges_firstBadged[Arch_assms]: "\ valid_arch_badges cap cap' node; mdbFirstBadged node = mdbFirstBadged node' \ \ valid_arch_badges cap cap' node'" by (simp add: valid_arch_badges_def) -lemma valid_arch_badges_master[CSpace_R_assms]: +lemma valid_arch_badges_master[Arch_assms]: "\capMasterCap src_cap = capMasterCap cap; (capBadge src_cap, capBadge cap) \ capBadge_ordering False; valid_arch_badges src_cap cap' node\ \ valid_arch_badges cap cap' node" by (clarsimp simp: valid_arch_badges_def isCap_simps) -lemma badge_derived'_capRange[CSpace_R_assms]: +lemma badge_derived'_capRange[Arch_assms]: "badge_derived' cap src_cap \ capRange cap = capRange src_cap" apply (clarsimp simp: badge_derived'_def) apply (case_tac cap; clarsimp simp: gen_isCap_simps capRange_def) @@ -94,21 +94,21 @@ lemma badge_derived'_capRange[CSpace_R_assms]: apply (case_tac arch_capability; clarsimp simp: isCap_simps capRange_def) done -lemma valid_arch_badges_non_arch[CSpace_R_assms]: +lemma valid_arch_badges_non_arch[Arch_assms]: "\ \isArchObjectCap c; \isArchObjectCap c' \ \ valid_arch_badges c c' node" by (clarsimp simp add: valid_arch_badges_def isCap_simps) -lemma capMasterCap_valid_arch_badges_isCapRevocable[CSpace_R_assms]: +lemma capMasterCap_valid_arch_badges_isCapRevocable[Arch_assms]: "capMasterCap src_cap = capMasterCap cap \ valid_arch_badges src_cap cap (MDB word1 src (Arch.isCapRevocable cap src_cap) (Arch.isCapRevocable cap src_cap))" by (clarsimp simp add: valid_arch_badges_def) -lemma setCTE_valid_arch[CSpace_R_assms, wp]: +lemma setCTE_valid_arch[Arch_assms, wp]: "setCTE p c \valid_arch_state'\" by (wp valid_arch_state_lift' setCTE_typ_at') -lemma setCTE_global_refs[CSpace_R_assms, wp]: +lemma setCTE_global_refs[Arch_assms, wp]: "setCTE p c \\s. P (global_refs' s)\" apply (simp add: setCTE_def setObject_def split_def updateObject_cte global_refs'_def) apply (wpsimp+; auto) @@ -119,14 +119,14 @@ crunch cteInsert (wp: crunch_wps simp: cte_wp_at_ctes_of) crunch cteInsert - for valid_arch_state'[CSpace_R_assms, wp]: valid_arch_state' + for valid_arch_state'[Arch_assms, wp]: valid_arch_state' (wp: crunch_wps) -lemma acapClass_not_Reply[CSpace_R_assms]: +lemma acapClass_not_Reply[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) -lemma isArchMDBParentOf_non_arch[CSpace_R_assms]: +lemma isArchMDBParentOf_non_arch[Arch_assms]: "\isArchObjectCap cap \ isArchMDBParentOf cap cap' b" "\isArchObjectCap cap' \ isArchMDBParentOf cap cap' b" by (simp add: isCap_simps)+ @@ -289,7 +289,7 @@ context Arch begin arch_global_naming (* since these are not used after this theory, drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = Arch_mdb_insert.chunked_n[simplified Arch_mdb_insert_def] Arch_mdb_insert_sib.untyped_inc_n[simplified Arch_mdb_insert_sib_def] Arch_mdb_move.parent_preserved[simplified Arch_mdb_move_def] @@ -299,21 +299,22 @@ crunch cteInsert for pspace_in_kernel_mappings'[wp]: pspace_in_kernel_mappings' (wp: crunch_wps) -lemmas [CSpace_R_assms] = cteInsert_pspace_in_kernel_mappings' +lemmas [Arch_assms] = cteInsert_pspace_in_kernel_mappings' -end +lemmas CSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R?: CSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_2 locale *) -lemma deriveCap_derived[CSpace_R_2_assms]: +lemma deriveCap_derived[Arch_assms]: "\\s. c'\ capability.NullCap \ cte_wp_at' (\cte. badge_derived' c' (cteCap cte) \ capASID c' = capASID (cteCap cte) \ cap_asid_base' c' = cap_asid_base' (cteCap cte) @@ -343,7 +344,7 @@ lemma deriveCap_derived[CSpace_R_2_assms]: | clarsimp split: option.split_asm)+) done -lemma arch_deriveCap_untyped_derived[CSpace_R_2_assms, wp]: +lemma arch_deriveCap_untyped_derived[Arch_assms, wp]: "\\s. cte_wp_at' (\cte. untyped_derived_eq c' (cteCap cte)) slot s\ RISCV64_H.deriveCap slot (capCap c') \\rv s. cte_wp_at' (untyped_derived_eq rv o cteCap) slot s\, -" @@ -387,7 +388,7 @@ crunch setupReplyMaster for valid_arch'[wp]: "valid_arch_state'" (wp: crunch_wps simp: crunch_simps) -lemma ex_nonz_tcb_cte_caps'[CSpace_R_2_assms]: +lemma ex_nonz_tcb_cte_caps'[Arch_assms]: "\ex_nonz_cap_to' t s; tcb_at' t s; valid_objs' s; sl \ dom tcb_cte_cases\ \ ex_cte_cap_to' (t + sl) s" apply (clarsimp simp: ex_nonz_cap_to'_def ex_cte_cap_to'_def cte_wp_at_ctes_of) @@ -414,7 +415,7 @@ lemma ex_nonz_cap_not_global': apply (clarsimp simp: ctes_of_valid_cap') done -lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: +lemma setupReplyMaster_invs'[Arch_assms, wp]: "\invs' and tcb_at' t and ex_nonz_cap_to' t\ setupReplyMaster t \\rv. invs'\" @@ -429,7 +430,7 @@ lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: ex_nonz_cap_not_global' dom_def) done -lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: +lemma arch_update_setCTE_mdb[Arch_assms]: "\cte_wp_at' (is_arch_update' cap) p and cte_wp_at' ((=) oldcte) p and valid_mdb'\ setCTE p (cteCap_update (\_. cap) oldcte) \\rv. valid_mdb'\" @@ -552,19 +553,19 @@ lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: apply (clarsimp simp add: is_arch_update'_def isCap_simps) done -lemma capMaster_zobj_refs[CSpace_R_2_assms]: +lemma capMaster_zobj_refs[Arch_assms]: "capMasterCap c = capMasterCap c' \ zobj_refs' c = zobj_refs' c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma zobj_refs_Master[CSpace_R_2_assms]: +lemma zobj_refs_Master[Arch_assms]: "zobj_refs' (capMasterCap cap) = zobj_refs' cap" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.split arch_capability.split) -lemmas [CSpace_R_2_assms] = setCTE_pspace_in_kernel_mappings' +lemmas [Arch_assms] = setCTE_pspace_in_kernel_mappings' -lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: +lemma setUntypedCapAsFull_safe_parent_for'[Arch_assms]: "\\s. safe_parent_for' (ctes_of s) slot a \ cte_wp_at' ((=) srcCTE) slot s\ setUntypedCapAsFull (cteCap srcCTE) c' slot \\rv s. safe_parent_for' (ctes_of s) slot a\" @@ -584,7 +585,7 @@ lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: apply simp done -lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: +lemma maskedAsFull_revokable_safe_parent[Arch_assms]: "\is_simple_cap' c'; safe_parent_for' m p c'; m p = Some cte; cteCap cte = (maskedAsFull src_cap' a)\ \ isCapRevocable c' (maskedAsFull src_cap' a) = isCapRevocable c' src_cap'" @@ -593,12 +594,12 @@ lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: apply (auto simp: isCap_simps is_simple_cap'_def) done -lemma setUntypedCapAsFull_archMDBAssertions[CSpace_R_2_assms, wp]: +lemma setUntypedCapAsFull_archMDBAssertions[Arch_assms, wp]: "setUntypedCapAsFull src_cap cap p \archMDBAssertions\" unfolding archMDBAssertions_def arch_mdb_assert_def by wp -lemma sameRegion_capRange_sub[CSpace_R_2_assms]: +lemma sameRegion_capRange_sub[Arch_assms]: "sameRegionAs cap cap' \ capRange cap' \ capRange cap" apply (clarsimp simp: sameRegionAs_def2 gen_isCap_Master capRange_Master cong: conj_cong) @@ -606,7 +607,7 @@ lemma sameRegion_capRange_sub[CSpace_R_2_assms]: apply (fastforce simp: isCap_simps capRange_def split: if_split_asm) done -lemma capRange_sameRegionAs[CSpace_R_2_assms]: +lemma capRange_sameRegionAs[Arch_assms]: "\ sameRegionAs x y; s \' y; capClass x = PhysicalClass \ capClass y = PhysicalClass \ \ capRange x \ capRange y \ {}" apply (erule sameRegionAsE) @@ -623,7 +624,7 @@ lemma capRange_sameRegionAs[CSpace_R_2_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: +lemma safe_parent_for_capRange_capBits[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ capRange (cteCap cte) \ capBits cap \ capBits (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) @@ -633,7 +634,7 @@ lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: capMasterCap_def capRange_Master objBits_simps split: capability.splits arch_capability.splits) -lemma safe_parent_for_descendants'[CSpace_R_2_assms]: +lemma safe_parent_for_descendants'[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE pcap n); isUntypedCap pcap \ \ descendants_of' p m = {}" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) @@ -645,7 +646,7 @@ lemma safe_parent_not_ntfn': "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ \isNotificationCap src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) -lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_untypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ untypedRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -661,7 +662,7 @@ lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_capUntypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -674,14 +675,14 @@ lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_capClass[CSpace_R_2_assms]: +lemma safe_parent_capClass[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ capClass cap = capClass src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps sameRegionAs_def2 capRange_Master capRange_def capMasterCap_def split: capability.splits arch_capability.splits) (* Generic-only parts of is_simple_cap'. isArchFrameCap appears on all architectures and so is safe. *) -lemma is_simple_cap'_genD[CSpace_R_2_assms]: +lemma is_simple_cap'_genD[Arch_assms]: "is_simple_cap' cap \ cap \ NullCap \ cap \ IRQControlCap \ \ isUntypedCap cap \ \ isReplyCap cap \ \ isEndpointCap cap \ \ isNotificationCap cap \ \ isThreadCap cap \ \ isCNodeCap cap \ @@ -749,14 +750,15 @@ end context Arch begin arch_global_naming -lemmas [CSpace_R_2_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child +lemmas [Arch_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child -end +lemmas CSpace_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_2?: CSpace_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace_R_2_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales @@ -1081,18 +1083,18 @@ end (* Arch_mdb_insert_simple' *) context Arch begin arch_global_naming -named_theorems CSpace_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_3 locale *) (* since mdb_insert_simple' is not used after this theory, drop the Arch assumption directly instead of requalifying *) -lemmas [CSpace_R_3_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] +lemmas [Arch_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] -lemmas [CSpace_R_3_assms] = +lemmas [Arch_assms] = updateCap_valid_arch_state' master_cap_relation updateMDB_pspace_in_kernel_mappings' -lemma derived'_not_Null[CSpace_R_3_assms, simp]: +lemma derived'_not_Null[Arch_assms, simp]: "\ is_derived' m p c capability.NullCap" "\ is_derived' m p capability.NullCap c" by (clarsimp simp: is_derived'_def badge_derived'_def)+ @@ -1105,7 +1107,7 @@ lemma cte_refs_maskCapRights[simp]: split del: if_split split: arch_capability.split) -lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: +lemma ghost_relation_wrapper_set_cap_setCTE[Arch_assms]: "\ ghost_relation_wrapper a c; ((), c') \ fst (setCTE (cte_map slot) (cteCap_update (\_. cap') rv) c); ((), a') \ fst (set_cap cap slot a)\ @@ -1116,12 +1118,13 @@ lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: apply (frule use_valid[OF _ setCTE_gsCNodes]; simp) done -end +lemmas CSpace_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_3?: CSpace_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.CSpace_R_3_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales diff --git a/proof/refine/RISCV64/ArchDetype_R.thy b/proof/refine/RISCV64/ArchDetype_R.thy index 5df4b33446..4c2cb9f14c 100644 --- a/proof/refine/RISCV64/ArchDetype_R.thy +++ b/proof/refine/RISCV64/ArchDetype_R.thy @@ -191,9 +191,9 @@ lemma sym_refs_hyp_refs_triv[simp]: by (clarsimp simp: state_hyp_refs_of_def sym_refs_def) (case_tac "kheap s' x"; simp) -named_theorems Detype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R locale *) -lemma deleteObjects_corres[Detype_R_assms]: +lemma deleteObjects_corres[Arch_assms]: "\ is_aligned base magnitude; magnitude \ word_size_bits \ \ corres dc (\s. einvs s @@ -361,7 +361,7 @@ context Arch begin arch_global_naming Not all of them need to deal with these arch details, so if the def2/def3 lemmas can be generalised or wrapped, some of the lemmas in this block can become generic. *) -lemma deleteObjects_null_filter[Detype_R_assms]: +lemma deleteObjects_null_filter[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -381,7 +381,7 @@ lemma deleteObjects_null_filter[Detype_R_assms]: apply (unfold_locales, simp_all) done -lemma deleteObjects_invs'[Detype_R_assms]: +lemma deleteObjects_invs'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -412,7 +412,7 @@ proof - done qed -lemma deleteObjects_st_tcb_at'[Detype_R_assms]: +lemma deleteObjects_st_tcb_at'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -467,7 +467,7 @@ lemma deleteObjects_cap_to': apply (simp add: delete_locale_def) done -lemma deleteObject_no_overlap[Detype_R_assms, wp]: +lemma deleteObject_no_overlap[Arch_assms, wp]: "\valid_cap' (UntypedCap d ptr bits idx) and valid_pspace'\ deleteObjects ptr bits \\_ s. pspace_no_overlap' ptr bits s\" @@ -486,7 +486,7 @@ lemma deleteObject_no_overlap[Detype_R_assms, wp]: apply simp done -lemma deleteObjects_cte_wp_at'[Detype_R_assms]: +lemma deleteObjects_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ p \ mask_range ptr bits \ s \' (UntypedCap d ptr bits idx) \ valid_pspace' s\ deleteObjects ptr bits @@ -505,13 +505,13 @@ lemma deleteObjects_cte_wp_at'[Detype_R_assms]: apply (case_tac s, simp) done -lemma deleteObjects_nosch[wp, Detype_R_assms]: +lemma deleteObjects_nosch[wp, Arch_assms]: "deleteObjects ptr sz \\s. P (ksSchedulerAction s)\" by (simp add: deleteObjects_def3 | wp hoare_drop_imp)+ lemmas getObjSize_simps = RISCV64_H.getObjectSize_def[split_simps RISCV64_H.object_type.split apiobject_type.split] -lemma createObject_cte_wp_at'[Detype_R_assms]: +lemma createObject_cte_wp_at'[Arch_assms]: "\\s. Types_H.getObjectSize ty us < word_bits \ is_aligned ptr (Types_H.getObjectSize ty us) \ pspace_no_overlap' ptr (Types_H.getObjectSize ty us) s \ @@ -708,7 +708,7 @@ lemma placeNewObject_valid_arch_state: apply (erule(1) range_cover_full) done -lemma createObject_setCTE_commute[Detype_R_assms]: +lemma createObject_setCTE_commute[Arch_assms]: "monad_commute (cte_wp_at' (\_. True) src and pspace_aligned' and pspace_distinct' and @@ -779,7 +779,7 @@ lemma createObject_setCTE_commute[Detype_R_assms]: apply (simp add: bit_simps) done -lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: +lemma createObject_gsUntypedZeroRanges_commute[Arch_assms]: "monad_commute \ (RetypeDecls_H.createObject ty ptr us dev) @@ -802,26 +802,27 @@ lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: apply (simp add: curDomain_def monad_commute_def exec_modify exec_gets) done -lemma createNewCaps_not_nc[Detype_R_assms]: +lemma createNewCaps_not_nc[Arch_assms]: "\\\ createNewCaps ty ptr n us d \\r s. (\cap\set r. cap \ capability.NullCap)\" unfolding createNewCaps_def Arch_createNewCaps_def by (wpsimp simp: Arch_createNewCaps_def split_del: if_split)+ +lemmas Detype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R?: Detype_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Detype_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Detype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R_2 locale *) -lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: +lemma createNewCaps_pspace_no_overlap'[Arch_assms]: "\\s. range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n)) \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ ptr \ 0\ @@ -911,7 +912,7 @@ proof - done qed -lemma createNewCaps_ret_len[Detype_R_2_assms]: +lemma createNewCaps_ret_len[Arch_assms]: "\K (n < 2 ^ word_bits \ n \ 0)\ createNewCaps ty ptr n us d \\rv s. n = length rv\" @@ -933,7 +934,7 @@ lemma createNewCaps_ret_len[Detype_R_2_assms]: | intro conjI impI)+)+ done -lemma createNewCaps_Cons[Detype_R_2_assms]: +lemma createNewCaps_Cons[Arch_assms]: assumes cover:"range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n))" and "valid_pspace' s" "valid_arch_state' s" and "pspace_no_overlap' ptr sz s" @@ -1178,7 +1179,7 @@ proof - done qed -lemma createObject_def2[Detype_R_2_assms]: +lemma createObject_def2[Arch_assms]: "(RetypeDecls_H.createObject ty ptr us dev >>= (\x. return [x])) = createNewCaps ty ptr (Suc 0) us dev" apply (clarsimp simp: global.createObject_def createNewCaps_def placeNewObject_def2) @@ -1198,7 +1199,7 @@ lemma createObject_def2[Detype_R_2_assms]: storeWordVM_def)+ done -lemma ArchCreateObject_pspace_no_overlap'[Detype_R_2_assms]: +lemma ArchCreateObject_pspace_no_overlap'[Arch_assms]: "\\s. pspace_no_overlap' (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \ pspace_aligned' s \ pspace_distinct' s \ @@ -1272,12 +1273,13 @@ lemma createObject_pspace_aligned_distinct': split: RISCV64_H.object_type.splits apiobject_type.splits) done +lemmas Detype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R_2?: Detype_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Detype_R_2_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchEmptyFail.thy b/proof/refine/RISCV64/ArchEmptyFail.thy index 6aa4c59116..1970a7b70a 100644 --- a/proof/refine/RISCV64/ArchEmptyFail.thy +++ b/proof/refine/RISCV64/ArchEmptyFail.thy @@ -10,21 +10,22 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_R locale *) -lemma empty_fail_lookupIPCBuffer[EmptyFail_R_assms]: +lemma empty_fail_lookupIPCBuffer[Arch_assms]: "empty_fail (lookupIPCBuffer r t)" by (clarsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv split: capability.splits arch_capability.splits | wp | wpc | safe)+ declare setRegister_empty_fail[intro!, simp] (* FIXME: tag original instead *) -end +lemmas EmptyFail_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation EmptyFail_R?: EmptyFail_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact EmptyFail_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.EmptyFail_R_assms)?) qed end diff --git a/proof/refine/RISCV64/ArchEmptyFail_H.thy b/proof/refine/RISCV64/ArchEmptyFail_H.thy index 892a44efcc..7b6e927937 100644 --- a/proof/refine/RISCV64/ArchEmptyFail_H.thy +++ b/proof/refine/RISCV64/ArchEmptyFail_H.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H locale *) -lemma arch_deriveCap_empty_fail[EmptyFail_H_assms, intro!, wp, simp]: +lemma arch_deriveCap_empty_fail[Arch_assms, intro!, wp, simp]: "empty_fail (Arch.deriveCap x y)" unfolding RISCV64_H.deriveCap_def by (cases y, auto simp: isCap_simps cong: if_cong) @@ -43,7 +43,7 @@ lemma empty_fail_arch_cap_exhausted: by (cases cap; simp add: isCap_simps) crunch decodeRISCVMMUInvocation, Arch_postCapDeletion, setRegister, prepareThreadDelete - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def pteAtIndex_def wp: empty_fail_catch empty_fail_arch_cap_exhausted rule: RISCV64_H.postCapDeletion_def) @@ -55,7 +55,7 @@ lemma empty_fail_lookupPTFromLevel[intro!, wp, simp]: crunch Arch_finaliseCap, Arch.switchToThread, Arch.switchToIdleThread, prepareNextDomain, getRestartPC, makeArchFaultMessage - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (rule: RISCV64_H.finaliseCap_def) crunch @@ -64,32 +64,34 @@ crunch handleArchFaultReply, prepareSetDomain, postModifyRegisters, postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler, Arch.performInvocation, handleSpuriousIRQ, maskIrqSignal, handleVMFault, checkIRQ, prepareThreadDelete, Arch.postCapDeletion - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H?: EmptyFail_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.EmptyFail_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems EmptyFail_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H_2 locale *) crunch handleReservedIRQ, handleHypervisorFault - for (empty_fail) empty_fail[EmptyFail_H_2_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H_2?: EmptyFail_H_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.EmptyFail_H_2_assms)?)?) qed crunch callKernel diff --git a/proof/refine/RISCV64/ArchFinalise_R.thy b/proof/refine/RISCV64/ArchFinalise_R.thy index e98404400b..9a9cfa556d 100644 --- a/proof/refine/RISCV64/ArchFinalise_R.thy +++ b/proof/refine/RISCV64/ArchFinalise_R.thy @@ -12,9 +12,9 @@ begin context Arch begin arch_global_naming -named_theorems Finalise_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R locale *) -lemma arch_postCapDeletion_ksArchState_lift[Finalise_R_assms]: +lemma arch_postCapDeletion_ksArchState_lift[Arch_assms]: "\\s as. P (s\ksArchState := as\) = P s\ \ Arch.postCapDeletion ac \P\" unfolding postCapDeletion_def by wpsimp @@ -22,7 +22,7 @@ lemma arch_postCapDeletion_ksArchState_lift[Finalise_R_assms]: sublocale clearUntypedFreeIndex: typ_at_props' "clearUntypedFreeIndex slot" by typ_at_props' -lemma setIRQState_umm[Finalise_R_assms]: +lemma setIRQState_umm[Arch_assms]: "setIRQState irqState irq \\s. P (underlying_memory (ksMachineState s))\ " by (simp add: setIRQState_def maskInterrupt_def setInterruptState_def getInterruptState_def @@ -37,7 +37,7 @@ crunch Arch_postCapDeletion and valid_arch_state'[wp]: valid_arch_state' (rule: RISCV64_H.postCapDeletion_def) -lemma arch_postCapDeletion_corres[Finalise_R_assms]: +lemma arch_postCapDeletion_corres[Arch_assms]: "acap_relation cap cap' \ corres dc \ \ (arch_post_cap_deletion cap) (RISCV64_H.postCapDeletion cap')" by (clarsimp simp: arch_post_cap_deletion_def RISCV64_H.postCapDeletion_def) @@ -46,16 +46,16 @@ abbreviation (input) "Arch_finaliseCap \ Arch.finaliseCap" crunch Arch_finaliseCap, prepareThreadDelete, archThreadSet - for typ_at'[Finalise_R_assms, wp]: "\s. P (typ_at' T p s)" - and aligned'[Finalise_R_assms, wp]: "pspace_aligned'" - and distinct'[Finalise_R_assms, wp]: "pspace_distinct'" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" + and aligned'[Arch_assms, wp]: "pspace_aligned'" + and distinct'[Arch_assms, wp]: "pspace_distinct'" (wp: crunch_wps getObject_inv loadObject_default_inv simp: crunch_simps unless_def o_def ignore_del: setObject rule: RISCV64_H.finaliseCap_def) crunch prepareThreadDelete, Arch_finaliseCap - for it'[Finalise_R_assms, wp]: "\s. P (ksIdleThread s)" + for it'[Arch_assms, wp]: "\s. P (ksIdleThread s)" (wp: hoare_drop_imps simp: crunch_simps updateObject_default_def rule: RISCV64_H.finaliseCap_def) @@ -88,6 +88,8 @@ definition post_cap_delete_pre' :: "capability \ paddr \ IRQHandlerCap irq \ arch_valid_irq irq \ (\sl'. sl \ sl' \ cs sl' \ Some cap) | _ \ False" +lemmas Finalise_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -377,15 +379,14 @@ end (* mdb_empty *) interpretation Finalise_R?: Finalise_R arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Finalise_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Finalise_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_2 locale *) -lemma not_Final_removeable[Finalise_R_2_assms]: +lemma not_Final_removeable[Arch_assms]: "\ isFinal cap sl (cteCaps_of s) \ removeable' sl s cap" apply (erule not_FinalE) apply (clarsimp simp: removeable'_def gen_isCap_simps) @@ -394,7 +395,7 @@ lemma not_Final_removeable[Finalise_R_2_assms]: apply fastforce done -lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: +lemma deletedIRQHandler_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ deletedIRQHandler irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -408,7 +409,7 @@ lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: apply (clarsimp simp: valid_refs'_cteCaps valid_cap_sizes_cteCaps ball_ran_eq) done -lemma clearUntypedFreeIndex_valid_global_refs[Finalise_R_2_assms, wp]: +lemma clearUntypedFreeIndex_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ clearUntypedFreeIndex irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -454,7 +455,7 @@ lemma final_matters_mdb_chunked_arch_assms: by (clarsimp simp: mdb_chunked_arch_assms_def isCap_simps final_matters'_def arch_final_matters'_def) -lemma notFinal_prev_or_next[Finalise_R_2_assms]: +lemma notFinal_prev_or_next[Arch_assms]: "\ \ isFinal cap x (cteCaps_of s); mdb_chunked (ctes_of s); valid_dlist (ctes_of s); no_0 (ctes_of s); ctes_of s x = Some (CTE cap node); final_matters' cap \ @@ -501,12 +502,12 @@ lemma notFinal_prev_or_next[Finalise_R_2_assms]: apply (clarsimp simp: sameObjectAs_def3 simp del: isArchFrameCap_capMasterCap) done -lemma sameObjectAs_not_Untyped[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap \ \ \ isUntypedCap cap'" by (clarsimp simp: gen_isCap_simps sameObjectAs_def3) -lemma sameObjectAs_not_Untyped'[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped'[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap' \ \ global.sameObjectAs cap' cap" by (clarsimp simp: isCap_simps sameObjectAs_def3) @@ -558,7 +559,7 @@ lemma (in vmdb) isFinal_untypedParent: context Arch begin arch_global_naming -lemma isFinal_no_descendants[Finalise_R_2_assms]: +lemma isFinal_no_descendants[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); ctes_of s sl = Some (CTE cap n); valid_mdb' s; final_matters' cap \ \ descendants_of' sl (ctes_of s) = {}" @@ -789,7 +790,7 @@ lemma archThreadSet_valid_sched_pointers[wp]: "archThreadSet f t \valid_sched_pointers\" by (wp_pre, wps, wp, assumption) -lemma arch_finaliseCap_invs[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_invs[Arch_assms, wp]: "\invs' and valid_cap' (ArchObjectCap cap)\ Arch.finaliseCap cap fin \\rv. invs'\" unfolding RISCV64_H.finaliseCap_def Let_def by wpsimp @@ -829,16 +830,16 @@ crunch prepareThreadDelete ignore: archThreadSet) crunch Arch.finaliseCap, prepareThreadDelete - for irq_node'[Finalise_R_2_assms, wp]: "\s. P (irq_node' s)" + for irq_node'[Arch_assms, wp]: "\s. P (irq_node' s)" (wp: crunch_wps getObject_inv loadObject_default_inv updateObject_default_inv setObject_ksInterrupt simp: crunch_simps o_def) -lemmas Arch_finaliseCap_irq_node'[Finalise_R_2_assms] = ArchRetypeDecls_H_RISCV64_H_finaliseCap_irq_node' +lemmas Arch_finaliseCap_irq_node'[Arch_assms] = ArchRetypeDecls_H_RISCV64_H_finaliseCap_irq_node' crunch prepareThreadDelete - for cte_wp_at'[Finalise_R_2_assms, wp]: "cte_wp_at' P p" - and valid_cap'[Finalise_R_2_assms, wp]: "valid_cap' cap" + for cte_wp_at'[Arch_assms, wp]: "cte_wp_at' P p" + and valid_cap'[Arch_assms, wp]: "valid_cap' cap" lemma asUser_hyp_unlive[wp]: "asUser f t \ko_wp_at' (Not \ hyp_live') t'\" @@ -854,7 +855,7 @@ lemma prepareThreadDelete_hyp_unlive: (auto simp: ko_wp_at'_def obj_at'_def hyp_live'_def) crunch prepareThreadDelete - for invs[Finalise_R_2_assms, wp]: "invs'" + for invs[Arch_assms, wp]: "invs'" (ignore: doMachineOp simp: crunch_simps) lemma archThreadSet_tcbSchedPrevNext[wp]: @@ -890,35 +891,36 @@ lemma deleteASID_cte_wp_at'[wp]: | wpc)+ done -lemma arch_finaliseCap_cte_wp_at[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cte_wp_at[Arch_assms, wp]: "\cte_wp_at' P p\ Arch.finaliseCap cap fin \\rv. cte_wp_at' P p\" apply (simp add: RISCV64_H.finaliseCap_def) apply (wpsimp wp: unmapPage_cte_wp_at') done -lemma finaliseCap_valid_cap[Finalise_R_2_assms, wp]: +lemma finaliseCap_valid_cap[Arch_assms, wp]: "\\\ Arch.finaliseCap cap final \\rv. valid_cap' (fst rv)\" by (wpsimp simp: RISCV64_H.finaliseCap_def) -lemma arch_finaliseCap_cases[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cases[Arch_assms, wp]: "\\\ Arch.finaliseCap v0 final \\rv s. fst rv = capability.NullCap \ (snd rv \ capability.NullCap \ final \ arch_cap_has_cleanup' v0 \ snd rv = capability.ArchObjectCap v0)\" by (wpsimp simp: RISCV64_H.finaliseCap_def) -lemmas [Finalise_R_2_assms] = +lemmas [Arch_assms] = cancelAllIPC_cte_wp_at' cancelAllSignals_cte_wp_at' unbindMaybeNotification_cte_wp_at' prepareThreadDelete_cte_wp_at' unbindNotification_cte_wp_at' Arch_postCapDeletion_valid_global_refs Arch_postCapDeletion_valid_arch_state' mdb_empty.vmdb_n mdb_empty.descendants not_Final_removeable +lemmas Finalise_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Finalise_R_2?: Finalise_R_2 arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Finalise_R_2_assms)?)?) qed (* This is the only arch-specific lemma in delete_one_conc_pre so far; @@ -986,13 +988,13 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable: context Arch begin arch_global_naming -named_theorems Finalise_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_3 locale *) -lemma finaliseCap_cte_refs[Finalise_R_3_assms]: +lemma finaliseCap_cte_refs[Arch_assms]: "\\s. s \' cap\ finaliseCap cap final flag \\rv s. fst rv \ NullCap \ cte_refs' (fst rv) = cte_refs' cap\" - apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot finaliseCap_def + apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot RISCV64_H.finaliseCap_def cong: if_cong split del: if_split) apply (rule hoare_pre) apply (wp | wpc | simp only: o_def)+ @@ -1005,7 +1007,7 @@ lemma finaliseCap_cte_refs[Finalise_R_3_assms]: apply (fastforce simp: mask_def capAligned_def gen_objBits_simps shiftL_nat) done -lemma emptySlot_invs'[Finalise_R_3_assms, wp]: +lemma emptySlot_invs'[Arch_assms, wp]: "\\s. invs' s \ cte_wp_at' (\cte. removeable' sl s (cteCap cte)) sl s \ (info \ NullCap \ post_cap_delete_pre' info sl (cteCaps_of s))\ emptySlot sl info @@ -1016,7 +1018,7 @@ lemma emptySlot_invs'[Finalise_R_3_assms, wp]: split: capability.split_asm) by auto -lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: +lemma cteDeleteOne_invs[Arch_assms, wp]: "cteDeleteOne ptr \invs'\" apply (simp add: cteDeleteOne_def unless_def split_def finaliseCapTrue_standin_simple_def) @@ -1038,7 +1040,7 @@ lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: apply (fastforce simp: cte_wp_at_ctes_of) done -lemma isFinalCapability_corres'[Finalise_R_3_assms]: +lemma isFinalCapability_corres'[Arch_assms]: "final_matters' (cteCap cte) \ corres (=) (invs and cte_wp_at ((=) cap) ptr) (invs' and cte_wp_at' ((=) cte) (cte_map ptr)) @@ -1131,7 +1133,7 @@ crunch unmapPageTable crunch Arch_finaliseCap, prepareThreadDelete for nosch[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Finalise_R_3_assms, wp]: sch_act_simple + and sch_act_simple[Arch_assms, wp]: sch_act_simple (wp: crunch_wps getObject_inv simp: loadObject_default_def updateObject_default_def rule: RISCV64_H.finaliseCap_def sch_act_simple_lift cong: if_cong) @@ -1142,7 +1144,7 @@ crunch deletingIRQHandler rule: sch_act_simple_lift wp: getObject_inv loadObject_default_inv crunch_wps) -lemma arch_finaliseCap_corres[Finalise_R_3_assms]: +lemma arch_finaliseCap_corres[Arch_assms]: "\ final_matters' (ArchObjectCap cap') \ final = final'; acap_relation cap cap' \ \ corres (\r r'. cap_relation (fst r) (fst r') \ cap_relation (snd r) (snd r')) (\s. invs s \ s \ cap.ArchObjectCap cap @@ -1191,14 +1193,15 @@ lemma arch_finaliseCap_corres[Finalise_R_3_assms]: sublocale deleteCallerCap: typ_at_props' "deleteCallerCap receiver" by typ_at_props' +lemmas Finalise_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts post_cap_delete_pre' interpretation Finalise_R_3?: Finalise_R_3 arch_final_matters' arch_cap_has_cleanup' post_cap_delete_pre' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Finalise_R_3_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchInit_R.thy b/proof/refine/RISCV64/ArchInit_R.thy index 14e2c486b9..940b44b092 100644 --- a/proof/refine/RISCV64/ArchInit_R.thy +++ b/proof/refine/RISCV64/ArchInit_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Init_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Init_R locale *) definition zeroed_arch_abstract_state :: arch_state where "zeroed_arch_abstract_state \ \ @@ -23,23 +23,24 @@ definition zeroed_arch_intermediate_state :: Arch.kernel_state where "zeroed_arch_intermediate_state \ RISCVKernelState Map.empty (K []) (K RISCVVSpaceUserRegion)" (* the None maps are a result of unfolding zeroed_main_abstract_state *) -lemma ghost_relation_wrapper_arch_intermediate_state[Init_R_assms]: +lemma ghost_relation_wrapper_arch_intermediate_state[Arch_assms]: "ghost_relation_wrapper_2 (\_. None) (\_. None) (\_. None) zeroed_arch_intermediate_state" unfolding ghost_relation_wrapper_def ghost_relation_def zeroed_arch_intermediate_state_def by simp -lemma non_empty_refine_arch_state_relation[Init_R_assms]: +lemma non_empty_refine_arch_state_relation[Arch_assms]: "(zeroed_arch_abstract_state, zeroed_arch_intermediate_state) \ arch_state_relation Map.empty" unfolding zeroed_arch_abstract_state_def zeroed_arch_intermediate_state_def arch_state_relation_def by simp +lemmas Init_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Init_R?: Init_R RISCV64.zeroed_arch_abstract_state RISCV64.zeroed_arch_intermediate_state proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Init_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Init_R_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchInterrupt_R.thy b/proof/refine/RISCV64/ArchInterrupt_R.thy index 33cbcbdd18..0ed8894d99 100644 --- a/proof/refine/RISCV64/ArchInterrupt_R.thy +++ b/proof/refine/RISCV64/ArchInterrupt_R.thy @@ -13,17 +13,17 @@ begin context Arch begin arch_global_naming -named_theorems Interrupt_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R locale *) -lemma maxIRQ_H_ucast_toEnum_eq_irq[Interrupt_R_assms]: +lemma maxIRQ_H_ucast_toEnum_eq_irq[Arch_assms]: "x \ ucast maxIRQ \ toEnum (unat x) = (ucast x :: irq)" for x::machine_word by (simp add: word_le_nat_alt maxIRQ_def maxIRQ_ucast_toEnum_eq_irq) -lemma arch_valid_irq_le_maxIRQ[Interrupt_R_assms]: +lemma arch_valid_irq_le_maxIRQ[Arch_assms]: "arch_valid_irq irq \ irq \ maxIRQ" by simp -lemma arch_valid_irq_valid_IRQHandlerCap[Interrupt_R_assms]: +lemma arch_valid_irq_valid_IRQHandlerCap[Arch_assms]: "arch_valid_irq irq \ valid_cap' (capability.IRQHandlerCap irq) s" by (simp add: valid_cap'_def capAligned_def) @@ -40,7 +40,7 @@ primrec arch_irq_control_inv_valid' :: "Arch.irqcontrol_invocation \ ex_cte_cap_to' ptr and real_cte_at' ptr and (Not o irq_issued' irq) and K (irq \ maxIRQ \ irq \ irqInvalid))" -lemma checkIRQ_corres[Interrupt_R_assms]: +lemma checkIRQ_corres[Arch_assms]: "corres (ser \ dc) \ \ (arch_check_irq irq) (Arch.checkIRQ irq)" unfolding arch_check_irq_def checkIRQ_def by (clarsimp simp: minIRQ_def maxIRQ_def whenE_rangeCheck_eq whenE_def returnOk_def split: if_split) @@ -48,7 +48,7 @@ lemma checkIRQ_corres[Interrupt_R_assms]: lemmas irq_const_defs = minIRQ_def crunch arch_check_irq, checkIRQ - for inv[Interrupt_R_assms]: "P" + for inv[Arch_assms]: "P" (simp: crunch_simps) lemma arch_check_irq_valid: @@ -56,11 +56,11 @@ lemma arch_check_irq_valid: unfolding arch_check_irq_def by (wpsimp simp: validE_R_def not_less word_le_nat_alt maxIRQ_def wp: whenE_throwError_wp) -lemma arch_check_irq_valid'[Interrupt_R_assms]: +lemma arch_check_irq_valid'[Arch_assms]: "\\\ arch_check_irq irq \\_ _. irq \ ucast maxIRQ\, \\_. \\" by (wp arch_check_irq_valid) -lemma checkIRQ_irq_valid[Interrupt_R_assms]: +lemma checkIRQ_irq_valid[Arch_assms]: "\\\ checkIRQ irq \\_ _. arch_valid_irq (toEnum (unat irq))\, -" unfolding checkIRQ_def rangeCheck_def validE_R_def supply hoare_vcg_prop[wp del] @@ -69,7 +69,7 @@ lemma checkIRQ_irq_valid[Interrupt_R_assms]: apply (clarsimp simp: maxIRQ_def ucast_eq_irqInvalid_conv irq_machine_le_maxIRQ_irq) done -lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: +lemma arch_decodeIRQControlInvocation_corres[Arch_assms]: "list_all2 cap_relation caps caps' \ corres (ser \ arch_irq_control_inv_relation) (invs and (\s. \cp \ set caps. s \ cp)) @@ -108,7 +108,7 @@ lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: apply (auto split: arch_invocation_label.splits invocation_label.splits) done -lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: +lemma arch_decode_irq_control_valid'[Arch_assms, wp]: "\\s. invs' s \ (\cap \ set caps. s \' cap) \ (\cap \ set caps. \r \ cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) slot s\ @@ -129,12 +129,12 @@ lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: done crunch Arch.decodeIRQControlInvocation - for inv[Interrupt_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps wp: crunch_wps) -lemmas [Interrupt_R_assms] = arch_check_irq_inv +lemmas [Arch_assms] = arch_check_irq_inv -lemma irq_node_in_global_refs'[Interrupt_R_assms]: +lemma irq_node_in_global_refs'[Arch_assms]: "Invariants_H.irq_node' s + (ucast irq << cteSizeBits) \ global_refs' s" for irq :: irq by (simp add: global_refs'_def) @@ -143,13 +143,13 @@ lemma no_fail_plic_complete_claim[simp, wp]: unfolding RISCV64.plic_complete_claim_def by (rule no_fail_machine_op_lift) -lemma arch_invokeIRQHandler_corres[Interrupt_R_assms]: +lemma arch_invokeIRQHandler_corres[Arch_assms]: "irq_handler_inv_relation i i' \ corres dc \ \ (arch_invoke_irq_handler i) (Arch.invokeIRQHandler i')" by (cases i; clarsimp simp: RISCV64_H.invokeIRQHandler_def) (rule corres_machine_op, rule corres_Id; simp?) -lemma is_derived'_NotificationCap[Interrupt_R_assms]: +lemma is_derived'_NotificationCap[Arch_assms]: "\isNotificationCap cap; isNotificationCap cap'\ \ is_derived' ctes src cap' cap = badge_derived' cap' cap" by (clarsimp simp add: is_derived'_def gen_isCap_simps) @@ -169,7 +169,7 @@ lemma setIRQTrigger_corres: | simp add: dc_def)+ done -lemma arch_performIRQControl_corres[Interrupt_R_assms]: +lemma arch_performIRQControl_corres[Arch_assms]: "arch_irq_control_inv_relation ivk ivk' \ corres (dc \ dc) (einvs and arch_irq_control_inv_valid ivk) (invs' and arch_irq_control_inv_valid' ivk') @@ -195,11 +195,11 @@ lemma arch_performIRQControl_corres[Interrupt_R_assms]: apply (auto dest: valid_irq_handlers_ctes_ofD)[1] done -lemma is_simple_cap'_IRQHandlerCap[Interrupt_R_assms]: +lemma is_simple_cap'_IRQHandlerCap[Arch_assms]: "isIRQHandlerCap cap \ is_simple_cap' cap" by (clarsimp simp: isCap_simps is_simple_cap'_def) -lemma sameRegionAs_IRQControl_handler[Interrupt_R_assms, simp]: +lemma sameRegionAs_IRQControl_handler[Arch_assms, simp]: "global.sameRegionAs capability.IRQControlCap (capability.IRQHandlerCap irq)" by (simp add: sameRegionAs_def3 isCap_simps) @@ -212,7 +212,7 @@ lemma dmo_setIRQTrigger_invs'[wp]: apply (wpsimp simp: setIRQTrigger_def machine_op_lift_def machine_rest_lift_def split_def)+ done -lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: +lemma arch_invoke_irq_control_invs'[Arch_assms, wp]: "\invs' and arch_irq_control_inv_valid' i\ Arch.performIRQControl i \\rv. invs'\" apply (simp add: RISCV64_H.performIRQControl_def) apply (rule hoare_pre) @@ -225,44 +225,44 @@ lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: simp: invs'_def valid_state'_def IRQ_def) done -lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: +lemma handle_reserved_irq_corres[Arch_assms, corres]: "corres dc einvs (\s. invs' s \ (irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)) (handle_reserved_irq irq) (handleReservedIRQ irq)" unfolding handle_reserved_irq_def handleReservedIRQ_def by corres -lemma maskIrqSignal_corres[Interrupt_R_assms, corres]: +lemma maskIrqSignal_corres[Arch_assms, corres]: "corres dc \ \ (arch_mask_irq_signal irq) (Arch.maskIrqSignal irq)" unfolding arch_mask_irq_signal_def maskIrqSignal_def when_def by (corres corres: corres_machine_op) -lemma dmo_ackInterrupt_corres[Interrupt_R_assms, corres]: +lemma dmo_ackInterrupt_corres[Arch_assms, corres]: "corres dc \ \ (do_machine_op (ackInterrupt irq)) (doMachineOp (ackInterrupt irq))" by (corres corres: corres_machine_op) crunch maskIrqSignal - for invs'[Interrupt_R_assms]: invs' + for invs'[Arch_assms]: invs' (wp: dmo_maskInterrupt_True ignore: doMachineOp) -lemma handleReservedIRQ_invs'[Interrupt_R_assms]: +lemma handleReservedIRQ_invs'[Arch_assms]: "\invs' and (\s. irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)\ handleReservedIRQ irq \\_. invs'\" by (wpsimp simp: handleReservedIRQ_def) +lemmas Interrupt_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Interrupt_R?: Interrupt_R RISCV64.arch_irq_control_inv_valid' RISCV64.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Interrupt_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Interrupt_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R_2 locale *) lemma plic_complete_claim_irq_masks[wp]: "RISCV64.plic_complete_claim irq \\s. P (irq_masks s)\" @@ -274,17 +274,18 @@ lemma dmo_plic_complete_claim_invs'[wp]: (clarsimp simp: in_monad RISCV64.plic_complete_claim_def machine_op_lift_def machine_rest_lift_def select_f_def) -lemma invoke_arch_irq_handler_invs'[Interrupt_R_2_assms, wp]: +lemma invoke_arch_irq_handler_invs'[Arch_assms, wp]: "\invs' and irq_handler_inv_valid' i\ Arch.invokeIRQHandler i \\rv. invs'\" by (cases i; wpsimp simp: RISCV64_H.invokeIRQHandler_def) +lemmas Interrupt_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R_2?: Interrupt_R_2 RISCV64.arch_irq_control_inv_valid' RISCV64.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Interrupt_R_2_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchInvariantUpdates_H.thy b/proof/refine/RISCV64/ArchInvariantUpdates_H.thy index 7efc3b0fe7..177b39f248 100644 --- a/proof/refine/RISCV64/ArchInvariantUpdates_H.thy +++ b/proof/refine/RISCV64/ArchInvariantUpdates_H.thy @@ -10,24 +10,25 @@ begin context Arch begin arch_global_naming -named_theorems InvariantUpdates_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InvariantUpdates_H locale *) -lemma valid_arch_state'_interrupt[simp, InvariantUpdates_H_assms]: +lemma valid_arch_state'_interrupt[simp, Arch_assms]: "valid_arch_state' (ksInterruptState_update f s) = valid_arch_state' s" by (simp add: valid_arch_state'_def cong: option.case_cong) (* not generally true for ksInterruptState update *) -lemma global_refs'_intStateIRQTable_update[simp, InvariantUpdates_H_assms]: +lemma global_refs'_intStateIRQTable_update[simp, Arch_assms]: "global_refs' (s\ksInterruptState := intStateIRQTable_update f (ksInterruptState s)\) = global_refs' s" by (simp add: global_refs'_def) -end +lemmas InvariantUpdates_H_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation InvariantUpdates_H?: InvariantUpdates_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact InvariantUpdates_H_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.InvariantUpdates_H_assms)?) qed end diff --git a/proof/refine/RISCV64/ArchInvsLemmas_H.thy b/proof/refine/RISCV64/ArchInvsLemmas_H.thy index 6f73e1b1a1..906cc138e9 100644 --- a/proof/refine/RISCV64/ArchInvsLemmas_H.thy +++ b/proof/refine/RISCV64/ArchInvsLemmas_H.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Invariants_H_pspaceI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_pspaceI locale *) (* FIXME arch-split: word_size is available outside of Arch due to Word_Setup, but to provide more guard rails during arch-split we are hiding the Haskell constant definition outside of @@ -34,7 +34,7 @@ lemma frame_at'_pspaceI: "frame_at' p sz d s \ ksPSpace s = ksPSpace s' \ frame_at' p sz d s'" by (simp add: frame_at'_def typ_at'_def ko_wp_at'_def ps_clear_def) -lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_cap'_pspaceI[Arch_assms]: "s \' cap \ ksPSpace s = ksPSpace s' \ s' \' cap" unfolding valid_cap'_def by (cases cap) @@ -44,7 +44,7 @@ lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: simp: vspace_table_at'_defs valid_arch_cap'_def valid_arch_cap_ref'_def split: arch_capability.split zombie_type.split option.splits) -lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_obj'_pspaceI[Arch_assms]: "valid_obj' obj s \ ksPSpace s = ksPSpace s' \ valid_obj' obj s'" unfolding valid_obj'_def by (cases obj) @@ -55,7 +55,7 @@ lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: Structures_H.thread_state.splits ntfn.splits option.splits intro: obj_at'_pspaceI valid_cap'_pspaceI typ_at'_pspaceI) -lemma tcb_space_clear[Invariants_H_pspaceI_assms]: +lemma tcb_space_clear[Arch_assms]: "\ tcb_cte_cases (y - x) = Some (getF, setF); is_aligned x tcbBlockSizeBits; ps_clear x tcbBlockSizeBits s; ksPSpace s x = Some (KOTCB tcb); ksPSpace s y = Some v; @@ -78,12 +78,12 @@ lemma tcb_space_clear[Invariants_H_pspaceI_assms]: apply (simp add: tcb_cte_cases_def cteSizeBits_def split: if_split_asm) done -lemma pspace_in_kernel_mappings'_pspaceI[Invariants_H_pspaceI_assms]: +lemma pspace_in_kernel_mappings'_pspaceI[Arch_assms]: "pspace_in_kernel_mappings' s \ ksPSpace s = ksPSpace s' \ pspace_in_kernel_mappings' s'" unfolding pspace_in_kernel_mappings'_def by simp -lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: +lemma range_cover_canonical_address[Arch_assms]: "\ range_cover ptr sz us n ; p < n ; canonical_address (ptr && ~~ mask sz) ; sz \ maxUntypedSizeBits \ \ canonical_address (ptr + of_nat p * 2 ^ us)" @@ -100,17 +100,18 @@ lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: (* not interesting on this architecture *) lemmas [simp] = pspace_in_kernel_mappings'_pspaceI -end +lemmas Invariants_H_pspaceI_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_pspaceI?: Invariants_H_pspaceI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Invariants_H_pspaceI_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Invariants_H_pspaceI_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Invariants_H_cte_ats_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_cte_ats locale *) (* FIXME arch-split: for proofs which require exact offsets lining up instead of cteSizeBits *) lemma raw_tcb_cte_cases_simps: @@ -120,7 +121,7 @@ lemma raw_tcb_cte_cases_simps: "tcb_cte_cases 128 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)" by (simp add: tcb_cte_cases_def cteSizeBits_def)+ -lemma cte_wp_at_cases'[Invariants_H_cte_ats_assms]: +lemma cte_wp_at_cases'[Arch_assms]: shows "cte_wp_at' P p s = ((\cte. ksPSpace s p = Some (KOCTE cte) \ is_aligned p cte_level_bits \ P cte \ ps_clear p cteSizeBits s) \ @@ -213,7 +214,7 @@ lemma cte_wp_at_cteI': shows "cte_wp_at' P ptr s" using assms by (simp add: cte_wp_at_cases' cte_level_bits_def objBits_defs) -lemma cte_at_typ'[Invariants_H_cte_ats_assms]: +lemma cte_at_typ'[Arch_assms]: "cte_at' c = (\s. typ_at' CTET c s \ (\n. typ_at' TCBT (c - n) s \ n \ dom tcb_cte_cases))" proof - have P: "\ko. (koTypeOf ko = CTET) = (\cte. ko = KOCTE cte)" @@ -237,12 +238,13 @@ lemma tcb_at_cte_at': apply (clarsimp simp add: return_def objBits_simps) done -end +lemmas Invariants_H_cte_ats_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_cte_ats?: Invariants_H_cte_ats proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Invariants_H_cte_ats_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Invariants_H_cte_ats_assms)?) qed @@ -366,7 +368,7 @@ lemma is_physical_cases: | _ \ True)" by (simp split: capability.splits arch_capability.splits zombie_type.splits) -named_theorems Invariants_H_typ_at_lifts_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_typ_at_lifts locale *) lemma page_table_at'_typ_at_lift_strong: "(\p. f \\s. P (typ_at' (ArchT PTET) p s)\) \ f \\s. P (page_table_at' p s)\" @@ -390,12 +392,12 @@ lemma asid_pool_at'_typ_at_lift_strong: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (asid_pool_at' p s)\" by assumption -lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_tcb'_typ_at_lift_strong[Arch_assms]: assumes "\T p. f \\s. P (typ_at' T p s)\" shows "f \\s. P (valid_arch_tcb' tcb s)\" by (clarsimp simp: valid_arch_tcb'_def, wp) -lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_cap'_typ_at_lift[Arch_assms]: assumes P: "\P T p. f \\s. P (typ_at' T p s)\" shows "f \\s. valid_arch_cap' cap s\" apply (case_tac cap, @@ -405,12 +407,13 @@ lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: page_table_at'_typ_at_lift_strong frame_at'_typ_at_lift_strong)+ done +lemmas Invariants_H_typ_at_lifts_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) global_interpretation Invariants_H_typ_at_lifts?: Invariants_H_typ_at_lifts proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; unfold_locales; (fact Invariants_H_typ_at_lifts_assms)?) + case 1 show ?case by (intro_locales; unfold_locales; (fact RISCV64.Invariants_H_typ_at_lifts_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/RISCV64/ArchIpcCancel_R.thy b/proof/refine/RISCV64/ArchIpcCancel_R.thy index 921311e85d..8e78c3a14e 100644 --- a/proof/refine/RISCV64/ArchIpcCancel_R.thy +++ b/proof/refine/RISCV64/ArchIpcCancel_R.thy @@ -12,24 +12,24 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_R locale *) (* FIXME: move to Machine_AI *) crunch getRegister, setRegister for (no_fail) no_fail[intro!, wp, simp] crunch Arch.postCapDeletion - for pred_tcb_at'[IpcCancel_R_assms, wp]: "pred_tcb_at' proj P t" - and typ_at'[IpcCancel_R_assms, wp]: "\s. P (typ_at' T p s)" + for pred_tcb_at'[Arch_assms, wp]: "pred_tcb_at' proj P t" + and typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" (wp: setCTE_pred_tcb_at') -lemma acapClass_not_ReplyClass[IpcCancel_R_assms]: +lemma acapClass_not_ReplyClass[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) crunch arch_post_cap_deletion - for pspace_aligned[IpcCancel_R_assms, wp]: "pspace_aligned :: det_state \ _" - and pspace_distinct[IpcCancel_R_assms, wp]: "pspace_distinct :: det_state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_state \ _" (simp: crunch_simps wp: crunch_wps) crunch emptySlot @@ -71,7 +71,7 @@ proof - corres: getObject_TCB_corres setObject_update_TCB_corres') qed -lemma prepareThreadDelete_corres[IpcCancel_R_assms, corres]: +lemma prepareThreadDelete_corres[Arch_assms, corres]: "t' = t \ corres dc (invs and tcb_at t) no_0_obj' (prepare_thread_delete t) (prepareThreadDelete t')" @@ -92,12 +92,13 @@ crunch prepareThreadDelete and inactive: "st_tcb_at' ((=) Inactive) t'" (simp: obj_at'_not_comp_fold) +lemmas IpcCancel_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation IpcCancel_R?: IpcCancel_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact IpcCancel_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.IpcCancel_R_assms)?)?) qed (* instantiate locales with assumptions depending on IpcCancel_R instantiation *) diff --git a/proof/refine/RISCV64/ArchIpc_R.thy b/proof/refine/RISCV64/ArchIpc_R.thy index 82d4c1347b..691127ba7d 100644 --- a/proof/refine/RISCV64/ArchIpc_R.thy +++ b/proof/refine/RISCV64/ArchIpc_R.thy @@ -11,11 +11,11 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_R locale *) declare word64_minus_one_le[simp] -lemma max_ipc_size_le_2_msg_align_bits[Ipc_R_assms]: +lemma max_ipc_size_le_2_msg_align_bits[Arch_assms]: "max_ipc_words * word_size \ 2 ^ msg_align_bits" by (simp add: max_ipc_words word_size_def msg_align_bits) @@ -28,50 +28,50 @@ lemma maskCapRights_vs_cap_ref'[simp]: simp add: RISCV64_H.maskCapRights_def isCap_simps Let_def) done -lemma is_derived'_Untyped[Ipc_R_assms]: +lemma is_derived'_Untyped[Arch_assms]: "\isUntypedCap cap'\ \ is_derived' m src cap' cap = (isUntypedCap cap \ badge_derived' cap' cap \ descendants_of' src m = {})" by (clarsimp simp add: RISCV64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def) -lemma is_derived'_Reply[Ipc_R_assms]: +lemma is_derived'_Reply[Arch_assms]: "\isReplyCap cap'\ \ is_derived' m src cap' cap = (isReplyCap cap \ capTCBPtr cap = capTCBPtr cap' \ capReplyMaster cap \ \ capReplyMaster cap')" by (clarsimp simp add: RISCV64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def) -lemma arch_maskCapRights_not_null[Ipc_R_assms, simp]: +lemma arch_maskCapRights_not_null[Arch_assms, simp]: "Arch.maskCapRights r acap \ NullCap" by (case_tac acap; simp add: RISCV64_H.maskCapRights_def isCap_simps) -lemma capASID_gen_cap[Ipc_R_assms]: +lemma capASID_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ capASID cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_asid_base'_gen_cap[Ipc_R_assms]: +lemma cap_asid_base'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_asid_base' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_vptr'_gen_cap[Ipc_R_assms]: +lemma cap_vptr'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_vptr' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) crunch transferCapsToSlots - for pspace_in_kernel_mappings'[Ipc_R_assms, wp]: pspace_in_kernel_mappings' + for pspace_in_kernel_mappings'[Arch_assms, wp]: pspace_in_kernel_mappings' crunch makeArchFaultMessage - for sch_act[Ipc_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for sch_act[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma is_derived'_IRQHandlerCap[Ipc_R_assms]: +lemma is_derived'_IRQHandlerCap[Arch_assms]: "\isIRQHandlerCap cap'\ \ is_derived' (ctes_of (s::kernel_state)) src cap' cap = (isIRQHandlerCap cap \ badge_derived' cap' cap)" by (clarsimp simp add: RISCV64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def) (* variant of storeWord_um_inv which does not expose architecture-specific information *) -lemma storeWord_um_inv'[Ipc_R_assms]: +lemma storeWord_um_inv'[Arch_assms]: "\\s. underlying_memory s = um\ storeWord a v \\_ s. is_aligned a word_size_bits @@ -85,7 +85,7 @@ lemma storeWord_um_inv'[Ipc_R_assms]: apply (auto simp add: unat_plus_simple[THEN iffD1] word_plus_mono_right2 mask_def) done -lemma isArchObjectCap_maskCapRights[Ipc_R_assms]: +lemma isArchObjectCap_maskCapRights[Arch_assms]: "isArchObjectCap (Arch.maskCapRights R acap)" by (cases acap; simp add: RISCV64_H.maskCapRights_def isCap_simps) @@ -96,16 +96,16 @@ lemma isFrameCap_maskCapRights[simp]: apply (case_tac arch_capability; simp add: isCap_simps RISCV64_H.maskCapRights_def) done -lemma arch_updateCapData_ordering[Ipc_R_assms]: +lemma arch_updateCapData_ordering[Arch_assms]: "\ (x, arch_capBadge acap) \ capBadge_ordering P; Arch.updateCapData p d acap \ NullCap \ \ (x, capBadge (Arch.updateCapData p d acap)) \ capBadge_ordering P" by (cases acap; simp add: RISCV64_H.updateCapData_def) -lemma ArchUpdateCapData_noReply[Ipc_R_assms]: +lemma ArchUpdateCapData_noReply[Arch_assms]: "Arch.updateCapData p d acap \ capability.ReplyCap x y z" by (cases acap; simp add: RISCV64_H.updateCapData_def) -lemma ArchUpdateCapData_noIRQControl[Ipc_R_assms]: +lemma ArchUpdateCapData_noIRQControl[Arch_assms]: "Arch.updateCapData p d acap \ IRQControlCap" by (cases acap; simp add: RISCV64_H.updateCapData_def) @@ -126,15 +126,15 @@ lemma isFrameCap_updateCapData[simp]: apply (clarsimp split:capability.splits simp:Let_def) done -lemma badgeRegister_badge_register[Ipc_R_assms]: +lemma badgeRegister_badge_register[Arch_assms]: "badgeRegister = badge_register" by (simp add: badge_register_def badgeRegister_def) crunch copyMRs - for pspace_in_kernel_mappings'[Ipc_R_assms, wp]: pspace_in_kernel_mappings' + for pspace_in_kernel_mappings'[Arch_assms, wp]: pspace_in_kernel_mappings' (wp: crunch_wps simp: crunch_simps) -lemma makeArchFaultMessage_corres[Ipc_R_assms]: +lemma makeArchFaultMessage_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (make_arch_fault_msg f t) (makeArchFaultMessage (arch_fault_map f) t)" @@ -145,20 +145,20 @@ lemma makeArchFaultMessage_corres[Ipc_R_assms]: apply (wp+, auto) done -lemma syscallMessage_def'[Ipc_R_assms]: +lemma syscallMessage_def'[Arch_assms]: "FaultHandler_H.syscallMessage \ MachineExports.syscallMessage" by (simp add: syscallMessage_def) -lemma exceptionMessage_def'[Ipc_R_assms]: +lemma exceptionMessage_def'[Arch_assms]: "FaultHandler_H.exceptionMessage \ MachineExports.exceptionMessage" by (simp add: exceptionMessage_def) -lemma makeArchFaultMessage_inv[Ipc_R_assms, wp]: +lemma makeArchFaultMessage_inv[Arch_assms, wp]: "makeArchFaultMessage ft t \P\" unfolding makeArchFaultMessage_def by (wpsimp wp: asUser_inv getRestartPC_inv split: arch_fault.split) -lemma lookupIPCBuffer_valid_ipc_buffer[Ipc_R_assms, wp]: +lemma lookupIPCBuffer_valid_ipc_buffer[Arch_assms, wp]: "\valid_objs'\ VSpace_H.lookupIPCBuffer b s \case_option \ valid_ipc_buffer_ptr'\" unfolding lookupIPCBuffer_def supply raw_tcb_cte_cases_simps[simp] (* FIXME arch-split: legacy, try use tcb_cte_cases_neqs *) @@ -205,7 +205,7 @@ lemma lookupIPCBuffer_Some_0: "\\\ lookupIPCBuffer w t \\rv s. rv \ Some 0\" by (wpsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv) -lemma arch_getSanitiseRegisterInfo_corres[Ipc_R_assms]: +lemma arch_getSanitiseRegisterInfo_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (arch_get_sanitise_register_info t) (getSanitiseRegisterInfo t)" @@ -216,24 +216,24 @@ crunch getSanitiseRegisterInfo for tcb_at'[wp]: "tcb_at' t" crunch arch_get_sanitise_register_info - for pspace_distinct[Ipc_R_assms, wp]: pspace_distinct - and pspace_aligned[Ipc_R_assms, wp]: pspace_aligned + for pspace_distinct[Arch_assms, wp]: pspace_distinct + and pspace_aligned[Arch_assms, wp]: pspace_aligned -lemma sanitiseRegister_sanitise_register[Ipc_R_assms]: +lemma sanitiseRegister_sanitise_register[Arch_assms]: "sanitiseRegister = sanitise_register" by (rule ext)+ (clarsimp simp add: sanitiseRegister_def sanitise_register_def cong: register.case_cong) -lemma handleArchFaultReply_corres[Ipc_R_assms]: +lemma handleArchFaultReply_corres[Arch_assms]: "corres (=) \ \ (handle_arch_fault_reply ft t label msg) (handleArchFaultReply (arch_fault_map ft) t label msg)" by (clarsimp simp: handle_arch_fault_reply_def handleArchFaultReply_def split: arch_fault.split) crunch getSanitiseRegisterInfo, handleArchFaultReply, handle_arch_fault_reply - for inv[Ipc_R_assms, wp]: P + for inv[Arch_assms, wp]: P -lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: +lemma ctes_of_mdbNext_parentOf[Arch_assms]: "\ ctes_of s' \ cte_map cptr \ cte_map slot; ctes_of s' (cte_map cptr) = Some (CTE (capability.ReplyCap t master rights) n); ctes_of s' (mdbNext (cteMDBNode cte)) = Some (CTE (capability.ReplyCap t master' rights') n'); @@ -243,15 +243,16 @@ lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: (erule subtree.cases; clarsimp simp: parentOf_def isMDBParentOf_CTE) crunch debugPrint - for inv[Ipc_R_assms, wp]: P - and (no_fail) no_fail[Ipc_R_assms, intro!, wp, simp] + for inv[Arch_assms, wp]: P + and (no_fail) no_fail[Arch_assms, intro!, wp, simp] + +lemmas Ipc_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Ipc_R?: Ipc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Ipc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Ipc_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/RISCV64/ArchKHeap_R.thy b/proof/refine/RISCV64/ArchKHeap_R.thy index 12668e0f6a..28cdc55fe2 100644 --- a/proof/refine/RISCV64/ArchKHeap_R.thy +++ b/proof/refine/RISCV64/ArchKHeap_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems KHeap_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R locale *) lemmas typ_at_to_obj_at_arches = typ_at_to_obj_at'[where 'a=pte, simplified] @@ -22,12 +22,12 @@ lemmas typ_at_to_obj_at_arches lemmas page_table_at_obj_at' = page_table_at'_def[unfolded typ_at_to_obj_at_arches] -lemma koType_objBitsKO[KHeap_R_assms]: +lemma koType_objBitsKO[Arch_assms]: "koTypeOf k = koTypeOf k' \ objBitsKO k = objBitsKO k'" by (auto simp: objBitsKO_def archObjSize_def split: kernel_object.splits arch_kernel_object.splits) -lemma pspace_dom_update[KHeap_R_assms]: +lemma pspace_dom_update[Arch_assms]: "\ ps ptr = Some x; a_type x = a_type v \ \ pspace_dom (ps(ptr \ v)) = pspace_dom ps" apply (simp add: pspace_dom_def dom_fun_upd2 del: dom_fun_upd) apply (rule SUP_cong [OF refl]) @@ -35,7 +35,7 @@ lemma pspace_dom_update[KHeap_R_assms]: apply (simp add: obj_relation_cuts_def3) done -lemma cte_wp_at_ctes_of[KHeap_R_assms]: +lemma cte_wp_at_ctes_of[Arch_assms]: "cte_wp_at' P p s = (\cte. ctes_of s p = Some cte \ P cte)" supply diff_neg_mask[simp del] apply (simp add: cte_wp_at_cases' map_to_ctes_def Let_def @@ -68,7 +68,7 @@ lemma cte_wp_at_ctes_of[KHeap_R_assms]: word_bw_assocs) done -lemma ctes_of_canonical[KHeap_R_assms]: +lemma ctes_of_canonical[Arch_assms]: assumes canonical: "pspace_canonical' s" assumes ctes_of: "ctes_of s p = Some cte" shows "canonical_address p" @@ -81,9 +81,9 @@ proof - elim: cte_wp_atE' canonical_address_add) qed -lemma valid_updateCapDataI[KHeap_R_assms]: +lemma valid_updateCapDataI[Arch_assms]: "s \' c \ s \' updateCapData b x c" - apply (unfold global.updateCapData_def Let_def updateCapData_def) + apply (unfold global.updateCapData_def Let_def RISCV64_H.updateCapData_def) apply (cases c) apply (simp_all add: gen_isCap_defs valid_cap'_def global.capUntypedPtr_def gen_isCap_simps capAligned_def word_size word_bits_def word_bw_assocs @@ -247,7 +247,7 @@ lemma setObject_other_arch_corres: simp split: arch_kernel_obj.split_asm) by (fastforce dest: tcbs_of'_non_tcb_update) -lemmas [KHeap_R_assms] = +lemmas [Arch_assms] = setObject_other_corres[where 'a=endpoint] setObject_other_corres[where 'a=notification] @@ -275,9 +275,9 @@ lemma setObject_pspace_in_kernel_mappings'[wp]: crunch setEndpoint, setNotification for pspace_in_kernel_mappings'[wp]: "pspace_in_kernel_mappings'" -declare setEndpoint_pspace_in_kernel_mappings'[KHeap_R_assms] +declare setEndpoint_pspace_in_kernel_mappings'[Arch_assms] -declare setNotification_pspace_in_kernel_mappings'[KHeap_R_assms] +declare setNotification_pspace_in_kernel_mappings'[Arch_assms] (* interface lemma, but can't be done via locale *) lemma valid_global_refs_lift': @@ -305,27 +305,28 @@ lemma valid_arch_state_lift': apply (wp typs hoare_vcg_all_lift hoare_vcg_ball_lift arch)+ done -lemma idle_is_global[KHeap_R_assms, intro!]: +lemma idle_is_global[Arch_assms, intro!]: "ksIdleThread s \ global_refs' s" by (simp add: global_refs'_def) -end +lemmas KHeap_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R?: KHeap_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.KHeap_R_assms)?) qed context Arch begin arch_global_naming -named_theorems KHeap_R_assms_2 +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R_2 locale *) -lemmas setEndpoint_valid_globals[KHeap_R_assms_2, wp] +lemmas setEndpoint_valid_globals[Arch_assms, wp] = valid_global_refs_lift'[OF set_ep_ctes_of set_ep_arch' setEndpoint_it setEndpoint_ksInterruptState] -lemma set_ntfn_global_refs'[KHeap_R_assms_2, wp]: +lemma set_ntfn_global_refs'[Arch_assms, wp]: "\valid_global_refs'\ setNotification ptr val \\_. valid_global_refs'\" by (rule valid_global_refs_lift'; wp) @@ -346,7 +347,7 @@ lemma setObject_ko_wp_at': objBits_def[symmetric] ps_clear_upd in_magnitude_check v) -lemmas [KHeap_R_assms_2] = setEndpoint_valid_arch' setNotification_valid_arch' +lemmas [Arch_assms] = setEndpoint_valid_arch' setNotification_valid_arch' sublocale setObject: typ_at_props' "setObject p v" by typ_at_props' @@ -357,12 +358,13 @@ sublocale doMachineOp: typ_at_props' "doMachineOp mop" sublocale setEndpoint: typ_at_props' "setEndpoint ptr val" by typ_at_props' -end +lemmas KHeap_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R_2?: KHeap_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms_2)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.KHeap_R_2_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/RISCV64/ArchMachine_R.thy b/proof/refine/RISCV64/ArchMachine_R.thy index 3df20d2eec..d8cb2c66f2 100644 --- a/proof/refine/RISCV64/ArchMachine_R.thy +++ b/proof/refine/RISCV64/ArchMachine_R.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems Machine_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Machine_R locale *) -lemma dmo_getirq_inv[Machine_R_assms, wp]: +lemma dmo_getirq_inv[Arch_assms, wp]: "irq_state_independent_H P \ \P\ doMachineOp (getActiveIRQ in_kernel) \\rv. P\" apply (simp add: getActiveIRQ_def doMachineOp_def split_def exec_gets select_f_select[simplified liftM_def] @@ -33,7 +33,7 @@ lemma getActiveIRQ_masked: apply (clarsimp simp: valid_irq_masks'_def) done -lemma dmo_maskInterrupt[Machine_R_assms]: +lemma dmo_maskInterrupt[Arch_assms]: "\\s. P (ksMachineState_update (irq_masks_update (\t. t (irq := m))) s)\ doMachineOp (maskInterrupt m irq) \\_. P\" apply (simp add: doMachineOp_def split_def) @@ -51,7 +51,7 @@ lemma dmo_maskInterrupt_True: ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) done -lemma setIRQState_irq_states'[Machine_R_assms, wp]: +lemma setIRQState_irq_states'[Arch_assms, wp]: "setIRQState state irq \valid_irq_states'\" apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def) apply (wp dmo_maskInterrupt) @@ -67,20 +67,20 @@ lemma getActiveIRQ_le_maxIRQ: apply (simp add: irqs_masked'_def valid_irq_states'_def maxIRQ_def)+ done -lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: +lemma doMachineOp_getActiveIRQ_non_kernel[Arch_assms, wp]: "\\\ doMachineOp (getActiveIRQ True) \\rv s. \irq. rv = Some irq \ irq \ non_kernel_IRQs \ P irq s\" by (wpsimp simp: non_kernel_IRQs_def) -lemma frameRegisters_def'[Machine_R_assms]: +lemma frameRegisters_def'[Arch_assms]: "frameRegisters = MachineExports.frameRegisters" by (simp add: frameRegisters_def) -lemma gpRegisters_def'[Machine_R_assms]: +lemma gpRegisters_def'[Arch_assms]: "gpRegisters = MachineExports.gpRegisters" by (simp add: gpRegisters_def) -lemma tlsBaseRegister_def'[Machine_R_assms]: +lemma tlsBaseRegister_def'[Arch_assms]: "tlsBaseRegister = MachineExports.tlsBaseRegister" by (simp add: tlsBaseRegister_def) @@ -93,12 +93,13 @@ crunch setIRQTrigger for (no_fail) no_fail[intro!, wp, simp] (ignore: setIRQTrigger_impl) -end +lemmas Machine_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Machine_R?: Machine_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Machine_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.Machine_R_assms)?) qed end diff --git a/proof/refine/RISCV64/ArchRefine.thy b/proof/refine/RISCV64/ArchRefine.thy index 18125469ab..58b7ac847c 100644 --- a/proof/refine/RISCV64/ArchRefine.thy +++ b/proof/refine/RISCV64/ArchRefine.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Refine_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Refine locale *) text \User memory content is the same on both levels\ lemma typ_at_AUserDataI: @@ -133,7 +133,7 @@ lemma p_and_not_mask_pbfs_add_mask_pbfs_eq: add: shiftr_shiftl1 mask_out_add_aligned is_aligned_neg_mask pbfs_atleast_pageBits word_plus_and_or_coroll2 add.commute) -lemma pointerInUserData_relation[Refine_assms]: +lemma pointerInUserData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInUserData p s' = in_user_frame p s" apply (simp add: pointerInUserData_def in_user_frame_def) @@ -147,7 +147,7 @@ lemma pointerInUserData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma pointerInDeviceData_relation[Refine_assms]: +lemma pointerInDeviceData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInDeviceData p s' = in_device_frame p s" apply (simp add: pointerInDeviceData_def in_device_frame_def) @@ -161,31 +161,31 @@ lemma pointerInDeviceData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma user_mem_relation[Refine_assms]: +lemma user_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ user_mem' s' = user_mem s" by (rule ext) (clarsimp simp: user_mem_def user_mem'_def pointerInUserData_relation pointerInDeviceData_relation state_relation_def) -lemma device_mem_relation[Refine_assms]: +lemma device_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ device_mem' s' = device_mem s" by (rule ext) (clarsimp simp: device_mem_def device_mem'_def pointerInUserData_relation pointerInDeviceData_relation) -lemma arch_activate_thread_sched_act[Refine_assms]: +lemma arch_activate_thread_sched_act[Arch_assms]: "\ct_in_state activatable and (\s. P (scheduler_action s))\ arch_activate_idle_thread t \\rs s. P (scheduler_action (s::det_state))\" by (wpsimp simp: arch_activate_idle_thread_def) -lemma valid_list_init[Refine_assms, simp]: +lemma valid_list_init[Arch_assms, simp]: "valid_list init_A_st" by (simp add: valid_list_2_def init_A_st_def ext_init_def init_cdt_def) -lemma valid_sched_init[Refine_assms, simp]: +lemma valid_sched_init[Arch_assms, simp]: "valid_sched init_A_st" apply (simp add: valid_sched_def init_A_st_def ext_init_def) apply (clarsimp simp: init_kheap_def st_tcb_at_kh_def obj_at_kh_def @@ -197,15 +197,15 @@ lemma valid_sched_init[Refine_assms, simp]: etcb_at'_def etcbs_of'_def) done -lemma valid_domain_list_init[Refine_assms, simp]: +lemma valid_domain_list_init[Arch_assms, simp]: "valid_domain_list init_A_st" by (simp add: init_A_st_def ext_init_def valid_domain_list_def) -lemma valid_domain_time_init[Refine_assms, simp]: +lemma valid_domain_time_init[Arch_assms, simp]: "0 < domain_time init_A_st" by (simp add: init_A_st_def) -lemma sched_act_init[Refine_assms, simp]: +lemma sched_act_init[Arch_assms, simp]: "scheduler_action init_A_st = resume_cur_thread" by (simp add: init_A_st_def) @@ -213,13 +213,13 @@ lemma sched_act_init[Refine_assms, simp]: defs fastpathKernelAssertions_def: "fastpathKernelAssertions \ \s. True" -lemma fastpathKernelAssertions_cross[Refine_assms]: +lemma fastpathKernelAssertions_cross[Arch_assms]: "\ (s,s') \ state_relation; invs s; valid_arch_state' s'\ \ fastpathKernelAssertions s'" unfolding fastpathKernelAssertions_def by clarsimp (* interface lemma, no vs duplicates on this architecture *) -lemma callKernel_valid_duplicates'[Refine_assms]: +lemma callKernel_valid_duplicates'[Arch_assms]: "\invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and (\s. e \ Interrupt \ ct_running' s)\ @@ -228,42 +228,43 @@ lemma callKernel_valid_duplicates'[Refine_assms]: by wpsimp (* interface lemma, no vs duplicates on this architecture *) -lemma doUserOp_valid_duplicates'[Refine_assms]: +lemma doUserOp_valid_duplicates'[Arch_assms]: "doUserOp f tc \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp (* interface lemma, no vs duplicates on this architecture *) -lemma checkActiveIRQ_valid_duplicates'[Refine_assms]: +lemma checkActiveIRQ_valid_duplicates'[Arch_assms]: "checkActiveIRQ \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp -lemma tcb_hyp_refs'_atcbContextSet[Refine_assms, simp]: +lemma tcb_hyp_refs'_atcbContextSet[Arch_assms, simp]: "tcb_hyp_refs' (atcbContextSet tc atcb) = tcb_hyp_refs' atcb" by (simp add: atcbContextSet_def) -lemma ptable_lift_abs_state[Refine_assms, simp]: +lemma ptable_lift_abs_state[Arch_assms, simp]: "ptable_lift t (abs_state s) = ptable_lift t s" by (simp add: ptable_lift_def abs_state_def) -lemma ptable_rights_abs_state[Refine_assms, simp]: +lemma ptable_rights_abs_state[Arch_assms, simp]: "ptable_rights t (abs_state s) = ptable_rights t s" by (simp add: ptable_rights_def abs_state_def) -lemma arch_tcb_relation_arch_context_set[Refine_assms]: +lemma arch_tcb_relation_arch_context_set[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_relation (arch_tcb_context_set tc atcb) (atcbContextSet tc atcb')" by (simp add: arch_tcb_relation_def arch_tcb_context_set_def atcbContextSet_def) -lemma arch_tcb_relation_arch_context_get[Refine_assms]: +lemma arch_tcb_relation_arch_context_get[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_context_get atcb = atcbContextGet atcb'" by (simp add: arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) +lemmas Refine_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Refine?: Refine proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Refine_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Refine_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchRetype_R.thy b/proof/refine/RISCV64/ArchRetype_R.thy index 2749e8c51d..b41d54152c 100644 --- a/proof/refine/RISCV64/ArchRetype_R.thy +++ b/proof/refine/RISCV64/ArchRetype_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Retype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R locale *) -lemma toAPIType_Some[Retype_R_assms, simp]: +lemma toAPIType_Some[Arch_assms, simp]: "(toAPIType ty = Some x) = (ty = APIObjectType x)" by (cases ty; auto simp: toAPIType_def) @@ -33,19 +33,19 @@ definition APIType_map2 :: "kernel_object + RISCV64_H.object_type \ (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_map2_def = APIType_map2_raw_def[simplified APIType_map2_gen_def] -lemma APIType_map2_Untyped[Retype_R_assms, simp]: +lemma APIType_map2_Untyped[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.Untyped) = (tp = Inr (APIObjectType ArchTypes_H.Untyped))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_TCBObject[Retype_R_assms, simp]: +lemma APIType_map2_TCBObject[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.TCBObject) = (tp = Inr (APIObjectType ArchTypes_H.TCBObject))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_generic[Retype_R_assms, simp]: +lemma APIType_map2_generic[Arch_assms, simp]: "APIType_map2 (Inr (APIObjectType api)) = APIType_map2_gen api" by (simp add: APIType_map2_raw_def) @@ -61,11 +61,11 @@ definition APIType_capBits :: "RISCV64_H.object_type \ nat \ domain \ (kernel_obje (* inside of Arch, we don't need to isolate generic component *) lemmas makeObjectKO_def = makeObjectKO_raw_def[simplified makeObjectKO_gen_def] -lemma makeObjectKO_generic[Retype_R_assms, simp]: +lemma makeObjectKO_generic[Arch_assms, simp]: "makeObjectKO dev d (Inr (APIObjectType api)) = makeObjectKO_gen d api" by (simp add: makeObjectKO_raw_def) text \makeObject etc. lemmas\ -lemma valid_arch_tcb'_newArchTCB[Retype_R_assms, simp]: +lemma valid_arch_tcb'_newArchTCB[Arch_assms, simp]: "valid_arch_tcb' newArchTCB s" unfolding valid_arch_tcb'_def newArchTCB_def by simp @@ -112,7 +112,7 @@ text \On the abstract side\ text \Lemmas for createNewObjects etc.\ -lemma makeObjectKO_eq[Retype_R_assms]: +lemma makeObjectKO_eq[Arch_assms]: assumes x: "makeObjectKO dev d tp = Some v" shows "(v = KOCTE cte) = @@ -124,7 +124,7 @@ lemma makeObjectKO_eq[Retype_R_assms]: split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm RISCV64_H.object_type.split_asm arch_kernel_object.split_asm)+ -lemma objBits_le_obj_bits_api[Retype_R_assms]: +lemma objBits_le_obj_bits_api[Arch_assms]: "makeObjectKO dev d ty = Some ko \ objBitsKO ko \ obj_bits_api (APIType_map2 ty) us" apply (case_tac ty) apply (auto simp: default_arch_object_def bit_simps @@ -133,7 +133,7 @@ lemma objBits_le_obj_bits_api[Retype_R_assms]: Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits) done -lemma obj_relation_retype_other_obj[Retype_R_assms]: +lemma obj_relation_retype_other_obj[Arch_assms]: "\ is_other_obj_relation_type (a_type ko); other_obj_relation ko ko' \ \ obj_relation_retype ko ko'" apply (simp add: obj_relation_retype_def) @@ -166,7 +166,7 @@ lemma sym_refs_empty[simp]: unfolding sym_refs_def by simp -lemma ksPSpace_update_gs_eq[Retype_R_assms, simp]: +lemma ksPSpace_update_gs_eq[Arch_assms, simp]: "ksPSpace (update_gs ty us ptrs s) = ksPSpace s" by (simp add: update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) @@ -187,12 +187,12 @@ lemma update_gs_ksMachineState_update_swap: by (simp add: update_gs_def split: aobject_type.splits Structures_A.apiobject_type.splits) -lemma update_gs_id[Retype_R_assms]: +lemma update_gs_id[Arch_assms]: "tp \ no_gs_types \ update_gs tp us addrs = id" by (simp add: no_gs_types_def update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) -lemma no_gs_types_CapTableObject[Retype_R_assms]: +lemma no_gs_types_CapTableObject[Arch_assms]: "Structures_A.apiobject_type.CapTableObject \ no_gs_types" by (simp add: no_gs_types_def) @@ -207,7 +207,7 @@ lemma update_gs_simps[simp]: gsUserPages_update (\ups x. if x \ ptrs then Some RISCVHugePage else ups x)" by (simp_all add: update_gs_def) -lemma objBitsKO_gt_0[Retype_R_assms]: +lemma objBitsKO_gt_0[Arch_assms]: "0 < objBitsKO ko" apply (case_tac ko) apply (simp_all add: objBits_simps' pageBits_def) @@ -269,7 +269,7 @@ lemma range_cover_canonical_address': apply (frule range_cover_canonical_address[where p="unat p"]; simp?) using unat_less_helper by blast -lemma createNewCaps_valid_cap[Retype_R_assms]: +lemma createNewCaps_valid_cap[Arch_assms]: fixes ptr :: machine_word assumes cover: "range_cover ptr sz (APIType_capBits ty us) n " assumes not_0: "n \ 0" @@ -474,7 +474,7 @@ proof - qed qed -lemma arch_tcb_relation_default[Retype_R_assms]: +lemma arch_tcb_relation_default[Arch_assms]: "arch_tcb_relation default_arch_tcb newArchTCB" by (clarsimp simp: new_context_def newContext_def initContext_def default_arch_tcb_def newArchTCB_def arch_tcb_relation_def) @@ -509,7 +509,7 @@ lemmas object_splits = RISCV64_H.object_type.split_asm arch_kernel_object.split_asm -lemma valid_arch_badges_not_arch[Retype_R_assms]: +lemma valid_arch_badges_not_arch[Arch_assms]: "\isArchObjectCap cap' \ valid_arch_badges cap cap' node" by (auto simp: isCap_simps valid_arch_badges_def) @@ -517,7 +517,7 @@ lemma valid_arch_badges_NullCap[simp]: "valid_arch_badges cap NullCap node" by (simp add: valid_arch_badges_not_arch gen_isCap_simps) -lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: +lemma valid_untyped'_helper_arch_cap[Arch_assms]: "\pspace_aligned' s; pspace_distinct' s; pspace_no_overlap' ptr sz s; range_cover ptr sz (objBitsKO val) n; valid_arch_cap' acap s \ \ valid_arch_cap' acap @@ -526,7 +526,7 @@ lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: typ_at_to_obj_at_arches frame_at'_def page_table_at'_def split: if_split_asm arch_capability.splits) -lemma retype_in_kernel_mappings'[Retype_R_assms]: +lemma retype_in_kernel_mappings'[Arch_assms]: assumes pc': "pspace_in_kernel_mappings' s'" and cover: "range_cover ptr sz (objBitsKO ko) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -544,7 +544,7 @@ proof - done qed -lemma createNewCaps_cte_wp_at2[Retype_R_assms]: +lemma createNewCaps_cte_wp_at2[Arch_assms]: "\\s. P (cte_wp_at' P' p s) \ \ P' makeObject \ n \ 0 \ range_cover ptr sz (APIType_capBits ty objsz) n @@ -565,7 +565,7 @@ lemma createNewCaps_cte_wp_at2[Retype_R_assms]: | simp)+ done -lemma createNewCaps_cte_wp_at'[Retype_R_assms]: +lemma createNewCaps_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -590,7 +590,7 @@ lemma createNewCaps_cte_wp_at'[Retype_R_assms]: (* example of arch-split attempt of this kind of proof; unfortunately splitting off the arch-specific part doesn't actually save space, so we will leave these in Arch *) -lemma createNewCaps_state_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -618,7 +618,7 @@ lemma createNewCaps_state_refs_of'[Retype_R_assms]: apply (force simp: gen_objBits_simps split: ArchTypes_H.apiobject_type.splits) done -lemma createNewCaps_state_hyp_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_hyp_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -647,7 +647,7 @@ lemma arch_live'_KOPTE[simp]: "arch_live' (KOPTE makeObject) = False" by (simp add: makeObject_pte arch_live'_def) -lemma createNewCaps_iflive'[Retype_R_assms, wp]: +lemma createNewCaps_iflive'[Arch_assms, wp]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -679,20 +679,20 @@ crunch createNewCaps for qs[wp]: "\s. P (ksReadyQueues s)" and qsL1[wp]: "\s. P (ksReadyQueuesL1Bitmap s)" and qsL2[wp]: "\s. P (ksReadyQueuesL2Bitmap s)" - and ct[Retype_R_assms, wp]: "\s. P (ksCurThread s)" - and ksCurDomain[Retype_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksInterrupt[Retype_R_assms, wp]: "\s. P (ksInterruptState s)" - and nosch[Retype_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and it[Retype_R_assms, wp]: "\s. P (ksIdleThread s)" + and ct[Arch_assms, wp]: "\s. P (ksCurThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksInterrupt[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and it[Arch_assms, wp]: "\s. P (ksIdleThread s)" and asid_table[wp]: "\s. P (riscvKSASIDTable (ksArchState s))" and global_ksArch[wp]: "\s. P (riscvKSGlobalPTs (ksArchState s))" and vspace_ksArch[wp]: "\s. P (riscvKSKernelVSpace (ksArchState s))" and gsMaxObjectSize[wp]: "\s. P (gsMaxObjectSize s)" - and irq_states'[Retype_R_assms, wp]: valid_irq_states' - and ksDomSchedule[Retype_R_assms, wp]: "\s. P (ksDomSchedule s)" - and ksDomScheduleIdx[Retype_R_assms, wp]: "\s. P (ksDomScheduleIdx s)" - and ksDomScheduleStart[Retype_R_assms, wp]: "\s. P (ksDomScheduleStart s)" - and gsUntypedZeroRanges[Retype_R_assms, wp]: "\s. P (gsUntypedZeroRanges s)" + and irq_states'[Arch_assms, wp]: valid_irq_states' + and ksDomSchedule[Arch_assms, wp]: "\s. P (ksDomSchedule s)" + and ksDomScheduleIdx[Arch_assms, wp]: "\s. P (ksDomScheduleIdx s)" + and ksDomScheduleStart[Arch_assms, wp]: "\s. P (ksDomScheduleStart s)" + and gsUntypedZeroRanges[Arch_assms, wp]: "\s. P (gsUntypedZeroRanges s)" and ksArch[wp]: "\s. P (ksArchState s)" (simp: crunch_simps unless_def wp: mapM_x_wp' setObject_ksInterrupt updateObject_default_inv crunch_wps @@ -702,11 +702,11 @@ crunch copyGlobalMappings for ksCurThread[wp]: "\s. P (ksCurThread s)" (wp: crunch_wps) -lemma createNewCaps_arch_ko_type_pre_non_arch[Retype_R_assms]: +lemma createNewCaps_arch_ko_type_pre_non_arch[Arch_assms]: "(case ty of ArchT _ \ False | _ \ True) \ createNewCaps_arch_ko_type_pre ty" by simp -lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: +lemma createNewCaps_ko_wp_atQ'[Arch_assms]: "\(\s. P (ko_wp_at' P' p s) \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -734,7 +734,7 @@ lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: | split if_split_asm)+ done -lemma createNewCaps_global_refs'[Retype_R_assms]: +lemma createNewCaps_global_refs'[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ valid_global_refs' s @@ -756,7 +756,7 @@ lemma createNewCaps_global_refs'[Retype_R_assms]: apply (auto simp: linorder_not_less ball_ran_eq) done -lemma createNewCaps_valid_bitmaps[Retype_R_assms]: +lemma createNewCaps_valid_bitmaps[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_bitmaps s\ createNewCaps ty ptr n us dev \\_. valid_bitmaps\" @@ -772,7 +772,7 @@ lemma createNewCaps_valid_bitmaps[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: +lemma createNewCaps_valid_sched_pointers[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_sched_pointers s\ createNewCaps ty ptr n us dev \\_. valid_sched_pointers\" @@ -787,7 +787,7 @@ lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_vms[Retype_R_assms]: +lemma createNewCaps_vms[Arch_assms]: "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ 0 < n) and valid_machine_state'\ @@ -812,7 +812,7 @@ lemma createNewCaps_vms[Retype_R_assms]: field_simps mult_2_right bit_simps) done -lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: +lemma createNewCaps_pspace_domain_valid[Arch_assms, wp]: "\pspace_domain_valid and K ({ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \ kernel_data_refs = {} \ range_cover ptr sz (APIType_capBits ty us) n \ 0 < n)\ @@ -831,10 +831,12 @@ lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: (* safe for generic context, and we can't requalify object_type.inject as that would result in it being named "inject" *) -lemma object_type_inject[Retype_R_assms]: +lemma object_type_inject[Arch_assms]: "(APIObjectType x = APIObjectType y) = (x = y)" by simp +lemmas Retype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -845,8 +847,7 @@ arch_requalify_consts interpretation Retype_R?: Retype_R makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Retype_R_assms)?)?) qed locale Arch_retype_mdb = retype_mdb + Arch @@ -875,18 +876,18 @@ end (* Arch_retype_mdb *) context Arch begin arch_global_naming -named_theorems Retype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_2 locale *) (* drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [Retype_R_2_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] +lemmas [Arch_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] (* FIXME arch-split: currently only the gen_ version is used *) lemmas valid_obj_makeObject_rules = gen_valid_obj_makeObject_rules valid_obj_makeObject_pte valid_obj_makeObject_asid_pool -lemma retype_state_relation[Retype_R_2_assms]: +lemma retype_state_relation[Arch_assms]: notes data_map_insert_def[simp del] assumes sr: "(s, s') \ state_relation" and vs: "valid_pspace s" "valid_mdb s" @@ -1113,7 +1114,7 @@ lemma retype_state_relation[Retype_R_2_assms]: split: Structures_A.apiobject_type.splits aobject_type.splits) qed -lemma createObjects_valid_objs'[Retype_R_2_assms]: +lemma createObjects_valid_objs'[Arch_assms]: assumes mko: "makeObjectKO dev d ty = Some val" and max_d: "ty = Inr (APIObjectType TCBObject) \ d \ maxDomain" and vo: "valid_objs' s" @@ -1199,7 +1200,7 @@ proof - done qed -lemma createNewCaps_idle'[Retype_R_2_assms, wp]: +lemma createNewCaps_idle'[Arch_assms, wp]: "\valid_idle' and valid_pspace' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ createNewCaps ty ptr n us d @@ -1218,7 +1219,7 @@ lemma createNewCaps_idle'[Retype_R_2_assms, wp]: objBits_def createObjects_def tcb_cte_cases_neqs bit_simps)+ done -lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: +lemma createNewCaps_valid_arch_state[Arch_assms]: "\(\s. valid_arch_state' s \ valid_pspace' s \ pspace_no_overlap' ptr sz s \ (tp = APIObjectType ArchTypes_H.CapTableObject \ us > 0)) and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ @@ -1242,7 +1243,7 @@ lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: apply auto done -lemma createNewCaps_sched_queues[Retype_R_2_assms]: +lemma createNewCaps_sched_queues[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" assumes not_0: "n \ 0" shows @@ -1266,7 +1267,7 @@ lemma createNewCaps_sched_queues[Retype_R_2_assms]: split_del: if_split, fastforce simp add: mult_2 add_ac bit_simps)+ -lemma createNewCaps_null_filter'[Retype_R_2_assms]: +lemma createNewCaps_null_filter'[Arch_assms]: "\(\s. P (null_filter' (ctes_of s))) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0) \ @@ -1290,7 +1291,7 @@ lemma createNewCaps_null_filter'[Retype_R_2_assms]: | fastforce)+ done -lemma createObjects_no_cte_valid_global[Retype_R_2_assms]: +lemma createObjects_no_cte_valid_global[Arch_assms]: assumes no_cte: "\c. projectKO_opt val \ Some (c::cte)" assumes no_tcb: "\t. projectKO_opt val \ Some (t::tcb)" shows "\\s. pspace_aligned' s \ pspace_distinct' s \ @@ -1333,7 +1334,7 @@ lemma createObjects_valid_arch: apply auto done -lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: +lemma createObjects_untyped_ranges_zero'[Arch_assms]: assumes moKO: "makeObjectKO dev d ty = Some val" shows "\ct_active' and valid_pspace' and pspace_no_overlap' ptr sz @@ -1359,18 +1360,19 @@ lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: apply (simp add: makeObject_cte untypedZeroRange_def) done +lemmas Retype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_2?: Retype_R_2 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Retype_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Retype_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_3 locale *) lemma createObjects_no_cte_invs: assumes moKO: "makeObjectKO dev d ty = Some val" @@ -1457,7 +1459,7 @@ proof - split: option.splits kernel_object.splits) qed -lemma createNewCaps_valid_pspace[Retype_R_3_assms]: +lemma createNewCaps_valid_pspace[Arch_assms]: assumes not_0: "n \ 0" and cover: "range_cover ptr sz (APIType_capBits ty us) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -1510,7 +1512,7 @@ lemma init_arch_objects_APIType_map2_VCPU_noop: apply (simp add: init_arch_objects_def APIType_map2_def) done -lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: +lemma corres_retype_region_createNewCaps[Arch_assms]: "corres ((\r r'. length r = length r' \ list_all2 cap_relation r r') \ map (\ref. default_cap (APIType_map2 (Inr ty)) ref us dev)) (\s. valid_pspace s \ valid_mdb s \ valid_list s \ valid_arch_state s @@ -1660,13 +1662,14 @@ lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: apply fastforce+ done +lemmas Retype_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_3?: Retype_R_3 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Retype_R_3_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchSchedule_R.thy b/proof/refine/RISCV64/ArchSchedule_R.thy index fc5a057177..0fa5c504de 100644 --- a/proof/refine/RISCV64/ArchSchedule_R.thy +++ b/proof/refine/RISCV64/ArchSchedule_R.thy @@ -11,14 +11,14 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R locale *) crunch set_vm_root for pspace_distinct[wp]: pspace_distinct (simp: crunch_simps) crunch tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue - for state_hyp_refs_of'[Schedule_R_assms, wp]: "\s. P (state_hyp_refs_of' s)" + for state_hyp_refs_of'[Arch_assms, wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp) lemma arch_switch_thread_tcb_at'[wp]: @@ -42,21 +42,21 @@ proof - by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_RISCV64_H_switchToThread_typ_at' pos]) qed -lemmas Arch_switchToThread_st_tcb_at'[Schedule_R_assms] = +lemmas Arch_switchToThread_st_tcb_at'[Arch_assms] = Arch_switchToThread_pred_tcb'[where proj=itcbState] crunch storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread, Arch.switchToIdleThread for ksQ[wp]: "\s. P (ksReadyQueues s)" - and ksIdleThread[Schedule_R_assms, wp]: "\s. P (ksIdleThread s)" - and sym_heap_sched_pointers[Schedule_R_assms, wp]: sym_heap_sched_pointers - and valid_objs'[Schedule_R_assms, wp]: valid_objs' + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and sym_heap_sched_pointers[Arch_assms, wp]: sym_heap_sched_pointers + and valid_objs'[Arch_assms, wp]: valid_objs' (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp simp: crunch_simps obj_at'_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread - for pspace_aligned[Schedule_R_assms, wp]: pspace_aligned - and pspace_distinct[Schedule_R_assms, wp]: pspace_distinct - and ready_queues[Schedule_R_assms, wp]: "\s. P (ready_queues s)" + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct + and ready_queues[Arch_assms, wp]: "\s. P (ready_queues s)" and ready_qs_distinct[wp]: ready_qs_distinct (wp: ready_qs_distinct_lift crunch_wps simp: crunch_simps) @@ -74,7 +74,7 @@ lemma arch_switchToThread_corres: done (* use superset of arch_switchToThread_corres preconditions across the architectures as interface *) -lemma arch_switchToThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and valid_objs and valid_asid_map and valid_arch_caps and pspace_aligned and pspace_distinct and valid_global_objs and (\s. sym_refs (state_hyp_refs_of s)) @@ -95,7 +95,7 @@ lemma arch_switchToIdleThread_corres: valid_arch_state_asid_table valid_arch_state_global_arch_objs)+ (* use superset of arch_switchToIdleThread_corres preconditions across the architectures as interface *) -lemma arch_switchToIdleThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToIdleThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and pspace_aligned and pspace_distinct and valid_asid_map and valid_idle and valid_arch_caps and valid_global_objs and valid_vspace_objs and valid_objs) @@ -103,14 +103,14 @@ lemma arch_switchToIdleThread_corres_interface[Schedule_R_assms]: arch_switch_to_idle_thread Arch.switchToIdleThread" by (rule corres_guard_imp, rule arch_switchToIdleThread_corres; simp) -lemma Arch_switchToThread_invs[Schedule_R_assms, wp]: +lemma Arch_switchToThread_invs[Arch_assms, wp]: "\invs' and tcb_at' t\ Arch.switchToThread t \\rv. invs'\" unfolding RISCV64_H.switchToThread_def by wpsimp crunch "Arch.switchToThread" - for ksCurDomain[Schedule_R_assms, wp]: "\s. P (ksCurDomain s)" - and tcbDomain[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" - and tcbState[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" + for ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and tcbDomain[Arch_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" + and tcbState[Arch_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" (simp: crunch_simps wp: crunch_wps getASID_wp) lemma threadSet_invs_no_cicd'_trivialT: @@ -158,7 +158,7 @@ lemma asUser_invs_no_cicd'[wp]: apply (wp threadSet_invs_no_cicd'_trivial hoare_drop_imps | simp)+ done -lemma Arch_switchToThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToThread_invs_no_cicd'[Arch_assms]: "Arch.switchToThread t \invs_no_cicd'\" by (wpsimp wp: setVMRoot_invs_no_cicd' simp: RISCV64_H.switchToThread_def) @@ -174,7 +174,7 @@ crunch "ThreadDecls_H.switchToThread" for ksCurDomain[wp]: "\s. P (ksCurDomain s)" (* neater unfold, actual unfold is really ugly *) -lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: +lemma bitmapQ_lookupBitmapPriority_simp[Arch_assms]: "\ ksReadyQueuesL1Bitmap s d \ 0 ; valid_bitmapQ s ; bitmapQ_no_L1_orphans s \ \ bitmapQ d (lookupBitmapPriority d s) s = (ksReadyQueuesL1Bitmap s d !! word_log2 (ksReadyQueuesL1Bitmap s d) \ @@ -199,7 +199,7 @@ lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: apply (fastforce intro: word_of_nat_less simp: wordRadix_def' unat_of_nat word_size)+ done -lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToIdleThread_invs_no_cicd'[Arch_assms]: "Arch.switchToIdleThread \invs_no_cicd'\" unfolding switchToIdleThread_def by (wpsimp wp: setCurThread_invs_no_cicd'_idle_thread setVMRoot_invs_no_cicd') @@ -207,28 +207,29 @@ lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: crunch Arch.switchToIdleThread for obj_at'[wp]: "obj_at' P t" -lemmas Arch_switchToIdleThread_not_queued'[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_not_queued'[Arch_assms] = ArchThreadDecls_H_RISCV64_H_switchToIdleThread_obj_at'[where P="Not \ tcbQueued"] -lemmas Arch_switchToIdleThread_tcbState[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_tcbState[Arch_assms] = ArchThreadDecls_H_RISCV64_H_switchToIdleThread_obj_at'[where P="P \ tcbState" for P] crunch arch_switch_to_thread, handle_spurious_irq - for valid_idle[Schedule_R_assms, wp]: valid_idle + for valid_idle[Arch_assms, wp]: valid_idle + +lemmas Schedule_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R?: Schedule_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Schedule_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_2 locale *) -lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: +lemma bitmapL1_highest_lookup[Arch_assms]: "\ valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; bitmapQ d p s \ \ p \ lookupBitmapPriority d s" apply (subgoal_tac "ksReadyQueuesL1Bitmap s d \ 0") @@ -274,7 +275,7 @@ lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: apply (erule word_log2_maximum) done -lemma guarded_switch_to_chooseThread_fragment_corres[Schedule_R_2_assms]: +lemma guarded_switch_to_chooseThread_fragment_corres[Arch_assms]: "corres dc (P and st_tcb_at runnable t and invs and valid_sched) (P' and invs_no_cicd') @@ -310,19 +311,20 @@ crunch prepareNextDomain and nosch[wp]: "\s. P (ksSchedulerAction s)" crunch tcb_sched_action - for valid_vs_lookup[Schedule_R_2_assms, wp]: valid_vs_lookup + for valid_vs_lookup[Arch_assms, wp]: valid_vs_lookup + +lemmas Schedule_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R_2?: Schedule_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Schedule_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_3 locale *) lemma scheduleChooseNewThread_fragment_corres: "corres dc (invs and valid_domain_list and valid_sched and @@ -346,7 +348,7 @@ lemma scheduleChooseNewThread_fragment_corres: apply (auto simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def) done -lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_corres[Arch_assms]: "corres dc (\s. invs s \ valid_domain_list s \ valid_sched s \ scheduler_action s = choose_new_thread) (\s. invs' s \ ksSchedulerAction s = ChooseNewThread) @@ -359,7 +361,7 @@ lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: apply (wpsimp simp: getDomainTime_def)+ done -lemma scheduleChooseNewThread_invs'[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_invs'[Arch_assms]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \ \_ s. invs' s \" @@ -386,7 +388,7 @@ lemma stit_nosch[wp]: apply (wp setCurThread_nosch | simp add: getIdleThread_def)+ done -lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: +lemma scheduleChooseNewThread_ct_activatable'[Arch_assms, wp]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \\_. ct_in_state' activatable'\" @@ -397,12 +399,13 @@ lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: | (rule hoare_lift_Pf[where f=ksCurThread], solves wp) | strengthen invs'_invs_no_cicd)+ +lemmas Schedule_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Schedule_R_3?: Schedule_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Schedule_R_3_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchStateRelationLemmas.thy b/proof/refine/RISCV64/ArchStateRelationLemmas.thy index ab2d4bf1de..50c79e87c8 100644 --- a/proof/refine/RISCV64/ArchStateRelationLemmas.thy +++ b/proof/refine/RISCV64/ArchStateRelationLemmas.thy @@ -15,7 +15,7 @@ begin context Arch begin arch_global_naming -named_theorems StateRelation_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for StateRelation_R locale *) lemma obj_relation_cuts_def2: "obj_relation_cuts ko x = @@ -70,7 +70,7 @@ lemma obj_relation_cutsE: split: Structures_A.kernel_object.splits kernel_object.splits if_splits RISCV64_A.arch_kernel_obj.splits) -lemma is_other_obj_relation_type_gen[simp, StateRelation_R_assms]: +lemma is_other_obj_relation_type_gen[simp, Arch_assms]: "\n. \ is_other_obj_relation_type (ACapTable n)" "\ is_other_obj_relation_type ATCB" "is_other_obj_relation_type AEndpoint" @@ -90,7 +90,7 @@ lemma is_other_obj_relation_type_DeviceData: "\ is_other_obj_relation_type (AArch (ADeviceData sz))" unfolding is_other_obj_relation_type_def by simp -lemma obj_relation_cuts_trivial[StateRelation_R_assms]: +lemma obj_relation_cuts_trivial[Arch_assms]: "ptr \ fst ` obj_relation_cuts ty ptr" apply (case_tac ty) apply (rename_tac sz cs) @@ -159,7 +159,7 @@ lemma ghost_relation_wrapper_lift': apply wp done -lemma ghost_relation_wrapper_genD[StateRelation_R_assms]: +lemma ghost_relation_wrapper_genD[Arch_assms]: "ghost_relation_wrapper s s' \ ups_of_heap (kheap s) = gsUserPages s' \ cns_of_heap (kheap s) = gsCNodes s'" by (simp add: ghost_relation_of_heap) @@ -200,20 +200,21 @@ lemma other_aobj_relation_aobj: unfolding other_aobj_relation_def is_ArchObj_def by (clarsimp split: Structures_A.kernel_object.splits) -lemma msgLabelBits_msg_label_bits[StateRelation_R_assms]: +lemma msgLabelBits_msg_label_bits[Arch_assms]: "msgLabelBits = msg_label_bits" by (simp add: msgLabelBits_def) -lemma msgInfoRegister_msg_info_register[StateRelation_R_assms]: +lemma msgInfoRegister_msg_info_register[Arch_assms]: "msgInfoRegister = msg_info_register" by (simp add: msg_info_register_def msgInfoRegister_def) -end +lemmas StateRelation_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation StateRelation_R?: StateRelation_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact StateRelation_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact RISCV64.StateRelation_R_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/RISCV64/ArchSyscall_R.thy b/proof/refine/RISCV64/ArchSyscall_R.thy index fa96e13d57..719b9c60b0 100644 --- a/proof/refine/RISCV64/ArchSyscall_R.thy +++ b/proof/refine/RISCV64/ArchSyscall_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_R locale *) -lemma prepareSetDomain_corres[Syscall_R_assms, corres]: +lemma prepareSetDomain_corres[Arch_assms, corres]: "corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu and valid_arch_state and tcb_at tptr) (pspace_aligned' and pspace_distinct' and no_0_obj') (arch_prepare_set_domain tptr new_dom) (prepareSetDomain tptr new_dom)" @@ -23,19 +23,19 @@ lemma prepareSetDomain_corres[Syscall_R_assms, corres]: by corres crunch prepareSetDomain - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' and ksSchedulerAction[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Syscall_R_assms, wp]: sch_act_simple - and tcb_at'[Syscall_R_assms, wp]: "tcb_at' p" + and sch_act_simple[Arch_assms, wp]: sch_act_simple + and tcb_at'[Arch_assms, wp]: "tcb_at' p" and ksCurThread[wp]: "\s. P (ksCurThread s)" and pred_tcb_at'[wp]: "pred_tcb_at' proj P t" - and ct_in_state'[Syscall_R_assms, wp]: "ct_in_state' P" + and ct_in_state'[Arch_assms, wp]: "ct_in_state' P" (wp: sch_act_simple_lift ct_in_state_thread_state_lift' crunch_wps) crunch postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler - for typ_at'[Syscall_R_assms, wp]: "\s. P (typ_at' T p s)" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" -lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: +lemma setThreadState_irq_control_inv_valid'[Arch_assms, wp]: "setThreadState st t \irq_control_inv_valid' irqcontrol_invocation\" apply (case_tac irqcontrol_invocation; simp) apply (rename_tac archirq_inv) @@ -44,11 +44,11 @@ lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: done (* FIXME arch-split: consider moving to where other msgRegisters stuff goes... Tcb_R? Ipc_R? *) -lemma len_msg_registes_le_max_length[Syscall_R_assms]: +lemma len_msg_registes_le_max_length[Arch_assms]: "length msg_registers \ msg_max_length" by (simp add: msg_max_length_def msgRegisters_unfold) -lemma capRegister_cap_register[Syscall_R_assms]: +lemma capRegister_cap_register[Arch_assms]: "capRegister = cap_register" by (simp add: cap_register_def capRegister_def) @@ -56,7 +56,7 @@ lemma read_stval_invs'[wp]: "doMachineOp read_stval \invs'\" by (simp add: read_stval_def doMachineOp_def split_def select_f_returns | wp)+ -lemma hv_invs'[Syscall_R_assms, wp]: +lemma hv_invs'[Arch_assms, wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" apply (simp add: RISCV64_H.handleVMFault_def cong: vmfault_type.case_cong) @@ -65,20 +65,20 @@ lemma hv_invs'[Syscall_R_assms, wp]: done crunch handleVMFault - for nosch[Syscall_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma handleSpuriousIRQ_corres[Syscall_R_assms, corres]: +lemma handleSpuriousIRQ_corres[Arch_assms, corres]: "corres dc \ \ handle_spurious_irq handleSpuriousIRQ" by (simp add: handle_spurious_irq_def handleSpuriousIRQ_def) -lemma handleHypervisorFault_corres[Syscall_R_assms]: +lemma handleHypervisorFault_corres[Arch_assms]: "corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread) (invs' and sch_act_not thread and st_tcb_at' simple' thread and ex_nonz_cap_to' thread) (handle_hypervisor_fault thread fault) (handleHypervisorFault thread fault)" by (cases fault; clarsimp simp: handleHypervisorFault_def split del: if_split) -lemma hvmf_invs_lift[Syscall_R_assms]: +lemma hvmf_invs_lift[Arch_assms]: "(\s m. P (s\ksMachineState := ksMachineState s\machine_state_rest := m\\) = P s) \ \P\ handleVMFault t flt \\_ _. True\, \\_. P\" unfolding handleVMFault_def @@ -87,16 +87,16 @@ lemma hvmf_invs_lift[Syscall_R_assms]: doMachineOp_bind getRestartPC_def getRegister_def) crunch handleVMFault - for st_tcb_at'[Syscall_R_assms, wp]: "st_tcb_at' P t" - and ex_nonz_cap_to'[Syscall_R_assms, wp]: "ex_nonz_cap_to' t" - and norq[Syscall_R_assms, wp]: "\s. P (ksReadyQueues s)" - and ksit[Syscall_R_assms, wp]: "\s. P (ksIdleThread s)" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" + and ex_nonz_cap_to'[Arch_assms, wp]: "ex_nonz_cap_to' t" + and norq[Arch_assms, wp]: "\s. P (ksReadyQueues s)" + and ksit[Arch_assms, wp]: "\s. P (ksIdleThread s)" crunch handleHypervisorFault for ksit[wp]: "\s. P (ksIdleThread s)" (wp: undefined_valid haskell_assert_inv) -lemma hh_invs'[Syscall_R_assms, wp]: +lemma hh_invs'[Arch_assms, wp]: "\invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p and (\s. p \ ksIdleThread s)\ handleHypervisorFault p t \\_. invs'\" @@ -104,24 +104,25 @@ lemma hh_invs'[Syscall_R_assms, wp]: by (cases t; wpsimp simp: RISCV64_H.handleHypervisorFault_def) crunch handleSpuriousIRQ - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' (ignore: doMachineOp) -lemma arch_performInvocation_inv[Syscall_R_assms]: +lemma arch_performInvocation_inv[Arch_assms]: "\\\ Arch.performInvocation invocation -, \P\" by (wpsimp simp: performRISCVMMUInvocation_def RISCV64_H.performInvocation_def) -lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: +lemma Arch_performIRQControl_inv_EE[Arch_assms]: "\\\ Arch.performIRQControl irqc -, \P\" unfolding RISCV64_H.performIRQControl_def by wpsimp +lemmas Syscall_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Syscall_R?: Syscall_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Syscall_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Syscall_R_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchTcbAcc_R.thy b/proof/refine/RISCV64/ArchTcbAcc_R.thy index 6ec2fa101f..f61a8c6b85 100644 --- a/proof/refine/RISCV64/ArchTcbAcc_R.thy +++ b/proof/refine/RISCV64/ArchTcbAcc_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R locale *) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_loadWord_bits[TcbAcc_R_assms, wp]: +lemma no_fail_loadWord_bits[Arch_assms, wp]: "no_fail (\_. is_aligned p word_size_bits) (loadWord p)" by (wpsimp simp: loadWord_def is_aligned_mask[symmetric] word_size_bits_def) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_storeWord_bits[TcbAcc_R_assms]: +lemma no_fail_storeWord_bits[Arch_assms]: "no_fail (\_. is_aligned p word_size_bits) (storeWord p w)" by (wpsimp simp: storeWord_def is_aligned_mask[symmetric] word_size_bits_def) -lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: +lemma prioToL1Index_l1IndexToPrio_or_id[Arch_assms]: "\ unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \ \ prioToL1Index ((l1IndexToPrio w) || w') = w" unfolding l1IndexToPrio_def prioToL1Index_def @@ -33,12 +33,12 @@ lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: apply (subst unat_of_nat_eq, simp_all add: word_size) done -lemma l1IndexToPrio_wordRadix_mask[TcbAcc_R_assms, simp]: +lemma l1IndexToPrio_wordRadix_mask[Arch_assms, simp]: "l1IndexToPrio i && mask wordRadix = 0" unfolding l1IndexToPrio_def by (simp add: wordRadix_def') -lemma st_tcb_at_coerce_abstract[TcbAcc_R_assms]: +lemma st_tcb_at_coerce_abstract[Arch_assms]: assumes t: "st_tcb_at' P t c" assumes sr: "(a, c) \ state_relation" shows "st_tcb_at (\st. \st'. thread_state_relation st st' \ P st') t a" @@ -62,7 +62,7 @@ lemma tcb_at'_cross: other_obj_relation_def pte_relation_def is_tcb_def split: Structures_A.kernel_object.split_asm if_split_asm arch_kernel_obj.split_asm) -lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: +lemma setObject_update_TCB_corres'[Arch_assms]: assumes tcbs: "tcb_relation tcb tcb' \ tcb_relation new_tcb new_tcb'" assumes tables: "\(getF, v) \ ran tcb_cap_cases. getF new_tcb = getF tcb" assumes tables': "\(getF, v) \ ran tcb_cte_cases. getF new_tcb' = getF tcb'" @@ -134,11 +134,11 @@ lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: apply (fastforce simp: opt_map_def) by (clarsimp simp: ready_queue_relation_def opt_pred_def opt_map_def split: option.splits) -lemma setObject_tcb_valid_arch'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_valid_arch'[Arch_assms, wp]: "\valid_arch_state'\ setObject t (v :: tcb) \\rv. valid_arch_state'\" by (wp valid_arch_state_lift' setObject_typ_at') -lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_refs'[Arch_assms, wp]: "\\s. P (global_refs' s)\ setObject t (v::tcb) \\rv s. P (global_refs' s)\" apply (clarsimp simp: setObject_def split_def updateObject_default_def) apply wp @@ -146,7 +146,7 @@ lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: done (* assumption not needed on this architecture, but used in generic interface *) -lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: +lemma threadSet_state_hyp_refs_of'[Arch_assms]: assumes y: "\tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb)" shows "\\s. P (state_hyp_refs_of' s)\ threadSet F t \\rv s. P (state_hyp_refs_of' s)\" apply (simp add: threadSet_def) @@ -154,7 +154,7 @@ lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: simp: gen_objBits_simps obj_at'_def state_hyp_refs_of'_def) done -lemma threadSet_iflive'T[TcbAcc_R_assms]: +lemma threadSet_iflive'T[Arch_assms]: assumes x: "\tcb. \(getF, setF) \ ran tcb_cte_cases. getF (F tcb) = getF tcb" shows "\\s. if_live_then_nonz_cap' s @@ -188,11 +188,11 @@ lemma threadSet_iflive'T[TcbAcc_R_assms]: sublocale threadSet: typ_at_props' "threadSet tptr f" by typ_at_props' -lemma zobj_refs'_capRange[TcbAcc_R_assms]: +lemma zobj_refs'_capRange[Arch_assms]: "s \' cap \ zobj_refs' cap \ capRange cap" by (cases cap; simp add: valid_cap'_def capAligned_def capRange_def is_aligned_no_overflow) -lemma capAligned_zobj_refs'_capRange[TcbAcc_R_assms]: +lemma capAligned_zobj_refs'_capRange[Arch_assms]: "capAligned c \ zobj_refs' c \ capRange c" by (cases c; simp add: capAligned_def capRange_def is_aligned_no_overflow) @@ -219,7 +219,7 @@ schematic_goal l2BitmapSize_def': (* arch specific consequence *) "l2BitmapSize = numeral ?X" by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def) -lemma prioToL1Index_size[TcbAcc_R_assms, simp]: +lemma prioToL1Index_size[Arch_assms, simp]: "prioToL1Index w < l2BitmapSize" unfolding prioToL1Index_def wordRadix_def l2BitmapSize_def' by (fastforce simp: shiftr_div_2n' nat_divide_less_eq @@ -230,12 +230,12 @@ lemma prioToL1Index_max: unfolding prioToL1Index_def wordRadix_def by (insert unat_lt2p[where x=p], simp add: shiftr_div_2n') -lemma prioToL1Index_bit_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_set[Arch_assms]: "((2 :: machine_word) ^ prioToL1Index p) !! prioToL1Index p" using l2BitmapSize_def' by (fastforce simp: nth_w2p_same intro: order_less_le_trans[OF prioToL1Index_size]) -lemma prioL2Index_bit_set[TcbAcc_R_assms]: +lemma prioL2Index_bit_set[Arch_assms]: fixes p :: priority shows "((2::machine_word) ^ unat (ucast p && (mask wordRadix :: machine_word))) !! unat (p && mask wordRadix)" apply (simp add: nth_w2p wordRadix_def ucast_and_mask[symmetric] unat_ucast_upcast is_up) @@ -254,25 +254,25 @@ lemma prioToL1Index_bits_low_high_eq: unfolding prioToL1Index_def by (fastforce simp: nth_w2p wordRadix_def is_up bits_low_high_eq) -lemma prioToL1Index_bit_not_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_not_set[Arch_assms]: "\ (~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" apply (subst word_ops_nth_size, simp_all add: prioToL1Index_bit_set del: bit_exp_iff) apply (fastforce simp: prioToL1Index_def wordRadix_def word_size intro: order_less_le_trans[OF word_shiftr_lt]) done -lemma prioToL1Index_complement_nth_w2p[TcbAcc_R_assms]: +lemma prioToL1Index_complement_nth_w2p[Arch_assms]: fixes p p' :: priority shows "(~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p' = (prioToL1Index p \ prioToL1Index p')" by (fastforce simp: complement_nth_w2p prioToL1Index_lt wordRadix_def word_size)+ -lemma invertL1Index_eq_cancelD[TcbAcc_R_assms]: +lemma invertL1Index_eq_cancelD[Arch_assms]: "\ invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \ \ i = j" by (simp add: invertL1Index_def l2BitmapSize_def') -lemma pspace_dom_dom[TcbAcc_R_assms]: +lemma pspace_dom_dom[Arch_assms]: "dom ps \ pspace_dom ps" unfolding pspace_dom_def apply clarsimp @@ -290,7 +290,7 @@ lemma pspace_dom_dom[TcbAcc_R_assms]: apply (simp add: pageBitsForSize_def bit_simps split: vmpage_size.split) done -lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: +lemma less_max_ipc_words_less_2p_msg_align_bits[Arch_assms]: assumes y: "y < unat max_ipc_words" shows "word_of_nat y * (word_size :: machine_word) < 2 ^ msg_align_bits" apply (simp add: word_size_def word_size_bits_def) @@ -299,37 +299,38 @@ lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: apply (simp add: msg_align_bits max_ipc_words)+ done -lemma is_aligned_word_size_bits_less_max_ipc_words[TcbAcc_R_assms]: +lemma is_aligned_word_size_bits_less_max_ipc_words[Arch_assms]: "y < unat max_ipc_words \ is_aligned (word_of_nat y * word_size) word_size_bits" by (simp add: word_size_def word_size_bits_def) (rule is_aligned_mult_triv2[where n=3, simplified]) -lemma msg_align_bits_le_pageBitsForSize[TcbAcc_R_assms]: +lemma msg_align_bits_le_pageBitsForSize[Arch_assms]: "msg_align_bits \ pageBitsForSize sz" by (simp add: msg_align_bits pageBitsForSize_def bit_simps split: vmpage_size.split) -lemmas [TcbAcc_R_assms] = +lemmas [Arch_assms] = dmo_getirq_inv getActiveIRQ_masked tcb_at'_cross pspace_relation_update_tcbs +lemmas TcbAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R?: TcbAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.TcbAcc_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_2 locale *) sublocale asUser: typ_at_props' "asUser tptr f" by typ_at_props' -lemma tcb_hyp_refs'_valid_arch_tcb'_eq[TcbAcc_R_2_assms]: +lemma tcb_hyp_refs'_valid_arch_tcb'_eq[Arch_assms]: "tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ valid_arch_tcb' (tcbArch (F tcb)) s = valid_arch_tcb' (tcbArch tcb) s" by (auto simp: valid_arch_tcb'_def) @@ -404,14 +405,14 @@ lemma asUser_corres: apply (simp add: invs'_def valid_state'_def valid_pspace'_def) done -lemma asUser_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_getRegister_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (getRegister r)) (asUser t (getRegister r))" apply (rule asUser_corres') apply (clarsimp simp: getRegister_def) done -lemma user_getreg_inv'[TcbAcc_R_2_assms, wp]: +lemma user_getreg_inv'[Arch_assms, wp]: "\P\ asUser t (getRegister r) \\x. P\" apply (rule asUser_inv) apply (simp_all add: getRegister_def) @@ -445,7 +446,7 @@ lemma asUser_iflive'[wp]: unfolding asUser_def by (wpsimp wp: threadSet_iflive' hoare_drop_imps, auto) -lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_setRegister_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (setRegister r v)) (asUser t (setRegister r v))" @@ -454,7 +455,7 @@ lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: apply (rule corres_modify'; simp) done -lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs apply (wp | simp add: bitmap_fun_defs bitmapQ_no_L1_orphans_def)+ @@ -462,7 +463,7 @@ lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: prioToL1Index_complement_nth_w2p) done -lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L2_orphans[Arch_assms, wp]: "\ bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L2_orphans \" @@ -474,7 +475,7 @@ lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: apply metis done -lemma removeFromBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma removeFromBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p \ removeFromBitmap d p \\_. valid_bitmapQ_except d p \" @@ -525,7 +526,7 @@ proof - done qed -lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma addToBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ addToBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs bitmapQ_defs using word_unat_mask_lt[where w=p and m=wordRadix] @@ -535,7 +536,7 @@ lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: wordBits_def numPriorities_def) done -lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma addToBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p and bitmapQ_no_L2_orphans \ addToBitmap d p \\_. valid_bitmapQ_except d p \" @@ -547,7 +548,7 @@ lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: dest: prioToL1Index_bits_low_high_eq) done -lemma in_user_frame_eq[TcbAcc_R_2_assms]: +lemma in_user_frame_eq[Arch_assms]: assumes y: "y < unat max_ipc_words" and al: "is_aligned a msg_align_bits" shows "in_user_frame (a + of_nat y * word_size) s = in_user_frame a s" @@ -574,15 +575,15 @@ lemma thread_get_registers: apply (clarsimp simp: map_upd_triv select_f_def image_def return_def) done -lemma msgRegisters_msg_registers[TcbAcc_R_2_assms]: +lemma msgRegisters_msg_registers[Arch_assms]: "msgRegisters = msg_registers" by (simp add: msgRegisters_unfold) -lemma suc_len_msg_registers_less_2p_word_bits[TcbAcc_R_2_assms]: +lemma suc_len_msg_registers_less_2p_word_bits[Arch_assms]: "Suc (length msg_registers) < 2 ^ word_bits" by (simp add: msgRegisters_unfold word_bits_def) -lemma asUser_mapM_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_mapM_getRegister_corres[Arch_assms]: "corres (\con regs. regs = map con msg_registers) (tcb_at t and pspace_aligned and pspace_distinct) \ (thread_get (arch_tcb_get_registers o tcb_arch) t) @@ -618,7 +619,7 @@ lemma UserContext_fold: lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split] -lemma lookupIPCBuffer_corres'[TcbAcc_R_2_assms]: +lemma lookupIPCBuffer_corres'[Arch_assms]: "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct) (valid_objs' and no_0_obj') @@ -675,7 +676,7 @@ crunch rescheduleRequired, tcbSchedEnqueue for hyp_refs_of'[wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps wp: threadSet_state_hyp_refs_of' ignore: threadSet) -lemmas [TcbAcc_R_2_assms] = +lemmas [Arch_assms] = getThreadBufferSlot_inv lookupIPCBuffer_inv rescheduleRequired_hyp_refs_of' @@ -686,7 +687,7 @@ lemma archThreadGet_wp: unfolding archThreadGet_def by (wpsimp wp: getObject_tcb_wp simp: obj_at'_def) -lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setThreadState_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P ((state_hyp_refs_of' s))\ setThreadState st t \\rv s. P (state_hyp_refs_of' s)\" @@ -694,14 +695,14 @@ lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: | wp threadSet_state_hyp_refs_of')+ done -lemma setBoundNotification_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setBoundNotification_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P (state_hyp_refs_of' s)\ setBoundNotification ntfn t \\rv s. P (state_hyp_refs_of' s)\" by (simp add: setBoundNotification_def fun_upd_def | wp threadSet_state_hyp_refs_of')+ -lemma storeWord_invs'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs'[Arch_assms, wp]: "\pointerInUserData p and invs'\ doMachineOp (storeWord p w) \\rv. invs'\" proof - have aligned_offset_ignore: @@ -726,7 +727,7 @@ proof - done qed -lemma storeWord_invs_no_cicd'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs_no_cicd'[Arch_assms, wp]: "\pointerInUserData p and invs_no_cicd'\ doMachineOp (storeWord p w) \\rv. invs_no_cicd'\" proof - have aligned_offset_ignore: @@ -754,25 +755,26 @@ qed crunch tcbSchedAppend for pspace_in_kernel_mappings'[wp]: pspace_in_kernel_mappings' -lemmas [TcbAcc_R_2_assms] = tcbSchedAppend_pspace_in_kernel_mappings' +lemmas [Arch_assms] = tcbSchedAppend_pspace_in_kernel_mappings' (* FIXME: the code assumes that it is word_t, so length_type should be defined generically in ASpec, not per architecture *) -lemmas [TcbAcc_R_2_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] +lemmas [Arch_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] + +lemmas TcbAcc_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation TcbAcc_R_2?: TcbAcc_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.TcbAcc_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_3 locale *) -lemma setMRs_corres[TcbAcc_R_3_assms]: +lemma setMRs_corres[Arch_assms]: assumes m: "mrs' = mrs" shows "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \ in_user_frame buf) @@ -844,7 +846,7 @@ lemma asUser_invs[wp]: crunch storeWordUser for pred_tcb_at'[wp]: "\s. pred_tcb_at' proj P p s" -lemma set_mrs_invs'[TcbAcc_R_3_assms, wp]: +lemma set_mrs_invs'[Arch_assms, wp]: "\ invs' and tcb_at' receiver \ setMRs receiver recv_buf mrs \\rv. invs' \" apply (simp add: setMRs_def) apply (wp dmo_invs' no_irq_mapM no_irq_storeWord crunch_wps| @@ -863,12 +865,13 @@ sublocale setThreadState: typ_at_props' "setThreadState st p" sublocale setBoundNotification: typ_at_props' "setBoundNotification v p" by typ_at_props' +lemmas TcbAcc_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R_3?: TcbAcc_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.TcbAcc_R_3_assms)?)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/RISCV64/ArchTcb_R.thy b/proof/refine/RISCV64/ArchTcb_R.thy index 4531a6b50e..2f2f8c202e 100644 --- a/proof/refine/RISCV64/ArchTcb_R.thy +++ b/proof/refine/RISCV64/ArchTcb_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R locale *) -lemma activateIdleThread_corres[Tcb_R_assms]: +lemma activateIdleThread_corres[Arch_assms]: "corres dc (st_tcb_at idle t) (st_tcb_at' idle' t) (arch_activate_idle_thread t) (activateIdleThread t)" by (simp add: arch_activate_idle_thread_def activateIdleThread_def) crunch arch_post_modify_registers - for pspace_aligned[Tcb_R_assms, wp]: pspace_aligned - and pspace_distinct[Tcb_R_assms, wp]: pspace_distinct + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct (wp: crunch_wps simp: crunch_simps) -lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: +lemma asUser_postModifyRegisters_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' t and tcb_at' ct) (arch_post_modify_registers ct t) (asUser t $ postModifyRegisters ct t)" @@ -37,7 +37,7 @@ lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: (* formulation of threadSet_state_hyp_refs_of' varies based on whether VCPU is present; use this as interface, but keep original lemma name for use outside of Arch *) -lemma threadSet_state_hyp_refs_of'_interface[Tcb_R_assms]: +lemma threadSet_state_hyp_refs_of'_interface[Arch_assms]: "\ \tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ \ threadSet F t \\s. P (state_hyp_refs_of' s)\ " by (wpsimp simp: threadSet_state_hyp_refs_of') @@ -48,7 +48,7 @@ sublocale setPriority: typ_at_props' "setPriority t prio" sublocale setMCPriority: typ_at_props' "setMCPriority t prio" by typ_at_props' -lemma sameObject_corres2[Tcb_R_assms]: +lemma sameObject_corres2[Arch_assms]: "\ cap_relation c c'; cap_relation d d' \ \ same_object_as c d = sameObjectAs c' d'" apply (frule(1) same_region_as_relation[symmetric, where c=c and c'=d]) @@ -62,7 +62,7 @@ lemma sameObject_corres2[Tcb_R_assms]: split: arch_cap.splits) by (fastforce simp: global.sameRegionAs_def isCap_simps split: arch_cap.splits) -lemma untyped_derived_eq_from_sameObjectAs[Tcb_R_assms]: +lemma untyped_derived_eq_from_sameObjectAs[Arch_assms]: "sameObjectAs cap cap2 \ untyped_derived_eq cap cap2" by (clarsimp simp: untyped_derived_eq_def sameObjectAs_def2 gen_isCap_Master) @@ -75,8 +75,8 @@ lemma isValidVTableRootD: option.split_asm) crunch prepare_thread_delete, arch_finalise_cap - for pspace_aligned[Tcb_R_assms, wp]: "pspace_aligned :: det_ext state \ _" - and pspace_distinct[Tcb_R_assms, wp]: "pspace_distinct :: det_ext state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_ext state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_ext state \ _" (simp: crunch_simps preemption_point_def wp: crunch_wps OR_choiceE_weak_wp) lemma is_valid_vtable_root_simp: @@ -86,7 +86,7 @@ lemma is_valid_vtable_root_simp: split: cap.splits arch_cap.splits option.splits) (* FIXME: move after checked_insert_tcb_invs in ArchTcb_AI, and consolidate redundancy there *) -lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: +lemma checked_insert_tcb_invs_gen[Arch_assms]: "\invs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and K (is_cnode_or_valid_arch new_cap) and valid_cap new_cap and tcb_cap_valid new_cap (target, ref) @@ -101,37 +101,37 @@ lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: apply (clarsimp dest!: is_cnode_or_valid_arch_cap_asid) done -lemma is_valid_vtable_root_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_valid_vtable_root_is_cnode_or_valid_arch[Arch_assms]: "is_valid_vtable_root cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def is_valid_vtable_root_simp is_cap_simps) -lemma is_cnode_cap_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_cnode_cap_is_cnode_or_valid_arch[Arch_assms]: "is_cnode_cap cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def) -lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Tcb_R_assms]: +lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Arch_assms]: "\valid_ipc_buffer_cap cap buf; is_arch_cap cap\ \ is_nondevice_page_cap cap" by (clarsimp simp: is_cap_simps valid_ipc_buffer_cap_def) -lemma cte_at_tcb_at_2p_cteSizeBits[Tcb_R_assms]: +lemma cte_at_tcb_at_2p_cteSizeBits[Arch_assms]: "tcb_at' t s \ cte_at' (t + 2 ^ cteSizeBits) s" by (simp add: cte_at'_obj_at' tcb_cte_cases_def cteSizeBits_def) (* arch_capBadge may involve SMC caps on some architectures, but not page tables *) -lemma isValidVTableRootD_arch[Tcb_R_assms]: +lemma isValidVTableRootD_arch[Arch_assms]: "isValidVTableRoot cap \ isArchObjectCap cap \ arch_capBadge (capCap cap) = None" by (drule isValidVTableRootD; clarsimp simp: arch_capBadge_def isCap_simps) (* FIXME FPU: when the FPU being enabled is properly configurable for the proofs then this shouldn't need to unfold config_HAVE_FPU. *) -lemma postSetFlags_corres[Tcb_R_assms, corres]: +lemma postSetFlags_corres[Arch_assms, corres]: "flags = word_to_tcb_flags flags' \ corres dc (cur_tcb and pspace_aligned and pspace_distinct and valid_cur_fpu) \ (arch_post_set_flags t flags) (postSetFlags t flags')" unfolding arch_post_set_flags_def postSetFlags_def by (corres simp: Kernel_Config.config_HAVE_FPU_def cur_tcb_def) -lemma postSetFlags_invs'[Tcb_R_assms, wp]: +lemma postSetFlags_invs'[Arch_assms, wp]: "postSetFlags t flags \invs'\" unfolding postSetFlags_def by wpsimp @@ -142,11 +142,11 @@ lemma copyregsets_map_only[simp]: (* there are no extra registers on any architecture so far, and while it is theoretically possible in the design spec, the abstract invariant proof assumes this *) -lemma decodeTransfer_def'[Tcb_R_assms]: +lemma decodeTransfer_def'[Arch_assms]: "decodeTransfer w = returnOk (copyregsets_map ArchDefaultExtraRegisters)" by (simp add: decodeTransfer_def) -lemma checkValidIPCBuffer_corres[Tcb_R_assms]: +lemma checkValidIPCBuffer_corres[Arch_assms]: "cap_relation cap cap' \ corres (ser \ dc) \ \ (check_valid_ipc_buffer vptr cap) @@ -163,7 +163,7 @@ lemma checkValidIPCBuffer_corres[Tcb_R_assms]: apply (auto simp add: returnOk_def) done -lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: +lemma checkValidIPCBuffer_ArchObject_wp[Arch_assms]: "\\s. isArchObjectCap cap \ capBadge cap = None \ is_aligned p msg_align_bits \ P s\ checkValidIPCBuffer p cap \\rv s. P s\,-" @@ -177,27 +177,28 @@ lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: done crunch checkValidIPCBuffer - for inv[Tcb_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps) -lemma isValidVTableRoot_eq[Tcb_R_assms]: +lemma isValidVTableRoot_eq[Arch_assms]: "cap_relation cap cap' \ isValidVTableRoot cap' = is_valid_vtable_root cap" apply (cases cap; simp add: isValidVTableRoot_def is_valid_vtable_root_simp) apply (rename_tac acap, case_tac acap; simp) apply (auto split: option.split simp: mdata_map_def) done +lemmas Tcb_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R?: Tcb_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Tcb_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Tcb_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R_2 locale *) lemma checkCapAt_cteInsert_corres': "cap_relation new_cap newCap \ @@ -251,7 +252,7 @@ lemma checkCapAt_cteInsert_corres': apply fastforce done -lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: +lemma checkCapAt_cteInsert_corres[Arch_assms]: "cap_relation new_cap newCap \ corres dc (einvs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and cte_at slot and K (is_cnode_or_valid_arch new_cap) @@ -272,12 +273,13 @@ lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: apply fastforce done +lemmas Tcb_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R_2?: Tcb_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Tcb_R_2_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchUntyped_R.thy b/proof/refine/RISCV64/ArchUntyped_R.thy index a4492ff80d..a9b8ae9d6a 100644 --- a/proof/refine/RISCV64/ArchUntyped_R.thy +++ b/proof/refine/RISCV64/ArchUntyped_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R locale *) -lemma APIType_map2_CapTable[Untyped_R_assms, simp]: +lemma APIType_map2_CapTable[Arch_assms, simp]: "(APIType_map2 ty = Structures_A.CapTableObject) = (ty = Inr (APIObjectType ArchTypes_H.CapTableObject))" by (simp add: APIType_map2_def @@ -25,13 +25,13 @@ lemma APIType_map2_CapTable[Untyped_R_assms, simp]: lemmas is_frame_type_defs = is_frame_type_def isFrameType_def arch_is_frame_type_def -lemma is_frame_type_isFrameType_eq[Untyped_R_assms, simp]: +lemma is_frame_type_isFrameType_eq[Arch_assms, simp]: "(is_frame_type (APIType_map2 (Inr (toEnum (unat arg0))))) = (isFrameType (toEnum (unat arg0)))" by (simp add: APIType_map2_def is_frame_type_defs split: apiobject_type.splits object_type.splits)+ (* object_type enum (arch-specific) is extension of apiobject_type enum (generic) *) -lemma nth_enum_object_type_gen_eq[Untyped_R_assms]: +lemma nth_enum_object_type_gen_eq[Arch_assms]: assumes "n < length (enum :: apiobject_type list)" shows "((enum :: object_type list) ! n) = APIObjectType ((enum :: apiobject_type list) ! n)" proof - @@ -45,36 +45,36 @@ proof - (simp flip: nth_map[where f=APIObjectType]) qed -lemma length_enum_apiobject_less_enum_object_type[Untyped_R_assms]: +lemma length_enum_apiobject_less_enum_object_type[Arch_assms]: "length (enum :: apiobject_type list) < length (enum :: object_type list)" unfolding enum_apiobject_type enum_object_type by simp crunch freeMemory (* FIXME arch-split: clearMemory is already handled in ArchRetype_AI *) - for irq_masks_inv[wp, Untyped_R_assms]: "\s. P (irq_masks s)" + for irq_masks_inv[wp, Arch_assms]: "\s. P (irq_masks s)" (wp: crunch_wps) crunch updateFreeIndex, deleteGhost - for valid_irq_states'[Untyped_R_assms, wp]: "valid_irq_states'" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" - and gsMaxObjectSize[Untyped_R_assms, wp]: "\s. P (gsMaxObjectSize s)" - and ksIdleThread[Untyped_R_assms, wp]: "\s. P (ksIdleThread s)" - and ksCurDomain[Untyped_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksCurThread[Untyped_R_assms, wp]: "\s. P (ksCurThread s)" + for valid_irq_states'[Arch_assms, wp]: "valid_irq_states'" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and gsMaxObjectSize[Arch_assms, wp]: "\s. P (gsMaxObjectSize s)" + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksCurThread[Arch_assms, wp]: "\s. P (ksCurThread s)" (wp: crunch_wps) -lemma arch_data_to_obj_type_invalid[Untyped_R_assms]: +lemma arch_data_to_obj_type_invalid[Arch_assms]: "\ n \ length (enum :: object_type list) \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) = None" by (auto simp: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) -lemma arch_data_to_obj_type_valid[Untyped_R_assms]: +lemma arch_data_to_obj_type_valid[Arch_assms]: "\ n < length (enum :: object_type list); length (enum :: apiobject_type list) \ n \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) \ None" by (simp add: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) arith -lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: +lemma APIType_map2_arch_data_to_obj_type[Arch_assms]: defines [simp]: "object_types \ enum :: object_type list" defines [simp]: "apiobject_types \ enum :: apiobject_type list" shows @@ -89,7 +89,7 @@ lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: apply arith done -lemma obj_bits_api_APIType_map2[Untyped_R_assms]: +lemma obj_bits_api_APIType_map2[Arch_assms]: "obj_bits_api (APIType_map2 (Inr x)) y = getObjectSize x y" apply (clarsimp simp:obj_bits_api_def APIType_map2_def getObjectSize_def simp del: objSize_eq_capBits) apply (case_tac x) @@ -99,11 +99,11 @@ lemma obj_bits_api_APIType_map2[Untyped_R_assms]: apply (simp_all add: apiGetObjectSize_def slot_bits_def objBits_simps' bit_simps) done -lemma length_nat_to_cref[Untyped_R_assms]: +lemma length_nat_to_cref[Arch_assms]: "bits < word_bits \ length (nat_to_cref bits x) = bits" by (simp add: nat_to_cref_def word_bits_conv) -lemma ctes_of_ko_arch[Untyped_R_assms]: +lemma ctes_of_ko_arch[Arch_assms]: "\ valid_cap' cap s; isArchObjectCap cap \ \ \ptr\capRange cap. \optr ko. ksPSpace s optr = Some ko \ ptr \ obj_range' optr ko" apply (case_tac cap; simp add: gen_isCap_simps capRange_def) @@ -156,11 +156,11 @@ lemma ctes_of_ko_arch[Untyped_R_assms]: shiftl_t2n) done -lemma irq_nodes_global[Untyped_R_assms]: +lemma irq_nodes_global[Arch_assms]: "irq_node' s + (ucast (irq :: irq) << cteSizeBits) \ global_refs' s" by (simp add: global_refs'_def) -lemma untyped_inc_mdbD[Untyped_R_assms]: +lemma untyped_inc_mdbD[Arch_assms]: "\ sameRegionAs cap cap'; isUntypedCap cap; ctes p = Some (CTE cap node); ctes p' = Some (CTE cap' node'); untyped_inc' ctes; untyped_mdb' ctes; no_loops ctes \ @@ -186,16 +186,16 @@ lemma untyped_inc_mdbD[Untyped_R_assms]: apply (clarsimp simp: gen_isCap_simps) done -lemma mdb_chunked_arch_assms_non_arch[Untyped_R_assms]: +lemma mdb_chunked_arch_assms_non_arch[Arch_assms]: "\ isArchObjectCap cap \ mdb_chunked_arch_assms cap" by (simp add: mdb_chunked_arch_assms_def isCap_simps) -lemma sameRegionAs_def_untyped[Untyped_R_assms]: +lemma sameRegionAs_def_untyped[Arch_assms]: "\ isUntypedCap cap \ \ sameRegionAs cap cap' = (capRange cap' \ {} \ capRange cap' \ capRange cap)" by (clarsimp simp add: sameRegionAs_def3 isCap_simps) -lemma createNewCaps_range_helper[Untyped_R_assms]: +lemma createNewCaps_range_helper[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits tp us) n \ 0 < n\ createNewCaps tp ptr n us d \\rv s. \capfn. @@ -265,7 +265,7 @@ defs archOverlap_def: "archOverlap \ \_ _. False" (* trivial on this architecture *) -lemma archNoOverlap[Untyped_R_assms]: +lemma archNoOverlap[Arch_assms]: notes Int_atLeastAtMost[simp del] shows "corres dc (\s. \cref. cte_wp_at (\cap. is_untyped_cap cap @@ -275,34 +275,34 @@ lemma archNoOverlap[Untyped_R_assms]: (return ()) (stateAssert (\s. \ archOverlap s R) [])" by (simp add: archOverlap_def) -lemma word_size_bits_le_untyped_min_bits[Untyped_R_assms]: +lemma word_size_bits_le_untyped_min_bits[Arch_assms]: "word_size_bits \ untyped_min_bits" by (simp add: word_size_bits_def untyped_min_bits_def) -lemma minUntypedSizeBits_le_resetChunkBits[Untyped_R_assms]: +lemma minUntypedSizeBits_le_resetChunkBits[Arch_assms]: "minUntypedSizeBits \ resetChunkBits" by (simp add: minUntypedSizeBits_def Kernel_Config.resetChunkBits_def) -lemma maxUntypedSizeBits_less_word_bits[Untyped_R_assms]: +lemma maxUntypedSizeBits_less_word_bits[Arch_assms]: "maxUntypedSizeBits < word_bits" by (simp add: maxUntypedSizeBits_def word_bits_def) (* FIXME arch-split: candidate for Kernel_Config lemmas *) -lemma word_size_bits_le_resetChunkBits[Untyped_R_assms]: +lemma word_size_bits_le_resetChunkBits[Arch_assms]: "word_size_bits \ resetChunkBits" by (simp add: word_size_bits_def Kernel_Config.resetChunkBits_def) -lemma resetChunkBits_le_word_bits[Untyped_R_assms]: +lemma resetChunkBits_le_word_bits[Arch_assms]: "resetChunkBits < word_bits" by (simp add: Kernel_Config.resetChunkBits_def word_bits_def) -lemma APIType_capBits_lower_bound[Untyped_R_assms]: +lemma APIType_capBits_lower_bound[Arch_assms]: "\tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \ minUntypedSizeBits \ us\ \ minUntypedSizeBits \ APIType_capBits tp us" by (simp add: APIType_capBits_def objBits_simps' bit_simps minUntypedSizeBits_def split: object_type.split apiobject_type.split) -lemma dmo_freeMemory_clear_um[Untyped_R_assms]: +lemma dmo_freeMemory_clear_um[Arch_assms]: "\word_size_bits \ sz; sz \ word_bits; is_aligned ptr sz\ \ (do_machine_op (freeMemory ptr sz) :: (det_state, unit) nondet_monad) = modify (clear_um {ptr..ptr + 2 ^ sz - 1})" @@ -313,8 +313,8 @@ lemma dmo_freeMemory_clear_um[Untyped_R_assms]: done crunch createObject - for nosch[Untyped_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" crunch resetUntypedCap for arch_inv[wp]: "\s. P (ksArchState s)" @@ -322,12 +322,13 @@ crunch resetUntypedCap wp: hoare_drop_imps unless_wp mapME_x_inv_wp preemptionPoint_inv) +lemmas Untyped_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R?: Untyped_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Untyped_R_assms)?)?) qed locale Arch_mdb_insert_again_all = mdb_insert_again_all + Arch @@ -383,21 +384,22 @@ end (* invokeUntyped_proofs *) context Arch begin arch_global_naming -named_theorems Untyped_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R_2 locale *) -lemmas [Untyped_R_2_assms] = +lemmas [Arch_assms] = mdb_insert_again_all.valid_n' invokeUntyped_proofs.descendants_range invokeUntyped_proofs.ex_cte_no_overlap' invokeUntyped_proofs.cref_inv invokeUntyped_proofs.slots_invD +lemmas Untyped_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R_2?: Untyped_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.Untyped_R_2_assms)?)?) qed end diff --git a/proof/refine/RISCV64/ArchVSpace_R.thy b/proof/refine/RISCV64/ArchVSpace_R.thy index 7221ad1489..5e9f67179b 100644 --- a/proof/refine/RISCV64/ArchVSpace_R.thy +++ b/proof/refine/RISCV64/ArchVSpace_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems VSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for VSpace_R locale *) definition "vspace_at_asid' vs asid \ \s. \ap pool. @@ -55,7 +55,7 @@ lemma handleVMFault_corres': by (corres | corres_cases_both)+ (* interface lemma, superset of all architecture preconditions *) -lemma handleVMFault_corres[VSpace_R_assms]: +lemma handleVMFault_corres[Arch_assms]: "corres (fr \ dc) (tcb_at thread and pspace_aligned and pspace_distinct) (tcb_at' thread) (handle_vm_fault thread fault) (handleVMFault thread fault)" by (corres corres: handleVMFault_corres') @@ -1113,12 +1113,13 @@ lemma perform_aci_invs [wp]: wellformed_mapdata'_def) done +lemmas VSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation VSpace_R?: VSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact VSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact RISCV64.VSpace_R_assms)?)?) qed end diff --git a/proof/refine/RISCV64/LevityCatch.thy b/proof/refine/RISCV64/LevityCatch.thy index eb368ae40b..4afba56f52 100644 --- a/proof/refine/RISCV64/LevityCatch.thy +++ b/proof/refine/RISCV64/LevityCatch.thy @@ -41,17 +41,12 @@ lemma updateObject_default_inv: unfolding updateObject_default_def by (wpsimp wp: magnitudeCheck_inv alignCheck_inv projectKO_inv) - -context begin interpretation Arch . +context Arch begin arch_global_naming lemmas makeObject_simps = makeObject_endpoint makeObject_notification makeObject_cte makeObject_tcb makeObject_user_data makeObject_pte makeObject_asidpool -end - -context Arch begin arch_global_naming - lemma to_from_apiType[simp]: "toAPIType (fromAPIType x) = Some x" by (cases x) (auto simp add: fromAPIType_def toAPIType_def) diff --git a/proof/refine/X64/ArchADT_H.thy b/proof/refine/X64/ArchADT_H.thy index 972c1265f8..5086f2fe5f 100644 --- a/proof/refine/X64/ArchADT_H.thy +++ b/proof/refine/X64/ArchADT_H.thy @@ -13,14 +13,14 @@ begin context Arch begin arch_global_naming -named_theorems ADT_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H locale *) definition vm_rights_of :: "vmrights \ rights set" where "vm_rights_of x \ case x of VMKernelOnly \ vm_kernel_only | VMReadOnly \ vm_read_only | VMReadWrite \ vm_read_write" -lemma vm_rights_of_vmrights_map_id[ADT_H_assms, simp]: +lemma vm_rights_of_vmrights_map_id[Arch_assms, simp]: "rs \ valid_vm_rights \ vm_rights_of (vmrights_map rs) = rs" by (auto simp: vm_rights_of_def vmrights_map_def valid_vm_rights_def vm_read_write_def vm_read_only_def vm_kernel_only_def) @@ -121,14 +121,14 @@ fun ArchCapabilityMap :: "arch_capability \ cap" where | "ArchCapabilityMap arch_capability.IOPortControlCap = cap.ArchObjectCap arch_cap.IOPortControlCap" -lemma acap_relation_imp_ArchCapabilityMap[ADT_H_assms]: +lemma acap_relation_imp_ArchCapabilityMap[Arch_assms]: "\wellformed_acap ac; acap_relation ac ac'\ \ ArchCapabilityMap ac' = cap.ArchObjectCap ac" by (case_tac ac; simp add: wellformed_acap_simps ucast_down_ucast_id is_down) primrec ArchFaultMap :: "Fault_H.arch_fault \ ExceptionTypes_A.arch_fault" where "ArchFaultMap (ArchFault_H.X64_H.arch_fault.VMFault p m) = Machine_A.X64_A.arch_fault.VMFault p m" -lemma ArchFaultMap_arch_fault_map[ADT_H_assms]: +lemma ArchFaultMap_arch_fault_map[Arch_assms]: "ArchFaultMap (arch_fault_map f) = f" by (cases f; simp add: ArchFaultMap_def arch_fault_map_def) @@ -184,7 +184,7 @@ lemma cr3_expand_unexpand[simp]: "cr3 (cr3_base_address a) (cr3_pcid a) = a" by (cases a, simp) -lemma absArchState_correct[ADT_H_assms]: +lemma absArchState_correct[Arch_assms]: "(s,s') \ state_relation \ absArchState (ksArchState s') (aobjs_of' s') = arch_state s" apply (prop_tac "(arch_state s, ksArchState s') \ arch_state_relation (aobjs_of' s')") apply (simp add: state_relation_def) @@ -193,19 +193,20 @@ lemma absArchState_correct[ADT_H_assms]: split: X64_H.kernel_state.splits cr3.splits) done +lemmas ADT_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState interpretation ADT_H?: ADT_H vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.ADT_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems ADT_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ADT_H_2 locale *) (* Due to DataPage, current FPU owner and gsPPTypes this can't be made generic. In order to unify the type across architectures, we use the arch kernel state. *) @@ -225,7 +226,7 @@ definition absHeap :: | Some (KOArch ako) \ map_option ArchObj (absHeapArch h x ako) | None \ None" -lemma absHeap_correct[ADT_H_2_assms]: +lemma absHeap_correct[Arch_assms]: fixes s' :: kernel_state assumes pspace_aligned: "pspace_aligned s" assumes pspace_distinct: "pspace_distinct s" @@ -670,6 +671,8 @@ proof - done qed +lemmas ADT_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts absHeap @@ -677,8 +680,7 @@ arch_requalify_consts absHeap interpretation ADT_H_2?: ADT_H_2 vm_rights_of ArchCapabilityMap ArchFaultMap ArchTcbMap absArchState absHeap proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact ADT_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.ADT_H_2_assms)?)?) qed end diff --git a/proof/refine/X64/ArchArchAcc_R.thy b/proof/refine/X64/ArchArchAcc_R.thy index b7498303ca..fa55004a89 100644 --- a/proof/refine/X64/ArchArchAcc_R.thy +++ b/proof/refine/X64/ArchArchAcc_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems ArchAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for ArchAcc_R locale *) lemma asid_pool_at_ko: "asid_pool_at p s \ \pool. ko_at (ArchObj (X64_A.ASIDPool pool)) p s" @@ -30,7 +30,7 @@ lemma asid_low_bits [simp]: "asidLowBits = asid_low_bits" by (simp add: asid_low_bits_def asidLowBits_def) -lemma pspace_aligned_cross[ArchAcc_R_assms]: +lemma pspace_aligned_cross[Arch_assms]: "\ pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_aligned' s'" apply (clarsimp simp: pspace_aligned'_def pspace_aligned_def pspace_relation_def) apply (rename_tac p' ko') @@ -124,7 +124,7 @@ lemma obj_relation_cuts_range_limit: apply fastforce+ done -lemma obj_relation_cuts_range_mask_range[ArchAcc_R_assms]: +lemma obj_relation_cuts_range_mask_range[Arch_assms]: "\ (p', P) \ obj_relation_cuts ko p; P ko ko'; is_aligned p (obj_bits ko) \ \ p' \ mask_range p (obj_bits ko)" apply (drule (1) obj_relation_cuts_range_limit, clarsimp) @@ -147,7 +147,7 @@ lemma obj_relation_cuts_obj_bits: lemmas is_aligned_add_step_le' = is_aligned_add_step_le[simplified mask_2pm1 add_diff_eq] -lemma pspace_distinct_cross[ArchAcc_R_assms]: +lemma pspace_distinct_cross[Arch_assms]: "\ pspace_distinct s; pspace_aligned s; pspace_relation (kheap s) (ksPSpace s') \ \ pspace_distinct' s'" apply (frule (1) pspace_aligned_cross) @@ -1538,7 +1538,7 @@ lemma copy_global_mappings_corres [@lift_corres_args, corres]: by (auto simp: valid_arch_state_def valid_arch_state'_def elim: page_map_l4_pml4e_atI page_map_l4_pml4e_atI') -lemma arch_cap_rights_update[ArchAcc_R_assms]: +lemma arch_cap_rights_update[Arch_assms]: "acap_relation c c' \ cap_relation (cap.ArchObjectCap (acap_rights_update (acap_rights c \ msk) c)) (Arch.maskCapRights (rights_mask_map msk) c')" @@ -1567,7 +1567,7 @@ lemma arch_deriveCap_valid: split del: if_split) apply (rule hoare_pre, wp undefined_validE_R) apply (cases arch_cap, simp_all add: isCap_defs) - apply (simp add: valid_cap'_def capAligned_def global.capUntypedPtr_def capUntypedPtr_def)+ + apply (simp add: valid_cap'_def capAligned_def global.capUntypedPtr_def X64_H.capUntypedPtr_def)+ done lemma arch_deriveCap_corres: @@ -2065,12 +2065,13 @@ lemma corres_gets_x64_irq_state [corres]: "corres x64_irq_relation \ \ (gets (x64_irq_state \ arch_state)) (gets (x64KSIRQState \ ksArchState))" by (simp add: state_relation_def arch_state_relation_def) -end +lemmas ArchAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation ArchAcc_R?: ArchAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact ArchAcc_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.ArchAcc_R_assms)?) qed end diff --git a/proof/refine/X64/ArchArch_R.thy b/proof/refine/X64/ArchArch_R.thy index 328c0e5ed0..5913d80ae2 100644 --- a/proof/refine/X64/ArchArch_R.thy +++ b/proof/refine/X64/ArchArch_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Arch_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Arch_R locale *) definition "asid_ci_map i \ @@ -385,7 +385,7 @@ lemma asidHighBits [simp]: declare word_unat_power [symmetric, simp del] crunch Arch.decodeInvocation - for inv[Arch_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (wp: crunch_wps mapME_x_inv_wp getASID_wp simp: crunch_simps) @@ -984,7 +984,7 @@ lemma decodeX64PortInvocation_corres: apply (clarsimp simp: isCap_simps split: invocation_label.splits arch_invocation_label.splits) done -lemma arch_decodeInvocation_corres[Arch_R_assms]: +lemma arch_decodeInvocation_corres[Arch_assms]: notes check_vp_inv[wp del] check_vp_wpR[wp] (* FIXME: check_vp_inv shadowed check_vp_wpR. Instead, check_vp_wpR should probably be generalised to replace check_vp_inv. *) @@ -1312,7 +1312,7 @@ lemma arch_ioport_inv_case_simp: by (clarsimp simp: archinv_relation_def split: invocation.splits arch_invocation.splits) -lemma arch_performInvocation_corres[Arch_R_assms]: +lemma arch_performInvocation_corres[Arch_assms]: "archinv_relation ai ai' \ corres (dc \ (=)) (einvs and ct_active and valid_arch_inv ai and schact_is_rct) @@ -1425,7 +1425,7 @@ lemma performASIDControlInvocation_tcb_at': crunch performX64PortInvocation for tcb_at'[wp]: "tcb_at' t" -lemma invokeArch_tcb_at'[Arch_R_assms]: +lemma invokeArch_tcb_at'[Arch_assms]: "\invs' and valid_arch_inv' ai and ct_active' and st_tcb_at' active' p\ Arch.performInvocation ai \\rv. tcb_at' p\" @@ -1443,7 +1443,7 @@ lemma valid_slots_lift': apply (rule hoare_pre, wp hoare_vcg_const_Ball_lift t, simp)+ done -lemma sts_valid_arch_inv'[Arch_R_assms]: +lemma sts_valid_arch_inv'[Arch_assms]: "\valid_arch_inv' ai\ setThreadState st t \\rv. valid_arch_inv' ai\" apply (cases ai, simp_all add: valid_arch_inv'_def) apply (clarsimp simp: valid_pdpti'_def split: pdptinvocation.splits) @@ -1765,7 +1765,7 @@ lemma arch_decodeInvocation_wf[wp]: cong: if_cong split del: if_split) by (wpsimp) -lemma arch_decodeInvocation_wf_interface[Arch_R_assms]: +lemma arch_decodeInvocation_wf_interface[Arch_assms]: "\invs' and valid_cap' (ArchObjectCap arch_cap) 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 @@ -2034,7 +2034,7 @@ lemma setIOPortMask_cte_cap_to'[wp]: "\ex_cte_cap_to' p\ setIOPortMask f l b \\rv. ex_cte_cap_to' p\" by (wp ex_cte_cap_to'_pres) -lemma arch_performInvocation_invs'[Arch_R_assms]: +lemma arch_performInvocation_invs'[Arch_assms]: "\invs' and ct_active' and valid_arch_inv' invocation\ Arch.performInvocation invocation \\rv. invs'\" @@ -2058,7 +2058,7 @@ lemma arch_performInvocation_invs'[Arch_R_assms]: apply force done -lemma setObject_TCB_valid_duplicates'[Arch_R_assms, wp]: +lemma setObject_TCB_valid_duplicates'[Arch_assms, wp]: "setObject p (tcb::tcb) \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp @@ -2073,6 +2073,8 @@ lemma hv_inv_ex': apply simp done +lemmas Arch_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -2081,8 +2083,7 @@ arch_requalify_consts interpretation Arch_R?: Arch_R valid_arch_inv' archinv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Arch_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Arch_R_assms)?)?) qed end diff --git a/proof/refine/X64/ArchBits_R.thy b/proof/refine/X64/ArchBits_R.thy index ca520a094e..f0fbf42af2 100644 --- a/proof/refine/X64/ArchBits_R.thy +++ b/proof/refine/X64/ArchBits_R.thy @@ -10,28 +10,28 @@ begin context Arch begin arch_global_naming -named_theorems Bits_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Bits_R locale *) -lemma atcbContext_get_eq[Bits_R_assms, simp]: +lemma atcbContext_get_eq[Arch_assms, simp]: "atcbContextGet (atcbContextSet x atcb) = x" by (simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_eq[Bits_R_assms, simp]: +lemma atcbContext_set_eq[Arch_assms, simp]: "atcbContextSet (atcbContextGet t) t = t" by (cases t, simp add: atcbContextGet_def atcbContextSet_def) -lemma atcbContext_set_set[Bits_R_assms, simp]: +lemma atcbContext_set_set[Arch_assms, simp]: "atcbContextSet x (atcbContextSet y atcb) = atcbContextSet x atcb" by (cases atcb, simp add: atcbContextSet_def) -lemma objBitsKO_less_word_bits[Bits_R_assms]: +lemma objBitsKO_less_word_bits[Arch_assms]: "objBitsKO ko < word_bits" unfolding objBits_def by (case_tac ko; simp add: pageBits_def objBits_simps' word_bits_def split: arch_kernel_object.split) -lemma objBitsKO_neq_0[Bits_R_assms]: +lemma objBitsKO_neq_0[Arch_assms]: "objBitsKO ko \ 0" unfolding objBits_def by (case_tac ko; @@ -55,7 +55,7 @@ lemma arch_isCap_simps: lemmas isCap_simps = gen_isCap_simps arch_isCap_simps -lemma pageBits_le_maxUntypedSizeBits[Bits_R_assms, simp]: +lemma pageBits_le_maxUntypedSizeBits[Arch_assms, simp]: "pageBits \ maxUntypedSizeBits" by (simp add: pageBits_def maxUntypedSizeBits_def) @@ -100,7 +100,9 @@ lemmas arch_projectKOs = projectKO_ASID projectKO_PTE projectKO_PDE projectKO_PDPTE projectKO_PML4E projectKO_user_data projectKO_user_data_device -end +lemmas Bits_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) (* for projectKO_opt, we want to export the arch-specific instantiation lemmas *) arch_requalify_facts arch_projectKOs @@ -112,8 +114,7 @@ lemmas projectKOs = gen_projectKOs arch_projectKOs interpretation Bits_R?: Bits_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Bits_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Bits_R_assms)?) qed end diff --git a/proof/refine/X64/ArchCNodeInv_R.thy b/proof/refine/X64/ArchCNodeInv_R.thy index 1f230c0b1d..2bc08ca3d0 100644 --- a/proof/refine/X64/ArchCNodeInv_R.thy +++ b/proof/refine/X64/ArchCNodeInv_R.thy @@ -14,7 +14,7 @@ begin context Arch begin arch_global_naming -named_theorems CNodeInv_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CNodeInv_R locale *) definition ioport_state_independent_H :: "(kernel_state \ bool) \ bool" where "ioport_state_independent_H P \ @@ -27,44 +27,44 @@ declare ioport_state_independent_H_def[simp] definition arch_finalise_prop_stuff :: "(kernel_state \ bool) \ bool" where "arch_finalise_prop_stuff P = ioport_state_independent_H P" -lemma arch_finalise_prop_stuff_top[CNodeInv_R_assms, simp]: +lemma arch_finalise_prop_stuff_top[Arch_assms, simp]: "arch_finalise_prop_stuff \" by (simp add: arch_finalise_prop_stuff_def) -lemma acap_relation_arch_update_cap_data_NullCap[CNodeInv_R_assms]: +lemma acap_relation_arch_update_cap_data_NullCap[Arch_assms]: "acap_relation acap acap' \ (arch_update_cap_data P x acap = cap.NullCap) = (Arch.updateCapData P x acap' = NullCap)" unfolding arch_update_cap_data_def X64_H.updateCapData_def by (cases acap; simp) -lemma cnode_guard_size_bits_wordRadix[CNodeInv_R_assms]: +lemma cnode_guard_size_bits_wordRadix[Arch_assms]: "cnode_guard_size_bits = wordRadix" by (simp add: cnode_guard_size_bits_def wordRadix_def) -lemma cteRightsBits_cnode_padding_bits[CNodeInv_R_assms]: +lemma cteRightsBits_cnode_padding_bits[Arch_assms]: "cteRightsBits = cnode_padding_bits" by (simp add: cteRightsBits_def cnode_padding_bits_def) (* FIXME arch-split: valid_cnode_capI in CNodeInv_AI exposes the value of word_bits, replace with this *) -lemma valid_cnode_capI'[CNodeInv_R_assms]: +lemma valid_cnode_capI'[Arch_assms]: "\cap_table_at n w s; valid_objs s; pspace_aligned s; 0 < n; length g \ word_bits\ \ s \ cap.CNodeCap w n g" by (simp add: word_bits_def valid_cnode_capI) -lemma arch_capBadge_updateCapData_True[CNodeInv_R_assms]: +lemma arch_capBadge_updateCapData_True[Arch_assms]: "Arch.updateCapData True x acap \ NullCap \ capBadge (Arch.updateCapData True x acap) = arch_capBadge acap" unfolding X64_H.updateCapData_def by (cases acap; simp) crunch fpuRelease, prepareThreadDelete - for ctes_of[CNodeInv_R_assms, wp]: "\s. P (ctes_of s)" + for ctes_of[Arch_assms, wp]: "\s. P (ctes_of s)" crunch prepareThreadDelete - for not_recursive_ctes[CNodeInv_R_assms]: "\s. P (not_recursive_ctes s)" + for not_recursive_ctes[Arch_assms]: "\s. P (not_recursive_ctes s)" (simp: prepareThreadDelete_def not_recursive_ctes_def cteCaps_of_def) -lemma in_preempt'[CNodeInv_R_assms]: +lemma in_preempt'[Arch_assms]: "(Inr rv, s') \ fst (preemptionPoint s) \ \f g. s' = ksWorkUnitsCompleted_update f (s \ ksMachineState := ksMachineState s \ irq_state := g (irq_state (ksMachineState s)) \\)" @@ -90,19 +90,19 @@ lemma sameRegionAs_eq_parent: \ sameRegionAs c' cap" by (clarsimp simp: weak_derived'_def sameRegionAs_def2 isCap_simps) -lemma sameRegion_ep[CNodeInv_R_assms]: +lemma sameRegion_ep[Arch_assms]: "\ sameRegionAs cap cap'; isEndpointCap cap \ \ isEndpointCap cap'" by (auto simp: isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegion_ntfn[CNodeInv_R_assms]: +lemma sameRegion_ntfn[Arch_assms]: "\ sameRegionAs cap cap'; isNotificationCap cap \ \ isNotificationCap cap'" by (auto simp: isCap_simps sameRegionAs_def3 isArchFrameCap_non_arch) -lemma sameRegionAs_Zombie[CNodeInv_R_assms, simp]: +lemma sameRegionAs_Zombie[Arch_assms, simp]: "\ sameRegionAs (Zombie p zb n) cap" by (simp add: sameRegionAs_def3 isCap_simps) -lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: +lemma isFinal_notUntyped_capRange_disjoint[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); cteCaps_of s sl' = Some cap'; sl \ sl'; capUntypedPtr cap = capUntypedPtr cap'; capBits cap = capBits cap'; isThreadCap cap \ isCNodeCap cap; s \' cap; @@ -123,7 +123,7 @@ lemma isFinal_notUntyped_capRange_disjoint[CNodeInv_R_assms]: (clarsimp simp: sameObjectAs_def3 isCap_simps)?)+ done -lemma ztc_sameRegion[CNodeInv_R_assms]: +lemma ztc_sameRegion[Arch_assms]: "\ isCNodeCap cap \ isThreadCap cap \ isZombie cap \ \ sameRegionAs cap cap' = sameObjectAs cap cap'" apply (subgoal_tac "\ isUntypedCap cap \ \ isArchFrameCap cap @@ -132,7 +132,7 @@ lemma ztc_sameRegion[CNodeInv_R_assms]: apply (auto simp: isCap_simps) done -lemma mdb_chunked_update_final[CNodeInv_R_assms]: +lemma mdb_chunked_update_final[Arch_assms]: assumes chunked: "mdb_chunked m" and slot: "m slot = Some (CTE cap node)" and Fin1: "\x cte. m x = Some cte \ x \ slot @@ -191,19 +191,19 @@ proof - done qed -lemma sameRegionAs_ThreadCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_ThreadCap_eq[Arch_assms]: "sameRegionAs (ThreadCap p) (ThreadCap p') = (p = p')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_IRQHandlerCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_IRQHandlerCap_eq[Arch_assms]: "sameRegionAs (IRQHandlerCap irq) (IRQHandlerCap irq') = (irq = irq')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma sameRegionAs_CNodeCap_eq[CNodeInv_R_assms]: +lemma sameRegionAs_CNodeCap_eq[Arch_assms]: "sameRegionAs (CNodeCap p b g gs) (CNodeCap p' b' g' gs') = (p = p' \ b = b')" by (simp add: sameRegionAs_def2 isCap_simps) -lemma ztc_untyped_helper[CNodeInv_R_assms]: +lemma ztc_untyped_helper[Arch_assms]: "\ isCNodeCap cap' \ isThreadCap cap' \ isZombie cap'; sameRegionAs cap cap' \ \ isUntypedCap cap \ sameRegionAs cap' cap" apply (erule sameRegionAsE) @@ -217,12 +217,12 @@ lemma ztc_untyped_helper[CNodeInv_R_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma valid_arch_badges_PhysicalClass[CNodeInv_R_assms]: +lemma valid_arch_badges_PhysicalClass[Arch_assms]: "\ valid_arch_badges cap'' cap' node'; capClass cap'' = PhysicalClass; capClass cap = PhysicalClass \ \ valid_arch_badges cap cap' node'" by (auto simp: valid_arch_badges_def isCap_simps) -lemma isFinal_Zombie[CNodeInv_R_assms]: +lemma isFinal_Zombie[Arch_assms]: "isFinal (Zombie p' b n) p cs" by (simp add: isFinal_def sameObjectAs_def2 gen_isCap_simps) @@ -239,13 +239,13 @@ crunch Arch.postCapDeletion for no_cte_prop[wp]: "no_cte_prop P" (* interface, above crunch does not result in same lemma on all architectures *) -lemma arch_postCapDeletion_no_cte_prop[CNodeInv_R_assms]: +lemma arch_postCapDeletion_no_cte_prop[Arch_assms]: "\no_cte_prop P and K (arch_finalise_prop_stuff P)\ Arch.postCapDeletion t \\_. no_cte_prop P\" by wpsimp -lemma post_cap_delete_pre'_IRQHandlerCap[CNodeInv_R_assms]: +lemma post_cap_delete_pre'_IRQHandlerCap[Arch_assms]: "post_cap_delete_pre' (IRQHandlerCap irq) sl cs = (arch_valid_irq irq \ (\sl'. sl \ sl' \ cs sl' \ Some (IRQHandlerCap irq)))" by (simp add: post_cap_delete_pre'_def) @@ -255,14 +255,14 @@ lemma final_IOPort_no_copy: \ cteCaps_of s sl' \ Some (ArchObjectCap (IOPortCap f l))" by (fastforce simp: isFinal_def sameObjectAs_def2 isCap_simps) -lemma final_post_cap_delete_pre'_ArchObjectCap[CNodeInv_R_assms]: +lemma final_post_cap_delete_pre'_ArchObjectCap[Arch_assms]: "\ isFinal (ArchObjectCap acap) sl (cteCaps_of s); arch_cap_has_cleanup' acap; valid_arch_cap' acap s\ \ post_cap_delete_pre' (ArchObjectCap acap) sl (cteCaps_of s)" by (clarsimp simp add: post_cap_delete_pre'_def arch_cap_has_cleanup'_def isCap_simps final_IOPort_no_copy) crunch Arch_finaliseCap, prepareThreadDelete - for st_tcb_at'[CNodeInv_R_assms, wp]: "st_tcb_at' P t" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" (simp: crunch_simps wp: crunch_wps getObject_inv loadObject_default_inv rule: X64_H.finaliseCap_def) @@ -278,7 +278,7 @@ lemma archThreadSet_rvk_prog': by (wpsimp simp: cteCaps_of_def) crunch prepareThreadDelete, Arch_finaliseCap - for rvk_prog'[CNodeInv_R_assms]: + for rvk_prog'[Arch_assms]: "\s. revoke_progress_ord m (\x. option_map capToRPO (cteCaps_of s x))" (wp: crunch_wps emptySlot_rvk_prog' threadSet_ctesCaps_of getObject_inv loadObject_default_inv @@ -293,13 +293,13 @@ lemma arch_recycleCap_improve_cases: \ (if isASIDPoolCap cap then v else undefined) = v" by (cases cap, simp_all add: isCap_simps) -lemma cap_relation_trans[CNodeInv_R_assms]: +lemma cap_relation_trans[Arch_assms]: "\ cap_relation cap cap'; cap_relation cap cap'' \ \ cap' = cap''" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) crunch Arch_finaliseCap, prepareThreadDelete - for irq_states'[CNodeInv_R_assms, wp]: valid_irq_states' + for irq_states'[Arch_assms, wp]: valid_irq_states' (wp: crunch_wps unless_wp getASID_wp simp: crunch_simps o_def rule: X64_H.finaliseCap_def) @@ -433,19 +433,20 @@ end (* mdb_move *) context Arch begin arch_global_naming -lemmas [CNodeInv_R_assms] = +lemmas [Arch_assms] = mdb_swap.cteSwap_valid_mdb_helper mdb_move.cteMove_valid_mdb_helper +lemmas CNodeInv_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts arch_finalise_prop_stuff interpretation CNodeInv_R?: CNodeInv_R arch_finalise_prop_stuff proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CNodeInv_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CNodeInv_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/X64/ArchCSpace1_R.thy b/proof/refine/X64/ArchCSpace1_R.thy index 55abd05bf6..1e91ad0a7f 100644 --- a/proof/refine/X64/ArchCSpace1_R.thy +++ b/proof/refine/X64/ArchCSpace1_R.thy @@ -13,15 +13,15 @@ begin context Arch begin arch_global_naming -named_theorems CSpace1_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R locale *) -lemma ghost_relation_wrapper_same_abs_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_abs_set_cap[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap cap dest a); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ \ ghost_relation_wrapper a' c'" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma ghost_relation_wrapper_set_cap_twice[CSpace1_R_assms]: +lemma ghost_relation_wrapper_set_cap_twice[Arch_assms]: "\ ghost_relation_wrapper a c; ((), a') \ fst (set_cap dcap src a); ((), a'') \ fst (set_cap scap dest a'); ksArchState c' = ksArchState c; gsUserPages c' = gsUserPages c; gsCNodes c' = gsCNodes c \ @@ -63,7 +63,7 @@ lemma isMDBParentOf_trans: apply (erule(1) capBadge_ordering_trans) done -lemma parentOf_trans[CSpace1_R_assms]: +lemma parentOf_trans[Arch_assms]: "\ s \ a parentOf b; s \ b parentOf c \ \ s \ a parentOf c" by (auto simp: parentOf_def elim: isMDBParentOf_trans) @@ -90,7 +90,7 @@ lemma tcb_cases_related2: done (* FIXME: move *) -lemma pspace_relation_cte_wp_atI'[CSpace1_R_assms]: +lemma pspace_relation_cte_wp_atI'[Arch_assms]: "\ pspace_relation (kheap s) (ksPSpace s'); cte_wp_at' ((=) cte) x s'; valid_objs s \ \ \c slot. cte_wp_at ((=) c) slot s \ cap_relation c (cteCap cte) \ x = cte_map slot" @@ -160,7 +160,7 @@ lemma arch_mdb_assert_cross: apply fastforce done -lemma archMDBAssertions_cross[CSpace1_R_assms]: +lemma archMDBAssertions_cross[Arch_assms]: "\ valid_arch_mdb (is_original_cap s) (caps_of_state s); valid_arch_state s; valid_objs s; (s, s') \ state_relation \ \ archMDBAssertions s'" @@ -180,7 +180,7 @@ lemma is_physical_relation: by (auto simp: is_physical_def arch_is_physical_def split: cap.splits arch_cap.splits) -lemma obj_ref_of_relation[CSpace1_R_assms]: +lemma obj_ref_of_relation[Arch_assms]: "\ cap_relation c c'; capClass c' = PhysicalClass \ \ obj_ref_of c = capUntypedPtr c'" by (cases c; simp) (rename_tac arch_cap, case_tac arch_cap, auto) @@ -195,7 +195,7 @@ lemma obj_size_relation: apply (case_tac arch_cap; simp add: objBits_def X64_H.capUntypedSize_def bit_simps') done -lemma same_region_as_relation[CSpace1_R_assms]: +lemma same_region_as_relation[Arch_assms]: "\ cap_relation c d; cap_relation c' d' \ \ same_region_as c c' = sameRegionAs d d'" apply (cases c) @@ -217,7 +217,7 @@ lemma same_region_as_relation[CSpace1_R_assms]: clarsimp simp: global.sameRegionAs_def isCap_simps Let_def)+ done -lemma can_be_is[CSpace1_R_assms]: +lemma can_be_is[Arch_assms]: "\ cap_relation c (cteCap cte); cap_relation c' (cteCap cte'); mdbRevocable (cteMDBNode cte) = r; mdbFirstBadged (cteMDBNode cte') = r' \ \ @@ -242,14 +242,14 @@ lemma can_be_is[CSpace1_R_assms]: apply (auto simp: Let_def)[1] done -lemma maskCap_valid[CSpace1_R_assms, simp]: +lemma maskCap_valid[Arch_assms, simp]: "s \' global.maskCapRights R cap = s \' cap" by (clarsimp simp: valid_cap'_def global.maskCapRights_def isCap_simps capAligned_def X64_H.maskCapRights_def split: capability.split arch_capability.split cong: if_cong) -lemma cap_map_update_data[CSpace1_R_assms]: +lemma cap_map_update_data[Arch_assms]: assumes "cap_relation c c'" shows "cap_relation (update_cap_data p x c) (updateCapData p x c')" proof - @@ -295,7 +295,7 @@ qed sublocale setCTE: typ_at_props' "setCTE c cte" by typ_at_props' -lemma arch_updateCapData_Master[CSpace1_R_assms]: +lemma arch_updateCapData_Master[Arch_assms]: "Arch.updateCapData P d acap \ NullCap \ capMasterCap (Arch.updateCapData P d acap) = capMasterCap (ArchObjectCap acap)" by (cases acap; simp add: X64_H.updateCapData_def split: if_split_asm) @@ -307,28 +307,28 @@ private method updateCapData_cases for c = (rename_tac arch_capability), (case_tac arch_capability; simp add: X64_H.updateCapData_def isCap_simps Let_def) -lemma capASID_update[CSpace1_R_assms, simp]: +lemma capASID_update[Arch_assms, simp]: "capASID (RetypeDecls_H.updateCapData P x c) = capASID c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_vptr_update'[CSpace1_R_assms, simp]: +lemma cap_vptr_update'[Arch_assms, simp]: "cap_vptr' (RetypeDecls_H.updateCapData P x c) = cap_vptr' c" unfolding capASID_def by (updateCapData_cases c) -lemma cap_asid_base_update'[CSpace1_R_assms, simp]: +lemma cap_asid_base_update'[Arch_assms, simp]: "cap_asid_base' (RetypeDecls_H.updateCapData P x c) = cap_asid_base' c" unfolding cap_asid_base'_def by (updateCapData_cases c) -lemma updateCapData_Reply[CSpace1_R_assms, simp]: +lemma updateCapData_Reply[Arch_assms, simp]: "isReplyCap (updateCapData P x c) = isReplyCap c" by (updateCapData_cases c) end (* context private method *) -lemma capASID_mask[CSpace1_R_assms, simp]: +lemma capASID_mask[Arch_assms, simp]: "capASID (maskCapRights x c) = capASID c" unfolding capASID_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -337,7 +337,7 @@ lemma capASID_mask[CSpace1_R_assms, simp]: simp_all add: X64_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_vptr_mask'[CSpace1_R_assms, simp]: +lemma cap_vptr_mask'[Arch_assms, simp]: "cap_vptr' (maskCapRights x c) = cap_vptr' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -346,7 +346,7 @@ lemma cap_vptr_mask'[CSpace1_R_assms, simp]: simp_all add: X64_H.maskCapRights_def isCap_simps Let_def) done -lemma cap_asid_base_mask'[CSpace1_R_assms, simp]: +lemma cap_asid_base_mask'[Arch_assms, simp]: "cap_asid_base' (maskCapRights x c) = cap_asid_base' c" unfolding cap_vptr'_def apply (cases c, simp_all add: global.maskCapRights_def isCap_simps Let_def) @@ -464,7 +464,7 @@ proof - done qed -lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: +lemma set_cap_not_quite_corres_prequel[Arch_assms]: assumes cr: "pspace_relation (kheap s) (ksPSpace s')" "(x,t') \ fst (setCTE p' c' s')" @@ -512,23 +512,23 @@ lemma set_cap_not_quite_corres_prequel[CSpace1_R_assms]: apply (simp add: wf_cs_insert) done -lemma same_region_as_final_matters[CSpace1_R_assms]: +lemma same_region_as_final_matters[Arch_assms]: "\same_region_as c c'; final_matters c\ \ final_matters c'" by (rule ccontr) (simp add: final_matters_def final_matters_arch_def cap_relation_split_asm split: cap.split_asm arch_cap.splits) -lemma same_region_as_arch_gen_refs[CSpace1_R_assms]: +lemma same_region_as_arch_gen_refs[Arch_assms]: "\same_region_as c c'; final_matters c \ \ arch_gen_refs c = arch_gen_refs c'" by (auto simp: final_matters_def cap_relation_split_asm is_cap_simps split: cap.split_asm arch_cap.splits) -lemma arch_same_region_aobj_ref[CSpace1_R_assms]: +lemma arch_same_region_aobj_ref[Arch_assms]: "\arch_same_region_as ac ac'; final_matters_arch ac; final_matters_arch ac'\ \ aobj_ref ac = aobj_ref ac'" by (simp add: final_matters_arch_def split: X64_A.arch_cap.splits) -lemma obj_refs_relation_Master[CSpace1_R_assms]: +lemma obj_refs_relation_Master[Arch_assms]: "cap_relation cap cap' \ obj_refs cap = (if capClass (capMasterCap cap') = PhysicalClass \ \ isUntypedCap (capMasterCap cap') then {capUntypedPtr (capMasterCap cap')} @@ -542,13 +542,13 @@ lemma arch_gen_refs_relation_Master: (case capMasterCap cap' of ArchObjectCap (IOPortCap f l) \ {IOPortRef f} | _ \ {})" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma arch_gen_refs_cap_relation_Master_eq[CSpace1_R_assms]: +lemma arch_gen_refs_cap_relation_Master_eq[Arch_assms]: "\cap_relation c (cteCap cte); capMasterCap (cteCap cte') = capMasterCap (cteCap cte); cap_relation c' (cteCap cte')\ \ arch_gen_refs c = arch_gen_refs c'" by (simp split: cap_relation_split_asm arch_cap.split_asm) -lemma descendants_of_update_ztc[CSpace1_R_assms]: +lemma descendants_of_update_ztc[Arch_assms]: assumes c: "\x. \ m \ x \ slot; \ P \ \ \cte'. m x = Some cte' \ capMasterCap (cteCap cte') \ capMasterCap (cteCap cte) @@ -745,7 +745,7 @@ proof (simp add: descendants_of'_def subset_iff, by simp qed -lemma capRange_cap_relation[CSpace1_R_assms]: +lemma capRange_cap_relation[Arch_assms]: "\ cap_relation cap cap'; capClass cap' = PhysicalClass \ \ capRange cap' = {obj_ref_of cap .. obj_ref_of cap + obj_size cap - 1}" by (simp add: capRange_def objBits_simps' cte_level_bits_def @@ -753,23 +753,23 @@ lemma capRange_cap_relation[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm option.split sum.split) -lemma obj_refs_cap_relation_untyped_ptr[CSpace1_R_assms]: +lemma obj_refs_cap_relation_untyped_ptr[Arch_assms]: "\ cap_relation cap cap'; obj_refs cap \ {} \ \ capUntypedPtr cap' \ obj_refs cap" by (clarsimp split: cap_relation_split_asm arch_cap.split_asm) -lemma ghost_relation_wrapper_same_concrete_set_cap[CSpace1_R_assms]: +lemma ghost_relation_wrapper_same_concrete_set_cap[Arch_assms]: "\ ghost_relation_wrapper s c; ((), s') \ fst (set_cap cap src s) \ \ ghost_relation_wrapper s' c" by (clarsimp simp: ghost_relation_typ_at set_cap_a_type_inv data_at_def) -lemma revokable_plus_orderD[CSpace1_R_assms]: +lemma revokable_plus_orderD[Arch_assms]: "\ isCapRevocable new old; (capBadge old, capBadge new) \ capBadge_ordering P; capMasterCap old = capMasterCap new \ \ (isUntypedCap new \ (\x. capBadge old = Some 0 \ capBadge new = Some x \ x \ 0))" by (clarsimp simp: Retype_H.isCapRevocable_def X64_H.isCapRevocable_def isCap_simps split: if_split_asm capability.split_asm arch_capability.split_asm) -lemma valid_badges_def2[CSpace1_R_assms]: +lemma valid_badges_def2[Arch_assms]: "valid_badges m = (\p p' cap node cap' node'. m p = Some (CTE cap node) \ @@ -786,7 +786,7 @@ lemma valid_badges_def2[CSpace1_R_assms]: apply (case_tac cap; clarsimp simp: gen_isCap_simps) by (fastforce simp: sameRegionAs_def3 isCap_simps arch_capBadge_def)+ -lemma is_cap_revocable_eq[CSpace1_R_assms]: +lemma is_cap_revocable_eq[Arch_assms]: "\ cap_relation c c'; cap_relation src_cap src_cap'; sameRegionAs src_cap' c'; is_untyped_cap src_cap \ \ is_ep_cap c \ \ is_ntfn_cap c\ \ is_cap_revocable c src_cap = isCapRevocable c' src_cap'" @@ -796,10 +796,10 @@ lemma is_cap_revocable_eq[CSpace1_R_assms]: split: cap_relation_split_asm arch_cap.split_asm) done -lemmas use_update_ztc_one_descendants[CSpace1_R_assms] = +lemmas use_update_ztc_one_descendants[Arch_assms] = use_update_ztc_one[OF X64.descendants_of_update_ztc, simplified] -lemma is_derived'_genD[CSpace1_R_assms]: +lemma is_derived'_genD[Arch_assms]: "is_derived' m p cap' cap \ cap' \ NullCap \ \ isZombie cap \ @@ -811,11 +811,11 @@ lemma is_derived'_genD[CSpace1_R_assms]: (isReplyCap cap' \ \ capReplyMaster cap')" by (simp add: X64.is_derived'_def) -lemma acap_relation_capBadge[CSpace1_R_assms]: +lemma acap_relation_capBadge[Arch_assms]: "acap_relation acap acap' \ arch_capBadge acap' = arch_cap_badge acap" by (simp add: arch_capBadge_def) -lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: +lemma obj_relation_cuts_in_obj_range[Arch_assms]: "\ (y, P) \ obj_relation_cuts ko x; x \ obj_range x ko; kheap s x = Some ko; valid_objs s; pspace_aligned s \ \ y \ obj_range x ko" @@ -891,7 +891,7 @@ lemma obj_relation_cuts_in_obj_range[CSpace1_R_assms]: apply (simp add: word_bits_def) done -lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: +lemma isMDBParentOf_CTE_gen[Arch_assms]: "\isArchObjectCap cap \ isMDBParentOf (CTE cap node) cte = (\cap' node'. cte = CTE cap' node' \ sameRegionAs cap cap' @@ -899,19 +899,20 @@ lemma isMDBParentOf_CTE_gen[CSpace1_R_assms]: \ (capBadge cap, capBadge cap') \ capBadge_ordering (mdbFirstBadged node'))" by (simp add: isMDBParentOf_CTE isCap_simps) +lemmas CSpace1_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R?: CSpace1_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace1_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace1_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_2 locale *) -lemma updateMDB_pspace_relation[CSpace1_R_2_assms]: +lemma updateMDB_pspace_relation[Arch_assms]: assumes "(x, s'') \ fst (updateMDB p f s')" assumes "pspace_relation (kheap s) (ksPSpace s')" assumes "pspace_aligned' s'" "pspace_distinct' s'" @@ -969,7 +970,7 @@ lemma cap_asid_cap_relation: "cap_relation c c' \ capASID c' = map_option ucast (cap_asid c)" by (auto simp: capASID_def cap_asid_def split: cap.splits arch_cap.splits option.splits) -lemma is_derived_eq[CSpace1_R_2_assms]: +lemma is_derived_eq[Arch_assms]: "\ cap_relation c c'; cap_relation d d'; cdt_relation (swp cte_at s) (cdt s) (ctes_of s'); cte_at p s \ \ is_derived (cdt s) p c d = is_derived' (ctes_of s') (cte_map p) c' d'" @@ -1022,7 +1023,7 @@ lemma isMDBParentOf_eq_child: apply (clarsimp simp: sameRegionAs_def2 isCap_simps) done -lemma isMDBParentOf_eq[CSpace1_R_2_assms]: +lemma isMDBParentOf_eq[Arch_assms]: "\ isMDBParentOf c d; weak_derived' (cteCap c) (cteCap c'); mdbRevocable (cteMDBNode c') = mdbRevocable (cteMDBNode c); @@ -1067,11 +1068,11 @@ lemma maskedAsFull_revokable: split: arch_capability.splits if_splits) done -lemma arch_mdb_preservation_refl[simp, intro!, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_refl[simp, intro!, Arch_assms]: "arch_mdb_preservation cap cap" by simp -lemma arch_mdb_preservation_sym[CSpace1_R_2_assms]: +lemma arch_mdb_preservation_sym[Arch_assms]: "arch_mdb_preservation cap cap' = arch_mdb_preservation cap' cap" by simp @@ -1079,11 +1080,11 @@ lemma arch_mdb_preservation_non_arch: "\ \isArchObjectCap cap; \isArchObjectCap cap' \ \ arch_mdb_preservation cap cap'" by simp -lemma arch_mdb_preservation_Untyped[simp, CSpace1_R_2_assms]: +lemma arch_mdb_preservation_Untyped[simp, Arch_assms]: "arch_mdb_preservation (UntypedCap d p sz idx) (UntypedCap d' p' sz' idx')" by (simp add: arch_mdb_preservation_non_arch isCap_simps) -lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: +lemma parentOf_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. \m x = Some cte; m' x = Some cte'\ \ @@ -1125,7 +1126,7 @@ lemma parentOf_preserve_oneway[CSpace1_R_2_assms]: apply blast done -lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: +lemma mdb_chunked_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes sameRegion: "\x cte cte'. @@ -1171,7 +1172,7 @@ lemma mdb_chunked_preserve_oneway[CSpace1_R_2_assms]: apply (clarsimp simp:mdb_next_rel_def node) done -lemma valid_badges_preserve_oneway[CSpace1_R_2_assms]: +lemma valid_badges_preserve_oneway[Arch_assms]: assumes dom: "\x. (x \ dom m) = (x \ dom m')" assumes misc: "\x cte cte'. @@ -1232,12 +1233,13 @@ definition \ isArchPageCap cap \ \ isIOPortControlCap' cap" +lemmas CSpace1_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation CSpace1_R_2?: CSpace1_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_2_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace1_R_2_assms)?)) qed (* needed to prove dest_no_parent_n in Arch, then export to mdb_insert_der *) @@ -1368,19 +1370,20 @@ end context Arch begin arch_global_naming -named_theorems CSpace1_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace1_R_3 locale *) -lemmas [CSpace1_R_3_assms] = +lemmas [Arch_assms] = is_derived_maskedAsFull derived_sameRegionAs maskedAsFull_revokable mdb_insert_der.dest_no_parent_n mdb_insert_sib.src_no_mdb_parent mdb_insert_sib.parent_preserved -end +lemmas CSpace1_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace1_R_3?: CSpace1_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace1_R_3_assms)?)) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace1_R_3_assms)?)) qed locale Arch_masterCap = Arch + masterCap diff --git a/proof/refine/X64/ArchCSpace_I.thy b/proof/refine/X64/ArchCSpace_I.thy index 9dfbb4e56e..bbc8c291e4 100644 --- a/proof/refine/X64/ArchCSpace_I.thy +++ b/proof/refine/X64/ArchCSpace_I.thy @@ -16,7 +16,7 @@ abbreviation (input) context Arch begin arch_global_naming -named_theorems CSpace_I_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I locale *) lemma capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (X64_H.ASIDPoolCap r asid) = r" @@ -27,14 +27,14 @@ lemma capUntypedPtr_simps[simp]: "Arch.capUntypedPtr (X64_H.PML4Cap r mapdata5) = r" by (auto simp: X64_H.capUntypedPtr_def) -lemma maskCapRights_allRights[CSpace_I_assms, simp]: +lemma maskCapRights_allRights[Arch_assms, simp]: "maskCapRights allRights c = c" - unfolding global.maskCapRights_def isCap_defs allRights_def maskCapRights_def maskVMRights_def + unfolding global.maskCapRights_def isCap_defs allRights_def X64_H.maskCapRights_def maskVMRights_def by (cases c) (simp_all add: Let_def split: arch_capability.split vmrights.split) -lemma isPhysicalCap[CSpace_I_assms, simp]: +lemma isPhysicalCap[Arch_assms, simp]: "isPhysicalCap cap = (capClass cap = PhysicalClass)" - by (simp add: global.isPhysicalCap_def isPhysicalCap_def + by (simp add: global.isPhysicalCap_def X64_H.isPhysicalCap_def split: capability.split arch_capability.split) definition arch_capMasterCap :: "arch_capability \ arch_capability" where @@ -55,17 +55,17 @@ definition arch_capMasterCap :: "arch_capability \ arch_capability" lemmas arch_capMasterCap_simps[simp] = arch_capMasterCap_def[split_simps arch_capability.split] -lemma acapClass_arch_capMasterCap[CSpace_I_assms,simp]: +lemma acapClass_arch_capMasterCap[Arch_assms,simp]: "acapClass (arch_capMasterCap acap) = acapClass acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma capUntypedPtr_arch_capMasterCap[CSpace_I_assms, simp]: +lemma capUntypedPtr_arch_capMasterCap[Arch_assms, simp]: "Arch.capUntypedPtr (arch_capMasterCap acap) = Arch.capUntypedPtr acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) -lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: +lemma acapBits_arch_capMasterCap[Arch_assms, simp]: "acapBits (arch_capMasterCap acap) = acapBits acap" unfolding arch_capMasterCap_def by (simp split: arch_capability.splits) @@ -73,11 +73,11 @@ lemma acapBits_arch_capMasterCap[CSpace_I_assms, simp]: lemmas isArchFrameCap_simps[simp] = isArchFrameCap_def[split_simps capability.split arch_capability.split] -lemma isArchFrameCap_arch_capMasterCap[CSpace_I_assms, simp]: +lemma isArchFrameCap_arch_capMasterCap[Arch_assms, simp]: "isArchFrameCap (ArchObjectCap (arch_capMasterCap acap)) = isArchFrameCap (ArchObjectCap acap)" by (simp add: arch_capMasterCap_def split: arch_capability.split) -lemma isArchFrameCap_non_arch[CSpace_I_assms]: +lemma isArchFrameCap_non_arch[Arch_assms]: "\is_ArchObjectCap cap \ isArchFrameCap cap = False" by (simp add: isArchFrameCap_def is_ArchObjectCap_def split: capability.split) @@ -100,18 +100,19 @@ lemma arch_capBadge_def: "arch_capBadge acap = None" by (cases acap; simp) -end +lemmas CSpace_I_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I?: CSpace_I X64.arch_capMasterCap X64.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace_I_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_I_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_I_2 locale *) (* for the Arch locale we want the fully expanded version covering all cases, but avoiding the capMasterCap_ArchObjectCap rewrite case for an unspecified ArchObjectCap *) @@ -121,7 +122,7 @@ lemmas capMasterCap_simps[simp] = capMasterCap_def[simplified arch_capMasterCap_def, split_simps capability.split arch_capability.split] -lemma isArchFrameCap_capMasterCap[CSpace_I_2_assms, simp]: +lemma isArchFrameCap_capMasterCap[Arch_assms, simp]: "isArchFrameCap (capMasterCap cap) = isArchFrameCap cap" by (simp add: isArchFrameCap_def split: capability.split arch_capability.split) @@ -158,7 +159,7 @@ lemmas arch_capMasterCap_eqDs[dest!] = arch_capMasterCap_eqDs1 arch_capMasterCap lemma capUntypedSize_capBits: "capClass cap = PhysicalClass \ capUntypedSize cap = 2 ^ (capBits cap)" - by (fastforce simp: global.capUntypedSize_def objBits_simps bit_simps' capUntypedSize_def + by (fastforce simp: global.capUntypedSize_def objBits_simps bit_simps' X64_H.capUntypedSize_def split: capability.splits arch_capability.splits zombie_type.splits) (* unused in this architecture *) @@ -236,7 +237,7 @@ lemma sameRegionAsE: \ \ R" by (simp add: sameRegionAs_def3, fastforce) -lemma sameObjectAsE[CSpace_I_2_assms]: +lemma sameObjectAsE[Arch_assms]: "\ sameObjectAs cap cap'; \ capMasterCap cap = capMasterCap cap'; \ isNullCap cap; \ isZombie cap; \ isUntypedCap cap; @@ -247,7 +248,7 @@ lemma sameObjectAs_sameRegionAs: "sameObjectAs cap cap' \ sameRegionAs cap cap'" by (clarsimp simp add: sameObjectAs_def2 sameRegionAs_def2 isCap_simps) -lemma sameObjectAs_sym[CSpace_I_2_assms]: +lemma sameObjectAs_sym[Arch_assms]: "sameObjectAs c d = sameObjectAs d c" by (auto simp: sameObjectAs_def2) @@ -257,17 +258,17 @@ lemma sameObject_capRange: apply (clarsimp simp: sameObjectAs_def2) done -lemma sameRegionAs_Null[CSpace_I_2_assms, simp]: +lemma sameRegionAs_Null[Arch_assms, simp]: "sameRegionAs c NullCap = False" "sameRegionAs NullCap c = False" by (simp add: sameRegionAs_def3 capRange_def isCap_simps)+ -lemma sameRegionAs_classes[CSpace_I_2_assms]: +lemma sameRegionAs_classes[Arch_assms]: "sameRegionAs cap cap' \ capClass cap = capClass cap'" by (erule sameRegionAsE, rule master_eqI) (clarsimp simp: capRange_def isCap_simps intro!: capClass_Master split: if_split_asm)+ -lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: +lemma sameRegionAs_capRange_Int[Arch_assms]: "\ sameRegionAs cap cap'; capClass cap = PhysicalClass \ capClass cap' = PhysicalClass; capAligned cap; capAligned cap' \ \ capRange cap' \ capRange cap \ {}" @@ -279,26 +280,26 @@ lemma sameRegionAs_capRange_Int[CSpace_I_2_assms]: apply (fastforce simp: capRange_Master isCap_simps)+ done -lemma sameRegionAs_trans[CSpace_I_2_assms]: +lemma sameRegionAs_trans[Arch_assms]: "\ sameRegionAs a b; sameRegionAs b c \ \ sameRegionAs a c" by (simp add: sameRegionAs_def2, elim conjE disjE) (auto simp: isCap_simps capRange_def) (* long *) -lemma capMasterCap_maskCapRights[simp, CSpace_I_2_assms]: +lemma capMasterCap_maskCapRights[simp, Arch_assms]: "capMasterCap (maskCapRights msk cap) = capMasterCap cap" apply (cases cap; simp add: global.maskCapRights_def Let_def isCap_simps capMasterCap_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: X64_H.maskCapRights_def Let_def isCap_simps) done -lemma capBadge_maskCapRights[simp, CSpace_I_2_assms]: +lemma capBadge_maskCapRights[simp, Arch_assms]: "capBadge (maskCapRights msk cap) = capBadge cap" apply (cases cap; simp add: global.maskCapRights_def Let_def gen_isCap_simps capBadge_def) apply (rename_tac arch_capability) - apply (case_tac arch_capability; simp add: maskCapRights_def Let_def isCap_simps) + apply (case_tac arch_capability; simp add: X64_H.maskCapRights_def Let_def isCap_simps) done -lemma cte_refs_capRange[CSpace_I_2_assms]: +lemma cte_refs_capRange[Arch_assms]: "\ s \' c; \irq. c \ IRQHandlerCap irq \ \ cte_refs' c x \ capRange c" apply (cases c; simp add: capRange_def gen_isCap_simps) apply (clarsimp dest!: valid_capAligned @@ -369,15 +370,15 @@ lemma cte_refs_capRange[CSpace_I_2_assms]: apply (simp add: word_bits_def) done -lemma capBits_Master[CSpace_I_2_assms]: +lemma capBits_Master[Arch_assms]: "capBits (capMasterCap cap) = capBits cap" by (clarsimp simp: capMasterCap_def split: capability.split arch_capability.split) -lemma capUntyped_Master[CSpace_I_2_assms]: +lemma capUntyped_Master[Arch_assms]: "capUntypedPtr (capMasterCap cap) = capUntypedPtr cap" by (clarsimp simp: capMasterCap_def X64_H.capUntypedPtr_def split: capability.split arch_capability.split) -lemma distinct_zombies_copyMasterE[CSpace_I_2_assms]: +lemma distinct_zombies_copyMasterE[Arch_assms]: "\ distinct_zombies m; m x = Some cte; capClass (cteCap cte') = PhysicalClass \ capMasterCap (cteCap cte) = capMasterCap (cteCap cte'); @@ -399,22 +400,23 @@ lemmas distinct_zombies_sameMasterE = distinct_zombies_copyMasterE[where x=x and y=x for x, simplified, OF _ _ _] -declare distinct_zombies_sameMasterE[CSpace_I_2_assms] +declare distinct_zombies_sameMasterE[Arch_assms] crunch setCTE for pspace_in_kernel_mappings'[wp]: "pspace_in_kernel_mappings'" -lemma cap_table_at_gsCNodes_eq[CSpace_I_2_assms]: +lemma cap_table_at_gsCNodes_eq[Arch_assms]: "(s, s') \ state_relation \ (gsCNodes s' ptr = Some bits) = cap_table_at bits ptr s" by (fastforce simp: state_relation_def ghost_relation_def obj_at_def is_cap_table) -end +lemmas CSpace_I_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_I_2?: CSpace_I_2 X64.arch_capMasterCap X64.arch_capBadge proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_I_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace_I_2_assms)?)?) qed (* Arch constant definitions required to exist for sane locales in CSpace1_R *) diff --git a/proof/refine/X64/ArchCSpace_R.thy b/proof/refine/X64/ArchCSpace_R.thy index c69953a9c1..beedd0e98f 100644 --- a/proof/refine/X64/ArchCSpace_R.thy +++ b/proof/refine/X64/ArchCSpace_R.thy @@ -13,12 +13,12 @@ begin context Arch begin arch_global_naming -named_theorems CSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R locale *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = arch_deriveCap_corres arch_deriveCap_inv arch_deriveCap_valid -lemma capAligned_master[CSpace_R_assms]: +lemma capAligned_master[Arch_assms]: "\capAligned cap; capMasterCap cap = capMasterCap ncap\ \ capAligned ncap" apply (case_tac cap) apply (clarsimp simp: capAligned_def)+ @@ -36,7 +36,7 @@ sublocale updateCap: typ_at_props' "updateCap slot newCap" sublocale cteInsert: typ_at_props' "cteInsert newCap srcSlot destSlot" by typ_at_props' -lemma maskedAsFull_derived'[CSpace_R_assms]: +lemma maskedAsFull_derived'[Arch_assms]: "\m src = Some (CTE s_cap s_node); is_derived' m ptr b c\ \ is_derived' (m(src \ CTE (maskedAsFull s_cap cap) s_node)) ptr b c" apply (subgoal_tac "m(src \ CTE (maskedAsFull s_cap cap) s_node) @@ -51,21 +51,21 @@ lemma maskedAsFull_derived'[CSpace_R_assms]: apply (clarsimp simp:modify_map_def) done -lemma capMaster_capRange[CSpace_R_assms]: +lemma capMaster_capRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ capRange c = capRange c'" by (simp add: capMasterCap_def arch_capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_untypedRange[CSpace_R_assms]: +lemma capMaster_untypedRange[Arch_assms]: "capMasterCap c = capMasterCap c' \ untypedRange c = untypedRange c'" by (simp add: capMasterCap_def capRange_def split: capability.splits arch_capability.splits) -lemma capMaster_capClass[CSpace_R_assms]: +lemma capMaster_capClass[Arch_assms]: "capMasterCap c = capMasterCap c' \ capClass c = capClass c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma valid_arch_badges_mdbPrev_update[simp, CSpace_R_assms]: +lemma valid_arch_badges_mdbPrev_update[simp, Arch_assms]: "valid_arch_badges cap cap' (mdbPrev_update f node) = valid_arch_badges cap cap' node" by (simp add: valid_arch_badges_def) @@ -74,19 +74,19 @@ lemma valid_arch_badges_master_eq: valid_arch_badges src_cap cap' node = valid_arch_badges cap cap' node" by (auto simp: valid_arch_badges_def isCap_simps) -lemma valid_arch_badges_firstBadged[CSpace_R_assms]: +lemma valid_arch_badges_firstBadged[Arch_assms]: "\ valid_arch_badges cap cap' node; mdbFirstBadged node = mdbFirstBadged node' \ \ valid_arch_badges cap cap' node'" by (simp add: valid_arch_badges_def) -lemma valid_arch_badges_master[CSpace_R_assms]: +lemma valid_arch_badges_master[Arch_assms]: "\capMasterCap src_cap = capMasterCap cap; (capBadge src_cap, capBadge cap) \ capBadge_ordering False; valid_arch_badges src_cap cap' node\ \ valid_arch_badges cap cap' node" by (clarsimp simp: valid_arch_badges_def isCap_simps) -lemma badge_derived'_capRange[CSpace_R_assms]: +lemma badge_derived'_capRange[Arch_assms]: "badge_derived' cap src_cap \ capRange cap = capRange src_cap" apply (clarsimp simp: badge_derived'_def) apply (case_tac cap; clarsimp simp: gen_isCap_simps capRange_def) @@ -94,21 +94,21 @@ lemma badge_derived'_capRange[CSpace_R_assms]: apply (case_tac arch_capability; clarsimp simp: isCap_simps capRange_def) done -lemma valid_arch_badges_non_arch[CSpace_R_assms]: +lemma valid_arch_badges_non_arch[Arch_assms]: "\ \isArchObjectCap c; \isArchObjectCap c' \ \ valid_arch_badges c c' node" by (clarsimp simp add: valid_arch_badges_def isCap_simps) -lemma capMasterCap_valid_arch_badges_isCapRevocable[CSpace_R_assms]: +lemma capMasterCap_valid_arch_badges_isCapRevocable[Arch_assms]: "capMasterCap src_cap = capMasterCap cap \ valid_arch_badges src_cap cap (MDB word1 src (Arch.isCapRevocable cap src_cap) (Arch.isCapRevocable cap src_cap))" by (clarsimp simp add: valid_arch_badges_def) -lemma setCTE_valid_arch[CSpace_R_assms, wp]: +lemma setCTE_valid_arch[Arch_assms, wp]: "setCTE p c \valid_arch_state'\" by (wp valid_arch_state_lift' setCTE_typ_at') -lemma setCTE_global_refs[CSpace_R_assms, wp]: +lemma setCTE_global_refs[Arch_assms, wp]: "setCTE p c \\s. P (global_refs' s)\" apply (simp add: setCTE_def setObject_def split_def updateObject_cte global_refs'_def) apply (wpsimp+; auto) @@ -119,7 +119,7 @@ crunch cteInsert (wp: crunch_wps simp: cte_wp_at_ctes_of) crunch cteInsert - for valid_arch_state'[CSpace_R_assms, wp]: valid_arch_state' + for valid_arch_state'[Arch_assms, wp]: valid_arch_state' (wp: crunch_wps) lemmas cap_ioports'_simps[simp] = cap_ioports'_def[split_simps capability.split arch_capability.split] @@ -138,11 +138,11 @@ lemma not_ioport_cap_safe_ioport_insert'[simp]: "\isArchIOPortCap cap \ safe_ioport_insert' cap cap' s" by (clarsimp simp: safe_ioport_insert'_def isCap_simps) -lemma acapClass_not_Reply[CSpace_R_assms]: +lemma acapClass_not_Reply[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) -lemma isArchMDBParentOf_non_arch[CSpace_R_assms]: +lemma isArchMDBParentOf_non_arch[Arch_assms]: "\isArchObjectCap cap \ isArchMDBParentOf cap cap' b" "\isArchObjectCap cap' \ isArchMDBParentOf cap cap' b" by (simp add: isCap_simps)+ @@ -305,7 +305,7 @@ context Arch begin arch_global_naming (* since these are not used after this theory, drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [CSpace_R_assms] = +lemmas [Arch_assms] = Arch_mdb_insert.chunked_n[simplified Arch_mdb_insert_def] Arch_mdb_insert_sib.untyped_inc_n[simplified Arch_mdb_insert_sib_def] Arch_mdb_move.parent_preserved[simplified Arch_mdb_move_def] @@ -315,21 +315,22 @@ crunch cteInsert for pspace_in_kernel_mappings'[wp]: pspace_in_kernel_mappings' (wp: crunch_wps) -lemmas [CSpace_R_assms] = cteInsert_pspace_in_kernel_mappings' +lemmas [Arch_assms] = cteInsert_pspace_in_kernel_mappings' -end +lemmas CSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R?: CSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems CSpace_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_2 locale *) -lemma deriveCap_derived[CSpace_R_2_assms]: +lemma deriveCap_derived[Arch_assms]: "\\s. c'\ capability.NullCap \ cte_wp_at' (\cte. badge_derived' c' (cteCap cte) \ capASID c' = capASID (cteCap cte) \ cap_asid_base' c' = cap_asid_base' (cteCap cte) @@ -359,7 +360,7 @@ lemma deriveCap_derived[CSpace_R_2_assms]: | clarsimp split: option.split_asm)+) done -lemma arch_deriveCap_untyped_derived[CSpace_R_2_assms, wp]: +lemma arch_deriveCap_untyped_derived[Arch_assms, wp]: "\\s. cte_wp_at' (\cte. untyped_derived_eq c' (cteCap cte)) slot s\ X64_H.deriveCap slot (capCap c') \\rv s. cte_wp_at' (untyped_derived_eq rv o cteCap) slot s\, -" @@ -403,7 +404,7 @@ crunch setupReplyMaster for valid_arch'[wp]: "valid_arch_state'" (wp: crunch_wps simp: crunch_simps) -lemma ex_nonz_tcb_cte_caps'[CSpace_R_2_assms]: +lemma ex_nonz_tcb_cte_caps'[Arch_assms]: "\ex_nonz_cap_to' t s; tcb_at' t s; valid_objs' s; sl \ dom tcb_cte_cases\ \ ex_cte_cap_to' (t + sl) s" apply (clarsimp simp: ex_nonz_cap_to'_def ex_cte_cap_to'_def cte_wp_at_ctes_of) @@ -430,7 +431,7 @@ lemma ex_nonz_cap_not_global': apply (clarsimp simp: ctes_of_valid_cap') done -lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: +lemma setupReplyMaster_invs'[Arch_assms, wp]: "\invs' and tcb_at' t and ex_nonz_cap_to' t\ setupReplyMaster t \\rv. invs'\" @@ -445,7 +446,7 @@ lemma setupReplyMaster_invs'[CSpace_R_2_assms, wp]: ex_nonz_cap_not_global' dom_def) done -lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: +lemma arch_update_setCTE_mdb[Arch_assms]: "\cte_wp_at' (is_arch_update' cap) p and cte_wp_at' ((=) oldcte) p and valid_mdb'\ setCTE p (cteCap_update (\_. cap) oldcte) \\rv. valid_mdb'\" @@ -568,19 +569,19 @@ lemma arch_update_setCTE_mdb[CSpace_R_2_assms]: apply (clarsimp simp add: is_arch_update'_def isCap_simps) done -lemma capMaster_zobj_refs[CSpace_R_2_assms]: +lemma capMaster_zobj_refs[Arch_assms]: "capMasterCap c = capMasterCap c' \ zobj_refs' c = zobj_refs' c'" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.splits arch_capability.splits) -lemma zobj_refs_Master[CSpace_R_2_assms]: +lemma zobj_refs_Master[Arch_assms]: "zobj_refs' (capMasterCap cap) = zobj_refs' cap" by (simp add: capMasterCap_def arch_capMasterCap_def split: capability.split arch_capability.split) -lemmas [CSpace_R_2_assms] = setCTE_pspace_in_kernel_mappings' +lemmas [Arch_assms] = setCTE_pspace_in_kernel_mappings' -lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: +lemma setUntypedCapAsFull_safe_parent_for'[Arch_assms]: "\\s. safe_parent_for' (ctes_of s) slot a \ cte_wp_at' ((=) srcCTE) slot s\ setUntypedCapAsFull (cteCap srcCTE) c' slot \\rv s. safe_parent_for' (ctes_of s) slot a\" @@ -600,7 +601,7 @@ lemma setUntypedCapAsFull_safe_parent_for'[CSpace_R_2_assms]: apply simp done -lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: +lemma maskedAsFull_revokable_safe_parent[Arch_assms]: "\is_simple_cap' c'; safe_parent_for' m p c'; m p = Some cte; cteCap cte = (maskedAsFull src_cap' a)\ \ isCapRevocable c' (maskedAsFull src_cap' a) = isCapRevocable c' src_cap'" @@ -609,7 +610,7 @@ lemma maskedAsFull_revokable_safe_parent[CSpace_R_2_assms]: apply (auto simp: isCap_simps is_simple_cap'_def) done -lemma setUntypedCapAsFull_archMDBAssertions[CSpace_R_2_assms, wp]: +lemma setUntypedCapAsFull_archMDBAssertions[Arch_assms, wp]: "setUntypedCapAsFull src_cap cap p \archMDBAssertions\" unfolding setUntypedCapAsFull_def archMDBAssertions_def updateCap_def apply (wpsimp wp: getCTE_wp') @@ -617,7 +618,7 @@ lemma setUntypedCapAsFull_archMDBAssertions[CSpace_R_2_assms, wp]: apply (clarsimp simp: arch_mdb_assert_def cte_wp_at_ctes_of isCap_simps split: if_split_asm) done -lemma sameRegion_capRange_sub[CSpace_R_2_assms]: +lemma sameRegion_capRange_sub[Arch_assms]: "sameRegionAs cap cap' \ capRange cap' \ capRange cap" apply (clarsimp simp: sameRegionAs_def2 gen_isCap_Master arch_isCap_Master capRange_Master cong: conj_cong) @@ -625,7 +626,7 @@ lemma sameRegion_capRange_sub[CSpace_R_2_assms]: apply (fastforce simp: isCap_simps capRange_def split: if_split_asm) done -lemma capRange_sameRegionAs[CSpace_R_2_assms]: +lemma capRange_sameRegionAs[Arch_assms]: "\ sameRegionAs x y; s \' y; capClass x = PhysicalClass \ capClass y = PhysicalClass \ \ capRange x \ capRange y \ {}" apply (erule sameRegionAsE) @@ -642,7 +643,7 @@ lemma capRange_sameRegionAs[CSpace_R_2_assms]: apply (clarsimp simp: isCap_simps)+ done -lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: +lemma safe_parent_for_capRange_capBits[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ capRange (cteCap cte) \ capBits cap \ capBits (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) @@ -652,7 +653,7 @@ lemma safe_parent_for_capRange_capBits[CSpace_R_2_assms]: capMasterCap_def capRange_Master objBits_simps split: capability.splits arch_capability.splits) -lemma safe_parent_for_descendants'[CSpace_R_2_assms]: +lemma safe_parent_for_descendants'[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE pcap n); isUntypedCap pcap \ \ descendants_of' p m = {}" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) @@ -664,7 +665,7 @@ lemma safe_parent_not_ntfn': "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ \isNotificationCap src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps) -lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_untypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ untypedRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -682,7 +683,7 @@ lemma safe_parent_for_untypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: +lemma safe_parent_for_capUntypedRange[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some cte \ \ capRange cap \ untypedRange (cteCap cte)" apply (clarsimp simp: safe_parent_for'_def safe_parent_for_arch'_def) apply (erule disjE) @@ -697,14 +698,14 @@ lemma safe_parent_for_capUntypedRange[CSpace_R_2_assms]: apply (clarsimp simp: gen_isCap_Master isCap_simps) done -lemma safe_parent_capClass[CSpace_R_2_assms]: +lemma safe_parent_capClass[Arch_assms]: "\ safe_parent_for' m p cap; m p = Some (CTE src_cap n) \ \ capClass cap = capClass src_cap" by (auto simp: safe_parent_for'_def safe_parent_for_arch'_def isCap_simps sameRegionAs_def2 capRange_Master capRange_def capMasterCap_def split: capability.splits arch_capability.splits) (* Generic-only parts of is_simple_cap'. isArchFrameCap appears on all architectures and so is safe. *) -lemma is_simple_cap'_genD[CSpace_R_2_assms]: +lemma is_simple_cap'_genD[Arch_assms]: "is_simple_cap' cap \ cap \ NullCap \ cap \ IRQControlCap \ \ isUntypedCap cap \ \ isReplyCap cap \ \ isEndpointCap cap \ \ isNotificationCap cap \ \ isThreadCap cap \ \ isCNodeCap cap \ @@ -782,14 +783,15 @@ end context Arch begin arch_global_naming -lemmas [CSpace_R_2_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child +lemmas [Arch_assms] = mdb_insert_simple.dest_no_parent_n mdb_insert_simple.new_child -end +lemmas CSpace_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_2?: CSpace_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace_R_2_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales @@ -1144,18 +1146,18 @@ end (* Arch_mdb_insert_simple' *) context Arch begin arch_global_naming -named_theorems CSpace_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for CSpace_R_3 locale *) (* since mdb_insert_simple' is not used after this theory, drop the Arch assumption directly instead of requalifying *) -lemmas [CSpace_R_3_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] +lemmas [Arch_assms] = Arch_mdb_insert_simple'.mdb[simplified Arch_mdb_insert_simple'_def] -lemmas [CSpace_R_3_assms] = +lemmas [Arch_assms] = updateCap_valid_arch_state' master_cap_relation updateMDB_pspace_in_kernel_mappings' -lemma derived'_not_Null[CSpace_R_3_assms, simp]: +lemma derived'_not_Null[Arch_assms, simp]: "\ is_derived' m p c capability.NullCap" "\ is_derived' m p capability.NullCap c" by (clarsimp simp: is_derived'_def badge_derived'_def)+ @@ -1168,7 +1170,7 @@ lemma cte_refs_maskCapRights[simp]: split del: if_split split: arch_capability.split) -lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: +lemma ghost_relation_wrapper_set_cap_setCTE[Arch_assms]: "\ ghost_relation_wrapper a c; ((), c') \ fst (setCTE (cte_map slot) (cteCap_update (\_. cap') rv) c); ((), a') \ fst (set_cap cap slot a)\ @@ -1179,12 +1181,13 @@ lemma ghost_relation_wrapper_set_cap_setCTE[CSpace_R_3_assms]: apply (frule use_valid[OF _ setCTE_gsCNodes]; simp) done -end +lemmas CSpace_R_3_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation CSpace_R_3?: CSpace_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact CSpace_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.CSpace_R_3_assms)?)?) qed (* transfer facts from partial locales (with extra assumptions) into complete locales diff --git a/proof/refine/X64/ArchDetype_R.thy b/proof/refine/X64/ArchDetype_R.thy index 46e8e06fa2..a47d356cb8 100644 --- a/proof/refine/X64/ArchDetype_R.thy +++ b/proof/refine/X64/ArchDetype_R.thy @@ -218,9 +218,9 @@ end (* detype_locale' *) context Arch begin arch_global_naming -named_theorems Detype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R locale *) -lemma deleteObjects_corres[Detype_R_assms]: +lemma deleteObjects_corres[Arch_assms]: "\ is_aligned base magnitude; magnitude \ word_size_bits \ \ corres dc (\s. einvs s @@ -408,7 +408,7 @@ context Arch begin arch_global_naming Not all of them need to deal with these arch details, so if the def2/def3 lemmas can be generalised or wrapped, some of the lemmas in this block can become generic. *) -lemma deleteObjects_null_filter[Detype_R_assms]: +lemma deleteObjects_null_filter[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -428,7 +428,7 @@ lemma deleteObjects_null_filter[Detype_R_assms]: apply (unfold_locales, simp_all) done -lemma deleteObjects_invs'[Detype_R_assms]: +lemma deleteObjects_invs'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -460,7 +460,7 @@ proof - done qed -lemma deleteObjects_st_tcb_at'[Detype_R_assms]: +lemma deleteObjects_st_tcb_at'[Arch_assms]: "\cte_wp_at' (\c. cteCap c = UntypedCap d ptr bits idx) p and invs' and ct_active' and sch_act_simple and (\s. descendants_range' (UntypedCap d ptr bits idx) p (ctes_of s)) @@ -515,7 +515,7 @@ lemma deleteObjects_cap_to': apply (simp add: delete_locale_def) done -lemma deleteObject_no_overlap[Detype_R_assms, wp]: +lemma deleteObject_no_overlap[Arch_assms, wp]: "\valid_cap' (UntypedCap d ptr bits idx) and valid_pspace'\ deleteObjects ptr bits \\_ s. pspace_no_overlap' ptr bits s\" @@ -534,7 +534,7 @@ lemma deleteObject_no_overlap[Detype_R_assms, wp]: apply simp done -lemma deleteObjects_cte_wp_at'[Detype_R_assms]: +lemma deleteObjects_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ p \ mask_range ptr bits \ s \' (UntypedCap d ptr bits idx) \ valid_pspace' s\ deleteObjects ptr bits @@ -553,13 +553,13 @@ lemma deleteObjects_cte_wp_at'[Detype_R_assms]: apply (case_tac s, simp) done -lemma deleteObjects_nosch[wp, Detype_R_assms]: +lemma deleteObjects_nosch[wp, Arch_assms]: "deleteObjects ptr sz \\s. P (ksSchedulerAction s)\" by (simp add: deleteObjects_def3 | wp hoare_drop_imp)+ lemmas getObjSize_simps = X64_H.getObjectSize_def[split_simps X64_H.object_type.split apiobject_type.split] -lemma createObject_cte_wp_at'[Detype_R_assms]: +lemma createObject_cte_wp_at'[Arch_assms]: "\\s. Types_H.getObjectSize ty us < word_bits \ is_aligned ptr (Types_H.getObjectSize ty us) \ pspace_no_overlap' ptr (Types_H.getObjectSize ty us) s \ @@ -1301,7 +1301,7 @@ lemma placeNewObject_pml4_at': apply simp done -lemma createObject_setCTE_commute[Detype_R_assms]: +lemma createObject_setCTE_commute[Arch_assms]: "monad_commute (cte_wp_at' (\_. True) src and pspace_aligned' and pspace_distinct' and @@ -1395,7 +1395,7 @@ lemma copyGlobalMappings_gsUntypedZeroRanges_commute': apply simp done -lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: +lemma createObject_gsUntypedZeroRanges_commute[Arch_assms]: "monad_commute \ (RetypeDecls_H.createObject ty ptr us dev) @@ -1419,24 +1419,25 @@ lemma createObject_gsUntypedZeroRanges_commute[Detype_R_assms]: apply (simp add: curDomain_def monad_commute_def exec_modify exec_gets) done -lemma createNewCaps_not_nc[Detype_R_assms]: +lemma createNewCaps_not_nc[Arch_assms]: "\\\ createNewCaps ty ptr n us d \\r s. (\cap\set r. cap \ capability.NullCap)\" unfolding createNewCaps_def Arch_createNewCaps_def by (wpsimp simp: Arch_createNewCaps_def split_del: if_split)+ +lemmas Detype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R?: Detype_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Detype_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Detype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Detype_R_2 locale *) lemma copyGlobalMappings_pspace_no_overlap': "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz\ @@ -1448,7 +1449,7 @@ lemma copyGlobalMappings_pspace_no_overlap': apply clarsimp done -lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: +lemma createNewCaps_pspace_no_overlap'[Arch_assms]: "\\s. range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n)) \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ ptr \ 0\ @@ -1501,7 +1502,7 @@ lemma createNewCaps_pspace_no_overlap'[Detype_R_2_assms]: | assumption | clarsimp simp: word_bits_def | intro conjI range_cover_le[where n = "Suc n"] range_cover.aligned)+) -lemma createNewCaps_ret_len[Detype_R_2_assms]: +lemma createNewCaps_ret_len[Arch_assms]: "\K (n < 2 ^ word_bits \ n \ 0)\ createNewCaps ty ptr n us d \\rv s. n = length rv\" @@ -1619,7 +1620,7 @@ lemma createObjects'_page_map_l4_at': apply (case_tac arch_kernel_object; simp) done -lemma createNewCaps_Cons[Detype_R_2_assms]: +lemma createNewCaps_Cons[Arch_assms]: assumes cover:"range_cover ptr sz (Types_H.getObjectSize ty us) (Suc (Suc n))" and "valid_pspace' s" "valid_arch_state' s" and "pspace_no_overlap' ptr sz s" @@ -1989,7 +1990,7 @@ proof - done qed -lemma createObject_def2[Detype_R_2_assms]: +lemma createObject_def2[Arch_assms]: "(RetypeDecls_H.createObject ty ptr us dev >>= (\x. return [x])) = createNewCaps ty ptr (Suc 0) us dev" apply (clarsimp simp: global.createObject_def createNewCaps_def placeNewObject_def2) @@ -2009,7 +2010,7 @@ lemma createObject_def2[Detype_R_2_assms]: storeWordVM_def)+ done -lemma ArchCreateObject_pspace_no_overlap'[Detype_R_2_assms]: +lemma ArchCreateObject_pspace_no_overlap'[Arch_assms]: "\\s. pspace_no_overlap' (ptr + (of_nat n << APIType_capBits ty userSize)) sz s \ pspace_aligned' s \ pspace_distinct' s \ @@ -2084,12 +2085,13 @@ lemma createObject_pspace_aligned_distinct': split: X64_H.object_type.splits apiobject_type.splits) done +lemmas Detype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Detype_R_2?: Detype_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Detype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Detype_R_2_assms)?)?) qed end diff --git a/proof/refine/X64/ArchEmptyFail.thy b/proof/refine/X64/ArchEmptyFail.thy index 464f988c90..946d4e4292 100644 --- a/proof/refine/X64/ArchEmptyFail.thy +++ b/proof/refine/X64/ArchEmptyFail.thy @@ -10,21 +10,22 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_R locale *) -lemma empty_fail_lookupIPCBuffer[EmptyFail_R_assms]: +lemma empty_fail_lookupIPCBuffer[Arch_assms]: "empty_fail (lookupIPCBuffer r t)" by (clarsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv split: capability.splits arch_capability.splits | wp | wpc | safe)+ declare setRegister_empty_fail[intro!, simp] (* FIXME: tag original instead *) -end +lemmas EmptyFail_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation EmptyFail_R?: EmptyFail_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact EmptyFail_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.EmptyFail_R_assms)?) qed end diff --git a/proof/refine/X64/ArchEmptyFail_H.thy b/proof/refine/X64/ArchEmptyFail_H.thy index 4ca32c58bc..8f53b97cb2 100644 --- a/proof/refine/X64/ArchEmptyFail_H.thy +++ b/proof/refine/X64/ArchEmptyFail_H.thy @@ -11,9 +11,9 @@ begin context Arch begin arch_global_naming -named_theorems EmptyFail_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H locale *) -lemma arch_deriveCap_empty_fail[EmptyFail_H_assms, intro!, wp, simp]: +lemma arch_deriveCap_empty_fail[Arch_assms, intro!, wp, simp]: "empty_fail (Arch.deriveCap x y)" unfolding X64_H.deriveCap_def by (cases y, auto simp: isCap_simps cong: if_cong) @@ -45,7 +45,7 @@ crunch decodeX64MMUInvocation, decodeX64PortInvocation crunch Arch_finaliseCap, Arch.switchToThread, Arch.switchToIdleThread, prepareNextDomain, getRestartPC, makeArchFaultMessage - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (rule: X64_H.finaliseCap_def) lemma empty_fail_portIn[intro!, wp, simp]: @@ -62,32 +62,34 @@ crunch handleArchFaultReply, prepareSetDomain, postModifyRegisters, postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler, Arch.performInvocation, handleSpuriousIRQ, maskIrqSignal, handleVMFault, checkIRQ, prepareThreadDelete, Arch.postCapDeletion - for (empty_fail) empty_fail[EmptyFail_H_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H?: EmptyFail_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.EmptyFail_H_assms)?)?) qed context Arch begin arch_global_naming -named_theorems EmptyFail_H_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for EmptyFail_H_2 locale *) crunch handleReservedIRQ, handleHypervisorFault - for (empty_fail) empty_fail[EmptyFail_H_2_assms, intro!, wp, simp] + for (empty_fail) empty_fail[Arch_assms, intro!, wp, simp] (simp: Let_def) +lemmas EmptyFail_H_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation EmptyFail_H_2?: EmptyFail_H_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact EmptyFail_H_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.EmptyFail_H_2_assms)?)?) qed crunch callKernel diff --git a/proof/refine/X64/ArchFinalise_R.thy b/proof/refine/X64/ArchFinalise_R.thy index e0566582f4..9f5efde342 100644 --- a/proof/refine/X64/ArchFinalise_R.thy +++ b/proof/refine/X64/ArchFinalise_R.thy @@ -12,9 +12,9 @@ begin context Arch begin arch_global_naming -named_theorems Finalise_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R locale *) -lemma arch_postCapDeletion_ksArchState_lift[Finalise_R_assms]: +lemma arch_postCapDeletion_ksArchState_lift[Arch_assms]: "\\s as. P (s\ksArchState := as\) = P s\ \ Arch.postCapDeletion ac \P\" unfolding postCapDeletion_def freeIOPortRange_def setIOPortMask_def by wpsimp @@ -23,7 +23,7 @@ sublocale clearUntypedFreeIndex: typ_at_props' "clearUntypedFreeIndex slot" by typ_at_props' crunch setIRQState - for umm[Finalise_R_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" + for umm[Arch_assms, wp]: "\s. P (underlying_memory (ksMachineState s))" (wp: dmo_lift') lemma setIOPortMask_valid_arch'[wp]: @@ -70,7 +70,7 @@ lemma set_ioport_mask_corres[corres]: apply wpsimp+ done -lemma arch_postCapDeletion_corres[Finalise_R_assms]: +lemma arch_postCapDeletion_corres[Arch_assms]: "acap_relation cap cap' \ corres dc \ \ (arch_post_cap_deletion cap) (X64_H.postCapDeletion cap')" apply (clarsimp simp: arch_post_cap_deletion_def X64_H.postCapDeletion_def) apply (rule corres_guard_imp) @@ -85,16 +85,16 @@ abbreviation (input) "Arch_finaliseCap \ Arch.finaliseCap" crunch Arch_finaliseCap, prepareThreadDelete, archThreadSet - for typ_at'[Finalise_R_assms, wp]: "\s. P (typ_at' T p s)" - and aligned'[Finalise_R_assms, wp]: "pspace_aligned'" - and distinct'[Finalise_R_assms, wp]: "pspace_distinct'" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" + and aligned'[Arch_assms, wp]: "pspace_aligned'" + and distinct'[Arch_assms, wp]: "pspace_distinct'" (wp: crunch_wps getObject_inv loadObject_default_inv simp: crunch_simps unless_def o_def ignore_del: setObject rule: X64_H.finaliseCap_def) crunch prepareThreadDelete, Arch_finaliseCap - for it'[Finalise_R_assms, wp]: "\s. P (ksIdleThread s)" + for it'[Arch_assms, wp]: "\s. P (ksIdleThread s)" (wp: hoare_drop_imps simp: crunch_simps updateObject_default_def rule: X64_H.finaliseCap_def) @@ -118,6 +118,8 @@ definition post_cap_delete_pre' :: "capability \ paddr \ | ArchObjectCap (IOPortCap f l) \ f \ l \ (\sl'. sl \ sl' \ cs sl' \ Some cap) | _ \ False" +lemmas Finalise_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -404,15 +406,14 @@ end (* mdb_empty *) interpretation Finalise_R?: Finalise_R arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Finalise_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Finalise_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_2 locale *) -lemma not_Final_removeable[Finalise_R_2_assms]: +lemma not_Final_removeable[Arch_assms]: "\ isFinal cap sl (cteCaps_of s) \ removeable' sl s cap" apply (erule not_FinalE) apply (clarsimp simp: removeable'_def gen_isCap_simps) @@ -421,7 +422,7 @@ lemma not_Final_removeable[Finalise_R_2_assms]: apply fastforce done -lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: +lemma deletedIRQHandler_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ deletedIRQHandler irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -435,7 +436,7 @@ lemma deletedIRQHandler_valid_global_refs[Finalise_R_2_assms, wp]: apply (clarsimp simp: valid_refs'_cteCaps valid_cap_sizes_cteCaps ball_ran_eq) done -lemma clearUntypedFreeIndex_valid_global_refs[Finalise_R_2_assms, wp]: +lemma clearUntypedFreeIndex_valid_global_refs[Arch_assms, wp]: "\valid_global_refs'\ clearUntypedFreeIndex irq \\rv. valid_global_refs'\" apply (clarsimp simp: valid_global_refs'_def global_refs'_def) apply (rule hoare_pre) @@ -483,7 +484,7 @@ lemma final_matters_mdb_chunked_arch_assms: by (clarsimp simp: mdb_chunked_arch_assms_def isCap_simps final_matters'_def arch_final_matters'_def) -lemma notFinal_prev_or_next[Finalise_R_2_assms]: +lemma notFinal_prev_or_next[Arch_assms]: "\ \ isFinal cap x (cteCaps_of s); mdb_chunked (ctes_of s); valid_dlist (ctes_of s); no_0 (ctes_of s); ctes_of s x = Some (CTE cap node); final_matters' cap \ @@ -530,12 +531,12 @@ lemma notFinal_prev_or_next[Finalise_R_2_assms]: apply (clarsimp simp: sameObjectAs_def3 simp del: isArchFrameCap_capMasterCap) done -lemma sameObjectAs_not_Untyped[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap \ \ \ isUntypedCap cap'" by (clarsimp simp: gen_isCap_simps sameObjectAs_def3) -lemma sameObjectAs_not_Untyped'[Finalise_R_2_assms]: +lemma sameObjectAs_not_Untyped'[Arch_assms]: "\ global.sameObjectAs cap cap'; \ isUntypedCap cap' \ \ global.sameObjectAs cap' cap" by (clarsimp simp: isCap_simps sameObjectAs_def3) @@ -586,7 +587,7 @@ lemma (in vmdb) isFinal_untypedParent: context Arch begin arch_global_naming -lemma isFinal_no_descendants[Finalise_R_2_assms]: +lemma isFinal_no_descendants[Arch_assms]: "\ isFinal cap sl (cteCaps_of s); ctes_of s sl = Some (CTE cap n); valid_mdb' s; final_matters' cap \ \ descendants_of' sl (ctes_of s) = {}" @@ -830,7 +831,7 @@ lemma archThreadSet_valid_sched_pointers[wp]: "archThreadSet f t \valid_sched_pointers\" by (wp_pre, wps, wp, assumption) -lemma arch_finaliseCap_invs[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_invs[Arch_assms, wp]: "\invs' and valid_cap' (ArchObjectCap cap)\ Arch.finaliseCap cap fin \\rv. invs'\" unfolding X64_H.finaliseCap_def Let_def by wpsimp @@ -891,16 +892,16 @@ crunch prepareThreadDelete ignore: archThreadSet) crunch Arch.finaliseCap, prepareThreadDelete - for irq_node'[Finalise_R_2_assms, wp]: "\s. P (irq_node' s)" + for irq_node'[Arch_assms, wp]: "\s. P (irq_node' s)" (wp: crunch_wps getObject_inv loadObject_default_inv updateObject_default_inv setObject_ksInterrupt simp: crunch_simps o_def) -lemmas Arch_finaliseCap_irq_node'[Finalise_R_2_assms] = ArchRetypeDecls_H_X64_H_finaliseCap_irq_node' +lemmas Arch_finaliseCap_irq_node'[Arch_assms] = ArchRetypeDecls_H_X64_H_finaliseCap_irq_node' crunch prepareThreadDelete, postCapDeletion, setIOPortMask - for cte_wp_at'[Finalise_R_2_assms, wp]: "cte_wp_at' P p" - and valid_cap'[Finalise_R_2_assms, wp]: "valid_cap' cap" + for cte_wp_at'[Arch_assms, wp]: "cte_wp_at' P p" + and valid_cap'[Arch_assms, wp]: "valid_cap' cap" crunch setIOPortMask for ctes_of[wp]: "\s. P (ctes_of s)" @@ -925,7 +926,7 @@ lemma prepareThreadDelete_hyp_unlive: (auto simp: ko_wp_at'_def obj_at'_def hyp_live'_def) crunch prepareThreadDelete - for invs[Finalise_R_2_assms, wp]: "invs'" + for invs[Arch_assms, wp]: "invs'" (ignore: doMachineOp simp: crunch_simps) lemma archThreadSet_tcbSchedPrevNext[wp]: @@ -961,35 +962,36 @@ lemma deleteASID_cte_wp_at'[wp]: | wpc)+ done -lemma arch_finaliseCap_cte_wp_at[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cte_wp_at[Arch_assms, wp]: "\cte_wp_at' P p\ Arch.finaliseCap cap fin \\rv. cte_wp_at' P p\" apply (simp add: X64_H.finaliseCap_def) apply (wpsimp wp: unmapPage_cte_wp_at') done -lemma finaliseCap_valid_cap[Finalise_R_2_assms, wp]: +lemma finaliseCap_valid_cap[Arch_assms, wp]: "\\\ Arch.finaliseCap cap final \\rv. valid_cap' (fst rv)\" by (wpsimp simp: X64_H.finaliseCap_def) -lemma arch_finaliseCap_cases[Finalise_R_2_assms, wp]: +lemma arch_finaliseCap_cases[Arch_assms, wp]: "\\\ Arch.finaliseCap v0 final \\rv s. fst rv = capability.NullCap \ (snd rv \ capability.NullCap \ final \ arch_cap_has_cleanup' v0 \ snd rv = capability.ArchObjectCap v0)\" by (wpsimp simp: X64_H.finaliseCap_def simp: arch_cap_has_cleanup'_def isCap_simps) -lemmas [Finalise_R_2_assms] = +lemmas [Arch_assms] = cancelAllIPC_cte_wp_at' cancelAllSignals_cte_wp_at' unbindMaybeNotification_cte_wp_at' prepareThreadDelete_cte_wp_at' unbindNotification_cte_wp_at' Arch_postCapDeletion_valid_global_refs Arch_postCapDeletion_valid_arch_state' mdb_empty.vmdb_n mdb_empty.descendants not_Final_removeable +lemmas Finalise_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Finalise_R_2?: Finalise_R_2 arch_final_matters' arch_cap_has_cleanup' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Finalise_R_2_assms)?)?) qed (* This is the only arch-specific lemma in delete_one_conc_pre so far; @@ -1057,13 +1059,13 @@ lemma (in delete_one_conc_pre) finaliseCap_replaceable: context Arch begin arch_global_naming -named_theorems Finalise_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Finalise_R_3 locale *) -lemma finaliseCap_cte_refs[Finalise_R_3_assms]: +lemma finaliseCap_cte_refs[Arch_assms]: "\\s. s \' cap\ finaliseCap cap final flag \\rv s. fst rv \ NullCap \ cte_refs' (fst rv) = cte_refs' cap\" - apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot finaliseCap_def + apply (simp add: global.finaliseCap_def Let_def getThreadCSpaceRoot X64_H.finaliseCap_def cong: if_cong split del: if_split) apply (rule hoare_pre) apply (wp | wpc | simp only: o_def)+ @@ -1076,7 +1078,7 @@ lemma finaliseCap_cte_refs[Finalise_R_3_assms]: apply (fastforce simp: mask_def capAligned_def gen_objBits_simps shiftL_nat) done -lemma emptySlot_invs'[Finalise_R_3_assms, wp]: +lemma emptySlot_invs'[Arch_assms, wp]: "\\s. invs' s \ cte_wp_at' (\cte. removeable' sl s (cteCap cte)) sl s \ (info \ NullCap \ post_cap_delete_pre' info sl (cteCaps_of s))\ emptySlot sl info @@ -1087,7 +1089,7 @@ lemma emptySlot_invs'[Finalise_R_3_assms, wp]: split: capability.split_asm arch_capability.split_asm) done -lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: +lemma cteDeleteOne_invs[Arch_assms, wp]: "cteDeleteOne ptr \invs'\" apply (simp add: cteDeleteOne_def unless_def split_def finaliseCapTrue_standin_simple_def) @@ -1109,7 +1111,7 @@ lemma cteDeleteOne_invs[Finalise_R_3_assms, wp]: apply (fastforce simp: cte_wp_at_ctes_of) done -lemma isFinalCapability_corres'[Finalise_R_3_assms]: +lemma isFinalCapability_corres'[Arch_assms]: "final_matters' (cteCap cte) \ corres (=) (invs and cte_wp_at ((=) cap) ptr) (invs' and cte_wp_at' ((=) cte) (cte_map ptr)) @@ -1210,7 +1212,7 @@ crunch unmapPageTable crunch Arch_finaliseCap, prepareThreadDelete for nosch[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Finalise_R_3_assms, wp]: sch_act_simple + and sch_act_simple[Arch_assms, wp]: sch_act_simple (wp: crunch_wps getObject_inv simp: loadObject_default_def updateObject_default_def rule: X64_H.finaliseCap_def sch_act_simple_lift cong: if_cong) @@ -1221,7 +1223,7 @@ crunch deletingIRQHandler rule: sch_act_simple_lift wp: getObject_inv loadObject_default_inv crunch_wps) -lemma arch_finaliseCap_corres[Finalise_R_3_assms]: +lemma arch_finaliseCap_corres[Arch_assms]: "\ final_matters' (ArchObjectCap cap') \ final = final'; acap_relation cap cap' \ \ corres (\r r'. cap_relation (fst r) (fst r') \ cap_relation (snd r) (snd r')) (\s. invs s \ s \ cap.ArchObjectCap cap @@ -1265,14 +1267,15 @@ lemma arch_finaliseCap_corres[Finalise_R_3_assms]: sublocale deleteCallerCap: typ_at_props' "deleteCallerCap receiver" by typ_at_props' +lemmas Finalise_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts post_cap_delete_pre' interpretation Finalise_R_3?: Finalise_R_3 arch_final_matters' arch_cap_has_cleanup' post_cap_delete_pre' proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Finalise_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Finalise_R_3_assms)?)?) qed end diff --git a/proof/refine/X64/ArchInit_R.thy b/proof/refine/X64/ArchInit_R.thy index c810d1c5c2..45a65a8752 100644 --- a/proof/refine/X64/ArchInit_R.thy +++ b/proof/refine/X64/ArchInit_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Init_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Init_R locale *) definition zeroed_arch_abstract_state :: arch_state where "zeroed_arch_abstract_state \ \ @@ -34,23 +34,24 @@ definition zeroed_arch_intermediate_state :: Arch.kernel_state where (K X64VSpaceUserRegion) \ 0 (K 0) (K X64IRQFree) None" (* the None maps are a result of unfolding zeroed_main_abstract_state *) -lemma ghost_relation_wrapper_arch_intermediate_state[Init_R_assms]: +lemma ghost_relation_wrapper_arch_intermediate_state[Arch_assms]: "ghost_relation_wrapper_2 (\_. None) (\_. None) (\_. None) zeroed_arch_intermediate_state" unfolding ghost_relation_wrapper_def ghost_relation_def zeroed_arch_intermediate_state_def by simp -lemma non_empty_refine_arch_state_relation[Init_R_assms]: +lemma non_empty_refine_arch_state_relation[Arch_assms]: "(zeroed_arch_abstract_state, zeroed_arch_intermediate_state) \ arch_state_relation Map.empty" unfolding zeroed_arch_abstract_state_def zeroed_arch_intermediate_state_def arch_state_relation_def by (simp add: cr3_relation_def x64_irq_relation_def comp_def) +lemmas Init_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Init_R?: Init_R X64.zeroed_arch_abstract_state X64.zeroed_arch_intermediate_state proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Init_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Init_R_assms)?)?) qed end diff --git a/proof/refine/X64/ArchInterrupt_R.thy b/proof/refine/X64/ArchInterrupt_R.thy index a0d7ab18f7..bd62dbbfc3 100644 --- a/proof/refine/X64/ArchInterrupt_R.thy +++ b/proof/refine/X64/ArchInterrupt_R.thy @@ -12,17 +12,17 @@ begin context Arch begin arch_global_naming -named_theorems Interrupt_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R locale *) -lemma maxIRQ_H_ucast_toEnum_eq_irq[Interrupt_R_assms]: +lemma maxIRQ_H_ucast_toEnum_eq_irq[Arch_assms]: "x \ ucast maxIRQ \ toEnum (unat x) = (ucast x :: irq)" for x::machine_word by (simp add: word_le_nat_alt maxIRQ_def) -lemma arch_valid_irq_le_maxIRQ[Interrupt_R_assms]: +lemma arch_valid_irq_le_maxIRQ[Arch_assms]: "arch_valid_irq irq \ irq \ maxIRQ" by simp -lemma arch_valid_irq_valid_IRQHandlerCap[Interrupt_R_assms]: +lemma arch_valid_irq_valid_IRQHandlerCap[Arch_assms]: "arch_valid_irq irq \ valid_cap' (capability.IRQHandlerCap irq) s" by (simp add: valid_cap'_def capAligned_def) @@ -46,7 +46,7 @@ primrec arch_irq_control_inv_valid' :: "Arch.irqcontrol_invocation \ ex_cte_cap_to' p and real_cte_at' p and (Not o irq_issued' irq) and K (irq \ maxIRQ))" -lemma checkIRQ_corres[Interrupt_R_assms]: +lemma checkIRQ_corres[Arch_assms]: "corres (ser \ dc) \ \ (arch_check_irq irq) (Arch.checkIRQ irq)" unfolding arch_check_irq_def checkIRQ_def by (clarsimp simp: minIRQ_def maxIRQ_def whenE_rangeCheck_eq whenE_def returnOk_def split: if_split) @@ -56,7 +56,7 @@ lemmas irq_const_defs = X64.maxUserIRQ_def X64.minUserIRQ_def X64_H.maxUserIRQ_def X64_H.minUserIRQ_def crunch arch_check_irq, checkIRQ - for inv[Interrupt_R_assms]: "P" + for inv[Arch_assms]: "P" (simp: crunch_simps) lemma arch_check_irq_valid: @@ -64,11 +64,11 @@ lemma arch_check_irq_valid: unfolding arch_check_irq_def by (wpsimp simp: validE_R_def not_less word_le_nat_alt maxIRQ_def wp: whenE_throwError_wp) -lemma arch_check_irq_valid'[Interrupt_R_assms]: +lemma arch_check_irq_valid'[Arch_assms]: "\\\ arch_check_irq irq \\_ _. irq \ ucast maxIRQ\, \\_. \\" by (wp arch_check_irq_valid) -lemma checkIRQ_irq_valid[Interrupt_R_assms]: +lemma checkIRQ_irq_valid[Arch_assms]: "\\\ checkIRQ irq \\_ _. arch_valid_irq (toEnum (unat irq))\, -" unfolding checkIRQ_def rangeCheck_def validE_R_def supply hoare_vcg_prop[wp del] @@ -97,7 +97,7 @@ lemma corres_gets_ioapic_nirqs[corres]: "corres (=) \ \ (gets (x64_ioapic_nirqs \ arch_state)) (gets (x64KSIOAPICnIRQs \ ksArchState))" by (simp add: state_relation_def arch_state_relation_def) -lemma arch_decodeIRQControlInvocation_corres[Interrupt_R_assms]: +lemma arch_decodeIRQControlInvocation_corres[Arch_assms]: "list_all2 cap_relation caps caps' \ corres (ser \ arch_irq_control_inv_relation) (invs and (\s. \cp \ set caps. s \ cp)) @@ -172,7 +172,7 @@ lemma unat_add_ucast_helper: apply (simp add: unat_ucast) done -lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: +lemma arch_decode_irq_control_valid'[Arch_assms, wp]: "\\s. invs' s \ (\cap \ set caps. s \' cap) \ (\cap \ set caps. \r \ cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) \ cte_wp_at' (\cte. cteCap cte = IRQControlCap) slot s\ @@ -192,22 +192,22 @@ lemma arch_decode_irq_control_valid'[Interrupt_R_assms, wp]: done crunch Arch.decodeIRQControlInvocation - for inv[Interrupt_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps wp: crunch_wps) -lemmas [Interrupt_R_assms] = arch_check_irq_inv +lemmas [Arch_assms] = arch_check_irq_inv -lemma irq_node_in_global_refs'[Interrupt_R_assms]: +lemma irq_node_in_global_refs'[Arch_assms]: "Invariants_H.irq_node' s + (ucast irq << cteSizeBits) \ global_refs' s" for irq :: irq by (simp add: global_refs'_def cteSizeBits_cte_level_bits cte_level_bits_def shiftl_t2n) -lemma arch_invokeIRQHandler_corres[Interrupt_R_assms]: +lemma arch_invokeIRQHandler_corres[Arch_assms]: "irq_handler_inv_relation i i' \ corres dc \ \ (arch_invoke_irq_handler i) (Arch.invokeIRQHandler i')" by (cases i; clarsimp simp: X64_H.invokeIRQHandler_def) (rule corres_machine_op, rule corres_Id; simp?) -lemma is_derived'_NotificationCap[Interrupt_R_assms]: +lemma is_derived'_NotificationCap[Arch_assms]: "\isNotificationCap cap; isNotificationCap cap'\ \ is_derived' ctes src cap' cap = badge_derived' cap' cap" by (clarsimp simp add: is_derived'_def isCap_simps vsCapRef_def) @@ -244,7 +244,7 @@ lemma maxUserIRQ_le_maxIRQ: "X64.maxUserIRQ \ maxIRQ" by (simp add: X64.maxUserIRQ_def maxIRQ_def) -lemma arch_performIRQControl_corres[Interrupt_R_assms]: +lemma arch_performIRQControl_corres[Arch_assms]: "arch_irq_control_inv_relation ivk ivk' \ corres (dc \ dc) (einvs and arch_irq_control_inv_valid ivk) (invs' and arch_irq_control_inv_valid' ivk') @@ -295,11 +295,11 @@ lemma arch_performIRQControl_corres[Interrupt_R_assms]: apply (auto dest: valid_irq_handlers_ctes_ofD)[1] done -lemma is_simple_cap'_IRQHandlerCap[Interrupt_R_assms]: +lemma is_simple_cap'_IRQHandlerCap[Arch_assms]: "isIRQHandlerCap cap \ is_simple_cap' cap" by (clarsimp simp: isCap_simps is_simple_cap'_def) -lemma sameRegionAs_IRQControl_handler[Interrupt_R_assms, simp]: +lemma sameRegionAs_IRQControl_handler[Arch_assms, simp]: "global.sameRegionAs capability.IRQControlCap (capability.IRQHandlerCap irq)" by (simp add: sameRegionAs_def3 isCap_simps) @@ -330,7 +330,7 @@ lemma dmo_ioapicMapPinToVector_invs'[wp]: machine_rest_lift_def split_def)+ done -lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: +lemma arch_invoke_irq_control_invs'[Arch_assms, wp]: "\invs' and arch_irq_control_inv_valid' i\ Arch.performIRQControl i \\rv. invs'\" apply (simp add: X64_H.performIRQControl_def) apply (rule hoare_pre) @@ -350,56 +350,57 @@ lemma arch_invoke_irq_control_invs'[Interrupt_R_assms, wp]: simp: invs'_def valid_state'_def IRQ_def)[1] done -lemma handle_reserved_irq_corres[Interrupt_R_assms, corres]: +lemma handle_reserved_irq_corres[Arch_assms, corres]: "corres dc einvs (\s. invs' s \ (irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)) (handle_reserved_irq irq) (handleReservedIRQ irq)" unfolding handle_reserved_irq_def handleReservedIRQ_def by corres -lemma maskIrqSignal_corres[Interrupt_R_assms, corres]: +lemma maskIrqSignal_corres[Arch_assms, corres]: "corres dc \ \ (arch_mask_irq_signal irq) (Arch.maskIrqSignal irq)" unfolding arch_mask_irq_signal_def maskIrqSignal_def when_def by (corres corres: corres_machine_op) -lemma dmo_ackInterrupt_corres[Interrupt_R_assms, corres]: +lemma dmo_ackInterrupt_corres[Arch_assms, corres]: "corres dc \ \ (do_machine_op (ackInterrupt irq)) (doMachineOp (ackInterrupt irq))" by (corres corres: corres_machine_op) crunch maskIrqSignal - for invs'[Interrupt_R_assms]: invs' + for invs'[Arch_assms]: invs' (wp: dmo_maskInterrupt_True ignore: doMachineOp) -lemma handleReservedIRQ_invs'[Interrupt_R_assms]: +lemma handleReservedIRQ_invs'[Arch_assms]: "\invs' and (\s. irq \ non_kernel_IRQs \ sch_act_not (ksCurThread s) s)\ handleReservedIRQ irq \\_. invs'\" by (wpsimp simp: handleReservedIRQ_def) +lemmas Interrupt_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Interrupt_R?: Interrupt_R X64.arch_irq_control_inv_valid' X64.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Interrupt_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Interrupt_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Interrupt_R_2 locale *) -lemma invoke_arch_irq_handler_invs'[Interrupt_R_2_assms, wp]: +lemma invoke_arch_irq_handler_invs'[Arch_assms, wp]: "\invs' and irq_handler_inv_valid' i\ Arch.invokeIRQHandler i \\rv. invs'\" by (cases i; wpsimp simp: X64_H.invokeIRQHandler_def) +lemmas Interrupt_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Interrupt_R_2?: Interrupt_R_2 X64.arch_irq_control_inv_valid' X64.arch_irq_control_inv_relation proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Interrupt_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Interrupt_R_2_assms)?)?) qed end diff --git a/proof/refine/X64/ArchInvariantUpdates_H.thy b/proof/refine/X64/ArchInvariantUpdates_H.thy index 7efc3b0fe7..ba4280768b 100644 --- a/proof/refine/X64/ArchInvariantUpdates_H.thy +++ b/proof/refine/X64/ArchInvariantUpdates_H.thy @@ -10,24 +10,25 @@ begin context Arch begin arch_global_naming -named_theorems InvariantUpdates_H_assms +clear_named_theorems Arch_assms (* accumulate assumptions for InvariantUpdates_H locale *) -lemma valid_arch_state'_interrupt[simp, InvariantUpdates_H_assms]: +lemma valid_arch_state'_interrupt[simp, Arch_assms]: "valid_arch_state' (ksInterruptState_update f s) = valid_arch_state' s" by (simp add: valid_arch_state'_def cong: option.case_cong) (* not generally true for ksInterruptState update *) -lemma global_refs'_intStateIRQTable_update[simp, InvariantUpdates_H_assms]: +lemma global_refs'_intStateIRQTable_update[simp, Arch_assms]: "global_refs' (s\ksInterruptState := intStateIRQTable_update f (ksInterruptState s)\) = global_refs' s" by (simp add: global_refs'_def) -end +lemmas InvariantUpdates_H_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation InvariantUpdates_H?: InvariantUpdates_H proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact InvariantUpdates_H_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.InvariantUpdates_H_assms)?) qed end diff --git a/proof/refine/X64/ArchInvsLemmas_H.thy b/proof/refine/X64/ArchInvsLemmas_H.thy index 0b0b016f2c..cf82e33c03 100644 --- a/proof/refine/X64/ArchInvsLemmas_H.thy +++ b/proof/refine/X64/ArchInvsLemmas_H.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems Invariants_H_pspaceI_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_pspaceI locale *) (* FIXME arch-split: word_size is available outside of Arch due to Word_Setup, but to provide more guard rails during arch-split we are hiding the Haskell constant definition outside of @@ -30,7 +30,7 @@ lemmas untypedBits_defs = minUntypedSizeBits_def maxUntypedSizeBits_def lemmas objBits_simps = objBits_def objBitsKO_def word_size_def archObjSize_def lemmas objBits_simps' = objBits_simps objBits_defs -lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_cap'_pspaceI[Arch_assms]: "s \' cap \ ksPSpace s = ksPSpace s' \ s' \' cap" unfolding valid_cap'_def by (cases cap) @@ -40,7 +40,7 @@ lemma valid_cap'_pspaceI[Invariants_H_pspaceI_assms]: simp: vspace_table_at'_defs valid_arch_cap'_def split: arch_capability.split zombie_type.split option.splits)+ -lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: +lemma valid_obj'_pspaceI[Arch_assms]: "valid_obj' obj s \ ksPSpace s = ksPSpace s' \ valid_obj' obj s'" unfolding valid_obj'_def supply no_0_obj_at'[rule del] (* avoid weak elim rule warning *) @@ -52,7 +52,7 @@ lemma valid_obj'_pspaceI[Invariants_H_pspaceI_assms]: Structures_H.thread_state.splits ntfn.splits option.splits intro: obj_at'_pspaceI valid_cap'_pspaceI) -lemma tcb_space_clear[Invariants_H_pspaceI_assms]: +lemma tcb_space_clear[Arch_assms]: "\ tcb_cte_cases (y - x) = Some (getF, setF); is_aligned x tcbBlockSizeBits; ps_clear x tcbBlockSizeBits s; ksPSpace s x = Some (KOTCB tcb); ksPSpace s y = Some v; @@ -75,7 +75,7 @@ lemma tcb_space_clear[Invariants_H_pspaceI_assms]: apply (simp add: tcb_cte_cases_def cteSizeBits_def split: if_split_asm) done -lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: +lemma range_cover_canonical_address[Arch_assms]: "\ range_cover ptr sz us n ; p < n ; canonical_address (ptr && ~~ mask sz) ; sz \ maxUntypedSizeBits \ \ canonical_address (ptr + of_nat p * 2 ^ us)" @@ -88,22 +88,23 @@ lemma range_cover_canonical_address[Invariants_H_pspaceI_assms]: apply unat_arith done -lemma pspace_in_kernel_mappings'_pspaceI[Invariants_H_pspaceI_assms]: +lemma pspace_in_kernel_mappings'_pspaceI[Arch_assms]: "pspace_in_kernel_mappings' s \ ksPSpace s = ksPSpace s' \ pspace_in_kernel_mappings' s'" unfolding pspace_in_kernel_mappings'_def by simp -end +lemmas Invariants_H_pspaceI_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_pspaceI?: Invariants_H_pspaceI proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Invariants_H_pspaceI_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Invariants_H_pspaceI_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Invariants_H_cte_ats_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_cte_ats locale *) (* FIXME arch-split: for proofs which require exact offsets lining up instead of cteSizeBits *) lemma raw_tcb_cte_cases_simps: @@ -113,7 +114,7 @@ lemma raw_tcb_cte_cases_simps: "tcb_cte_cases 128 = Some (tcbIPCBufferFrame, tcbIPCBufferFrame_update)" by (simp add: tcb_cte_cases_def cteSizeBits_def)+ -lemma cte_wp_at_cases'[Invariants_H_cte_ats_assms]: +lemma cte_wp_at_cases'[Arch_assms]: shows "cte_wp_at' P p s = ((\cte. ksPSpace s p = Some (KOCTE cte) \ is_aligned p cte_level_bits \ P cte \ ps_clear p cteSizeBits s) \ @@ -206,7 +207,7 @@ lemma cte_wp_at_cteI': shows "cte_wp_at' P ptr s" using assms by (simp add: cte_wp_at_cases' cte_level_bits_def objBits_defs) -lemma cte_at_typ'[Invariants_H_cte_ats_assms]: +lemma cte_at_typ'[Arch_assms]: "cte_at' c = (\s. typ_at' CTET c s \ (\n. typ_at' TCBT (c - n) s \ n \ dom tcb_cte_cases))" proof - have P: "\ko. (koTypeOf ko = CTET) = (\cte. ko = KOCTE cte)" @@ -230,12 +231,13 @@ lemma tcb_at_cte_at': apply (clarsimp simp add: return_def objBits_simps) done -end +lemmas Invariants_H_cte_ats_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Invariants_H_cte_ats?: Invariants_H_cte_ats proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Invariants_H_cte_ats_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Invariants_H_cte_ats_assms)?) qed @@ -400,7 +402,7 @@ lemma is_physical_cases: | _ \ True)" by (simp split: capability.splits arch_capability.splits zombie_type.splits) -named_theorems Invariants_H_typ_at_lifts_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Invariants_H_typ_at_lifts locale *) lemma page_directory_at'_typ_at_lift_strong: "(\p. f \\s. P (typ_at' (ArchT PDET) p s)\) \ f \\s. P (page_directory_at' p s)\" @@ -442,7 +444,7 @@ lemma asid_pool_at'_typ_at_lift_strong: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (asid_pool_at' p s)\" by assumption -lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_tcb'_typ_at_lift_strong[Arch_assms]: "(\T p. f \\s. P (typ_at' T p s)\) \ f \\s. P (valid_arch_tcb' tcb s)\" unfolding valid_arch_tcb'_def apply (rule bool_to_bool_cases[where f=P]; clarsimp) @@ -450,7 +452,7 @@ lemma valid_arch_tcb'_typ_at_lift_strong[Invariants_H_typ_at_lifts_assms]: | assumption)+ done -lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: +lemma valid_arch_cap'_typ_at_lift[Arch_assms]: assumes P: "\P T p. f \\s. P (typ_at' T p s)\" shows "f \\s. valid_arch_cap' cap s\" apply (case_tac cap, @@ -461,12 +463,13 @@ lemma valid_arch_cap'_typ_at_lift[Invariants_H_typ_at_lifts_assms]: pd_pointer_table_at'_typ_at_lift_strong page_map_l4_at'_typ_at_lift_strong)+ done +lemmas Invariants_H_typ_at_lifts_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) global_interpretation Invariants_H_typ_at_lifts?: Invariants_H_typ_at_lifts proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; unfold_locales; (fact Invariants_H_typ_at_lifts_assms)?) + case 1 show ?case by (intro_locales; unfold_locales; (fact X64.Invariants_H_typ_at_lifts_assms)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/X64/ArchIpcCancel_R.thy b/proof/refine/X64/ArchIpcCancel_R.thy index a57503d8fc..5412e3c6d4 100644 --- a/proof/refine/X64/ArchIpcCancel_R.thy +++ b/proof/refine/X64/ArchIpcCancel_R.thy @@ -12,20 +12,20 @@ begin context Arch begin arch_global_naming -named_theorems IpcCancel_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for IpcCancel_R locale *) crunch Arch.postCapDeletion - for pred_tcb_at'[IpcCancel_R_assms, wp]: "pred_tcb_at' proj P t" - and typ_at'[IpcCancel_R_assms, wp]: "\s. P (typ_at' T p s)" + for pred_tcb_at'[Arch_assms, wp]: "pred_tcb_at' proj P t" + and typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" (wp: setCTE_pred_tcb_at') -lemma acapClass_not_ReplyClass[IpcCancel_R_assms]: +lemma acapClass_not_ReplyClass[Arch_assms]: "acapClass acap \ ReplyClass t" by (cases acap; simp) crunch arch_post_cap_deletion - for pspace_aligned[IpcCancel_R_assms, wp]: "pspace_aligned :: det_state \ _" - and pspace_distinct[IpcCancel_R_assms, wp]: "pspace_distinct :: det_state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_state \ _" (simp: crunch_simps wp: crunch_wps) crunch emptySlot @@ -72,7 +72,7 @@ lemma fpuRelease_corres[corres]: corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu) \ (fpu_release t) (fpuRelease t')" by (corres simp: fpu_release_def fpuRelease_def) -lemma prepareThreadDelete_corres[IpcCancel_R_assms, corres]: +lemma prepareThreadDelete_corres[Arch_assms, corres]: "t' = t \ corres dc (invs and tcb_at t) no_0_obj' (prepare_thread_delete t) (prepareThreadDelete t')" @@ -154,12 +154,13 @@ lemma setThreadState_oa_queued: by (simp add: not_obj_at' comp_def, wp hoare_convert_imp pos) qed +lemmas IpcCancel_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation IpcCancel_R?: IpcCancel_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact IpcCancel_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.IpcCancel_R_assms)?)?) qed (* instantiate locales with assumptions depending on IpcCancel_R instantiation *) diff --git a/proof/refine/X64/ArchIpc_R.thy b/proof/refine/X64/ArchIpc_R.thy index a86b474899..3eda884676 100644 --- a/proof/refine/X64/ArchIpc_R.thy +++ b/proof/refine/X64/ArchIpc_R.thy @@ -11,11 +11,11 @@ begin context Arch begin arch_global_naming -named_theorems Ipc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Ipc_R locale *) declare word64_minus_one_le[simp] -lemma max_ipc_size_le_2_msg_align_bits[Ipc_R_assms]: +lemma max_ipc_size_le_2_msg_align_bits[Arch_assms]: "max_ipc_words * word_size \ 2 ^ msg_align_bits" by (simp add: max_ipc_words word_size_def msg_align_bits) @@ -32,50 +32,50 @@ lemma vsCapRef_generic: "\ isArchObjectCap cap \ vsCapRef cap = None" by (clarsimp simp add: vsCapRef_def gen_isCap_simps split: capability.splits) -lemma is_derived'_Untyped[Ipc_R_assms]: +lemma is_derived'_Untyped[Arch_assms]: "\isUntypedCap cap'\ \ is_derived' m src cap' cap = (isUntypedCap cap \ badge_derived' cap' cap \ descendants_of' src m = {})" by (clarsimp simp add: X64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) -lemma is_derived'_Reply[Ipc_R_assms]: +lemma is_derived'_Reply[Arch_assms]: "\isReplyCap cap'\ \ is_derived' m src cap' cap = (isReplyCap cap \ capTCBPtr cap = capTCBPtr cap' \ capReplyMaster cap \ \ capReplyMaster cap')" by (clarsimp simp add: X64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) -lemma arch_maskCapRights_not_null[Ipc_R_assms, simp]: +lemma arch_maskCapRights_not_null[Arch_assms, simp]: "Arch.maskCapRights r acap \ NullCap" by (case_tac acap; simp add: X64_H.maskCapRights_def isCap_simps) -lemma capASID_gen_cap[Ipc_R_assms]: +lemma capASID_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ capASID cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_asid_base'_gen_cap[Ipc_R_assms]: +lemma cap_asid_base'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_asid_base' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) -lemma cap_vptr'_gen_cap[Ipc_R_assms]: +lemma cap_vptr'_gen_cap[Arch_assms]: "\ isArchObjectCap cap \ cap_vptr' cap = None" by (cases cap; simp add: isCap_simps split: arch_capability.split option.split) crunch transferCapsToSlots - for pspace_in_kernel_mappings'[Ipc_R_assms, wp]: pspace_in_kernel_mappings' + for pspace_in_kernel_mappings'[Arch_assms, wp]: pspace_in_kernel_mappings' crunch makeArchFaultMessage - for sch_act[Ipc_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for sch_act[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma is_derived'_IRQHandlerCap[Ipc_R_assms]: +lemma is_derived'_IRQHandlerCap[Arch_assms]: "\isIRQHandlerCap cap'\ \ is_derived' (ctes_of (s::kernel_state)) src cap' cap = (isIRQHandlerCap cap \ badge_derived' cap' cap)" by (clarsimp simp add: X64.is_derived'_def gen_isCap_simps) (cases cap; clarsimp simp: badge_derived'_def capMasterCap_def vsCapRef_generic isCap_simps) (* variant of storeWord_um_inv which does not expose architecture-specific information *) -lemma storeWord_um_inv'[Ipc_R_assms]: +lemma storeWord_um_inv'[Arch_assms]: "\\s. underlying_memory s = um\ storeWord a v \\_ s. is_aligned a word_size_bits @@ -89,7 +89,7 @@ lemma storeWord_um_inv'[Ipc_R_assms]: apply (auto simp add: unat_plus_simple[THEN iffD1] word_plus_mono_right2 mask_def) done -lemma isArchObjectCap_maskCapRights[Ipc_R_assms]: +lemma isArchObjectCap_maskCapRights[Arch_assms]: "isArchObjectCap (Arch.maskCapRights R acap)" by (cases acap; simp add: X64_H.maskCapRights_def isCap_simps) @@ -100,16 +100,16 @@ lemma isPageCap_maskCapRights[simp]: apply (case_tac arch_capability; simp add: isCap_simps X64_H.maskCapRights_def) done -lemma arch_updateCapData_ordering[Ipc_R_assms]: +lemma arch_updateCapData_ordering[Arch_assms]: "\ (x, arch_capBadge acap) \ capBadge_ordering P; Arch.updateCapData p d acap \ NullCap \ \ (x, capBadge (Arch.updateCapData p d acap)) \ capBadge_ordering P" by (cases acap; simp add: X64_H.updateCapData_def) -lemma ArchUpdateCapData_noReply[Ipc_R_assms]: +lemma ArchUpdateCapData_noReply[Arch_assms]: "Arch.updateCapData p d acap \ capability.ReplyCap x y z" by (cases acap; simp add: X64_H.updateCapData_def) -lemma ArchUpdateCapData_noIRQControl[Ipc_R_assms]: +lemma ArchUpdateCapData_noIRQControl[Arch_assms]: "Arch.updateCapData p d acap \ IRQControlCap" by (cases acap; simp add: X64_H.updateCapData_def) @@ -130,15 +130,15 @@ lemma isPageCap_updateCapData[simp]: apply (clarsimp split:capability.splits simp:Let_def) done -lemma badgeRegister_badge_register[Ipc_R_assms]: +lemma badgeRegister_badge_register[Arch_assms]: "badgeRegister = badge_register" by (simp add: badge_register_def badgeRegister_def) crunch copyMRs - for pspace_in_kernel_mappings'[Ipc_R_assms, wp]: pspace_in_kernel_mappings' + for pspace_in_kernel_mappings'[Arch_assms, wp]: pspace_in_kernel_mappings' (wp: crunch_wps simp: crunch_simps) -lemma makeArchFaultMessage_corres[Ipc_R_assms]: +lemma makeArchFaultMessage_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (make_arch_fault_msg f t) (makeArchFaultMessage (arch_fault_map f) t)" @@ -149,20 +149,20 @@ lemma makeArchFaultMessage_corres[Ipc_R_assms]: apply (wp+, auto) done -lemma syscallMessage_def'[Ipc_R_assms]: +lemma syscallMessage_def'[Arch_assms]: "FaultHandler_H.syscallMessage \ MachineExports.syscallMessage" by (simp add: syscallMessage_def) -lemma exceptionMessage_def'[Ipc_R_assms]: +lemma exceptionMessage_def'[Arch_assms]: "FaultHandler_H.exceptionMessage \ MachineExports.exceptionMessage" by (simp add: exceptionMessage_def) -lemma makeArchFaultMessage_inv[Ipc_R_assms, wp]: +lemma makeArchFaultMessage_inv[Arch_assms, wp]: "makeArchFaultMessage ft t \P\" unfolding makeArchFaultMessage_def by (wpsimp wp: asUser_inv getRestartPC_inv split: arch_fault.split) -lemma lookupIPCBuffer_valid_ipc_buffer[Ipc_R_assms, wp]: +lemma lookupIPCBuffer_valid_ipc_buffer[Arch_assms, wp]: "\valid_objs'\ VSpace_H.lookupIPCBuffer b s \case_option \ valid_ipc_buffer_ptr'\" unfolding lookupIPCBuffer_def supply raw_tcb_cte_cases_simps[simp] (* FIXME arch-split: legacy, try use tcb_cte_cases_neqs *) @@ -210,7 +210,7 @@ lemma lookupIPCBuffer_Some_0: "\\\ lookupIPCBuffer w t \\rv s. rv \ Some 0\" by (wpsimp simp: lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv) -lemma arch_getSanitiseRegisterInfo_corres[Ipc_R_assms]: +lemma arch_getSanitiseRegisterInfo_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (arch_get_sanitise_register_info t) (getSanitiseRegisterInfo t)" @@ -221,10 +221,10 @@ crunch getSanitiseRegisterInfo for tcb_at'[wp]: "tcb_at' t" crunch arch_get_sanitise_register_info - for pspace_distinct[Ipc_R_assms, wp]: pspace_distinct - and pspace_aligned[Ipc_R_assms, wp]: pspace_aligned + for pspace_distinct[Arch_assms, wp]: pspace_distinct + and pspace_aligned[Arch_assms, wp]: pspace_aligned -lemma sanitiseRegister_sanitise_register[Ipc_R_assms]: +lemma sanitiseRegister_sanitise_register[Arch_assms]: "sanitiseRegister = sanitise_register" by (rule ext)+ (clarsimp simp: sanitiseRegister_def sanitise_register_def @@ -232,16 +232,16 @@ lemma sanitiseRegister_sanitise_register[Ipc_R_assms]: sanitiseAndFlags_def sanitise_and_flags_def mask_def cong: register.case_cong) -lemma handleArchFaultReply_corres[Ipc_R_assms]: +lemma handleArchFaultReply_corres[Arch_assms]: "corres (=) \ \ (handle_arch_fault_reply ft t label msg) (handleArchFaultReply (arch_fault_map ft) t label msg)" by (clarsimp simp: handle_arch_fault_reply_def handleArchFaultReply_def split: arch_fault.split) crunch getSanitiseRegisterInfo, handleArchFaultReply, handle_arch_fault_reply - for inv[Ipc_R_assms, wp]: P + for inv[Arch_assms, wp]: P -lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: +lemma ctes_of_mdbNext_parentOf[Arch_assms]: "\ ctes_of s' \ cte_map cptr \ cte_map slot; ctes_of s' (cte_map cptr) = Some (CTE (capability.ReplyCap t master rights) n); ctes_of s' (mdbNext (cteMDBNode cte)) = Some (CTE (capability.ReplyCap t master' rights') n'); @@ -251,15 +251,16 @@ lemma ctes_of_mdbNext_parentOf[Ipc_R_assms]: (erule subtree.cases; clarsimp simp: parentOf_def isMDBParentOf_CTE) crunch debugPrint - for inv[Ipc_R_assms, wp]: P - and (no_fail) no_fail[Ipc_R_assms, intro!, wp, simp] + for inv[Arch_assms, wp]: P + and (no_fail) no_fail[Arch_assms, intro!, wp, simp] + +lemmas Ipc_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Ipc_R?: Ipc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Ipc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Ipc_R_assms)?)?) qed context Arch begin arch_global_naming diff --git a/proof/refine/X64/ArchKHeap_R.thy b/proof/refine/X64/ArchKHeap_R.thy index 797950063d..fbe8b0a880 100644 --- a/proof/refine/X64/ArchKHeap_R.thy +++ b/proof/refine/X64/ArchKHeap_R.thy @@ -14,7 +14,7 @@ declare a_type_simps[simp] (* FIXME: on RISCV64/AARCH64 this is in ArchInvariant context Arch begin arch_global_naming -named_theorems KHeap_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R locale *) declare aa_type_simps[simp] (* FIXME: on RISCV64/AARCH64 this is in ArchInvariants_AI already *) @@ -30,12 +30,12 @@ lemmas typ_at_to_obj_at_arches lemmas page_table_at_obj_at' = page_table_at'_def[unfolded typ_at_to_obj_at_arches] -lemma koType_objBitsKO[KHeap_R_assms]: +lemma koType_objBitsKO[Arch_assms]: "koTypeOf k = koTypeOf k' \ objBitsKO k = objBitsKO k'" by (auto simp: objBitsKO_def archObjSize_def split: kernel_object.splits arch_kernel_object.splits) -lemma pspace_dom_update[KHeap_R_assms]: +lemma pspace_dom_update[Arch_assms]: "\ ps ptr = Some x; a_type x = a_type v \ \ pspace_dom (ps(ptr \ v)) = pspace_dom ps" apply (simp add: pspace_dom_def dom_fun_upd2 del: dom_fun_upd) apply (rule SUP_cong [OF refl]) @@ -43,7 +43,7 @@ lemma pspace_dom_update[KHeap_R_assms]: apply (simp add: obj_relation_cuts_def3) done -lemma cte_wp_at_ctes_of[KHeap_R_assms]: +lemma cte_wp_at_ctes_of[Arch_assms]: "cte_wp_at' P p s = (\cte. ctes_of s p = Some cte \ P cte)" supply diff_neg_mask[simp del] apply (simp add: cte_wp_at_cases' map_to_ctes_def Let_def @@ -76,7 +76,7 @@ lemma cte_wp_at_ctes_of[KHeap_R_assms]: word_bw_assocs) done -lemma ctes_of_canonical[KHeap_R_assms]: +lemma ctes_of_canonical[Arch_assms]: assumes canonical: "pspace_canonical' s" assumes ctes_of: "ctes_of s p = Some cte" shows "canonical_address p" @@ -89,9 +89,9 @@ proof - elim: cte_wp_atE' canonical_address_add) qed -lemma valid_updateCapDataI[KHeap_R_assms]: +lemma valid_updateCapDataI[Arch_assms]: "s \' c \ s \' updateCapData b x c" - apply (unfold global.updateCapData_def Let_def updateCapData_def) + apply (unfold global.updateCapData_def Let_def X64_H.updateCapData_def) apply (cases c) apply (simp_all add: gen_isCap_defs valid_cap'_def global.capUntypedPtr_def gen_isCap_simps capAligned_def word_size word_bits_def word_bw_assocs @@ -255,7 +255,7 @@ lemma setObject_other_arch_corres: simp split: arch_kernel_obj.split_asm) by (fastforce dest: tcbs_of'_non_tcb_update) -lemmas [KHeap_R_assms] = +lemmas [Arch_assms] = setObject_other_corres[where 'a=endpoint] setObject_other_corres[where 'a=notification] @@ -318,9 +318,9 @@ crunch setEndpoint, getEndpoint, setNotification, getNotification for pspace_canonical'[wp]: "pspace_canonical'" and pspace_in_kernel_mappings'[wp]: "pspace_in_kernel_mappings'" -declare setEndpoint_pspace_in_kernel_mappings'[KHeap_R_assms] +declare setEndpoint_pspace_in_kernel_mappings'[Arch_assms] -declare setNotification_pspace_in_kernel_mappings'[KHeap_R_assms] +declare setNotification_pspace_in_kernel_mappings'[Arch_assms] (* interface lemma, but can't be done via locale *) lemma valid_global_refs_lift': @@ -353,27 +353,28 @@ lemma valid_arch_state_lift': apply (wp typs hoare_vcg_const_Ball_lift arch)+ done -lemma idle_is_global[KHeap_R_assms, intro!]: +lemma idle_is_global[Arch_assms, intro!]: "ksIdleThread s \ global_refs' s" by (simp add: global_refs'_def) -end +lemmas KHeap_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R?: KHeap_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.KHeap_R_assms)?) qed context Arch begin arch_global_naming -named_theorems KHeap_R_assms_2 +clear_named_theorems Arch_assms (* accumulate assumptions for KHeap_R_2 locale *) -lemmas setEndpoint_valid_globals[KHeap_R_assms_2, wp] +lemmas setEndpoint_valid_globals[Arch_assms, wp] = valid_global_refs_lift'[OF set_ep_ctes_of set_ep_arch' setEndpoint_it setEndpoint_ksInterruptState] -lemma set_ntfn_global_refs'[KHeap_R_assms_2, wp]: +lemma set_ntfn_global_refs'[Arch_assms, wp]: "\valid_global_refs'\ setNotification ptr val \\_. valid_global_refs'\" by (rule valid_global_refs_lift'; wp) @@ -394,7 +395,7 @@ lemma setObject_ko_wp_at': objBits_def[symmetric] ps_clear_upd in_magnitude_check v) -lemmas [KHeap_R_assms_2] = setEndpoint_valid_arch' setNotification_valid_arch' +lemmas [Arch_assms] = setEndpoint_valid_arch' setNotification_valid_arch' sublocale setObject: typ_at_props' "setObject p v" by typ_at_props' @@ -405,12 +406,13 @@ sublocale doMachineOp: typ_at_props' "doMachineOp mop" sublocale setEndpoint: typ_at_props' "setEndpoint ptr val" by typ_at_props' -end +lemmas KHeap_R_2_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) interpretation KHeap_R_2?: KHeap_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact KHeap_R_assms_2)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.KHeap_R_2_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/X64/ArchMachine_R.thy b/proof/refine/X64/ArchMachine_R.thy index 627b5e6a08..0f5e3a7592 100644 --- a/proof/refine/X64/ArchMachine_R.thy +++ b/proof/refine/X64/ArchMachine_R.thy @@ -14,9 +14,9 @@ begin context Arch begin arch_global_naming -named_theorems Machine_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Machine_R locale *) -lemma dmo_getirq_inv[Machine_R_assms, wp]: +lemma dmo_getirq_inv[Arch_assms, wp]: "irq_state_independent_H P \ \P\ doMachineOp (getActiveIRQ in_kernel) \\rv. P\" apply (simp add: getActiveIRQ_def doMachineOp_def split_def exec_gets select_f_select[simplified liftM_def] @@ -33,7 +33,7 @@ lemma getActiveIRQ_masked: apply (clarsimp simp: valid_irq_masks'_def) done -lemma dmo_maskInterrupt[Machine_R_assms]: +lemma dmo_maskInterrupt[Arch_assms]: "\\s. P (ksMachineState_update (irq_masks_update (\t. t (irq := m))) s)\ doMachineOp (maskInterrupt m irq) \\_. P\" apply (simp add: doMachineOp_def split_def) @@ -51,7 +51,7 @@ lemma dmo_maskInterrupt_True: ct_not_inQ_def ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) done -lemma setIRQState_irq_states'[Machine_R_assms, wp]: +lemma setIRQState_irq_states'[Arch_assms, wp]: "setIRQState state irq \valid_irq_states'\" apply (simp add: setIRQState_def setInterruptState_def getInterruptState_def) apply (wp dmo_maskInterrupt) @@ -67,29 +67,30 @@ lemma getActiveIRQ_le_maxIRQ: apply (simp add: irqs_masked'_def valid_irq_states'_def maxIRQ_def)+ done -lemma doMachineOp_getActiveIRQ_non_kernel[Machine_R_assms, wp]: +lemma doMachineOp_getActiveIRQ_non_kernel[Arch_assms, wp]: "\\\ doMachineOp (getActiveIRQ True) \\rv s. \irq. rv = Some irq \ irq \ non_kernel_IRQs \ P irq s\" by (wpsimp simp: non_kernel_IRQs_def) -lemma frameRegisters_def'[Machine_R_assms]: +lemma frameRegisters_def'[Arch_assms]: "frameRegisters = MachineExports.frameRegisters" by (simp add: frameRegisters_def) -lemma gpRegisters_def'[Machine_R_assms]: +lemma gpRegisters_def'[Arch_assms]: "gpRegisters = MachineExports.gpRegisters" by (simp add: gpRegisters_def) -lemma tlsBaseRegister_def'[Machine_R_assms]: +lemma tlsBaseRegister_def'[Arch_assms]: "tlsBaseRegister = MachineExports.tlsBaseRegister" by (simp add: tlsBaseRegister_def) -end +lemmas Machine_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation Machine_R?: Machine_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact Machine_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.Machine_R_assms)?) qed end diff --git a/proof/refine/X64/ArchMove_R.thy b/proof/refine/X64/ArchMove_R.thy index af26dfd6fd..c3046047ad 100644 --- a/proof/refine/X64/ArchMove_R.thy +++ b/proof/refine/X64/ArchMove_R.thy @@ -182,7 +182,7 @@ lemma no_irq_invalidateTranslationSingleASID[wp]: (* FIXME: move, missing in Ipc_AI on this architecture *) crunch handle_arch_fault_reply, arch_get_sanitise_register_info - for inv[Ipc_AI_2_assms]: P + for inv[Arch_assms]: P (* FIXME arch-split: missing from ArchCSpaceInvPre_AI on this architecture *) lemma set_cap_aobjs_of[wp]: diff --git a/proof/refine/X64/ArchRefine.thy b/proof/refine/X64/ArchRefine.thy index 5f51a7ffeb..b5647a42c5 100644 --- a/proof/refine/X64/ArchRefine.thy +++ b/proof/refine/X64/ArchRefine.thy @@ -13,7 +13,7 @@ begin context Arch begin arch_global_naming -named_theorems Refine_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Refine locale *) text \User memory content is the same on both levels\ lemma typ_at_AUserDataI: @@ -133,7 +133,7 @@ lemma p_and_not_mask_pbfs_add_mask_pbfs_eq: add: shiftr_shiftl1 mask_out_add_aligned is_aligned_neg_mask pbfs_atleast_pageBits word_plus_and_or_coroll2 add.commute) -lemma pointerInUserData_relation[Refine_assms]: +lemma pointerInUserData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInUserData p s' = in_user_frame p s" apply (simp add: pointerInUserData_def in_user_frame_def) @@ -147,7 +147,7 @@ lemma pointerInUserData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma pointerInDeviceData_relation[Refine_assms]: +lemma pointerInDeviceData_relation[Arch_assms]: "\ (s,s') \ state_relation; valid_state' s'; valid_state s\ \ pointerInDeviceData p s' = in_device_frame p s" apply (simp add: pointerInDeviceData_def in_device_frame_def) @@ -161,31 +161,31 @@ lemma pointerInDeviceData_relation[Refine_assms]: apply (simp add: p_and_not_mask_pbfs_add_mask_pbfs_eq) done -lemma user_mem_relation[Refine_assms]: +lemma user_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ user_mem' s' = user_mem s" by (rule ext) (clarsimp simp: user_mem_def user_mem'_def pointerInUserData_relation pointerInDeviceData_relation state_relation_def) -lemma device_mem_relation[Refine_assms]: +lemma device_mem_relation[Arch_assms]: "\(s,s') \ state_relation; valid_state' s'; valid_state s\ \ device_mem' s' = device_mem s" by (rule ext) (clarsimp simp: device_mem_def device_mem'_def pointerInUserData_relation pointerInDeviceData_relation) -lemma arch_activate_thread_sched_act[Refine_assms]: +lemma arch_activate_thread_sched_act[Arch_assms]: "\ct_in_state activatable and (\s. P (scheduler_action s))\ arch_activate_idle_thread t \\rs s. P (scheduler_action (s::det_state))\" by (wpsimp simp: arch_activate_idle_thread_def) -lemma valid_list_init[Refine_assms, simp]: +lemma valid_list_init[Arch_assms, simp]: "valid_list init_A_st" by (simp add: valid_list_2_def init_A_st_def ext_init_def init_cdt_def) -lemma valid_sched_init[Refine_assms, simp]: +lemma valid_sched_init[Arch_assms, simp]: "valid_sched init_A_st" apply (simp add: valid_sched_def init_A_st_def ext_init_def) apply (clarsimp simp: init_kheap_def st_tcb_at_kh_def obj_at_kh_def @@ -197,15 +197,15 @@ lemma valid_sched_init[Refine_assms, simp]: etcb_at'_def etcbs_of'_def) done -lemma valid_domain_list_init[Refine_assms, simp]: +lemma valid_domain_list_init[Arch_assms, simp]: "valid_domain_list init_A_st" by (simp add: init_A_st_def ext_init_def valid_domain_list_def) -lemma valid_domain_time_init[Refine_assms, simp]: +lemma valid_domain_time_init[Arch_assms, simp]: "0 < domain_time init_A_st" by (simp add: init_A_st_def) -lemma sched_act_init[Refine_assms, simp]: +lemma sched_act_init[Arch_assms, simp]: "scheduler_action init_A_st = resume_cur_thread" by (simp add: init_A_st_def) @@ -213,13 +213,13 @@ lemma sched_act_init[Refine_assms, simp]: defs fastpathKernelAssertions_def: "fastpathKernelAssertions \ \s. True" -lemma fastpathKernelAssertions_cross[Refine_assms]: +lemma fastpathKernelAssertions_cross[Arch_assms]: "\ (s,s') \ state_relation; invs s; valid_arch_state' s'\ \ fastpathKernelAssertions s'" unfolding fastpathKernelAssertions_def by clarsimp (* interface lemma, no vs duplicates on this architecture *) -lemma callKernel_valid_duplicates'[Refine_assms]: +lemma callKernel_valid_duplicates'[Arch_assms]: "\invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and (\s. e \ Interrupt \ ct_running' s)\ @@ -228,42 +228,43 @@ lemma callKernel_valid_duplicates'[Refine_assms]: by wpsimp (* interface lemma, no vs duplicates on this architecture *) -lemma doUserOp_valid_duplicates'[Refine_assms]: +lemma doUserOp_valid_duplicates'[Arch_assms]: "doUserOp f tc \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp (* interface lemma, no vs duplicates on this architecture *) -lemma checkActiveIRQ_valid_duplicates'[Refine_assms]: +lemma checkActiveIRQ_valid_duplicates'[Arch_assms]: "checkActiveIRQ \\s. vs_valid_duplicates' (ksPSpace s)\" by wpsimp -lemma tcb_hyp_refs'_atcbContextSet[Refine_assms, simp]: +lemma tcb_hyp_refs'_atcbContextSet[Arch_assms, simp]: "tcb_hyp_refs' (atcbContextSet tc atcb) = tcb_hyp_refs' atcb" by (simp add: atcbContextSet_def) -lemma ptable_lift_abs_state[Refine_assms, simp]: +lemma ptable_lift_abs_state[Arch_assms, simp]: "ptable_lift t (abs_state s) = ptable_lift t s" by (simp add: ptable_lift_def abs_state_def) -lemma ptable_rights_abs_state[Refine_assms, simp]: +lemma ptable_rights_abs_state[Arch_assms, simp]: "ptable_rights t (abs_state s) = ptable_rights t s" by (simp add: ptable_rights_def abs_state_def) -lemma arch_tcb_relation_arch_context_set[Refine_assms]: +lemma arch_tcb_relation_arch_context_set[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_relation (arch_tcb_context_set tc atcb) (atcbContextSet tc atcb')" by (simp add: arch_tcb_relation_def arch_tcb_context_set_def atcbContextSet_def) -lemma arch_tcb_relation_arch_context_get[Refine_assms]: +lemma arch_tcb_relation_arch_context_get[Arch_assms]: "arch_tcb_relation atcb atcb' \ arch_tcb_context_get atcb = atcbContextGet atcb'" by (simp add: arch_tcb_relation_def arch_tcb_context_get_def atcbContextGet_def) +lemmas Refine_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Refine?: Refine proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Refine_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Refine_assms)?)?) qed end diff --git a/proof/refine/X64/ArchRetype_R.thy b/proof/refine/X64/ArchRetype_R.thy index cf5c9f8c9c..6d97cb1e77 100644 --- a/proof/refine/X64/ArchRetype_R.thy +++ b/proof/refine/X64/ArchRetype_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Retype_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R locale *) -lemma toAPIType_Some[Retype_R_assms, simp]: +lemma toAPIType_Some[Arch_assms, simp]: "(toAPIType ty = Some x) = (ty = APIObjectType x)" by (cases ty; auto simp: toAPIType_def) @@ -36,19 +36,19 @@ definition APIType_map2 :: "kernel_object + X64_H.object_type \ Stru (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_map2_def = APIType_map2_raw_def[simplified APIType_map2_gen_def] -lemma APIType_map2_Untyped[Retype_R_assms, simp]: +lemma APIType_map2_Untyped[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.Untyped) = (tp = Inr (APIObjectType ArchTypes_H.Untyped))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_TCBObject[Retype_R_assms, simp]: +lemma APIType_map2_TCBObject[Arch_assms, simp]: "(APIType_map2 tp = Structures_A.TCBObject) = (tp = Inr (APIObjectType ArchTypes_H.TCBObject))" by (simp add: APIType_map2_def split: sum.split object_type.split kernel_object.split arch_kernel_object.splits apiobject_type.split) -lemma APIType_map2_generic[Retype_R_assms, simp]: +lemma APIType_map2_generic[Arch_assms, simp]: "APIType_map2 (Inr (APIObjectType api)) = APIType_map2_gen api" by (simp add: APIType_map2_raw_def) @@ -67,11 +67,11 @@ definition APIType_capBits :: "X64_H.object_type \ nat \ (* inside of Arch, we don't need to isolate generic component *) lemmas APIType_capBits_def = APIType_capBits_raw_def[simplified APIType_capBits_gen_def] -lemma APIType_capBits_generic[Retype_R_assms, simp]: +lemma APIType_capBits_generic[Arch_assms, simp]: "APIType_capBits (APIObjectType api) us = APIType_capBits_gen api us" by (simp add: APIType_capBits_raw_def) -lemma objSize_eq_capBits[simp, Retype_R_assms]: +lemma objSize_eq_capBits[simp, Arch_assms]: "Types_H.getObjectSize ty us = APIType_capBits ty us" by (cases ty; clarsimp simp: getObjectSize_def objBits_simps bit_simps @@ -97,13 +97,13 @@ definition makeObjectKO :: "bool \ domain \ (kernel_obje (* inside of Arch, we don't need to isolate generic component *) lemmas makeObjectKO_def = makeObjectKO_raw_def[simplified makeObjectKO_gen_def] -lemma makeObjectKO_generic[Retype_R_assms, simp]: +lemma makeObjectKO_generic[Arch_assms, simp]: "makeObjectKO dev d (Inr (APIObjectType api)) = makeObjectKO_gen d api" by (simp add: makeObjectKO_raw_def) text \makeObject etc. lemmas\ -lemma valid_arch_tcb'_newArchTCB[Retype_R_assms, simp]: +lemma valid_arch_tcb'_newArchTCB[Arch_assms, simp]: "valid_arch_tcb' newArchTCB s" unfolding valid_arch_tcb'_def newArchTCB_def by simp @@ -133,7 +133,7 @@ text \On the abstract side\ text \Lemmas for createNewObjects etc.\ -lemma makeObjectKO_eq[Retype_R_assms]: +lemma makeObjectKO_eq[Arch_assms]: assumes x: "makeObjectKO dev d tp = Some v" shows "(v = KOCTE cte) = @@ -145,7 +145,7 @@ lemma makeObjectKO_eq[Retype_R_assms]: split: apiobject_type.split_asm sum.split_asm kernel_object.split_asm X64_H.object_type.split_asm arch_kernel_object.split_asm)+ -lemma objBits_le_obj_bits_api[Retype_R_assms]: +lemma objBits_le_obj_bits_api[Arch_assms]: "makeObjectKO dev d ty = Some ko \ objBitsKO ko \ obj_bits_api (APIType_map2 ty) us" apply (case_tac ty) apply (auto simp: default_arch_object_def bit_simps @@ -154,7 +154,7 @@ lemma objBits_le_obj_bits_api[Retype_R_assms]: Structures_H.kernel_object.splits arch_kernel_object.splits apiobject_type.splits) done -lemma obj_relation_retype_other_obj[Retype_R_assms]: +lemma obj_relation_retype_other_obj[Arch_assms]: "\ is_other_obj_relation_type (a_type ko); other_obj_relation ko ko' \ \ obj_relation_retype ko ko'" apply (simp add: obj_relation_retype_def) @@ -187,7 +187,7 @@ lemma sym_refs_empty[simp]: unfolding sym_refs_def by simp -lemma ksPSpace_update_gs_eq[Retype_R_assms, simp]: +lemma ksPSpace_update_gs_eq[Arch_assms, simp]: "ksPSpace (update_gs ty us ptrs s) = ksPSpace s" by (simp add: update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) @@ -208,12 +208,12 @@ lemma update_gs_ksMachineState_update_swap: by (simp add: update_gs_def split: aobject_type.splits Structures_A.apiobject_type.splits) -lemma update_gs_id[Retype_R_assms]: +lemma update_gs_id[Arch_assms]: "tp \ no_gs_types \ update_gs tp us addrs = id" by (simp add: no_gs_types_def update_gs_def split: Structures_A.apiobject_type.splits aobject_type.splits) -lemma no_gs_types_CapTableObject[Retype_R_assms]: +lemma no_gs_types_CapTableObject[Arch_assms]: "Structures_A.apiobject_type.CapTableObject \ no_gs_types" by (simp add: no_gs_types_def) @@ -228,7 +228,7 @@ lemma update_gs_simps[simp]: gsUserPages_update (\ups x. if x \ ptrs then Some X64HugePage else ups x)" by (simp_all add: update_gs_def) -lemma objBitsKO_gt_0[Retype_R_assms]: +lemma objBitsKO_gt_0[Arch_assms]: "0 < objBitsKO ko" apply (case_tac ko) apply (simp_all add: objBits_simps' pageBits_def) @@ -288,7 +288,7 @@ lemma range_cover_canonical_address': apply (frule range_cover_canonical_address[where p="unat p"]; simp?) using unat_less_helper by blast -lemma createNewCaps_valid_cap[Retype_R_assms]: +lemma createNewCaps_valid_cap[Arch_assms]: fixes ptr :: machine_word assumes cover: "range_cover ptr sz (APIType_capBits ty us) n " assumes not_0: "n \ 0" @@ -538,7 +538,7 @@ proof - qed qed -lemma arch_tcb_relation_default[Retype_R_assms]: +lemma arch_tcb_relation_default[Arch_assms]: "arch_tcb_relation default_arch_tcb newArchTCB" by (clarsimp simp: new_context_def newContext_def initContext_def default_arch_tcb_def newArchTCB_def arch_tcb_relation_def) @@ -633,7 +633,7 @@ lemmas object_splits = X64_H.object_type.split_asm arch_kernel_object.split_asm -lemma valid_arch_badges_not_arch[Retype_R_assms]: +lemma valid_arch_badges_not_arch[Arch_assms]: "\isArchObjectCap cap' \ valid_arch_badges cap cap' node" by (auto simp: isCap_simps valid_arch_badges_def) @@ -641,7 +641,7 @@ lemma valid_arch_badges_NullCap[simp]: "valid_arch_badges cap NullCap node" by (simp add: valid_arch_badges_not_arch gen_isCap_simps) -lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: +lemma valid_untyped'_helper_arch_cap[Arch_assms]: "\pspace_aligned' s; pspace_distinct' s; pspace_no_overlap' ptr sz s; range_cover ptr sz (objBitsKO val) n; valid_arch_cap' acap s \ \ valid_arch_cap' acap @@ -650,7 +650,7 @@ lemma valid_untyped'_helper_arch_cap[Retype_R_assms]: typ_at_to_obj_at_arches vspace_table_at'_defs split: if_split_asm arch_capability.splits) -lemma retype_in_kernel_mappings'[Retype_R_assms]: +lemma retype_in_kernel_mappings'[Arch_assms]: assumes pc': "pspace_in_kernel_mappings' s'" and cover: "range_cover ptr sz (objBitsKO ko) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -708,7 +708,7 @@ lemma copyGlobalMappings_valid_pspace[wp]: "\valid_pspace'\ copyGlobalMappings pd \\rv. valid_pspace'\" by (simp add: valid_pspace'_def | wp)+ -lemma createNewCaps_cte_wp_at2[Retype_R_assms]: +lemma createNewCaps_cte_wp_at2[Arch_assms]: "\\s. P (cte_wp_at' P' p s) \ \ P' makeObject \ n \ 0 \ range_cover ptr sz (APIType_capBits ty objsz) n @@ -729,7 +729,7 @@ lemma createNewCaps_cte_wp_at2[Retype_R_assms]: | simp)+ done -lemma createNewCaps_cte_wp_at'[Retype_R_assms]: +lemma createNewCaps_cte_wp_at'[Arch_assms]: "\\s. cte_wp_at' P p s \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -754,7 +754,7 @@ lemma createNewCaps_cte_wp_at'[Retype_R_assms]: (* example of arch-split attempt of this kind of proof; unfortunately splitting off the arch-specific part doesn't actually save space, so we will leave these in Arch *) -lemma createNewCaps_state_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -782,7 +782,7 @@ lemma createNewCaps_state_refs_of'[Retype_R_assms]: apply (force simp: gen_objBits_simps split: ArchTypes_H.apiobject_type.splits) done -lemma createNewCaps_state_hyp_refs_of'[Retype_R_assms]: +lemma createNewCaps_state_hyp_refs_of'[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -811,7 +811,7 @@ lemma arch_live'_KOPTE[simp]: "arch_live' (KOPTE makeObject) = False" by (simp add: makeObject_pte arch_live'_def) -lemma createNewCaps_iflive'[Retype_R_assms, wp]: +lemma createNewCaps_iflive'[Arch_assms, wp]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" and not_0: "n \ 0" shows @@ -843,17 +843,17 @@ crunch createNewCaps for qs[wp]: "\s. P (ksReadyQueues s)" and qsL1[wp]: "\s. P (ksReadyQueuesL1Bitmap s)" and qsL2[wp]: "\s. P (ksReadyQueuesL2Bitmap s)" - and ct[Retype_R_assms, wp]: "\s. P (ksCurThread s)" - and ksCurDomain[Retype_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksInterrupt[Retype_R_assms, wp]: "\s. P (ksInterruptState s)" - and nosch[Retype_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and it[Retype_R_assms, wp]: "\s. P (ksIdleThread s)" + and ct[Arch_assms, wp]: "\s. P (ksCurThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksInterrupt[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and it[Arch_assms, wp]: "\s. P (ksIdleThread s)" and gsMaxObjectSize[wp]: "\s. P (gsMaxObjectSize s)" - and irq_states'[Retype_R_assms, wp]: valid_irq_states' - and ksDomSchedule[Retype_R_assms, wp]: "\s. P (ksDomSchedule s)" - and ksDomScheduleIdx[Retype_R_assms, wp]: "\s. P (ksDomScheduleIdx s)" - and ksDomScheduleStart[Retype_R_assms, wp]: "\s. P (ksDomScheduleStart s)" - and gsUntypedZeroRanges[Retype_R_assms, wp]: "\s. P (gsUntypedZeroRanges s)" + and irq_states'[Arch_assms, wp]: valid_irq_states' + and ksDomSchedule[Arch_assms, wp]: "\s. P (ksDomSchedule s)" + and ksDomScheduleIdx[Arch_assms, wp]: "\s. P (ksDomScheduleIdx s)" + and ksDomScheduleStart[Arch_assms, wp]: "\s. P (ksDomScheduleStart s)" + and gsUntypedZeroRanges[Arch_assms, wp]: "\s. P (gsUntypedZeroRanges s)" and ksArch[wp]: "\s. P (ksArchState s)" (simp: crunch_simps unless_def wp: mapM_x_wp' setObject_ksInterrupt updateObject_default_inv crunch_wps @@ -882,11 +882,11 @@ proof (rule hoare_gen_asm) done qed -lemma createNewCaps_arch_ko_type_pre_non_arch[Retype_R_assms]: +lemma createNewCaps_arch_ko_type_pre_non_arch[Arch_assms]: "(case ty of ArchT _ \ False | _ \ True) \ createNewCaps_arch_ko_type_pre ty" by (clarsimp simp add: createNewCaps_arch_ko_type_pre_def) -lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: +lemma createNewCaps_ko_wp_atQ'[Arch_assms]: "\(\s. P (ko_wp_at' P' p s) \ range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s @@ -915,7 +915,7 @@ lemma createNewCaps_ko_wp_atQ'[Retype_R_assms]: | split if_split_asm)+ done -lemma createNewCaps_global_refs'[Retype_R_assms]: +lemma createNewCaps_global_refs'[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits ty us) n \ n \ 0 \ pspace_aligned' s \ pspace_distinct' s \ pspace_no_overlap' ptr sz s \ valid_global_refs' s @@ -938,7 +938,7 @@ lemma createNewCaps_global_refs'[Retype_R_assms]: apply (auto simp: linorder_not_less ball_ran_eq) done -lemma createNewCaps_valid_bitmaps[Retype_R_assms]: +lemma createNewCaps_valid_bitmaps[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_bitmaps s\ createNewCaps ty ptr n us dev \\_. valid_bitmaps\" @@ -954,7 +954,7 @@ lemma createNewCaps_valid_bitmaps[Retype_R_assms]: | intro conjI impI)+ done -lemma createNewCaps_valid_sched_pointers[Retype_R_assms]: +lemma createNewCaps_valid_sched_pointers[Arch_assms]: "\\s. valid_pspace' s \ pspace_no_overlap' ptr sz s \ valid_sched_pointers s\ createNewCaps ty ptr n us dev \\_. valid_sched_pointers\" @@ -976,7 +976,7 @@ lemma copyGlobalMappings_ksMachineState[wp]: by (simp add: copyGlobalMappings_def storePML4E_def split_def | wp mapM_x_wp_inv setObject_ksMachine updateObject_default_inv)+ -lemma createNewCaps_vms[Retype_R_assms]: +lemma createNewCaps_vms[Arch_assms]: "\pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ 0 < n) and valid_machine_state'\ @@ -1002,7 +1002,7 @@ lemma createNewCaps_vms[Retype_R_assms]: field_simps mult_2_right bit_simps) done -lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: +lemma createNewCaps_pspace_domain_valid[Arch_assms, wp]: "\pspace_domain_valid and K ({ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1} \ kernel_data_refs = {} \ range_cover ptr sz (APIType_capBits ty us) n \ 0 < n)\ @@ -1021,10 +1021,12 @@ lemma createNewCaps_pspace_domain_valid[Retype_R_assms, wp]: (* safe for generic context, and we can't requalify object_type.inject as that would result in it being named "inject" *) -lemma object_type_inject[Retype_R_assms]: +lemma object_type_inject[Arch_assms]: "(APIObjectType x = APIObjectType y) = (x = y)" by simp +lemmas Retype_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) arch_requalify_consts @@ -1035,8 +1037,7 @@ arch_requalify_consts interpretation Retype_R?: Retype_R makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Retype_R_assms)?)?) qed locale Arch_retype_mdb = retype_mdb + Arch @@ -1065,11 +1066,11 @@ end (* Arch_retype_mdb *) context Arch begin arch_global_naming -named_theorems Retype_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_2 locale *) (* drop the Arch assumption directly instead of requalifying to improve processing time (unfold_locales for Arch is slow) *) -lemmas [Retype_R_2_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] +lemmas [Arch_assms] = Arch_retype_mdb.valid_n[simplified Arch_retype_mdb_def] (* FIXME arch-split: currently only the gen_ version is used *) lemmas valid_obj_makeObject_rules = @@ -1077,7 +1078,7 @@ lemmas valid_obj_makeObject_rules = valid_obj_makeObject_pte valid_obj_makeObject_pde valid_obj_makeObject_asid_pool valid_obj_makeObject_pdpte valid_obj_makeObject_pml4e -lemma retype_state_relation[Retype_R_2_assms]: +lemma retype_state_relation[Arch_assms]: notes data_map_insert_def[simp del] assumes sr: "(s, s') \ state_relation" and vs: "valid_pspace s" "valid_mdb s" @@ -1305,7 +1306,7 @@ lemma retype_state_relation[Retype_R_2_assms]: split: Structures_A.apiobject_type.splits aobject_type.splits) qed -lemma createObjects_valid_objs'[Retype_R_2_assms]: +lemma createObjects_valid_objs'[Arch_assms]: assumes mko: "makeObjectKO dev d ty = Some val" and max_d: "ty = Inr (APIObjectType TCBObject) \ d \ maxDomain" and vo: "valid_objs' s" @@ -1391,7 +1392,7 @@ proof - done qed -lemma createNewCaps_idle'[Retype_R_2_assms, wp]: +lemma createNewCaps_idle'[Arch_assms, wp]: "\valid_idle' and valid_pspace' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ createNewCaps ty ptr n us d @@ -1432,7 +1433,7 @@ lemma createNewCaps_obj_at'': apply (clarsimp simp: project_koType project_inject) done -lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: +lemma createNewCaps_valid_arch_state[Arch_assms]: "\(\s. valid_arch_state' s \ valid_pspace' s \ pspace_no_overlap' ptr sz s \ (tp = APIObjectType ArchTypes_H.CapTableObject \ us > 0)) and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0)\ @@ -1459,7 +1460,7 @@ lemma createNewCaps_valid_arch_state[Retype_R_2_assms]: apply auto done -lemma createNewCaps_sched_queues[Retype_R_2_assms]: +lemma createNewCaps_sched_queues[Arch_assms]: assumes cover: "range_cover ptr sz (APIType_capBits ty us) n" assumes not_0: "n \ 0" shows @@ -1483,7 +1484,7 @@ lemma createNewCaps_sched_queues[Retype_R_2_assms]: split_del: if_split, fastforce simp add: mult_2 add_ac bit_simps)+ -lemma createNewCaps_null_filter'[Retype_R_2_assms]: +lemma createNewCaps_null_filter'[Arch_assms]: "\(\s. P (null_filter' (ctes_of s))) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \ n \ 0) \ @@ -1507,7 +1508,7 @@ lemma createNewCaps_null_filter'[Retype_R_2_assms]: | fastforce)+ done -lemma createObjects_no_cte_valid_global[Retype_R_2_assms]: +lemma createObjects_no_cte_valid_global[Arch_assms]: assumes no_cte: "\c. projectKO_opt val \ Some (c::cte)" assumes no_tcb: "\t. projectKO_opt val \ Some (t::tcb)" shows "\\s. pspace_aligned' s \ pspace_distinct' s \ @@ -1551,7 +1552,7 @@ lemma createObjects_valid_arch: apply auto done -lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: +lemma createObjects_untyped_ranges_zero'[Arch_assms]: assumes moKO: "makeObjectKO dev d ty = Some val" shows "\ct_active' and valid_pspace' and pspace_no_overlap' ptr sz @@ -1577,18 +1578,19 @@ lemma createObjects_untyped_ranges_zero'[Retype_R_2_assms]: apply (simp add: makeObject_cte untypedZeroRange_def) done +lemmas Retype_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_2?: Retype_R_2 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Retype_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Retype_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Retype_R_3 locale *) lemma createObjects_no_cte_invs: assumes moKO: "makeObjectKO dev d ty = Some val" @@ -1674,7 +1676,7 @@ proof - split: option.splits kernel_object.splits) qed -lemma createNewCaps_valid_pspace[Retype_R_3_assms]: +lemma createNewCaps_valid_pspace[Arch_assms]: assumes not_0: "n \ 0" and cover: "range_cover ptr sz (APIType_capBits ty us) n" and sz_limit: "sz \ maxUntypedSizeBits" @@ -1761,7 +1763,7 @@ lemma createObjects_pml4_at: apply clarsimp done -lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: +lemma corres_retype_region_createNewCaps[Arch_assms]: "corres ((\r r'. length r = length r' \ list_all2 cap_relation r r') \ map (\ref. default_cap (APIType_map2 (Inr ty)) ref us dev)) (\s. valid_pspace s \ valid_mdb s \ valid_list s \ valid_arch_state s @@ -1951,13 +1953,14 @@ lemma corres_retype_region_createNewCaps[Retype_R_3_assms]: range_cover.aligned) done +lemmas Retype_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Retype_R_3?: Retype_R_3 makeObjectKO APIType_map2 APIType_capBits update_gs proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Retype_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Retype_R_3_assms)?)?) qed end diff --git a/proof/refine/X64/ArchSchedule_R.thy b/proof/refine/X64/ArchSchedule_R.thy index 229b344e3a..472b4b943d 100644 --- a/proof/refine/X64/ArchSchedule_R.thy +++ b/proof/refine/X64/ArchSchedule_R.thy @@ -11,7 +11,7 @@ begin context Arch begin arch_global_naming -named_theorems Schedule_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R locale *) crunch set_vm_root for pspace_distinct[wp]: pspace_distinct @@ -118,7 +118,7 @@ crunch set_vm_root (simp: crunch_simps wp: crunch_wps valid_cur_fpu_lift_arch) crunch tcbSchedAppend, tcbSchedDequeue, tcbSchedEnqueue - for state_hyp_refs_of'[Schedule_R_assms, wp]: "\s. P (state_hyp_refs_of' s)" + for state_hyp_refs_of'[Arch_assms, wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps obj_at'_def wp: getObject_tcb_wp) crunch setVMRoot, lazyFpuRestore @@ -144,21 +144,21 @@ proof - by (rule lift_neg_pred_tcb_at' [OF ArchThreadDecls_H_X64_H_switchToThread_typ_at' pos]) qed -lemmas Arch_switchToThread_st_tcb_at'[Schedule_R_assms] = +lemmas Arch_switchToThread_st_tcb_at'[Arch_assms] = Arch_switchToThread_pred_tcb'[where proj=itcbState] crunch storeWordUser, setVMRoot, asUser, storeWordUser, Arch.switchToThread, Arch.switchToIdleThread for ksQ[wp]: "\s. P (ksReadyQueues s)" - and ksIdleThread[Schedule_R_assms, wp]: "\s. P (ksIdleThread s)" - and sym_heap_sched_pointers[Schedule_R_assms, wp]: sym_heap_sched_pointers - and valid_objs'[Schedule_R_assms, wp]: valid_objs' + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and sym_heap_sched_pointers[Arch_assms, wp]: sym_heap_sched_pointers + and valid_objs'[Arch_assms, wp]: valid_objs' (wp: crunch_wps threadSet_sched_pointers getObject_tcb_wp getASID_wp simp: crunch_simps obj_at'_def) crunch arch_switch_to_thread, arch_switch_to_idle_thread - for pspace_aligned[Schedule_R_assms, wp]: pspace_aligned - and pspace_distinct[Schedule_R_assms, wp]: pspace_distinct - and ready_queues[Schedule_R_assms, wp]: "\s. P (ready_queues s)" + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct + and ready_queues[Arch_assms, wp]: "\s. P (ready_queues s)" and ready_qs_distinct[wp]: ready_qs_distinct (wp: ready_qs_distinct_lift crunch_wps simp: crunch_simps) @@ -175,7 +175,7 @@ lemma arch_switchToThread_corres: term_simp: tcb_relation_def arch_tcb_relation_def) (* use superset of arch_switchToThread_corres preconditions across the architectures as interface *) -lemma arch_switchToThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and valid_objs and valid_asid_map and valid_arch_caps and pspace_aligned and pspace_distinct and valid_global_objs and (\s. sym_refs (state_hyp_refs_of s)) @@ -196,7 +196,7 @@ lemma arch_switchToIdleThread_corres: (clarsimp simp: valid_idle_def pred_tcb_at_def obj_at_def is_tcb)+ (* use superset of arch_switchToIdleThread_corres preconditions across the architectures as interface *) -lemma arch_switchToIdleThread_corres_interface[Schedule_R_assms]: +lemma arch_switchToIdleThread_corres_interface[Arch_assms]: "corres dc (valid_arch_state and pspace_aligned and pspace_distinct and valid_asid_map and valid_idle and valid_arch_caps and valid_global_objs and valid_vspace_objs and valid_objs) @@ -226,14 +226,14 @@ lemma lazyFpuRestore_invs[wp]: unfolding lazyFpuRestore_def by (wpsimp wp: threadGet_wp) -lemma Arch_switchToThread_invs[Schedule_R_assms, wp]: +lemma Arch_switchToThread_invs[Arch_assms, wp]: "\invs' and tcb_at' t\ Arch.switchToThread t \\rv. invs'\" unfolding X64_H.switchToThread_def by wpsimp crunch "Arch.switchToThread" - for ksCurDomain[Schedule_R_assms, wp]: "\s. P (ksCurDomain s)" - and tcbDomain[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" - and tcbState[Schedule_R_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" + for ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and tcbDomain[Arch_assms, wp]: "obj_at' (\tcb. P (tcbDomain tcb)) t'" + and tcbState[Arch_assms, wp]: "obj_at' (\tcb. P (tcbState tcb)) t'" (simp: crunch_simps wp: crunch_wps getASID_wp) lemma threadSet_invs_no_cicd'_trivialT: @@ -292,7 +292,7 @@ crunch lazyFpuRestore for invs_no_cicd'[wp]: invs_no_cicd' (ignore: doMachineOp modifyArchState) -lemma Arch_switchToThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToThread_invs_no_cicd'[Arch_assms]: "Arch.switchToThread t \invs_no_cicd'\" by (wpsimp wp: setVMRoot_invs_no_cicd' simp: X64_H.switchToThread_def) @@ -308,7 +308,7 @@ crunch "ThreadDecls_H.switchToThread" for ksCurDomain[wp]: "\s. P (ksCurDomain s)" (* neater unfold, actual unfold is really ugly *) -lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: +lemma bitmapQ_lookupBitmapPriority_simp[Arch_assms]: "\ ksReadyQueuesL1Bitmap s d \ 0 ; valid_bitmapQ s ; bitmapQ_no_L1_orphans s \ \ bitmapQ d (lookupBitmapPriority d s) s = (ksReadyQueuesL1Bitmap s d !! word_log2 (ksReadyQueuesL1Bitmap s d) \ @@ -333,7 +333,7 @@ lemma bitmapQ_lookupBitmapPriority_simp[Schedule_R_assms]: apply (fastforce intro: word_of_nat_less simp: wordRadix_def' unat_of_nat word_size)+ done -lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: +lemma Arch_switchToIdleThread_invs_no_cicd'[Arch_assms]: "Arch.switchToIdleThread \invs_no_cicd'\" unfolding switchToIdleThread_def by (wpsimp wp: setCurThread_invs_no_cicd'_idle_thread setVMRoot_invs_no_cicd') @@ -341,28 +341,29 @@ lemma Arch_switchToIdleThread_invs_no_cicd'[Schedule_R_assms]: crunch Arch.switchToIdleThread for obj_at'[wp]: "obj_at' P t" -lemmas Arch_switchToIdleThread_not_queued'[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_not_queued'[Arch_assms] = ArchThreadDecls_H_X64_H_switchToIdleThread_obj_at'[where P="Not \ tcbQueued"] -lemmas Arch_switchToIdleThread_tcbState[Schedule_R_assms] = +lemmas Arch_switchToIdleThread_tcbState[Arch_assms] = ArchThreadDecls_H_X64_H_switchToIdleThread_obj_at'[where P="P \ tcbState" for P] crunch arch_switch_to_thread, handle_spurious_irq - for valid_idle[Schedule_R_assms, wp]: valid_idle + for valid_idle[Arch_assms, wp]: valid_idle + +lemmas Schedule_R_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R?: Schedule_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Schedule_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_2 locale *) -lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: +lemma bitmapL1_highest_lookup[Arch_assms]: "\ valid_bitmapQ s ; bitmapQ_no_L1_orphans s ; bitmapQ d p s \ \ p \ lookupBitmapPriority d s" apply (subgoal_tac "ksReadyQueuesL1Bitmap s d \ 0") @@ -408,7 +409,7 @@ lemma bitmapL1_highest_lookup[Schedule_R_2_assms]: apply (erule word_log2_maximum) done -lemma guarded_switch_to_chooseThread_fragment_corres[Schedule_R_2_assms]: +lemma guarded_switch_to_chooseThread_fragment_corres[Arch_assms]: "corres dc (P and st_tcb_at runnable t and invs and valid_sched) (P' and invs_no_cicd') @@ -445,19 +446,20 @@ crunch prepareNextDomain and nosch[wp]: "\s. P (ksSchedulerAction s)" crunch tcb_sched_action - for valid_vs_lookup[Schedule_R_2_assms, wp]: valid_vs_lookup + for valid_vs_lookup[Arch_assms, wp]: valid_vs_lookup + +lemmas Schedule_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation Schedule_R_2?: Schedule_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Schedule_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Schedule_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Schedule_R_3 locale *) lemma scheduleChooseNewThread_fragment_corres: "corres dc (invs and valid_domain_list and valid_sched and @@ -481,7 +483,7 @@ lemma scheduleChooseNewThread_fragment_corres: apply (auto simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def) done -lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_corres[Arch_assms]: "corres dc (\s. invs s \ valid_domain_list s \ valid_sched s \ scheduler_action s = choose_new_thread) (\s. invs' s \ ksSchedulerAction s = ChooseNewThread) @@ -494,7 +496,7 @@ lemma scheduleChooseNewThread_corres[Schedule_R_3_assms]: apply (wpsimp simp: getDomainTime_def)+ done -lemma scheduleChooseNewThread_invs'[Schedule_R_3_assms]: +lemma scheduleChooseNewThread_invs'[Arch_assms]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \ \_ s. invs' s \" @@ -524,7 +526,7 @@ lemma stit_nosch[wp]: apply (wp setCurThread_nosch | simp add: getIdleThread_def)+ done -lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: +lemma scheduleChooseNewThread_ct_activatable'[Arch_assms, wp]: "\ invs' and (\s. ksSchedulerAction s = ChooseNewThread) \ scheduleChooseNewThread \\_. ct_in_state' activatable'\" @@ -535,12 +537,13 @@ lemma scheduleChooseNewThread_ct_activatable'[Schedule_R_3_assms, wp]: | (rule hoare_lift_Pf[where f=ksCurThread], solves wp) | strengthen invs'_invs_no_cicd)+ +lemmas Schedule_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Schedule_R_3?: Schedule_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Schedule_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Schedule_R_3_assms)?)?) qed end diff --git a/proof/refine/X64/ArchStateRelationLemmas.thy b/proof/refine/X64/ArchStateRelationLemmas.thy index a74245d57d..fc08790aab 100644 --- a/proof/refine/X64/ArchStateRelationLemmas.thy +++ b/proof/refine/X64/ArchStateRelationLemmas.thy @@ -19,7 +19,7 @@ lemma inj_ASIDPool[simp]: "inj ASIDPool" by (auto intro: injI) -named_theorems StateRelation_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for StateRelation_R locale *) lemma obj_relation_cuts_def2: "obj_relation_cuts ko x = @@ -100,7 +100,7 @@ lemma obj_relation_cutsE: pdpte_relation_def pml4e_relation_def)+) done -lemma is_other_obj_relation_type_gen[simp, StateRelation_R_assms]: +lemma is_other_obj_relation_type_gen[simp, Arch_assms]: "\n. \ is_other_obj_relation_type (ACapTable n)" "\ is_other_obj_relation_type ATCB" "is_other_obj_relation_type AEndpoint" @@ -116,7 +116,7 @@ lemma is_other_obj_relation_type_DeviceData: "\ is_other_obj_relation_type (AArch (ADeviceData sz))" unfolding is_other_obj_relation_type_def by simp -lemma obj_relation_cuts_trivial[StateRelation_R_assms]: +lemma obj_relation_cuts_trivial[Arch_assms]: "ptr \ fst ` obj_relation_cuts ty ptr" apply (case_tac ty) apply (rename_tac sz cs) @@ -192,7 +192,7 @@ lemma ghost_relation_wrapper_lift': apply wp done -lemma ghost_relation_wrapper_genD[StateRelation_R_assms]: +lemma ghost_relation_wrapper_genD[Arch_assms]: "ghost_relation_wrapper s s' \ ups_of_heap (kheap s) = gsUserPages s' \ cns_of_heap (kheap s) = gsCNodes s'" by (simp add: ghost_relation_of_heap) @@ -235,20 +235,21 @@ lemma other_aobj_relation_aobj: unfolding other_aobj_relation_def is_ArchObj_def by (clarsimp split: Structures_A.kernel_object.splits) -lemma msgLabelBits_msg_label_bits[StateRelation_R_assms]: +lemma msgLabelBits_msg_label_bits[Arch_assms]: "msgLabelBits = msg_label_bits" by (simp add: msgLabelBits_def) -lemma msgInfoRegister_msg_info_register[StateRelation_R_assms]: +lemma msgInfoRegister_msg_info_register[Arch_assms]: "msgInfoRegister = msg_info_register" by (simp add: msg_info_register_def msgInfoRegister_def) -end +lemmas StateRelation_R_assms = Arch_assms (* extract accumulated assumptions *) + +end (* Arch *) global_interpretation StateRelation_R?: StateRelation_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; fact StateRelation_R_assms)?) + case 1 show ?case by (intro_locales; (unfold_locales; fact X64.StateRelation_R_assms)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/X64/ArchSyscall_R.thy b/proof/refine/X64/ArchSyscall_R.thy index 13d389079f..331f593349 100644 --- a/proof/refine/X64/ArchSyscall_R.thy +++ b/proof/refine/X64/ArchSyscall_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Syscall_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Syscall_R locale *) -lemma prepareSetDomain_corres[Syscall_R_assms, corres]: +lemma prepareSetDomain_corres[Arch_assms, corres]: "corres dc (pspace_aligned and pspace_distinct and valid_cur_fpu and valid_arch_state and tcb_at tptr) (pspace_aligned' and pspace_distinct' and no_0_obj') (arch_prepare_set_domain tptr new_dom) (prepareSetDomain tptr new_dom)" @@ -23,19 +23,19 @@ lemma prepareSetDomain_corres[Syscall_R_assms, corres]: by corres crunch prepareSetDomain - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' and ksSchedulerAction[wp]: "\s. P (ksSchedulerAction s)" - and sch_act_simple[Syscall_R_assms, wp]: sch_act_simple - and tcb_at'[Syscall_R_assms, wp]: "tcb_at' p" + and sch_act_simple[Arch_assms, wp]: sch_act_simple + and tcb_at'[Arch_assms, wp]: "tcb_at' p" and ksCurThread[wp]: "\s. P (ksCurThread s)" and pred_tcb_at'[wp]: "pred_tcb_at' proj P t" - and ct_in_state'[Syscall_R_assms, wp]: "ct_in_state' P" + and ct_in_state'[Arch_assms, wp]: "ct_in_state' P" (wp: sch_act_simple_lift ct_in_state_thread_state_lift' crunch_wps) crunch postSetFlags, Arch.performIRQControl, Arch.invokeIRQHandler - for typ_at'[Syscall_R_assms, wp]: "\s. P (typ_at' T p s)" + for typ_at'[Arch_assms, wp]: "\s. P (typ_at' T p s)" -lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: +lemma setThreadState_irq_control_inv_valid'[Arch_assms, wp]: "setThreadState st t \irq_control_inv_valid' irqcontrol_invocation\" apply (case_tac irqcontrol_invocation; simp) apply (rename_tac archirq_inv) @@ -44,11 +44,11 @@ lemma setThreadState_irq_control_inv_valid'[Syscall_R_assms, wp]: done (* FIXME arch-split: consider moving to where other msgRegisters stuff goes... Tcb_R? Ipc_R? *) -lemma len_msg_registes_le_max_length[Syscall_R_assms]: +lemma len_msg_registes_le_max_length[Arch_assms]: "length msg_registers \ msg_max_length" by (simp add: msg_max_length_def msgRegisters_unfold) -lemma capRegister_cap_register[Syscall_R_assms]: +lemma capRegister_cap_register[Arch_assms]: "capRegister = cap_register" by (simp add: cap_register_def capRegister_def) @@ -56,7 +56,7 @@ lemma getFaultAddress_invs'[wp]: "doMachineOp getFaultAddress \invs'\" by (simp add: getFaultAddress_def doMachineOp_def split_def select_f_returns | wp)+ -lemma hv_invs'[Syscall_R_assms, wp]: +lemma hv_invs'[Arch_assms, wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" apply (simp add: X64_H.handleVMFault_def cong: vmfault_type.case_cong) @@ -65,13 +65,13 @@ lemma hv_invs'[Syscall_R_assms, wp]: done crunch handleVMFault - for nosch[Syscall_R_assms, wp]: "\s. P (ksSchedulerAction s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" -lemma handleSpuriousIRQ_corres[Syscall_R_assms, corres]: +lemma handleSpuriousIRQ_corres[Arch_assms, corres]: "corres dc \ \ handle_spurious_irq handleSpuriousIRQ" by (simp add: handle_spurious_irq_def handleSpuriousIRQ_def) -lemma handleHypervisorFault_corres[Syscall_R_assms]: +lemma handleHypervisorFault_corres[Arch_assms]: "corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread) (invs' and sch_act_not thread and st_tcb_at' simple' thread and ex_nonz_cap_to' thread) @@ -79,7 +79,7 @@ lemma handleHypervisorFault_corres[Syscall_R_assms]: apply (cases fault; clarsimp simp: handleHypervisorFault_def isFpuEnable_def split del: if_split) done -lemma hvmf_invs_lift[Syscall_R_assms]: +lemma hvmf_invs_lift[Arch_assms]: "(\s m. P (s\ksMachineState := ksMachineState s\machine_state_rest := m\\) = P s) \ \P\ handleVMFault t flt \\_ _. True\, \\_. P\" unfolding handleVMFault_def @@ -88,16 +88,16 @@ lemma hvmf_invs_lift[Syscall_R_assms]: doMachineOp_bind getRestartPC_def getRegister_def) crunch handleVMFault - for st_tcb_at'[Syscall_R_assms, wp]: "st_tcb_at' P t" - and ex_nonz_cap_to'[Syscall_R_assms, wp]: "ex_nonz_cap_to' t" - and norq[Syscall_R_assms, wp]: "\s. P (ksReadyQueues s)" - and ksit[Syscall_R_assms, wp]: "\s. P (ksIdleThread s)" + for st_tcb_at'[Arch_assms, wp]: "st_tcb_at' P t" + and ex_nonz_cap_to'[Arch_assms, wp]: "ex_nonz_cap_to' t" + and norq[Arch_assms, wp]: "\s. P (ksReadyQueues s)" + and ksit[Arch_assms, wp]: "\s. P (ksIdleThread s)" crunch handleHypervisorFault for ksit[wp]: "\s. P (ksIdleThread s)" (wp: undefined_valid haskell_assert_inv simp: isFpuEnable_def) -lemma hh_invs'[Syscall_R_assms, wp]: +lemma hh_invs'[Arch_assms, wp]: "\invs' and sch_act_not p and st_tcb_at' simple' p and ex_nonz_cap_to' p and (\s. p \ ksIdleThread s)\ handleHypervisorFault p t \\_. invs'\" @@ -105,14 +105,14 @@ lemma hh_invs'[Syscall_R_assms, wp]: by (cases t; wpsimp simp: X64_H.handleHypervisorFault_def isFpuEnable_def) crunch handleSpuriousIRQ - for invs'[Syscall_R_assms, wp]: invs' + for invs'[Arch_assms, wp]: invs' (ignore: doMachineOp) -lemma arch_performInvocation_inv[Syscall_R_assms]: +lemma arch_performInvocation_inv[Arch_assms]: "\\\ Arch.performInvocation invocation -, \P\" by (wpsimp simp: performX64MMUInvocation_def X64_H.performInvocation_def performX64PortInvocation_def) -lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: +lemma Arch_performIRQControl_inv_EE[Arch_assms]: "\\\ Arch.performIRQControl irqc -, \P\" unfolding X64_H.performIRQControl_def by wpsimp @@ -120,12 +120,13 @@ lemma Arch_performIRQControl_inv_EE[Syscall_R_assms]: (* FIXME arch-split: move to ArchInvariants_AI on this arch *) lemmas pageBitsForSize_bounded = pbfs_less_wb' +lemmas Syscall_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Syscall_R?: Syscall_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Syscall_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Syscall_R_assms)?)?) qed end diff --git a/proof/refine/X64/ArchTcbAcc_R.thy b/proof/refine/X64/ArchTcbAcc_R.thy index d5796aebd2..5e08e9dcf1 100644 --- a/proof/refine/X64/ArchTcbAcc_R.thy +++ b/proof/refine/X64/ArchTcbAcc_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems TcbAcc_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R locale *) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_loadWord_bits[TcbAcc_R_assms, wp]: +lemma no_fail_loadWord_bits[Arch_assms, wp]: "no_fail (\_. is_aligned p word_size_bits) (loadWord p)" by (wpsimp simp: loadWord_def is_aligned_mask[symmetric] word_size_bits_def) (* FIXME: move & the versions in Machine_AI could use word_size_bits form instead of specific number *) -lemma no_fail_storeWord_bits[TcbAcc_R_assms]: +lemma no_fail_storeWord_bits[Arch_assms]: "no_fail (\_. is_aligned p word_size_bits) (storeWord p w)" by (wpsimp simp: storeWord_def is_aligned_mask[symmetric] word_size_bits_def) -lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: +lemma prioToL1Index_l1IndexToPrio_or_id[Arch_assms]: "\ unat (w'::priority) < 2 ^ wordRadix ; w < 2^(size w' - wordRadix) \ \ prioToL1Index ((l1IndexToPrio w) || w') = w" unfolding l1IndexToPrio_def prioToL1Index_def @@ -33,12 +33,12 @@ lemma prioToL1Index_l1IndexToPrio_or_id[TcbAcc_R_assms]: apply (subst unat_of_nat_eq, simp_all add: word_size) done -lemma l1IndexToPrio_wordRadix_mask[TcbAcc_R_assms, simp]: +lemma l1IndexToPrio_wordRadix_mask[Arch_assms, simp]: "l1IndexToPrio i && mask wordRadix = 0" unfolding l1IndexToPrio_def by (simp add: wordRadix_def') -lemma st_tcb_at_coerce_abstract[TcbAcc_R_assms]: +lemma st_tcb_at_coerce_abstract[Arch_assms]: assumes t: "st_tcb_at' P t c" assumes sr: "(a, c) \ state_relation" shows "st_tcb_at (\st. \st'. thread_state_relation st st' \ P st') t a" @@ -51,7 +51,7 @@ lemma st_tcb_at_coerce_abstract[TcbAcc_R_assms]: X64_A.arch_kernel_obj.split_asm)+ done -lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: +lemma setObject_update_TCB_corres'[Arch_assms]: assumes tcbs: "tcb_relation tcb tcb' \ tcb_relation new_tcb new_tcb'" assumes tables: "\(getF, v) \ ran tcb_cap_cases. getF new_tcb = getF tcb" assumes tables': "\(getF, v) \ ran tcb_cte_cases. getF new_tcb' = getF tcb'" @@ -123,11 +123,11 @@ lemma setObject_update_TCB_corres'[TcbAcc_R_assms]: apply (fastforce simp: opt_map_def) by (clarsimp simp: ready_queue_relation_def opt_pred_def opt_map_def split: option.splits) -lemma setObject_tcb_valid_arch'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_valid_arch'[Arch_assms, wp]: "\valid_arch_state'\ setObject t (v :: tcb) \\rv. valid_arch_state'\" by (wp valid_arch_state_lift' setObject_typ_at') -lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: +lemma setObject_tcb_refs'[Arch_assms, wp]: "\\s. P (global_refs' s)\ setObject t (v::tcb) \\rv s. P (global_refs' s)\" apply (clarsimp simp: setObject_def split_def updateObject_default_def) apply wp @@ -135,7 +135,7 @@ lemma setObject_tcb_refs'[TcbAcc_R_assms, wp]: done (* assumption not needed on this architecture, but used in generic interface *) -lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: +lemma threadSet_state_hyp_refs_of'[Arch_assms]: assumes y: "\tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb)" shows "\\s. P (state_hyp_refs_of' s)\ threadSet F t \\rv s. P (state_hyp_refs_of' s)\" apply (simp add: threadSet_def) @@ -143,7 +143,7 @@ lemma threadSet_state_hyp_refs_of'[TcbAcc_R_assms]: simp: gen_objBits_simps obj_at'_def state_hyp_refs_of'_def) done -lemma threadSet_iflive'T[TcbAcc_R_assms]: +lemma threadSet_iflive'T[Arch_assms]: assumes x: "\tcb. \(getF, setF) \ ran tcb_cte_cases. getF (F tcb) = getF tcb" shows "\\s. if_live_then_nonz_cap' s @@ -177,11 +177,11 @@ lemma threadSet_iflive'T[TcbAcc_R_assms]: sublocale threadSet: typ_at_props' "threadSet tptr f" by typ_at_props' -lemma zobj_refs'_capRange[TcbAcc_R_assms]: +lemma zobj_refs'_capRange[Arch_assms]: "s \' cap \ zobj_refs' cap \ capRange cap" by (cases cap; simp add: valid_cap'_def capAligned_def capRange_def is_aligned_no_overflow) -lemma capAligned_zobj_refs'_capRange[TcbAcc_R_assms]: +lemma capAligned_zobj_refs'_capRange[Arch_assms]: "capAligned c \ zobj_refs' c \ capRange c" by (cases c, simp_all add: capRange_def capAligned_def is_aligned_no_overflow) @@ -208,7 +208,7 @@ schematic_goal l2BitmapSize_def': (* arch specific consequence *) "l2BitmapSize = numeral ?X" by (simp add: l2BitmapSize_def wordBits_def word_size numPriorities_def) -lemma prioToL1Index_size[TcbAcc_R_assms, simp]: +lemma prioToL1Index_size[Arch_assms, simp]: "prioToL1Index w < l2BitmapSize" unfolding prioToL1Index_def wordRadix_def l2BitmapSize_def' by (fastforce simp: shiftr_div_2n' nat_divide_less_eq @@ -219,12 +219,12 @@ lemma prioToL1Index_max: unfolding prioToL1Index_def wordRadix_def by (insert unat_lt2p[where x=p], simp add: shiftr_div_2n') -lemma prioToL1Index_bit_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_set[Arch_assms]: "((2 :: machine_word) ^ prioToL1Index p) !! prioToL1Index p" using l2BitmapSize_def' by (fastforce simp: nth_w2p_same intro: order_less_le_trans[OF prioToL1Index_size]) -lemma prioL2Index_bit_set[TcbAcc_R_assms]: +lemma prioL2Index_bit_set[Arch_assms]: fixes p :: priority shows "((2::machine_word) ^ unat (ucast p && (mask wordRadix :: machine_word))) !! unat (p && mask wordRadix)" apply (simp add: nth_w2p wordRadix_def ucast_and_mask[symmetric] unat_ucast_upcast is_up) @@ -243,25 +243,25 @@ lemma prioToL1Index_bits_low_high_eq: unfolding prioToL1Index_def by (fastforce simp: nth_w2p wordRadix_def is_up bits_low_high_eq) -lemma prioToL1Index_bit_not_set[TcbAcc_R_assms]: +lemma prioToL1Index_bit_not_set[Arch_assms]: "\ (~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p" apply (subst word_ops_nth_size, simp_all add: prioToL1Index_bit_set del: bit_exp_iff) apply (fastforce simp: prioToL1Index_def wordRadix_def word_size intro: order_less_le_trans[OF word_shiftr_lt]) done -lemma prioToL1Index_complement_nth_w2p[TcbAcc_R_assms]: +lemma prioToL1Index_complement_nth_w2p[Arch_assms]: fixes p p' :: priority shows "(~~ ((2 :: machine_word) ^ prioToL1Index p)) !! prioToL1Index p' = (prioToL1Index p \ prioToL1Index p')" by (fastforce simp: complement_nth_w2p prioToL1Index_lt wordRadix_def word_size)+ -lemma invertL1Index_eq_cancelD[TcbAcc_R_assms]: +lemma invertL1Index_eq_cancelD[Arch_assms]: "\ invertL1Index i = invertL1Index j ; i < l2BitmapSize ; j < l2BitmapSize \ \ i = j" by (simp add: invertL1Index_def l2BitmapSize_def') -lemma pspace_dom_dom[TcbAcc_R_assms]: +lemma pspace_dom_dom[Arch_assms]: "dom ps \ pspace_dom ps" unfolding pspace_dom_def apply clarsimp @@ -280,7 +280,7 @@ lemma pspace_dom_dom[TcbAcc_R_assms]: apply (case_tac vmpage_size, simp_all add: bit_simps) done -lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: +lemma less_max_ipc_words_less_2p_msg_align_bits[Arch_assms]: assumes y: "y < unat max_ipc_words" shows "word_of_nat y * (word_size :: machine_word) < 2 ^ msg_align_bits" apply (simp add: word_size_def word_size_bits_def) @@ -289,37 +289,38 @@ lemma less_max_ipc_words_less_2p_msg_align_bits[TcbAcc_R_assms]: apply (simp add: msg_align_bits max_ipc_words)+ done -lemma is_aligned_word_size_bits_less_max_ipc_words[TcbAcc_R_assms]: +lemma is_aligned_word_size_bits_less_max_ipc_words[Arch_assms]: "y < unat max_ipc_words \ is_aligned (word_of_nat y * word_size) word_size_bits" by (simp add: word_size_def word_size_bits_def) (rule is_aligned_mult_triv2[where n=3, simplified]) -lemma msg_align_bits_le_pageBitsForSize[TcbAcc_R_assms]: +lemma msg_align_bits_le_pageBitsForSize[Arch_assms]: "msg_align_bits \ pageBitsForSize sz" by (simp add: msg_align_bits pageBitsForSize_def bit_simps split: vmpage_size.split) -lemmas [TcbAcc_R_assms] = +lemmas [Arch_assms] = dmo_getirq_inv getActiveIRQ_masked tcb_at'_cross pspace_relation_update_tcbs +lemmas TcbAcc_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R?: TcbAcc_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.TcbAcc_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_2 locale *) sublocale asUser: typ_at_props' "asUser tptr f" by typ_at_props' -lemma tcb_hyp_refs'_valid_arch_tcb'_eq[TcbAcc_R_2_assms]: +lemma tcb_hyp_refs'_valid_arch_tcb'_eq[Arch_assms]: "tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ valid_arch_tcb' (tcbArch (F tcb)) s = valid_arch_tcb' (tcbArch tcb) s" by (auto simp: valid_arch_tcb'_def) @@ -394,14 +395,14 @@ lemma asUser_corres: apply (simp add: invs'_def valid_state'_def valid_pspace'_def) done -lemma asUser_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_getRegister_corres[Arch_assms]: "corres (=) (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (getRegister r)) (asUser t (getRegister r))" apply (rule asUser_corres') apply (clarsimp simp: getRegister_def) done -lemma user_getreg_inv'[TcbAcc_R_2_assms, wp]: +lemma user_getreg_inv'[Arch_assms, wp]: "\P\ asUser t (getRegister r) \\x. P\" apply (rule asUser_inv) apply (simp_all add: getRegister_def) @@ -435,7 +436,7 @@ lemma asUser_iflive'[wp]: unfolding asUser_def by (wpsimp wp: threadSet_iflive' hoare_drop_imps, auto) -lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_setRegister_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) \ (as_user t (setRegister r v)) (asUser t (setRegister r v))" @@ -444,7 +445,7 @@ lemma asUser_setRegister_corres[TcbAcc_R_2_assms]: apply (rule corres_modify'; simp) done -lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs apply (wp | simp add: bitmap_fun_defs bitmapQ_no_L1_orphans_def)+ @@ -452,7 +453,7 @@ lemma removeFromBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: prioToL1Index_complement_nth_w2p) done -lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: +lemma removeFromBitmap_bitmapQ_no_L2_orphans[Arch_assms, wp]: "\ bitmapQ_no_L2_orphans and bitmapQ_no_L1_orphans \ removeFromBitmap d p \\_. bitmapQ_no_L2_orphans \" @@ -464,7 +465,7 @@ lemma removeFromBitmap_bitmapQ_no_L2_orphans[TcbAcc_R_2_assms, wp]: apply metis done -lemma removeFromBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma removeFromBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p \ removeFromBitmap d p \\_. valid_bitmapQ_except d p \" @@ -515,7 +516,7 @@ proof - done qed -lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: +lemma addToBitmap_bitmapQ_no_L1_orphans[Arch_assms, wp]: "\ bitmapQ_no_L1_orphans \ addToBitmap d p \\_. bitmapQ_no_L1_orphans \" unfolding bitmap_fun_defs bitmapQ_defs using word_unat_mask_lt[where w=p and m=wordRadix] @@ -525,7 +526,7 @@ lemma addToBitmap_bitmapQ_no_L1_orphans[TcbAcc_R_2_assms, wp]: wordBits_def numPriorities_def) done -lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: +lemma addToBitmap_valid_bitmapQ_except[Arch_assms]: "\ valid_bitmapQ_except d p and bitmapQ_no_L2_orphans \ addToBitmap d p \\_. valid_bitmapQ_except d p \" @@ -537,7 +538,7 @@ lemma addToBitmap_valid_bitmapQ_except[TcbAcc_R_2_assms]: dest: prioToL1Index_bits_low_high_eq) done -lemma in_user_frame_eq[TcbAcc_R_2_assms]: +lemma in_user_frame_eq[Arch_assms]: assumes y: "y < unat max_ipc_words" and al: "is_aligned a msg_align_bits" shows "in_user_frame (a + of_nat y * word_size) s = in_user_frame a s" @@ -564,15 +565,15 @@ lemma thread_get_registers: apply (clarsimp simp: map_upd_triv select_f_def image_def return_def) done -lemma msgRegisters_msg_registers[TcbAcc_R_2_assms]: +lemma msgRegisters_msg_registers[Arch_assms]: "msgRegisters = msg_registers" by (simp add: msgRegisters_unfold) -lemma suc_len_msg_registers_less_2p_word_bits[TcbAcc_R_2_assms]: +lemma suc_len_msg_registers_less_2p_word_bits[Arch_assms]: "Suc (length msg_registers) < 2 ^ word_bits" by (simp add: msgRegisters_unfold word_bits_def) -lemma asUser_mapM_getRegister_corres[TcbAcc_R_2_assms]: +lemma asUser_mapM_getRegister_corres[Arch_assms]: "corres (\con regs. regs = map con msg_registers) (tcb_at t and pspace_aligned and pspace_distinct) \ (thread_get (arch_tcb_get_registers o tcb_arch) t) @@ -609,7 +610,7 @@ lemma UserContext_fold: lemmas valid_ipc_buffer_cap_simps = valid_ipc_buffer_cap_def [split_simps cap.split arch_cap.split] -lemma lookupIPCBuffer_corres'[TcbAcc_R_2_assms]: +lemma lookupIPCBuffer_corres'[Arch_assms]: "corres (=) (tcb_at t and valid_objs and pspace_aligned and pspace_distinct) (valid_objs' and no_0_obj') (lookup_ipc_buffer w t) (lookupIPCBuffer w t)" @@ -665,13 +666,13 @@ crunch rescheduleRequired, tcbSchedEnqueue for hyp_refs_of'[wp]: "\s. P (state_hyp_refs_of' s)" (simp: unless_def crunch_simps wp: threadSet_state_hyp_refs_of' ignore: threadSet) -lemmas [TcbAcc_R_2_assms] = +lemmas [Arch_assms] = getThreadBufferSlot_inv lookupIPCBuffer_inv rescheduleRequired_hyp_refs_of' tcbSchedEnqueue_hyp_refs_of' -lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setThreadState_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P ((state_hyp_refs_of' s))\ setThreadState st t \\rv s. P (state_hyp_refs_of' s)\" @@ -679,14 +680,14 @@ lemma setThreadState_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: | wp threadSet_state_hyp_refs_of')+ done -lemma setBoundNotification_state_hyp_refs_of'[TcbAcc_R_2_assms, wp]: +lemma setBoundNotification_state_hyp_refs_of'[Arch_assms, wp]: "\\s. P (state_hyp_refs_of' s)\ setBoundNotification ntfn t \\rv s. P (state_hyp_refs_of' s)\" by (simp add: setBoundNotification_def fun_upd_def | wp threadSet_state_hyp_refs_of')+ -lemma storeWord_invs'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs'[Arch_assms, wp]: "\pointerInUserData p and invs'\ doMachineOp (storeWord p w) \\rv. invs'\" proof - have aligned_offset_ignore: @@ -711,7 +712,7 @@ proof - done qed -lemma storeWord_invs_no_cicd'[TcbAcc_R_2_assms, wp]: +lemma storeWord_invs_no_cicd'[Arch_assms, wp]: "\pointerInUserData p and invs_no_cicd'\ doMachineOp (storeWord p w) \\rv. invs_no_cicd'\" proof - have aligned_offset_ignore: @@ -739,25 +740,26 @@ qed crunch tcbSchedAppend for pspace_in_kernel_mappings'[wp]: pspace_in_kernel_mappings' -lemmas [TcbAcc_R_2_assms] = tcbSchedAppend_pspace_in_kernel_mappings' +lemmas [Arch_assms] = tcbSchedAppend_pspace_in_kernel_mappings' (* FIXME: the code assumes that it is word_t, so length_type should be defined generically in ASpec, not per architecture *) -lemmas [TcbAcc_R_2_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] +lemmas [Arch_assms] = meta_eq_to_obj_eq[OF nat_to_len_def] + +lemmas TcbAcc_R_2_assms = Arch_assms (* extract accumulated assumptions *) end (* Arch *) interpretation TcbAcc_R_2?: TcbAcc_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.TcbAcc_R_2_assms)?)?) qed context Arch begin arch_global_naming -named_theorems TcbAcc_R_3_assms +clear_named_theorems Arch_assms (* accumulate assumptions for TcbAcc_R_3 locale *) -lemma setMRs_corres[TcbAcc_R_3_assms]: +lemma setMRs_corres[Arch_assms]: assumes m: "mrs' = mrs" shows "corres (=) (tcb_at t and pspace_aligned and pspace_distinct and case_option \ in_user_frame buf) @@ -829,7 +831,7 @@ lemma asUser_invs[wp]: crunch storeWordUser for pred_tcb_at'[wp]: "\s. pred_tcb_at' proj P p s" -lemma set_mrs_invs'[TcbAcc_R_3_assms, wp]: +lemma set_mrs_invs'[Arch_assms, wp]: "\ invs' and tcb_at' receiver \ setMRs receiver recv_buf mrs \\rv. invs' \" apply (simp add: setMRs_def) apply (wp dmo_invs' no_irq_mapM no_irq_storeWord crunch_wps| @@ -848,12 +850,13 @@ sublocale setThreadState: typ_at_props' "setThreadState st p" sublocale setBoundNotification: typ_at_props' "setBoundNotification v p" by typ_at_props' +lemmas TcbAcc_R_3_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation TcbAcc_R_3?: TcbAcc_R_3 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact TcbAcc_R_3_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.TcbAcc_R_3_assms)?)?) qed (* requalify interface lemmas which can't be locale assumptions due to free type variable *) diff --git a/proof/refine/X64/ArchTcb_R.thy b/proof/refine/X64/ArchTcb_R.thy index 6cd3c2f828..2aa9d6c8cc 100644 --- a/proof/refine/X64/ArchTcb_R.thy +++ b/proof/refine/X64/ArchTcb_R.thy @@ -11,19 +11,19 @@ begin context Arch begin arch_global_naming -named_theorems Tcb_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R locale *) -lemma activateIdleThread_corres[Tcb_R_assms]: +lemma activateIdleThread_corres[Arch_assms]: "corres dc (st_tcb_at idle t) (st_tcb_at' idle' t) (arch_activate_idle_thread t) (activateIdleThread t)" by (simp add: arch_activate_idle_thread_def activateIdleThread_def) crunch arch_post_modify_registers - for pspace_aligned[Tcb_R_assms, wp]: pspace_aligned - and pspace_distinct[Tcb_R_assms, wp]: pspace_distinct + for pspace_aligned[Arch_assms, wp]: pspace_aligned + and pspace_distinct[Arch_assms, wp]: pspace_distinct (wp: crunch_wps simp: crunch_simps) -lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: +lemma asUser_postModifyRegisters_corres[Arch_assms]: "corres dc (tcb_at t and pspace_aligned and pspace_distinct) (tcb_at' t and tcb_at' ct) (arch_post_modify_registers ct t) (asUser t $ postModifyRegisters ct t)" @@ -37,7 +37,7 @@ lemma asUser_postModifyRegisters_corres[Tcb_R_assms]: (* formulation of threadSet_state_hyp_refs_of' varies based on whether VCPU is present; use this as interface, but keep original lemma name for use outside of Arch *) -lemma threadSet_state_hyp_refs_of'_interface[Tcb_R_assms]: +lemma threadSet_state_hyp_refs_of'_interface[Arch_assms]: "\ \tcb. tcb_hyp_refs' (tcbArch (F tcb)) = tcb_hyp_refs' (tcbArch tcb) \ \ threadSet F t \\s. P (state_hyp_refs_of' s)\ " by (wpsimp simp: threadSet_state_hyp_refs_of') @@ -48,7 +48,7 @@ sublocale setPriority: typ_at_props' "setPriority t prio" sublocale setMCPriority: typ_at_props' "setMCPriority t prio" by typ_at_props' -lemma sameObject_corres2[Tcb_R_assms]: +lemma sameObject_corres2[Arch_assms]: "\ cap_relation c c'; cap_relation d d' \ \ same_object_as c d = sameObjectAs c' d'" apply (frule(1) same_region_as_relation[symmetric, where c=c and c'=d]) @@ -63,7 +63,7 @@ lemma sameObject_corres2[Tcb_R_assms]: by (fastforce simp: add_mask_fold global.sameRegionAs_def isCap_simps split: arch_cap.splits) -lemma untyped_derived_eq_from_sameObjectAs[Tcb_R_assms]: +lemma untyped_derived_eq_from_sameObjectAs[Arch_assms]: "sameObjectAs cap cap2 \ untyped_derived_eq cap cap2" by (clarsimp simp: untyped_derived_eq_def sameObjectAs_def2 gen_isCap_Master) @@ -75,8 +75,8 @@ lemma isValidVTableRootD: split: capability.split_asm arch_capability.split_asm option.split_asm) crunch prepare_thread_delete, arch_finalise_cap - for pspace_aligned[Tcb_R_assms, wp]: "pspace_aligned :: det_ext state \ _" - and pspace_distinct[Tcb_R_assms, wp]: "pspace_distinct :: det_ext state \ _" + for pspace_aligned[Arch_assms, wp]: "pspace_aligned :: det_ext state \ _" + and pspace_distinct[Arch_assms, wp]: "pspace_distinct :: det_ext state \ _" (simp: crunch_simps preemption_point_def wp: crunch_wps OR_choiceE_weak_wp) lemma is_valid_vtable_root_simp: @@ -86,7 +86,7 @@ lemma is_valid_vtable_root_simp: split: cap.splits arch_cap.splits option.splits) (* FIXME: move after checked_insert_tcb_invs in ArchTcb_AI, and consolidate redundancy there *) -lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: +lemma checked_insert_tcb_invs_gen[Arch_assms]: "\invs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and K (is_cnode_or_valid_arch new_cap) and valid_cap new_cap and tcb_cap_valid new_cap (target, ref) @@ -101,37 +101,37 @@ lemma checked_insert_tcb_invs_gen[Tcb_R_assms]: apply (clarsimp dest!: is_cnode_or_valid_arch_cap_asid) done -lemma is_valid_vtable_root_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_valid_vtable_root_is_cnode_or_valid_arch[Arch_assms]: "is_valid_vtable_root cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def is_valid_vtable_root_simp is_cap_simps) -lemma is_cnode_cap_is_cnode_or_valid_arch[Tcb_R_assms]: +lemma is_cnode_cap_is_cnode_or_valid_arch[Arch_assms]: "is_cnode_cap cap \ is_cnode_or_valid_arch cap" by (clarsimp simp: is_cnode_or_valid_arch_def) -lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Tcb_R_assms]: +lemma valid_ipc_buffer_cap_is_nondevice_page_cap[Arch_assms]: "\valid_ipc_buffer_cap cap buf; is_arch_cap cap\ \ is_nondevice_page_cap cap" by (clarsimp simp: is_cap_simps valid_ipc_buffer_cap_def split: arch_cap.splits) -lemma cte_at_tcb_at_2p_cteSizeBits[Tcb_R_assms]: +lemma cte_at_tcb_at_2p_cteSizeBits[Arch_assms]: "tcb_at' t s \ cte_at' (t + 2 ^ cteSizeBits) s" by (simp add: cte_at'_obj_at' tcb_cte_cases_def cteSizeBits_def) (* arch_capBadge may involve SMC caps on some architectures, but not page tables *) -lemma isValidVTableRootD_arch[Tcb_R_assms]: +lemma isValidVTableRootD_arch[Arch_assms]: "isValidVTableRoot cap \ isArchObjectCap cap \ arch_capBadge (capCap cap) = None" by (drule isValidVTableRootD; clarsimp simp: arch_capBadge_def isCap_simps) (* FIXME FPU: when the FPU being enabled is properly configurable for the proofs then this shouldn't need to unfold config_HAVE_FPU. *) -lemma postSetFlags_corres[Tcb_R_assms, corres]: +lemma postSetFlags_corres[Arch_assms, corres]: "flags = word_to_tcb_flags flags' \ corres dc (cur_tcb and pspace_aligned and pspace_distinct and valid_cur_fpu) \ (arch_post_set_flags t flags) (postSetFlags t flags')" unfolding arch_post_set_flags_def postSetFlags_def by (corres simp: Kernel_Config.config_HAVE_FPU_def cur_tcb_def) -lemma postSetFlags_invs'[Tcb_R_assms, wp]: +lemma postSetFlags_invs'[Arch_assms, wp]: "postSetFlags t flags \invs'\" unfolding postSetFlags_def by wpsimp @@ -142,11 +142,11 @@ lemma copyregsets_map_only[simp]: (* there are no extra registers on any architecture so far, and while it is theoretically possible in the design spec, the abstract invariant proof assumes this *) -lemma decodeTransfer_def'[Tcb_R_assms]: +lemma decodeTransfer_def'[Arch_assms]: "decodeTransfer w = returnOk (copyregsets_map ArchDefaultExtraRegisters)" by (simp add: decodeTransfer_def) -lemma checkValidIPCBuffer_corres[Tcb_R_assms]: +lemma checkValidIPCBuffer_corres[Arch_assms]: "cap_relation cap cap' \ corres (ser \ dc) \ \ (check_valid_ipc_buffer vptr cap) @@ -163,7 +163,7 @@ lemma checkValidIPCBuffer_corres[Tcb_R_assms]: apply (auto simp add: returnOk_def) done -lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: +lemma checkValidIPCBuffer_ArchObject_wp[Arch_assms]: "\\s. isArchObjectCap cap \ capBadge cap = None \ is_aligned p msg_align_bits \ P s\ checkValidIPCBuffer p cap \\rv s. P s\,-" @@ -177,27 +177,28 @@ lemma checkValidIPCBuffer_ArchObject_wp[Tcb_R_assms]: done crunch checkValidIPCBuffer - for inv[Tcb_R_assms, wp]: "P" + for inv[Arch_assms, wp]: "P" (simp: crunch_simps) -lemma isValidVTableRoot_eq[Tcb_R_assms]: +lemma isValidVTableRoot_eq[Arch_assms]: "cap_relation cap cap' \ isValidVTableRoot cap' = is_valid_vtable_root cap" apply (cases cap; simp add: isValidVTableRoot_def is_valid_vtable_root_simp) apply (rename_tac acap, case_tac acap; simp) apply (auto split: option.split) done +lemmas Tcb_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R?: Tcb_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Tcb_R_assms)?)?) qed context Arch begin arch_global_naming -named_theorems Tcb_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Tcb_R_2 locale *) lemma checkCapAt_cteInsert_corres': "cap_relation new_cap newCap \ @@ -251,7 +252,7 @@ lemma checkCapAt_cteInsert_corres': apply fastforce done -lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: +lemma checkCapAt_cteInsert_corres[Arch_assms]: "cap_relation new_cap newCap \ corres dc (einvs and cte_wp_at (\c. c = cap.NullCap) (target, ref) and cte_at slot and K (is_cnode_or_valid_arch new_cap) @@ -272,12 +273,13 @@ lemma checkCapAt_cteInsert_corres[Tcb_R_2_assms]: apply fastforce done +lemmas Tcb_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Tcb_R_2?: Tcb_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Tcb_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Tcb_R_2_assms)?)?) qed end diff --git a/proof/refine/X64/ArchUntyped_R.thy b/proof/refine/X64/ArchUntyped_R.thy index b7e2df4f48..0998b429da 100644 --- a/proof/refine/X64/ArchUntyped_R.thy +++ b/proof/refine/X64/ArchUntyped_R.thy @@ -13,9 +13,9 @@ begin context Arch begin arch_global_naming -named_theorems Untyped_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R locale *) -lemma APIType_map2_CapTable[Untyped_R_assms, simp]: +lemma APIType_map2_CapTable[Arch_assms, simp]: "(APIType_map2 ty = Structures_A.CapTableObject) = (ty = Inr (APIObjectType ArchTypes_H.CapTableObject))" by (simp add: APIType_map2_def @@ -25,13 +25,13 @@ lemma APIType_map2_CapTable[Untyped_R_assms, simp]: lemmas is_frame_type_defs = is_frame_type_def isFrameType_def arch_is_frame_type_def -lemma is_frame_type_isFrameType_eq[Untyped_R_assms, simp]: +lemma is_frame_type_isFrameType_eq[Arch_assms, simp]: "(is_frame_type (APIType_map2 (Inr (toEnum (unat arg0))))) = (isFrameType (toEnum (unat arg0)))" by (simp add: APIType_map2_def is_frame_type_defs split: apiobject_type.splits object_type.splits)+ (* object_type enum (arch-specific) is extension of apiobject_type enum (generic) *) -lemma nth_enum_object_type_gen_eq[Untyped_R_assms]: +lemma nth_enum_object_type_gen_eq[Arch_assms]: assumes "n < length (enum :: apiobject_type list)" shows "((enum :: object_type list) ! n) = APIObjectType ((enum :: apiobject_type list) ! n)" proof - @@ -45,36 +45,36 @@ proof - (simp flip: nth_map[where f=APIObjectType]) qed -lemma length_enum_apiobject_less_enum_object_type[Untyped_R_assms]: +lemma length_enum_apiobject_less_enum_object_type[Arch_assms]: "length (enum :: apiobject_type list) < length (enum :: object_type list)" unfolding enum_apiobject_type enum_object_type by simp crunch freeMemory (* FIXME arch-split: clearMemory is already handled in ArchRetype_AI *) - for irq_masks_inv[wp, Untyped_R_assms]: "\s. P (irq_masks s)" + for irq_masks_inv[wp, Arch_assms]: "\s. P (irq_masks s)" (wp: crunch_wps) crunch updateFreeIndex, deleteGhost - for valid_irq_states'[Untyped_R_assms, wp]: "valid_irq_states'" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" - and gsMaxObjectSize[Untyped_R_assms, wp]: "\s. P (gsMaxObjectSize s)" - and ksIdleThread[Untyped_R_assms, wp]: "\s. P (ksIdleThread s)" - and ksCurDomain[Untyped_R_assms, wp]: "\s. P (ksCurDomain s)" - and ksCurThread[Untyped_R_assms, wp]: "\s. P (ksCurThread s)" + for valid_irq_states'[Arch_assms, wp]: "valid_irq_states'" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" + and gsMaxObjectSize[Arch_assms, wp]: "\s. P (gsMaxObjectSize s)" + and ksIdleThread[Arch_assms, wp]: "\s. P (ksIdleThread s)" + and ksCurDomain[Arch_assms, wp]: "\s. P (ksCurDomain s)" + and ksCurThread[Arch_assms, wp]: "\s. P (ksCurThread s)" (wp: crunch_wps) -lemma arch_data_to_obj_type_invalid[Untyped_R_assms]: +lemma arch_data_to_obj_type_invalid[Arch_assms]: "\ n \ length (enum :: object_type list) \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) = None" by (auto simp: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) -lemma arch_data_to_obj_type_valid[Untyped_R_assms]: +lemma arch_data_to_obj_type_valid[Arch_assms]: "\ n < length (enum :: object_type list); length (enum :: apiobject_type list) \ n \ \ arch_data_to_obj_type (n - length (enum :: apiobject_type list)) \ None" by (simp add: enum_apiobject_type_length enum_object_type arch_data_to_obj_type_def) arith -lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: +lemma APIType_map2_arch_data_to_obj_type[Arch_assms]: defines [simp]: "object_types \ enum :: object_type list" defines [simp]: "apiobject_types \ enum :: apiobject_type list" shows @@ -89,7 +89,7 @@ lemma APIType_map2_arch_data_to_obj_type[Untyped_R_assms]: apply arith done -lemma obj_bits_api_APIType_map2[Untyped_R_assms]: +lemma obj_bits_api_APIType_map2[Arch_assms]: "obj_bits_api (APIType_map2 (Inr x)) y = getObjectSize x y" apply (clarsimp simp:obj_bits_api_def APIType_map2_def getObjectSize_def simp del: objSize_eq_capBits) apply (case_tac x) @@ -99,11 +99,11 @@ lemma obj_bits_api_APIType_map2[Untyped_R_assms]: apply (simp_all add: apiGetObjectSize_def slot_bits_def objBits_simps' bit_simps) done -lemma length_nat_to_cref[Untyped_R_assms]: +lemma length_nat_to_cref[Arch_assms]: "bits < word_bits \ length (nat_to_cref bits x) = bits" by (simp add: nat_to_cref_def word_bits_conv) -lemma ctes_of_ko_arch[Untyped_R_assms]: +lemma ctes_of_ko_arch[Arch_assms]: "\ valid_cap' cap s; isArchObjectCap cap \ \ \ptr\capRange cap. \optr ko. ksPSpace s optr = Some ko \ ptr \ obj_range' optr ko" apply (case_tac cap; simp add: gen_isCap_simps capRange_def) @@ -205,11 +205,11 @@ lemma ctes_of_ko_arch[Untyped_R_assms]: apply (simp add: field_simps archObjSize_def shiftl_t2n mask_def) done -lemma irq_nodes_global[Untyped_R_assms]: +lemma irq_nodes_global[Arch_assms]: "irq_node' s + (ucast (irq :: irq) << cteSizeBits) \ global_refs' s" by (simp add: global_refs'_def cteSizeBits_def shiftl_t2n) -lemma untyped_inc_mdbD[Untyped_R_assms]: +lemma untyped_inc_mdbD[Arch_assms]: "\ sameRegionAs cap cap'; isUntypedCap cap; ctes p = Some (CTE cap node); ctes p' = Some (CTE cap' node'); untyped_inc' ctes; untyped_mdb' ctes; no_loops ctes \ @@ -235,16 +235,16 @@ lemma untyped_inc_mdbD[Untyped_R_assms]: apply (clarsimp simp: isCap_simps) done -lemma mdb_chunked_arch_assms_non_arch[Untyped_R_assms]: +lemma mdb_chunked_arch_assms_non_arch[Arch_assms]: "\ isArchObjectCap cap \ mdb_chunked_arch_assms cap" by (simp add: mdb_chunked_arch_assms_def isCap_simps) -lemma sameRegionAs_def_untyped[Untyped_R_assms]: +lemma sameRegionAs_def_untyped[Arch_assms]: "\ isUntypedCap cap \ \ sameRegionAs cap cap' = (capRange cap' \ {} \ capRange cap' \ capRange cap)" by (clarsimp simp add: sameRegionAs_def3 isCap_simps) -lemma createNewCaps_range_helper[Untyped_R_assms]: +lemma createNewCaps_range_helper[Arch_assms]: "\\s. range_cover ptr sz (APIType_capBits tp us) n \ 0 < n\ createNewCaps tp ptr n us d \\rv s. \capfn. @@ -314,7 +314,7 @@ defs archOverlap_def: "archOverlap \ \_ _. False" (* trivial on this architecture *) -lemma archNoOverlap[Untyped_R_assms]: +lemma archNoOverlap[Arch_assms]: notes Int_atLeastAtMost[simp del] shows "corres dc (\s. \cref. cte_wp_at (\cap. is_untyped_cap cap @@ -324,34 +324,34 @@ lemma archNoOverlap[Untyped_R_assms]: (return ()) (stateAssert (\s. \ archOverlap s R) [])" by (simp add: archOverlap_def) -lemma word_size_bits_le_untyped_min_bits[Untyped_R_assms]: +lemma word_size_bits_le_untyped_min_bits[Arch_assms]: "word_size_bits \ untyped_min_bits" by (simp add: word_size_bits_def untyped_min_bits_def) -lemma minUntypedSizeBits_le_resetChunkBits[Untyped_R_assms]: +lemma minUntypedSizeBits_le_resetChunkBits[Arch_assms]: "minUntypedSizeBits \ resetChunkBits" by (simp add: minUntypedSizeBits_def Kernel_Config.resetChunkBits_def) -lemma maxUntypedSizeBits_less_word_bits[Untyped_R_assms]: +lemma maxUntypedSizeBits_less_word_bits[Arch_assms]: "maxUntypedSizeBits < word_bits" by (simp add: maxUntypedSizeBits_def word_bits_def) (* FIXME arch-split: candidate for Kernel_Config lemmas *) -lemma word_size_bits_le_resetChunkBits[Untyped_R_assms]: +lemma word_size_bits_le_resetChunkBits[Arch_assms]: "word_size_bits \ resetChunkBits" by (simp add: word_size_bits_def Kernel_Config.resetChunkBits_def) -lemma resetChunkBits_le_word_bits[Untyped_R_assms]: +lemma resetChunkBits_le_word_bits[Arch_assms]: "resetChunkBits < word_bits" by (simp add: Kernel_Config.resetChunkBits_def word_bits_def) -lemma APIType_capBits_lower_bound[Untyped_R_assms]: +lemma APIType_capBits_lower_bound[Arch_assms]: "\tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \ minUntypedSizeBits \ us\ \ minUntypedSizeBits \ APIType_capBits tp us" by (simp add: APIType_capBits_def objBits_simps' bit_simps minUntypedSizeBits_def split: object_type.split apiobject_type.split) -lemma dmo_freeMemory_clear_um[Untyped_R_assms]: +lemma dmo_freeMemory_clear_um[Arch_assms]: "\word_size_bits \ sz; sz \ word_bits; is_aligned ptr sz\ \ (do_machine_op (freeMemory ptr sz) :: (det_state, unit) nondet_monad) = modify (clear_um {ptr..ptr + 2 ^ sz - 1})" @@ -362,8 +362,8 @@ lemma dmo_freeMemory_clear_um[Untyped_R_assms]: done crunch createObject - for nosch[Untyped_R_assms, wp]: "\s. P (ksSchedulerAction s)" - and ksInterruptState[Untyped_R_assms, wp]: "\s. P (ksInterruptState s)" + for nosch[Arch_assms, wp]: "\s. P (ksSchedulerAction s)" + and ksInterruptState[Arch_assms, wp]: "\s. P (ksInterruptState s)" crunch createNewObjects for arch_inv[wp]: "\s. P (x64KSSKIMPML4 (ksArchState s))" @@ -376,12 +376,13 @@ crunch resetUntypedCap preemptionPoint_inv ignore: freeMemory) +lemmas Untyped_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R?: Untyped_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Untyped_R_assms)?)?) qed locale Arch_mdb_insert_again_all = mdb_insert_again_all + Arch @@ -437,21 +438,22 @@ end (* invokeUntyped_proofs *) context Arch begin arch_global_naming -named_theorems Untyped_R_2_assms +clear_named_theorems Arch_assms (* accumulate assumptions for Untyped_R_2 locale *) -lemmas [Untyped_R_2_assms] = +lemmas [Arch_assms] = mdb_insert_again_all.valid_n' invokeUntyped_proofs.descendants_range invokeUntyped_proofs.ex_cte_no_overlap' invokeUntyped_proofs.cref_inv invokeUntyped_proofs.slots_invD +lemmas Untyped_R_2_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation Untyped_R_2?: Untyped_R_2 proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact Untyped_R_2_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.Untyped_R_2_assms)?)?) qed end diff --git a/proof/refine/X64/ArchVSpace_R.thy b/proof/refine/X64/ArchVSpace_R.thy index e5d4a9e5ed..737a06f6e9 100644 --- a/proof/refine/X64/ArchVSpace_R.thy +++ b/proof/refine/X64/ArchVSpace_R.thy @@ -12,7 +12,7 @@ begin context Arch begin arch_global_naming -named_theorems VSpace_R_assms +clear_named_theorems Arch_assms (* accumulate assumptions for VSpace_R locale *) definition "vspace_at_asid' vs asid \ \s. \ap pool. @@ -171,7 +171,7 @@ lemma handleVMFault_corres': done (* interface lemma, superset of all architecture preconditions *) -lemma handleVMFault_corres[VSpace_R_assms]: +lemma handleVMFault_corres[Arch_assms]: "corres (fr \ dc) (tcb_at thread and pspace_aligned and pspace_distinct) (tcb_at' thread) (handle_vm_fault thread fault) (handleVMFault thread fault)" by (corres corres: handleVMFault_corres') @@ -2544,12 +2544,13 @@ crunch flushTable for valid_arch_state'[wp]: valid_arch_state' (wp: crunch_wps simp: crunch_simps unless_def) +lemmas VSpace_R_assms = Arch_assms (* extract accumulated assumptions *) + end (* Arch *) interpretation VSpace_R?: VSpace_R proof goal_cases - interpret Arch . - case 1 show ?case by (intro_locales; (unfold_locales; (fact VSpace_R_assms)?)?) + case 1 show ?case by (intro_locales; (unfold_locales; (fact X64.VSpace_R_assms)?)?) qed end diff --git a/proof/refine/X64/LevityCatch.thy b/proof/refine/X64/LevityCatch.thy index 111d69bc3d..ca8f977479 100644 --- a/proof/refine/X64/LevityCatch.thy +++ b/proof/refine/X64/LevityCatch.thy @@ -21,12 +21,6 @@ lemma magnitudeCheck_assert: split: option.split) apply fastforce done -context begin interpretation Arch . (*FIXME: arch-split*) -lemmas makeObject_simps = - makeObject_endpoint makeObject_notification makeObject_cte - makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte - makeObject_asidpool makeObject_pdpte makeObject_pml4e -end lemma projectKO_inv : "\P\ projectKO ko \\rv. P\" by (simp add: projectKO_def fail_def valid_def return_def @@ -59,6 +53,11 @@ lemma updateObject_default_inv: context Arch begin arch_global_naming +lemmas makeObject_simps = + makeObject_endpoint makeObject_notification makeObject_cte + makeObject_tcb makeObject_user_data makeObject_pde makeObject_pte + makeObject_asidpool makeObject_pdpte makeObject_pml4e + lemma to_from_apiType[simp]: "toAPIType (fromAPIType x) = Some x" by (cases x) (auto simp add: fromAPIType_def toAPIType_def)