361 lines
16 KiB
Plaintext
361 lines
16 KiB
Plaintext
(*
|
|
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
|
|
*
|
|
* SPDX-License-Identifier: GPL-2.0-only
|
|
*)
|
|
|
|
theory ArchFinalise_IF
|
|
imports Finalise_IF
|
|
begin
|
|
|
|
context Arch begin global_naming RISCV64
|
|
|
|
named_theorems Finalise_IF_assms
|
|
|
|
crunches arch_post_cap_deletion
|
|
for globals_equiv[Finalise_IF_assms, wp]: "globals_equiv st"
|
|
|
|
lemma dmo_maskInterrupt_reads_respects[Finalise_IF_assms]:
|
|
"reads_respects aag l \<top> (do_machine_op (maskInterrupt m irq))"
|
|
unfolding maskInterrupt_def
|
|
apply (rule use_spec_ev)
|
|
apply (rule do_machine_op_spec_reads_respects)
|
|
apply (simp add: equiv_valid_def2)
|
|
apply (rule modify_ev2)
|
|
apply (fastforce simp: equiv_for_def)
|
|
apply (wp modify_wp | simp)+
|
|
done
|
|
|
|
lemma arch_post_cap_deletion_read_respects[Finalise_IF_assms, wp]:
|
|
"reads_respects aag l \<top> (arch_post_cap_deletion acap)"
|
|
by wpsimp
|
|
|
|
lemma equiv_asid_sa_update[Finalise_IF_assms, simp]:
|
|
"equiv_asid asid (scheduler_action_update f s) s' = equiv_asid asid s s'"
|
|
"equiv_asid asid s (scheduler_action_update f s') = equiv_asid asid s s'"
|
|
by (auto simp: equiv_asid_def)
|
|
|
|
lemma equiv_asid_ready_queues_update[Finalise_IF_assms, simp]:
|
|
"equiv_asid asid (ready_queues_update f s) s' = equiv_asid asid s s'"
|
|
"equiv_asid asid s (ready_queues_update f s') = equiv_asid asid s s'"
|
|
by (auto simp: equiv_asid_def)
|
|
|
|
lemma arch_finalise_cap_makes_halted[Finalise_IF_assms]:
|
|
"\<lbrace>invs and valid_cap (ArchObjectCap arch_cap)
|
|
and (\<lambda>s. ex = is_final_cap' (ArchObjectCap arch_cap) s)
|
|
and cte_wp_at ((=) (ArchObjectCap arch_cap)) slot\<rbrace>
|
|
arch_finalise_cap arch_cap ex
|
|
\<lbrace>\<lambda>rv s. \<forall>t \<in> obj_refs_ac (fst rv). halted_if_tcb t s\<rbrace>"
|
|
by (wpsimp simp: arch_finalise_cap_def)
|
|
|
|
(* FIXME: move *)
|
|
lemma set_object_modifies_at_most:
|
|
"modifies_at_most aag {pasObjectAbs aag ptr}
|
|
(\<lambda>s. \<not> asid_pool_at ptr s \<and> (\<forall>asid_pool. obj \<noteq> ArchObj (ASIDPool asid_pool)))
|
|
(set_object ptr obj)"
|
|
apply (rule modifies_at_mostI)
|
|
apply (wp set_object_equiv_but_for_labels)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma set_thread_state_reads_respects[Finalise_IF_assms]:
|
|
assumes domains_distinct: "pas_domains_distinct aag"
|
|
shows "reads_respects aag l (\<lambda>s. is_subject aag (cur_thread s)) (set_thread_state ref ts)"
|
|
unfolding set_thread_state_def fun_app_def
|
|
apply (simp add: bind_assoc[symmetric])
|
|
apply (rule pre_ev)
|
|
apply (rule_tac P'=\<top> in bind_ev)
|
|
apply (rule set_thread_state_ext_reads_respects)
|
|
apply (case_tac "aag_can_read aag ref \<or> aag_can_affect aag l ref")
|
|
apply (wp set_object_reads_respects gets_the_ev)
|
|
apply (fastforce simp: get_tcb_def split: option.splits
|
|
elim: reads_equivE affects_equivE equiv_forE)
|
|
apply (simp add: equiv_valid_def2)
|
|
apply (rule equiv_valid_rv_bind)
|
|
apply (rule equiv_valid_rv_trivial)
|
|
apply (wp | simp)+
|
|
apply (rule_tac P=\<top> and P'=\<top> and L="{pasObjectAbs aag ref}" and L'="{pasObjectAbs aag ref}"
|
|
in ev2_invisible[OF domains_distinct])
|
|
apply (blast | simp add: labels_are_invisible_def)+
|
|
apply (rule set_object_modifies_at_most)
|
|
apply (rule set_object_modifies_at_most)
|
|
apply (simp | wp)+
|
|
apply (blast dest: get_tcb_not_asid_pool_at)
|
|
apply (subst thread_set_def[symmetric, simplified fun_app_def])
|
|
apply (wp | simp)+
|
|
done
|
|
|
|
lemma set_thread_state_runnable_reads_respects[Finalise_IF_assms]:
|
|
assumes domains_distinct: "pas_domains_distinct aag"
|
|
shows "runnable ts \<Longrightarrow> reads_respects aag l \<top> (set_thread_state ref ts)"
|
|
unfolding set_thread_state_def fun_app_def
|
|
apply (simp add: bind_assoc[symmetric])
|
|
apply (rule pre_ev)
|
|
apply (rule_tac P'=\<top> in bind_ev)
|
|
apply (rule set_thread_state_ext_runnable_reads_respects)
|
|
apply (case_tac "aag_can_read aag ref \<or> aag_can_affect aag l ref")
|
|
apply (wp set_object_reads_respects gets_the_ev)
|
|
apply (fastforce simp: get_tcb_def split: option.splits elim: reads_equivE affects_equivE equiv_forE)
|
|
apply (simp add: equiv_valid_def2)
|
|
apply (rule equiv_valid_rv_bind)
|
|
apply (rule equiv_valid_rv_trivial)
|
|
apply (wp | simp)+
|
|
apply (rule_tac P=\<top> and P'=\<top> and L="{pasObjectAbs aag ref}" and L'="{pasObjectAbs aag ref}"
|
|
in ev2_invisible[OF domains_distinct])
|
|
apply (blast | simp add: labels_are_invisible_def)+
|
|
apply (rule set_object_modifies_at_most)
|
|
apply (rule set_object_modifies_at_most)
|
|
apply (simp | wp)+
|
|
apply (blast dest: get_tcb_not_asid_pool_at)
|
|
apply (subst thread_set_def[symmetric, simplified fun_app_def])
|
|
apply (wp thread_set_st_tcb_at | simp)+
|
|
done
|
|
|
|
lemma set_bound_notification_none_reads_respects[Finalise_IF_assms]:
|
|
assumes domains_distinct: "pas_domains_distinct aag"
|
|
shows "reads_respects aag l \<top> (set_bound_notification ref None)"
|
|
unfolding set_bound_notification_def fun_app_def
|
|
apply (rule pre_ev(5)[where Q=\<top>])
|
|
apply (case_tac "aag_can_read aag ref \<or> aag_can_affect aag l ref")
|
|
apply (wp set_object_reads_respects gets_the_ev)[1]
|
|
apply (fastforce simp: get_tcb_def split: option.splits elim: reads_equivE affects_equivE equiv_forE)
|
|
apply (simp add: equiv_valid_def2)
|
|
apply (rule equiv_valid_rv_bind)
|
|
apply (rule equiv_valid_rv_trivial)
|
|
apply (wp | simp)+
|
|
apply (rule_tac P=\<top> and P'=\<top> and L="{pasObjectAbs aag ref}" and L'="{pasObjectAbs aag ref}"
|
|
in ev2_invisible[OF domains_distinct])
|
|
apply (blast | simp add: labels_are_invisible_def)+
|
|
apply (rule set_object_modifies_at_most)
|
|
apply (rule set_object_modifies_at_most)
|
|
apply (simp | wp)+
|
|
apply (blast dest: get_tcb_not_asid_pool_at)
|
|
apply simp
|
|
done
|
|
|
|
lemma set_tcb_queue_reads_respects[Finalise_IF_assms, wp]:
|
|
"reads_respects aag l \<top> (set_tcb_queue d prio queue)"
|
|
unfolding equiv_valid_def2 equiv_valid_2_def
|
|
apply (clarsimp simp: set_tcb_queue_def bind_def modify_def put_def get_def)
|
|
apply (rule conjI)
|
|
apply (rule reads_equiv_ready_queues_update, assumption)
|
|
apply (fastforce simp: reads_equiv_def affects_equiv_def states_equiv_for_def equiv_for_def)
|
|
apply (rule affects_equiv_ready_queues_update, assumption)
|
|
apply (clarsimp simp: reads_equiv_def affects_equiv_def states_equiv_for_def equiv_for_def
|
|
equiv_asids_def equiv_asid_def)
|
|
apply (rule ext)
|
|
apply force
|
|
done
|
|
|
|
lemma set_tcb_queue_modifies_at_most:
|
|
"modifies_at_most aag L (\<lambda>s. pasDomainAbs aag d \<inter> L \<noteq> {}) (set_tcb_queue d prio queue)"
|
|
apply (rule modifies_at_mostI)
|
|
apply (simp add: set_tcb_queue_def modify_def, wp)
|
|
apply (force simp: equiv_but_for_labels_def states_equiv_for_def equiv_for_def equiv_asids_def)
|
|
done
|
|
|
|
lemma set_notification_equiv_but_for_labels[Finalise_IF_assms]:
|
|
"\<lbrace>equiv_but_for_labels aag L st and K (pasObjectAbs aag ntfnptr \<in> L)\<rbrace>
|
|
set_notification ntfnptr ntfn
|
|
\<lbrace>\<lambda>_. equiv_but_for_labels aag L st\<rbrace>"
|
|
unfolding set_simple_ko_def
|
|
apply (wp set_object_equiv_but_for_labels get_object_wp)
|
|
apply (clarsimp simp: asid_pool_at_kheap partial_inv_def obj_at_def split: kernel_object.splits)
|
|
done
|
|
|
|
lemma thread_set_reads_respects[Finalise_IF_assms]:
|
|
assumes domains_distinct[wp]: "pas_domains_distinct aag"
|
|
shows "reads_respects aag l \<top> (thread_set x y)"
|
|
unfolding thread_set_def fun_app_def
|
|
apply (case_tac "aag_can_read aag y \<or> aag_can_affect aag l y")
|
|
apply (wp set_object_reads_respects)
|
|
apply (clarsimp, rule reads_affects_equiv_get_tcb_eq, simp+)[1]
|
|
apply (simp add: equiv_valid_def2)
|
|
apply (rule equiv_valid_rv_guard_imp)
|
|
apply (rule_tac L="{pasObjectAbs aag y}" and L'="{pasObjectAbs aag y}"
|
|
in ev2_invisible[OF domains_distinct])
|
|
apply (assumption | simp add: labels_are_invisible_def)+
|
|
apply (rule modifies_at_mostI[where P="\<top>"]
|
|
| wp set_object_equiv_but_for_labels
|
|
| simp
|
|
| (clarify, drule get_tcb_not_asid_pool_at))+
|
|
done
|
|
|
|
lemma aag_cap_auth_ASIDPoolCap:
|
|
"pas_cap_cur_auth aag (ArchObjectCap (ASIDPoolCap r asid)) \<Longrightarrow>
|
|
pas_refined aag s \<Longrightarrow> is_subject aag r"
|
|
unfolding aag_cap_auth_def
|
|
by (simp add: clas_no_asid cap_auth_conferred_def arch_cap_auth_conferred_def
|
|
cli_no_irqs pas_refined_all_auth_is_owns)
|
|
|
|
lemma aag_cap_auth_PageDirectory:
|
|
"pas_cap_cur_auth aag (ArchObjectCap (PageTableCap word (Some a))) \<Longrightarrow>
|
|
pas_refined aag s \<Longrightarrow> is_subject aag word"
|
|
unfolding aag_cap_auth_def
|
|
by (simp add: clas_no_asid cap_auth_conferred_def arch_cap_auth_conferred_def
|
|
cli_no_irqs pas_refined_all_auth_is_owns)
|
|
|
|
lemma aag_cap_auth_ASIDPoolCap_asid:
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (ASIDPoolCap r asid)); asid' \<noteq> 0;
|
|
asid_high_bits_of asid' = asid_high_bits_of asid; pas_refined aag s \<rbrakk>
|
|
\<Longrightarrow> is_subject_asid aag asid'"
|
|
apply (frule (1) aag_cap_auth_ASIDPoolCap)
|
|
apply (unfold aag_cap_auth_def)
|
|
apply (rule is_subject_into_is_subject_asid)
|
|
apply auto
|
|
done
|
|
|
|
lemma aag_cap_auth_PageCap_asid:
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (FrameCap dev ref r sz (Some (a, b)))); pas_refined aag s \<rbrakk>
|
|
\<Longrightarrow> is_subject_asid aag a"
|
|
by (auto simp: aag_cap_auth_def cap_links_asid_slot_def label_owns_asid_slot_def
|
|
intro: pas_refined_Control_into_is_subject_asid)
|
|
|
|
lemma aag_cap_auth_PageTableCap:
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (PageTableCap word option)); pas_refined aag s \<rbrakk>
|
|
\<Longrightarrow> is_subject aag word"
|
|
unfolding aag_cap_auth_def
|
|
by (simp add: clas_no_asid cap_auth_conferred_def arch_cap_auth_conferred_def
|
|
cli_no_irqs pas_refined_all_auth_is_owns)
|
|
|
|
lemma aag_cap_auth_PageTableCap_asid:
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (PageTableCap word (Some (a, b)))); pas_refined aag s \<rbrakk>
|
|
\<Longrightarrow> is_subject_asid aag a"
|
|
by (auto simp: aag_cap_auth_def cap_links_asid_slot_def label_owns_asid_slot_def
|
|
intro: pas_refined_Control_into_is_subject_asid)
|
|
|
|
lemma aag_cap_auth_PageDirectoryCap:
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (PageTableCap word option)); pas_refined aag s \<rbrakk>
|
|
\<Longrightarrow> is_subject aag word"
|
|
unfolding aag_cap_auth_def
|
|
by (simp add: clas_no_asid cap_auth_conferred_def arch_cap_auth_conferred_def
|
|
cli_no_irqs pas_refined_all_auth_is_owns)
|
|
|
|
lemma aag_cap_auth_PageDirectoryCap_asid:
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (PageTableCap word (Some (a,vref)))); pas_refined aag s \<rbrakk>
|
|
\<Longrightarrow> is_subject_asid aag a"
|
|
unfolding aag_cap_auth_def
|
|
by (auto simp: cap_links_asid_slot_def label_owns_asid_slot_def
|
|
intro: pas_refined_Control_into_is_subject_asid)
|
|
|
|
lemmas aag_cap_auth_subject = aag_cap_auth_ASIDPoolCap_asid
|
|
aag_cap_auth_PageCap_asid
|
|
aag_cap_auth_PageTableCap_asid
|
|
|
|
lemma prepare_thread_delete_reads_respects_f[Finalise_IF_assms]:
|
|
"reads_respects_f aag l \<top> (prepare_thread_delete thread)"
|
|
unfolding prepare_thread_delete_def by wp
|
|
|
|
lemma arch_finalise_cap_reads_respects[Finalise_IF_assms]:
|
|
"reads_respects aag l (pas_refined aag and invs and cte_wp_at ((=) (ArchObjectCap cap)) slot
|
|
and K (pas_cap_cur_auth aag (ArchObjectCap cap)))
|
|
(arch_finalise_cap cap final)"
|
|
unfolding arch_finalise_cap_def
|
|
apply (rule gen_asm_ev)
|
|
apply (case_tac cap)
|
|
apply simp
|
|
apply (simp split: bool.splits)
|
|
apply (intro impI conjI)
|
|
by (wp delete_asid_pool_reads_respects unmap_page_reads_respects unmap_page_table_reads_respects
|
|
delete_asid_reads_respects find_vspace_for_asid_reads_respects
|
|
| simp add: invs_psp_aligned invs_vspace_objs invs_valid_objs valid_cap_def
|
|
valid_arch_state_asid_table invs_arch_state wellformed_mapdata_def
|
|
split: option.splits bool.splits
|
|
| intro impI conjI allI
|
|
| elim conjE
|
|
| drule cte_wp_valid_cap
|
|
| fastforce dest: aag_can_read_own_asids aag_cap_auth_subject)+
|
|
|
|
(*NOTE: Required to dance around the issue of the base potentially
|
|
being zero and thus we can't conclude it is in the current subject.*)
|
|
lemma requiv_riscv_asid_table_asid_high_bits_of_asid_eq':
|
|
"\<lbrakk> pas_cap_cur_auth aag (ArchObjectCap (ASIDPoolCap p b)); reads_equiv aag s t; pas_refined aag x \<rbrakk>
|
|
\<Longrightarrow> asid_table s (asid_high_bits_of b) =
|
|
asid_table t (asid_high_bits_of b)"
|
|
apply (subgoal_tac "asid_high_bits_of 0 = asid_high_bits_of 1")
|
|
apply (case_tac "b = 0")
|
|
apply (subgoal_tac "is_subject_asid aag 1")
|
|
apply ((fastforce intro: requiv_riscv_asid_table_asid_high_bits_of_asid_eq
|
|
aag_cap_auth_ASIDPoolCap_asid)+)[2]
|
|
apply (auto intro: requiv_riscv_asid_table_asid_high_bits_of_asid_eq
|
|
aag_cap_auth_ASIDPoolCap_asid)[1]
|
|
apply (simp add: asid_high_bits_of_def asid_low_bits_def)
|
|
done
|
|
|
|
lemma pt_cap_aligned:
|
|
"\<lbrakk> caps_of_state s p = Some (ArchObjectCap (PageTableCap word x)); valid_caps (caps_of_state s) s \<rbrakk>
|
|
\<Longrightarrow> is_aligned word pt_bits"
|
|
by (auto simp: obj_ref_of_def pt_bits_def pageBits_def
|
|
dest!: cap_aligned_valid[OF valid_capsD, unfolded cap_aligned_def, THEN conjunct1])
|
|
|
|
lemma maskInterrupt_no_mem:
|
|
"maskInterrupt a b \<lbrace>\<lambda>ms. P (underlying_memory ms)\<rbrace>"
|
|
by (wpsimp simp: maskInterrupt_def)
|
|
|
|
lemma set_irq_state_valid_global_objs:
|
|
"set_irq_state state irq \<lbrace>valid_global_objs\<rbrace>"
|
|
apply (simp add: set_irq_state_def)
|
|
apply (wp modify_wp)
|
|
apply (fastforce simp: valid_global_objs_def)
|
|
done
|
|
|
|
lemma set_irq_state_globals_equiv[Finalise_IF_assms]:
|
|
"set_irq_state state irq \<lbrace>globals_equiv st\<rbrace>"
|
|
apply (simp add: set_irq_state_def)
|
|
apply (wp dmo_no_mem_globals_equiv maskInterrupt_no_mem modify_wp)
|
|
apply (simp add: globals_equiv_interrupt_states_update)
|
|
done
|
|
|
|
lemma set_notification_globals_equiv[Finalise_IF_assms]:
|
|
"\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
|
|
set_notification ptr ntfn
|
|
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
|
unfolding set_simple_ko_def
|
|
apply (wp set_object_globals_equiv get_object_wp)
|
|
apply (fastforce simp: obj_at_def valid_arch_state_def dest: valid_global_arch_objs_pt_at)
|
|
done
|
|
|
|
lemma delete_asid_globals_equiv:
|
|
"\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
|
|
delete_asid asid pt
|
|
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
|
unfolding delete_asid_def
|
|
by (wpsimp wp: set_vm_root_globals_equiv set_asid_pool_globals_equiv simp: hwASIDFlush_def)
|
|
|
|
lemma arch_finalise_cap_globals_equiv[Finalise_IF_assms]:
|
|
"\<lbrace>globals_equiv st and invs and valid_arch_cap cap\<rbrace>
|
|
arch_finalise_cap cap b
|
|
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
|
apply (induct cap; simp add: arch_finalise_cap_def)
|
|
by (wp delete_asid_pool_globals_equiv case_option_wp unmap_page_globals_equiv
|
|
unmap_page_table_globals_equiv delete_asid_globals_equiv
|
|
| wpc | clarsimp simp: valid_arch_cap_def wellformed_mapdata_def)+
|
|
|
|
declare arch_get_sanitise_register_info_def[simp]
|
|
|
|
crunch globals_equiv[Finalise_IF_assms, wp]: prepare_thread_delete "globals_equiv st"
|
|
(wp: dxo_wp_weak)
|
|
|
|
lemma set_bound_notification_globals_equiv[Finalise_IF_assms]:
|
|
"\<lbrace>globals_equiv s and valid_arch_state\<rbrace>
|
|
set_bound_notification ref ts
|
|
\<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
|
|
unfolding set_bound_notification_def
|
|
apply (wp set_object_globals_equiv dxo_wp_weak |simp)+
|
|
apply (intro impI conjI allI)
|
|
by (fastforce simp: valid_arch_state_def obj_at_def tcb_at_def2 get_tcb_def is_tcb_def
|
|
dest: get_tcb_SomeD valid_global_arch_objs_pt_at
|
|
split: option.splits kernel_object.splits)+
|
|
|
|
end
|
|
|
|
|
|
global_interpretation Finalise_IF_1?: Finalise_IF_1
|
|
proof goal_cases
|
|
interpret Arch .
|
|
case 1 show ?case
|
|
by (unfold_locales; (fact Finalise_IF_assms)?)
|
|
qed
|
|
|
|
end
|