ainvs: integrate all architectures
This commit is contained in:
Matthew Brecknell
parent
22999e54a3
commit
2f70a304da
|
|
@ -1957,8 +1957,8 @@ lemma set_asid_pool_table_caps [wp]:
|
|||
apply (rule hoare_lift_Pf2 [where f=caps_of_state];wp?)
|
||||
apply (simp add: set_asid_pool_def set_object_def)
|
||||
apply (wp get_object_wp)
|
||||
by (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
|
||||
(fastforce simp: obj_at_def empty_table_def)
|
||||
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
|
||||
by (fastforce simp: obj_at_def empty_table_def)
|
||||
|
||||
|
||||
|
||||
|
|
@ -2183,8 +2183,7 @@ lemma set_asid_pool_invs_restrict:
|
|||
set_asid_pool p (ap |` S) \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (simp add: invs_def valid_state_def valid_pspace_def
|
||||
valid_arch_caps_def)
|
||||
apply (rule hoare_pre,
|
||||
wp valid_irq_node_typ set_asid_pool_typ_at
|
||||
apply (wp valid_irq_node_typ set_asid_pool_typ_at
|
||||
set_asid_pool_vspace_objs_unmap valid_irq_handlers_lift
|
||||
set_asid_pool_vs_lookup_unmap set_asid_pool_restrict_asid_map)
|
||||
apply simp
|
||||
|
|
|
|||
|
|
@ -618,16 +618,10 @@ where
|
|||
obj_at (valid_pd_kernel_mappings (arm_kernel_vspace (arch_state s)) s)
|
||||
(arm_global_pd (arch_state s)) s"
|
||||
|
||||
fun
|
||||
is_vspace_typ :: "a_type \<Rightarrow> bool"
|
||||
where
|
||||
"is_vspace_typ (AArch _) = True"
|
||||
| "is_vspace_typ _ = False"
|
||||
|
||||
definition
|
||||
valid_vso_at :: "obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_vso_at p \<equiv> \<lambda>s. \<exists>ao. ko_at (ArchObj ao) p s \<and> valid_vspace_obj ao s \<and> is_vspace_typ (AArch (aa_type ao))"
|
||||
"valid_vso_at p \<equiv> \<lambda>s. \<exists>ao. ko_at (ArchObj ao) p s \<and> valid_vspace_obj ao s"
|
||||
|
||||
definition
|
||||
valid_ao_at :: "obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
|
|
@ -1609,7 +1603,7 @@ lemma stronger_vspace_objsD_lemma:
|
|||
apply (drule (2) valid_vspace_objsD)
|
||||
apply (fastforce simp: valid_arch_obj_def)
|
||||
apply clarsimp
|
||||
apply (simp only: valid_arch_obj_def[symmetric])
|
||||
apply (simp only: valid_arch_obj_def[symmetric])
|
||||
apply (frule (2) vs_lookup1_ko_at_dest)
|
||||
apply (drule (1) vs_lookup_trancl_step)
|
||||
apply (drule (1) vs_lookup_step)
|
||||
|
|
@ -2076,22 +2070,6 @@ lemma valid_pde_lift2:
|
|||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_pde pde s\<rbrace> f \<lbrace>\<lambda>rv s. valid_pde pde s\<rbrace>"
|
||||
by (cases pde) (simp add: data_at_def | wp hoare_vcg_disj_lift x)+
|
||||
|
||||
lemma valid_arch_obj_typ2:
|
||||
assumes P: "\<And>P p T. \<lbrace>\<lambda>s. Q s \<and> P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_arch_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_obj ob s\<rbrace>"
|
||||
apply (cases ob, simp_all add: valid_arch_obj_def)
|
||||
apply (wp hoare_vcg_const_Ball_lift [OF P], simp)
|
||||
apply (rule hoare_pre, wp hoare_vcg_all_lift valid_pte_lift2 P)
|
||||
apply clarsimp
|
||||
apply assumption
|
||||
apply clarsimp
|
||||
apply (wp hoare_vcg_ball_lift valid_pde_lift2 P)
|
||||
apply clarsimp
|
||||
apply assumption
|
||||
apply clarsimp
|
||||
apply wp
|
||||
done
|
||||
|
||||
lemma valid_vspace_obj_typ2:
|
||||
assumes P: "\<And>P p T. \<lbrace>\<lambda>s. Q s \<and> P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_vspace_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_vspace_obj ob s\<rbrace>"
|
||||
|
|
@ -2108,6 +2086,11 @@ lemma valid_vspace_obj_typ2:
|
|||
apply wp
|
||||
done
|
||||
|
||||
lemma valid_arch_obj_typ2:
|
||||
assumes P: "\<And>P p T. \<lbrace>\<lambda>s. Q s \<and> P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_arch_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_obj ob s\<rbrace>"
|
||||
using assms unfolding valid_arch_obj_def by (rule valid_vspace_obj_typ2)
|
||||
|
||||
lemma valid_arch_objsI [intro?]:
|
||||
"(\<And>p ao. \<lbrakk> (\<exists>\<rhd> p) s; ko_at (ArchObj ao) p s \<rbrakk> \<Longrightarrow> valid_arch_obj ao s) \<Longrightarrow> valid_arch_objs s"
|
||||
by (simp add: valid_arch_objs_def)
|
||||
|
|
@ -2320,13 +2303,8 @@ where
|
|||
lemma refs_of_a_simps[simp]:
|
||||
"refs_of_a ao = {}"
|
||||
by (auto simp: refs_of_a_def)
|
||||
(*
|
||||
lemma refs_of_a_rev: (* duplicate? *)
|
||||
"(x, y) \<in> refs_of_a ao ==> False"
|
||||
by (auto simp: refs_of_a_def vcpu_tcb_refs_def split: arch_kernel_obj.splits option.split)
|
||||
*)
|
||||
|
||||
definition (* refs to arch objects from a kernel object: move to generic? *)
|
||||
definition
|
||||
hyp_refs_of :: "kernel_object \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"hyp_refs_of x \<equiv> case x of
|
||||
|
|
@ -2343,23 +2321,12 @@ lemma hyp_refs_of_simps[simp]:
|
|||
"hyp_refs_of (Notification ntfn) = {}"
|
||||
"hyp_refs_of (ArchObj ao) = refs_of_a ao"
|
||||
by (auto simp: hyp_refs_of_def)
|
||||
(*
|
||||
lemma hyp_refs_of_rev:
|
||||
"(x, TCBHypRef) \<in> hyp_refs_of ko =
|
||||
(\<exists>tcb. ko = TCB tcb \<and> (tcb_vcpu (tcb_arch tcb) = Some x))"
|
||||
"(x, HypTCBRef) \<in> hyp_refs_of ko =
|
||||
(\<exists>v. ko = ArchObj (VCPU v) \<and> (vcpu_tcb v = Some x))"
|
||||
by (auto simp: hyp_refs_of_def tcb_hyp_refs_def tcb_vcpu_refs_def
|
||||
vcpu_tcb_refs_def refs_of_a_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits option.split)
|
||||
*)
|
||||
|
||||
definition
|
||||
state_hyp_refs_of :: "'z::state_ext state \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"state_hyp_refs_of s \<equiv> \<lambda>x. case (kheap s x) of Some ko \<Rightarrow> hyp_refs_of ko | None \<Rightarrow> {}"
|
||||
|
||||
|
||||
definition
|
||||
state_refs_of_a :: "'z::state_ext state \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
|
|
@ -2367,7 +2334,6 @@ where
|
|||
Some ko \<Rightarrow> (case ko of ArchObj ao \<Rightarrow> refs_of_a ao | _ \<Rightarrow> {})
|
||||
| None \<Rightarrow> {}"
|
||||
|
||||
|
||||
lemma state_hyp_refs_of_elemD:
|
||||
"\<lbrakk> ref \<in> state_hyp_refs_of s x \<rbrakk> \<Longrightarrow> obj_at (\<lambda>obj. ref \<in> hyp_refs_of obj) x s"
|
||||
by (clarsimp simp add: state_hyp_refs_of_def obj_at_def
|
||||
|
|
@ -2419,13 +2385,7 @@ lemma hyp_refs_of_hyp_live:
|
|||
"hyp_refs_of ko \<noteq> {} \<Longrightarrow> hyp_live ko"
|
||||
apply (cases ko, simp_all add: hyp_refs_of_def)
|
||||
done
|
||||
(*
|
||||
lemma hyp_refs_of_hyp_live_iff:
|
||||
"hyp_refs_of ko \<noteq> {} = hyp_live ko"
|
||||
apply (rule, clarsimp simp: hyp_refs_of_hyp_live)
|
||||
apply (cases ko; clarsimp simp add: hyp_live_def arch_live_def split: arch_kernel_obj.splits)
|
||||
done
|
||||
*)
|
||||
|
||||
lemma hyp_refs_of_hyp_live_obj:
|
||||
"\<lbrakk> obj_at P p s; \<And>ko. \<lbrakk> P ko; hyp_refs_of ko = {} \<rbrakk> \<Longrightarrow> False \<rbrakk> \<Longrightarrow> obj_at hyp_live p s"
|
||||
by (fastforce simp: obj_at_def hyp_refs_of_hyp_live)
|
||||
|
|
|
|||
|
|
@ -20,22 +20,6 @@ where
|
|||
"non_vspace_obj (ArchObj _) = False"
|
||||
| "non_vspace_obj _ = True"
|
||||
|
||||
lemma valid_vspace_is_vspace_lift:
|
||||
assumes P: "\<And>p T. \<lbrace>(K (is_vspace_typ (AArch T))) and (typ_at (AArch T) p)\<rbrace> f \<lbrace>\<lambda>rv. typ_at (AArch T) p\<rbrace>"
|
||||
shows "\<lbrace>valid_vspace_obj ob\<rbrace> f \<lbrace>\<lambda>rv. valid_vspace_obj ob\<rbrace>"
|
||||
apply (cases ob, simp_all add: aa_type_def)
|
||||
apply (rule hoare_vcg_const_Ball_lift)
|
||||
apply (wp P, simp)
|
||||
apply (rule hoare_vcg_all_lift)
|
||||
apply (rename_tac "fun" x)
|
||||
apply (case_tac "fun x"; simp_all add: data_at_def hoare_vcg_prop)
|
||||
apply (rule hoare_vcg_conj_lift hoare_vcg_disj_lift | wp P | simp )+
|
||||
apply (rule hoare_vcg_ball_lift)
|
||||
apply (rename_tac "fun" x)
|
||||
apply (case_tac "fun x";simp_all add: data_at_def hoare_vcg_prop)
|
||||
apply (rule hoare_vcg_conj_lift hoare_vcg_disj_lift | wp P | simp )+
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_lift2: "valid_pspace s \<Longrightarrow> valid_vspace_objs s \<Longrightarrow> valid_arch_objs s"
|
||||
by (clarsimp simp add: valid_pspace_def valid_objs_def valid_vspace_objs_def valid_arch_objs_def valid_arch_obj_def obj_at_def)
|
||||
|
||||
|
|
@ -44,16 +28,13 @@ lemma obj_at_split: "(obj_at (P xo) p s \<and> (Q xo)) = obj_at (\<lambda>ko. P
|
|||
|
||||
lemma valid_vspace_objs_lift:
|
||||
assumes x: "\<And>P. \<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> f \<lbrace>\<lambda>_ s. P (vs_lookup s)\<rbrace>"
|
||||
assumes y: "\<And>ako p. is_vspace_typ (AArch (aa_type ako))
|
||||
\<Longrightarrow> \<lbrace>\<lambda>s. \<not> ko_at (ArchObj ako) p s\<rbrace> f \<lbrace>\<lambda>rv s. \<not> ko_at (ArchObj ako) p s\<rbrace>"
|
||||
assumes z: "\<And>p T. \<lbrace>(K (is_vspace_typ (AArch T))) and typ_at (AArch T) p\<rbrace> f \<lbrace>\<lambda>rv. typ_at (AArch T) p\<rbrace>"
|
||||
assumes y: "\<And>ako p. \<lbrace>\<lambda>s. \<not> ko_at (ArchObj ako) p s\<rbrace> f \<lbrace>\<lambda>rv s. \<not> ko_at (ArchObj ako) p s\<rbrace>"
|
||||
assumes z: "\<And>p T. \<lbrace>typ_at (AArch T) p\<rbrace> f \<lbrace>\<lambda>rv. typ_at (AArch T) p\<rbrace>"
|
||||
shows "\<lbrace>valid_vspace_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
apply (simp add: valid_vspace_objs_def)
|
||||
apply (rule hoare_vcg_all_lift, wp hoare_convert_imp [OF x]; (rule hoare_vcg_all_lift | assumption))
|
||||
apply (rule hoare_convert_imp)
|
||||
apply (rule y)
|
||||
apply (clarsimp simp: aa_type_def split: arch_kernel_obj.split)
|
||||
apply (rule valid_vspace_is_vspace_lift [OF z])
|
||||
apply (rule hoare_vcg_all_lift, wp hoare_convert_imp[OF x]; (rule hoare_vcg_all_lift | assumption))
|
||||
apply (rule hoare_convert_imp[OF y])
|
||||
apply (rule valid_vspace_obj_typ[OF z])
|
||||
done
|
||||
|
||||
lemma vspace_obj_imp: "non_arch_obj ko \<Longrightarrow> non_vspace_obj ko"
|
||||
|
|
@ -74,12 +55,6 @@ definition vspace_obj_pred :: "(kernel_object \<Rightarrow> bool) \<Rightarrow>
|
|||
\<forall>ko ko'. non_vspace_obj ko \<longrightarrow> non_vspace_obj ko' \<longrightarrow>
|
||||
P ko = P ko'"
|
||||
|
||||
lemma arch_obj_imp_vspace_obj[simp]: "arch_obj_pred P \<Longrightarrow> vspace_obj_pred P"
|
||||
apply (clarsimp simp: arch_obj_pred_def vspace_obj_pred_def non_arch_obj_def;
|
||||
erule_tac x=ko in allE; case_tac ko; simp; (erule_tac x=ko' in allE)?)
|
||||
apply (drule mp; clarsimp)+
|
||||
done
|
||||
|
||||
lemma vspace_obj_predE:
|
||||
"\<lbrakk>vspace_obj_pred P; non_vspace_obj ko; non_vspace_obj ko'\<rbrakk> \<Longrightarrow> P ko = P ko'"
|
||||
apply (unfold vspace_obj_pred_def)
|
||||
|
|
@ -143,44 +118,28 @@ declare
|
|||
vspace_obj_pred_fI[where f=All, intro]
|
||||
vspace_obj_pred_fI[where f=Ex, intro]
|
||||
|
||||
sublocale
|
||||
empty_table: vspace_only_obj_pred "empty_table S" vspace_obj_pred for S
|
||||
by (unfold_locales, clarsimp simp : empty_table_def
|
||||
vspace_obj_pred_def
|
||||
del : vspace_obj_fun_lift_expand
|
||||
split : arch_kernel_obj.splits kernel_object.splits)
|
||||
end
|
||||
|
||||
sublocale
|
||||
vs_refs: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko" vspace_obj_pred
|
||||
by (unfold_locales, clarsimp simp : vspace_obj_pred_def
|
||||
vs_refs_def
|
||||
del : vs_refs_arch_def
|
||||
split : arch_kernel_obj.splits
|
||||
kernel_object.splits)
|
||||
(*
|
||||
sublocale
|
||||
vs_refs': arch_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by (unfold_locales, simp add: vs_refs_def del: vs_refs_arch_def)
|
||||
*)
|
||||
sublocale
|
||||
vs_refs_pages: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko" vspace_obj_pred
|
||||
by (unfold_locales, clarsimp simp : vspace_obj_pred_def
|
||||
vs_refs_pages_def
|
||||
del : vs_refs_pages_arch_def
|
||||
split : arch_kernel_obj.split
|
||||
kernel_object.splits)
|
||||
(* keep arch version for now *)
|
||||
sublocale
|
||||
empty_table: arch_only_obj_pred "empty_table S" for S
|
||||
by (unfold_locales, simp add: empty_table_def del: arch_obj_fun_lift_expand)
|
||||
locale vspace_only_obj_pred = Arch +
|
||||
fixes P :: "kernel_object \<Rightarrow> bool"
|
||||
assumes vspace_only: "vspace_obj_pred P"
|
||||
|
||||
sublocale
|
||||
vs_refs: arch_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by (unfold_locales, simp add: vs_refs_def del: vs_refs_arch_def)
|
||||
sublocale vspace_only_obj_pred < arch_only_obj_pred
|
||||
using vspace_pred_imp[OF vspace_only] by unfold_locales
|
||||
|
||||
sublocale
|
||||
vs_refs_pages: arch_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko"
|
||||
by (unfold_locales, simp add: vs_refs_pages_def del: vs_refs_pages_arch_def)
|
||||
context Arch begin global_naming ARM
|
||||
|
||||
sublocale empty_table: vspace_only_obj_pred "empty_table S" for S
|
||||
by unfold_locales (clarsimp simp: vspace_obj_pred_def empty_table_def
|
||||
split: arch_kernel_obj.splits kernel_object.splits)
|
||||
|
||||
sublocale vs_refs: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by unfold_locales (clarsimp simp: vspace_obj_pred_def vs_refs_def
|
||||
split: arch_kernel_obj.splits kernel_object.splits)
|
||||
|
||||
sublocale vs_refs_pages: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko"
|
||||
by unfold_locales (clarsimp simp: vspace_obj_pred_def vs_refs_pages_def
|
||||
split: arch_kernel_obj.split kernel_object.splits)
|
||||
|
||||
lemma pspace_in_kernel_window_atyp_lift_strong:
|
||||
assumes atyp_inv: "\<And>P p T. \<lbrace> \<lambda>s. P (typ_at T p s) \<rbrace> f \<lbrace> \<lambda>rv s. P (typ_at T p s) \<rbrace>"
|
||||
|
|
@ -307,11 +266,6 @@ lemma valid_vspace_objs_lift_weak:
|
|||
apply (rule valid_vspace_objs_lift)
|
||||
apply (rule vs_lookup_vspace_obj_at_lift)
|
||||
apply (rule obj_at arch_state vspace_pred_imp; simp)+
|
||||
apply (rule hoare_gen_asm_lk)
|
||||
apply (rule obj_at)
|
||||
subgoal
|
||||
by (auto simp: aa_type_def a_type_def vspace_obj_pred_def
|
||||
split: arch_kernel_obj.splits kernel_object.splits)
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_lift_weak:
|
||||
|
|
@ -543,26 +497,19 @@ lemma valid_global_objs_lift':
|
|||
lemmas valid_global_objs_lift
|
||||
= valid_global_objs_lift' [where v=False, simplified]
|
||||
|
||||
lemma arch_lifts_vspace:
|
||||
context
|
||||
fixes f :: "'a::state_ext state \<Rightarrow> ('b \<times> 'a state) set \<times> bool"
|
||||
assumes arch: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (arch_state s)\<rbrace>"
|
||||
assumes aobj_at: "\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
notes vspace_obj_fun_lift_expand[simp del]
|
||||
shows
|
||||
valid_global_vspace_mappings_lift:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_global_vspace_mappings\<rbrace>" and
|
||||
valid_arch_caps_lift_weak:
|
||||
"(\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>) \<Longrightarrow>
|
||||
\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>" and
|
||||
valid_global_objs_lift_weak:
|
||||
"\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>" and
|
||||
valid_asid_map_lift:
|
||||
"\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>" and
|
||||
valid_kernel_mappings_lift:
|
||||
"\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>"
|
||||
apply -
|
||||
begin
|
||||
|
||||
subgoal
|
||||
context
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
notes vspace_obj_fun_lift_expand[simp del]
|
||||
begin
|
||||
|
||||
lemma valid_global_vspace_mappings_lift:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_global_vspace_mappings\<rbrace>"
|
||||
apply (simp add: valid_global_vspace_mappings_def valid_pd_kernel_mappings_def
|
||||
del: valid_pd_kernel_mappings_arch_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
|
|
@ -580,13 +527,16 @@ lemma arch_lifts_vspace:
|
|||
drule use_valid[OF _ aobj_at[where P="\<lambda>x. \<not>x", OF vspace_obj_pred_fun_lift_id]],
|
||||
simp+)+
|
||||
|
||||
subgoal
|
||||
lemma valid_arch_caps_lift_weak:
|
||||
"(\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>) \<Longrightarrow>
|
||||
\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>"
|
||||
apply (rule valid_arch_caps_lift[OF _ _ arch aobj_at])
|
||||
apply (rule vs_lookup_pages_vspace_obj_at_lift[OF aobj_at arch], assumption+)
|
||||
apply (rule empty_table.vspace_only)
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_global_objs_lift_weak:
|
||||
"\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
apply (rule valid_global_objs_lift)
|
||||
apply (wp arch)+
|
||||
apply (simp add: valid_vso_at_def)
|
||||
|
|
@ -595,13 +545,15 @@ lemma arch_lifts_vspace:
|
|||
apply (wp aobj_at valid_vspace_obj_typ | simp | rule empty_table.vspace_only)+
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_asid_map_lift:
|
||||
"\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>"
|
||||
apply (simp add: valid_asid_map_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (simp add: vspace_at_asid_def)
|
||||
by (rule vs_lookup_vspace_obj_at_lift[OF aobj_at arch])
|
||||
|
||||
subgoal
|
||||
lemma valid_kernel_mappings_lift:
|
||||
"\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>"
|
||||
apply (simp add: valid_kernel_mappings_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (simp add: valid_kernel_mappings_if_pd_def ran_def
|
||||
|
|
@ -618,21 +570,16 @@ lemma arch_lifts_vspace:
|
|||
apply (clarsimp simp del: valid_kernel_mappings_if_pd_arch_def)
|
||||
apply (case_tac xa; simp add: hoare_vcg_prop)
|
||||
done
|
||||
done
|
||||
|
||||
lemma arch_lifts':
|
||||
assumes arch: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (arch_state s)\<rbrace>"
|
||||
assumes aobj_at: "\<And>P P' pd. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
notes arch_obj_fun_lift_expand[simp del]
|
||||
shows
|
||||
valid_global_pts_lift:
|
||||
"\<lbrace>valid_global_pts\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pts\<rbrace>" and
|
||||
valid_arch_state_lift_aobj_at:
|
||||
"\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
apply -
|
||||
end
|
||||
|
||||
subgoal valid_global_pts
|
||||
context
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. arch_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
begin
|
||||
|
||||
lemma valid_global_pts_lift:
|
||||
"\<lbrace>valid_global_pts\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pts\<rbrace>"
|
||||
apply (simp add: valid_global_pts_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (rule hoare_vcg_ball_lift)
|
||||
|
|
@ -640,19 +587,20 @@ lemma arch_lifts':
|
|||
apply clarsimp
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_arch_state_lift_aobj_at:
|
||||
"\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
apply (simp add: valid_arch_state_def valid_asid_table_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (wp hoare_vcg_conj_lift hoare_vcg_ball_lift valid_global_pts | (rule aobj_at, clarsimp))+
|
||||
apply (wp hoare_vcg_conj_lift hoare_vcg_ball_lift valid_global_pts_lift | (rule aobj_at, clarsimp))+
|
||||
apply simp
|
||||
done
|
||||
done
|
||||
|
||||
lemmas arch_lifts = arch_lifts' arch_lifts_vspace valid_arch_state_lift_aobj_at
|
||||
end
|
||||
end
|
||||
|
||||
lemma equal_kernel_mappings_lift:
|
||||
assumes aobj_at: "\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
shows "\<lbrace>equal_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. equal_kernel_mappings\<rbrace>"
|
||||
apply (simp add: equal_kernel_mappings_def)
|
||||
apply (rule hoare_vcg_all_lift)+
|
||||
|
|
@ -692,7 +640,7 @@ lemma valid_vso_at_lift:
|
|||
and y: "\<And>ao. \<lbrace>\<lambda>s. ko_at (ArchObj ao) p s\<rbrace> f \<lbrace>\<lambda>rv s. ko_at (ArchObj ao) p s\<rbrace>"
|
||||
shows "\<lbrace>valid_vso_at p\<rbrace> f \<lbrace>\<lambda>rv. valid_vso_at p\<rbrace>"
|
||||
unfolding valid_vso_at_def
|
||||
by (wpsimp wp: hoare_vcg_ex_lift y valid_vspace_is_vspace_lift z)+
|
||||
by (wpsimp wp: hoare_vcg_ex_lift y valid_vspace_obj_typ z)+
|
||||
|
||||
lemma valid_vso_at_lift_aobj_at:
|
||||
assumes aobj_at: "\<And>P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>obj_at P' pd\<rbrace> f \<lbrace>\<lambda>r s. obj_at P' pd s\<rbrace>"
|
||||
|
|
@ -702,10 +650,9 @@ lemma valid_vso_at_lift_aobj_at:
|
|||
apply (rule hoare_vcg_conj_lift aobj_at)+
|
||||
apply (clarsimp simp: vspace_obj_pred_def)
|
||||
apply (rule iffI)
|
||||
apply ((case_tac ao; clarsimp)+)[2]
|
||||
apply (wpsimp wp: valid_vspace_is_vspace_lift)
|
||||
apply (wpsimp wp: aobj_at)
|
||||
apply wp
|
||||
apply ((case_tac ao; clarsimp)+)[2]
|
||||
apply (wpsimp wp: valid_vspace_obj_typ)
|
||||
apply (wpsimp wp: aobj_at)
|
||||
apply assumption
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -853,7 +853,7 @@ end
|
|||
context retype_region_proofs begin
|
||||
|
||||
interpretation retype_region_proofs_arch ..
|
||||
thm valid_arch_objsI
|
||||
|
||||
lemma valid_vspace_objs':
|
||||
assumes va: "valid_vspace_objs s"
|
||||
shows "valid_vspace_objs s'"
|
||||
|
|
|
|||
|
|
@ -1554,7 +1554,7 @@ lemma set_pt_kernel_window[wp]:
|
|||
lemma set_pt_respects_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_pt p pt \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_pt_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (wp set_object_pspace_respects_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm
|
||||
arch_kernel_obj.split_asm)
|
||||
|
|
@ -2119,7 +2119,7 @@ lemma set_asid_pool_kernel_window[wp]:
|
|||
lemma set_asid_pool_pspace_respects_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_asid_pool p ap \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_asid_pool_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (wp set_object_pspace_respects_device_region get_object_wp)
|
||||
including unfold_objects_asm
|
||||
by (clarsimp simp: a_type_def)
|
||||
|
||||
|
|
@ -3014,7 +3014,7 @@ lemma set_pd_kernel_window[wp]:
|
|||
lemma set_pd_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_pd p pd \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_pd_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (wp set_object_pspace_respects_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm
|
||||
arch_kernel_obj.split_asm)
|
||||
|
|
|
|||
|
|
@ -692,7 +692,7 @@ lemma perform_asid_control_invocation_st_tcb_at:
|
|||
apply (drule(1) caps_of_state_valid[rotated])+
|
||||
apply (simp add:valid_cap_simps cap_aligned_def page_bits_def)
|
||||
apply (subst delete_objects_rewrite)
|
||||
apply (simp add:page_bits_def word_bits_def pageBits_def)+
|
||||
apply (simp add:page_bits_def word_bits_def word_size_bits_def pageBits_def)+
|
||||
apply (simp add:is_aligned_neg_mask_eq)
|
||||
apply wp
|
||||
apply (clarsimp simp: valid_aci_def)
|
||||
|
|
@ -814,21 +814,19 @@ lemma aci_invs':
|
|||
retype_region_ap'[simplified]
|
||||
retype_region_no_cap_to_obj[where sz = pageBits,simplified]
|
||||
| simp del: split_paired_Ex)+
|
||||
apply (strengthen invs_valid_objs invs_psp_aligned
|
||||
invs_mdb invs_valid_pspace
|
||||
exI[where x="case aci of MakePool frame slot parent base \<Rightarrow> parent"]
|
||||
exI[where x="case aci of MakePool frame slot parent base \<Rightarrow> parent",
|
||||
simplified]
|
||||
caps_region_kernel_window_imp[where
|
||||
p = "case aci of MakePool frame slot parent base \<Rightarrow> parent"]
|
||||
invs_cap_refs_in_kernel_window)+
|
||||
apply (strengthen invs_valid_objs invs_psp_aligned invs_mdb invs_valid_pspace
|
||||
exI[where x="case aci of MakePool frame slot parent base \<Rightarrow> parent"]
|
||||
exI[where x="case aci of MakePool frame slot parent base \<Rightarrow> parent", simplified]
|
||||
caps_region_kernel_window_imp[where
|
||||
p = "case aci of MakePool frame slot parent base \<Rightarrow> parent"]
|
||||
invs_cap_refs_in_kernel_window)+
|
||||
apply (wp set_cap_caps_no_overlap set_cap_no_overlap get_cap_wp
|
||||
max_index_upd_caps_overlap_reserved max_index_upd_invs_simple
|
||||
set_cap_cte_cap_wp_to set_cap_cte_wp_at max_index_upd_no_cap_to
|
||||
| simp split del: if_split | wp_once hoare_vcg_ex_lift)+
|
||||
apply (rule_tac P = "is_aligned word1 page_bits" in hoare_gen_asm)
|
||||
apply (subst delete_objects_rewrite)
|
||||
apply (simp add:page_bits_def pageBits_def)
|
||||
apply (simp add:page_bits_def pageBits_def word_size_bits_def)
|
||||
apply (simp add:page_bits_def pageBits_def word_bits_def)
|
||||
apply (simp add:is_aligned_neg_mask_eq)
|
||||
apply wp
|
||||
|
|
|
|||
|
|
@ -20,6 +20,20 @@ lemma set_cap_in_device_frame[wp]:
|
|||
"\<lbrace>in_device_frame buffer\<rbrace> set_cap cap ref \<lbrace>\<lambda>_. in_device_frame buffer\<rbrace>"
|
||||
by (simp add: in_device_frame_def) (wp hoare_vcg_ex_lift set_cap_typ_at)
|
||||
|
||||
lemma valid_cnode_capI:
|
||||
"\<lbrakk>cap_table_at n w s; valid_objs s; pspace_aligned s; n > 0; length g \<le> 32\<rbrakk>
|
||||
\<Longrightarrow> s \<turnstile> cap.CNodeCap w n g"
|
||||
apply (simp add: valid_cap_def cap_aligned_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp add: pspace_aligned_def obj_at_def)
|
||||
apply (drule bspec, fastforce)
|
||||
apply (clarsimp simp: is_obj_defs wf_obj_bits)
|
||||
apply (clarsimp simp add: obj_at_def is_obj_defs valid_objs_def dom_def)
|
||||
apply (erule allE, erule impE, blast)
|
||||
apply (simp add: valid_obj_def valid_cs_def valid_cs_size_def)
|
||||
apply (simp add: word_bits_def cte_level_bits_def)
|
||||
done
|
||||
|
||||
(* unused *)
|
||||
lemma derive_cap_objrefs [CNodeInv_AI_assms]:
|
||||
"\<lbrace>\<lambda>s. P (obj_refs cap)\<rbrace> derive_cap slot cap \<lbrace>\<lambda>rv s. rv \<noteq> NullCap \<longrightarrow> P (obj_refs rv)\<rbrace>,-"
|
||||
|
|
|
|||
|
|
@ -20,6 +20,19 @@ context Arch begin global_naming ARM
|
|||
|
||||
named_theorems CSpace_AI_assms
|
||||
|
||||
lemma cte_at_length_limit:
|
||||
"\<lbrakk> cte_at p s; valid_objs s \<rbrakk> \<Longrightarrow> length (snd p) < word_bits - cte_level_bits"
|
||||
apply (simp add: cte_at_cases)
|
||||
apply (erule disjE)
|
||||
apply clarsimp
|
||||
apply (erule(1) valid_objsE)
|
||||
apply (clarsimp simp: valid_obj_def well_formed_cnode_n_def valid_cs_def valid_cs_size_def
|
||||
length_set_helper)
|
||||
apply (drule arg_cong[where f="\<lambda>S. snd p \<in> S"])
|
||||
apply (simp add: domI)
|
||||
apply (clarsimp simp add: tcb_cap_cases_length word_bits_conv cte_level_bits_def)
|
||||
done
|
||||
|
||||
(* FIXME: move? *)
|
||||
lemma getActiveIRQ_wp [CSpace_AI_assms]:
|
||||
"irq_state_independent_A P \<Longrightarrow>
|
||||
|
|
|
|||
|
|
@ -122,6 +122,20 @@ lemma state_hyp_refs_of_detype:
|
|||
"state_hyp_refs_of (detype S s) = (\<lambda>x. if x \<in> S then {} else state_hyp_refs_of s x)"
|
||||
by (rule ext, simp add: state_hyp_refs_of_def detype_def)
|
||||
|
||||
lemma of_bl_length2:
|
||||
"length xs < word_bits - cte_level_bits \<Longrightarrow> of_bl xs * 16 < (2 :: machine_word) ^ (length xs + 4)"
|
||||
apply (simp add: power_add cte_level_bits_def)
|
||||
apply (rule word_mult_less_mono1)
|
||||
apply (rule of_bl_length, simp add: word_bits_def)
|
||||
apply simp
|
||||
apply simp
|
||||
apply (simp add: word_bits_def)
|
||||
apply (rule order_less_le_trans)
|
||||
apply (erule power_strict_increasing)
|
||||
apply simp
|
||||
apply simp
|
||||
done
|
||||
|
||||
end
|
||||
|
||||
interpretation Detype_AI?: Detype_AI
|
||||
|
|
|
|||
|
|
@ -515,7 +515,7 @@ lemma arch_thread_set_pspace_respects_device_region[wp]:
|
|||
arch_thread_set p v
|
||||
\<lbrace>\<lambda>s. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: arch_thread_set_def)
|
||||
apply (wp get_object_wp set_object_pspace_respect_device_region)
|
||||
apply (wp get_object_wp set_object_pspace_respects_device_region)
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -281,22 +281,11 @@ where
|
|||
"valid_vspace_obj (ASIDPool pool) =
|
||||
(\<lambda>s. \<forall>x \<in> ran pool. typ_at (AArch APageDirectory) x s)"
|
||||
| "valid_vspace_obj (PageDirectory pd) =
|
||||
(\<lambda>s. \<forall>x. valid_pde (pd x) s)" (* ARMHYP? *)
|
||||
(\<lambda>s. \<forall>x. valid_pde (pd x) s)"
|
||||
| "valid_vspace_obj (PageTable pt) = (\<lambda>s. \<forall>x. valid_pte (pt x) s)"
|
||||
| "valid_vspace_obj (DataPage dev sz) = \<top>"
|
||||
| "valid_vspace_obj (VCPU v) = \<top>"
|
||||
(*
|
||||
primrec
|
||||
valid_arch_obj :: "arch_kernel_obj \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_arch_obj (ASIDPool pool) =
|
||||
(\<lambda>s. \<forall>x \<in> ran pool. typ_at (AArch APageDirectory) x s)"
|
||||
| "valid_arch_obj (PageDirectory pd) =
|
||||
(\<lambda>s. \<forall>x . valid_pde (pd x) s)"
|
||||
| "valid_arch_obj (PageTable pt) = (\<lambda>s. \<forall>x. valid_pte (pt x) s)" (* ARMHYP? *)
|
||||
| "valid_arch_obj (DataPage dev sz) = \<top>"
|
||||
| "valid_arch_obj (VCPU v) = valid_vcpu v"
|
||||
*)
|
||||
|
||||
definition
|
||||
valid_arch_obj :: "arch_kernel_obj \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
|
|
|
|||
|
|
@ -100,16 +100,6 @@ lemma vspace_pred_imp: "vspace_obj_pred P \<Longrightarrow> arch_obj_pred P"
|
|||
lemma vspace_obj_pred_a_type[intro, simp]: "T \<noteq> AVCPU \<Longrightarrow> vspace_obj_pred (\<lambda>ko. a_type ko = AArch T)"
|
||||
by (auto simp add: vspace_obj_pred_defs a_type_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
(*
|
||||
lemma
|
||||
vspace_obj_pred_arch_obj_l[intro, simp]: "\<lbrakk>\<And>v. ako \<noteq> (VCPU v)\<rbrakk> \<Longrightarrow> vspace_obj_pred (\<lambda>ko. ArchObj ako = ko)" and
|
||||
vspace_obj_pred_arch_obj_r[intro, simp]: "\<lbrakk>\<And>v. ako \<noteq> (VCPU v)\<rbrakk> \<Longrightarrow> vspace_obj_pred (\<lambda>ko. ko = ArchObj ako)"
|
||||
apply (simp add: vspace_obj_pred_defs)
|
||||
apply intros
|
||||
apply (rule allI[OF impI[OF allI[OF impI]]])
|
||||
apply (auto simp add: vspace_obj_pred_defs
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
*)
|
||||
|
||||
lemma vspace_obj_pred_fun_lift: "vspace_obj_pred (\<lambda>ko. F (vspace_obj_fun_lift P N ko))"
|
||||
by (auto simp: vspace_obj_pred_defs vspace_obj_fun_lift_def
|
||||
|
|
@ -143,32 +133,28 @@ declare
|
|||
vspace_obj_pred_fI[where f=All, intro]
|
||||
vspace_obj_pred_fI[where f=Ex, intro]
|
||||
|
||||
sublocale
|
||||
empty_table: vspace_only_obj_pred "empty_table S" vspace_obj_pred for S
|
||||
by (unfold_locales, clarsimp simp : empty_table_def
|
||||
vspace_obj_pred_def
|
||||
del : vspace_obj_fun_lift_expand
|
||||
split : arch_kernel_obj.splits kernel_object.splits)
|
||||
end
|
||||
|
||||
sublocale
|
||||
vs_refs: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko" vspace_obj_pred
|
||||
by (unfold_locales, clarsimp simp : vspace_obj_pred_def
|
||||
vs_refs_def
|
||||
del : vs_refs_arch_def
|
||||
split : arch_kernel_obj.splits
|
||||
kernel_object.splits)
|
||||
locale vspace_only_obj_pred = Arch +
|
||||
fixes P :: "kernel_object \<Rightarrow> bool"
|
||||
assumes vspace_only: "vspace_obj_pred P"
|
||||
|
||||
sublocale
|
||||
vs_refs': arch_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by (unfold_locales, simp add: vs_refs_def del: vs_refs_arch_def)
|
||||
sublocale vspace_only_obj_pred < arch_only_obj_pred
|
||||
using vspace_pred_imp[OF vspace_only] by unfold_locales
|
||||
|
||||
sublocale
|
||||
vs_refs_pages: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko" vspace_obj_pred
|
||||
by (unfold_locales, clarsimp simp : vspace_obj_pred_def
|
||||
vs_refs_pages_def
|
||||
del : vs_refs_pages_arch_def
|
||||
split : arch_kernel_obj.split
|
||||
kernel_object.splits)
|
||||
context Arch begin global_naming ARM
|
||||
|
||||
sublocale empty_table: vspace_only_obj_pred "empty_table S" for S
|
||||
by unfold_locales (clarsimp simp: vspace_obj_pred_def empty_table_def
|
||||
split: arch_kernel_obj.splits kernel_object.splits)
|
||||
|
||||
sublocale vs_refs: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by unfold_locales (clarsimp simp: vspace_obj_pred_def vs_refs_def
|
||||
split: arch_kernel_obj.splits kernel_object.splits)
|
||||
|
||||
sublocale vs_refs_pages: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko"
|
||||
by unfold_locales (clarsimp simp: vspace_obj_pred_def vs_refs_pages_def
|
||||
split: arch_kernel_obj.split kernel_object.splits)
|
||||
|
||||
lemma pspace_in_kernel_window_atyp_lift_strong:
|
||||
assumes atyp_inv: "\<And>P p T. \<lbrace> \<lambda>s. P (typ_at T p s) \<rbrace> f \<lbrace> \<lambda>rv s. P (typ_at T p s) \<rbrace>"
|
||||
|
|
@ -176,22 +162,21 @@ lemma pspace_in_kernel_window_atyp_lift_strong:
|
|||
shows "\<lbrace>\<lambda>s. pspace_in_kernel_window s\<rbrace> f \<lbrace>\<lambda>rv s. pspace_in_kernel_window s\<rbrace>"
|
||||
apply (simp add: pspace_in_kernel_window_def)
|
||||
apply (rule hoare_lift_Pf[where f="\<lambda>s. arm_kernel_vspace (arch_state s)", OF _ arch_inv])
|
||||
apply (rule hoare_vcg_all_lift)
|
||||
apply (simp add: obj_bits_T)
|
||||
apply (simp add: valid_def)
|
||||
apply (rule hoare_vcg_all_lift)
|
||||
apply (simp add: obj_bits_T)
|
||||
apply (simp add: valid_def)
|
||||
apply clarsimp
|
||||
subgoal for _ x s _ _ ko
|
||||
apply (cases "kheap s x")
|
||||
apply (frule use_valid[OF _ atyp_inv, where P1= "\<lambda>x. \<not> x" and T1="a_type ko" and p1=x];
|
||||
simp add: obj_at_def a_type_def)
|
||||
|
||||
subgoal for ko'
|
||||
apply (drule spec[of _ ko'])
|
||||
apply (simp add: obj_bits_T)
|
||||
apply (frule use_valid[OF _ atyp_inv, where P1= "\<lambda>x. x" and T1="a_type ko'" and p1=x])
|
||||
simp add: obj_at_def a_type_def)
|
||||
subgoal for ko'
|
||||
apply (drule spec[of _ ko'])
|
||||
apply (simp add: obj_bits_T)
|
||||
apply (frule use_valid[OF _ atyp_inv, where P1= "\<lambda>x. x" and T1="a_type ko'" and p1=x])
|
||||
by (simp add: obj_at_def a_type_def)+
|
||||
done
|
||||
done
|
||||
done
|
||||
done
|
||||
|
||||
lemma pspace_in_kernel_window_atyp_lift:
|
||||
assumes atyp_inv: "\<And>P p T. \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
||||
|
|
@ -218,41 +203,7 @@ lemma in_user_frame_obj_pred_lift:
|
|||
apply (clarsimp simp: vspace_obj_pred_def)
|
||||
apply (auto simp: a_type_def aa_type_def split: kernel_object.splits arch_kernel_obj.splits)
|
||||
done
|
||||
(*
|
||||
lemma vs_lookup_arch_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> f \<lbrace>\<lambda>rv s. P (vs_lookup s)\<rbrace>"
|
||||
apply (simp add: vs_lookup_def vs_lookup1_def)
|
||||
apply (simp add: ex_ko_at_def2)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch_state])
|
||||
apply (rule hoare_lift_Pf[where f="\<lambda>s rs p rs' p'. obj_at (P' p rs rs' p') p s" for P'])
|
||||
apply (rule hoare_vcg_prop)
|
||||
apply (clarsimp simp add: valid_def)
|
||||
apply (erule_tac P=P in rsubst)
|
||||
apply (rule ext)+
|
||||
apply (erule use_valid, rule obj_at, simp)
|
||||
by (auto simp: vs_refs'.arch_only
|
||||
intro!: arch_obj_pred_fI[where f=Ex])
|
||||
|
||||
lemma vs_lookup_pages_arch_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. P (vs_lookup_pages s)\<rbrace> f \<lbrace>\<lambda>rv s. P (vs_lookup_pages s)\<rbrace>"
|
||||
apply (simp add: vs_lookup_pages_def vs_lookup_pages1_def)
|
||||
apply (simp add: ex_ko_at_def2)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch_state])
|
||||
apply (rule hoare_lift_Pf[where f="\<lambda>s rs p rs' p'. obj_at (P' p rs rs' p') p s" for P'])
|
||||
apply (rule hoare_vcg_prop)
|
||||
apply (clarsimp simp add: valid_def)
|
||||
apply (erule_tac P=P in rsubst)
|
||||
apply (rule ext)+
|
||||
apply (erule use_valid, rule obj_at, simp)
|
||||
by (auto simp: vs_refs_pages.arch_only
|
||||
intro!: arch_obj_pred_fI[where f=Ex])
|
||||
*)
|
||||
lemma vs_lookup_vspace_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
|
|
@ -287,7 +238,6 @@ lemma vs_lookup_pages_vspace_obj_at_lift:
|
|||
by (auto simp: vs_refs_pages.vspace_only
|
||||
intro!: vspace_obj_pred_fI[where f=Ex])
|
||||
|
||||
|
||||
lemma valid_vspace_objs_lift_weak:
|
||||
assumes obj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
|
|
@ -424,26 +374,7 @@ lemma set_object_atyp_at:
|
|||
lemma hoare_post_imp_conj_disj: "(\<lbrace> \<lambda>s. R \<rbrace> f \<lbrace> \<lambda>_ s. P \<longrightarrow> Q \<rbrace>) = (\<lbrace> \<lambda>s. R \<rbrace> f \<lbrace> \<lambda>_ s. \<not> P \<or> Q \<rbrace>)"
|
||||
by (subst imp_conv_disj, auto)
|
||||
|
||||
(*
|
||||
lemma set_object_arch_objs: (* used in set_pd_arch_objs_unmap in ArchAcc_AI *) (* ARMHYP *)
|
||||
"\<lbrace>valid_arch_objs and typ_at (a_type ko) p and
|
||||
obj_at (\<lambda>ko'. vs_refs ko \<subseteq> vs_refs ko') p and
|
||||
(\<lambda>s. case ko of ArchObj ao \<Rightarrow> (\<exists>\<rhd>p)s \<longrightarrow> valid_arch_obj ao s
|
||||
| _ \<Rightarrow> True)\<rbrace>
|
||||
set_object p ko
|
||||
\<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
|
||||
apply (simp add: valid_arch_objs_def)
|
||||
apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
|
||||
apply (subst imp_conv_disj)
|
||||
apply (subst imp_conv_disj)
|
||||
apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift set_object_neg_lookup set_object_neg_ko)
|
||||
apply (wp valid_arch_obj_typ2 [where Q="typ_at (a_type ko) p"] set_object_typ_at
|
||||
| simp)+
|
||||
apply (clarsimp simp: pred_neg_def obj_at_def)
|
||||
apply (case_tac ko; auto)
|
||||
done *)
|
||||
|
||||
lemma set_object_vspace_objs: (* used in set_pd_arch_objs_unmap in ArchAcc_AI *) (* ARMHYP *)
|
||||
lemma set_object_vspace_objs:
|
||||
"\<lbrace>valid_vspace_objs and typ_at (a_type ko) p and
|
||||
obj_at (\<lambda>ko'. vs_refs ko \<subseteq> vs_refs ko') p and
|
||||
(\<lambda>s. case ko of ArchObj ao \<Rightarrow> (\<exists>\<rhd>p)s \<longrightarrow> valid_vspace_obj ao s
|
||||
|
|
@ -511,55 +442,51 @@ lemma valid_global_objs_lift':
|
|||
lemmas valid_global_objs_lift
|
||||
= valid_global_objs_lift' [where v=False, simplified]
|
||||
|
||||
lemma arch_lifts_vspace:
|
||||
context
|
||||
fixes f :: "'a::state_ext state \<Rightarrow> ('b \<times> 'a state) set \<times> bool"
|
||||
assumes arch: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (arch_state s)\<rbrace>"
|
||||
assumes aobj_at: "\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
notes arch_obj_fun_lift_expand[simp del]
|
||||
shows
|
||||
valid_global_vspace_mappings_lift:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_global_vspace_mappings\<rbrace>" and
|
||||
valid_arch_caps_lift_weak:
|
||||
"(\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>) \<Longrightarrow>
|
||||
\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>" and
|
||||
valid_global_objs_lift_weak:
|
||||
"\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>" and
|
||||
valid_asid_map_lift:
|
||||
"\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>" and
|
||||
valid_kernel_mappings_lift:
|
||||
"\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>"
|
||||
apply -
|
||||
begin
|
||||
|
||||
subgoal
|
||||
context
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
notes vspace_obj_fun_lift_expand[simp del]
|
||||
begin
|
||||
|
||||
lemma valid_global_vspace_mappings_lift:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_global_vspace_mappings\<rbrace>"
|
||||
by (wpsimp simp: valid_global_vspace_mappings_def)
|
||||
|
||||
subgoal
|
||||
lemma valid_arch_caps_lift_weak:
|
||||
"(\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>) \<Longrightarrow>
|
||||
\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>"
|
||||
apply (rule valid_arch_caps_lift[OF _ _ aobj_at])
|
||||
apply (rule vs_lookup_pages_vspace_obj_at_lift[OF aobj_at arch], assumption+)
|
||||
apply (rule empty_table.vspace_only)
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_global_objs_lift_weak:
|
||||
"\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
by (wpsimp simp: valid_global_objs_def)
|
||||
|
||||
subgoal
|
||||
lemma valid_asid_map_lift:
|
||||
"\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>"
|
||||
apply (simp add: valid_asid_map_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (simp add: vspace_at_asid_def)
|
||||
by (rule vs_lookup_vspace_obj_at_lift[OF aobj_at arch])
|
||||
|
||||
subgoal
|
||||
lemma valid_kernel_mappings_lift:
|
||||
"\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>"
|
||||
apply (simp add: valid_kernel_mappings_def, wp)
|
||||
done
|
||||
done
|
||||
|
||||
end
|
||||
|
||||
lemma valid_arch_state_lift_aobj_at:
|
||||
assumes arch: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (arch_state s)\<rbrace>"
|
||||
assumes aobj_at: "\<And>P P' pd. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
notes arch_obj_fun_lift_expand[simp del]
|
||||
shows
|
||||
"\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. arch_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
shows "\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
apply (simp add: valid_arch_state_def valid_asid_table_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (rule hoare_vcg_conj_lift hoare_vcg_ball_lift hoare_vcg_prop | (rule aobj_at, clarsimp))+
|
||||
|
|
@ -570,11 +497,11 @@ lemma valid_arch_state_lift_aobj_at:
|
|||
apply wp
|
||||
done
|
||||
|
||||
lemmas arch_lifts = arch_lifts_vspace valid_arch_state_lift_aobj_at
|
||||
end
|
||||
|
||||
lemma equal_kernel_mappings_lift:
|
||||
assumes vsobj_at: "\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
assumes vsobj_at:
|
||||
"\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
shows "\<lbrace>equal_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. equal_kernel_mappings\<rbrace>"
|
||||
apply (simp add: equal_kernel_mappings_def, wp)
|
||||
done
|
||||
|
|
|
|||
|
|
@ -298,20 +298,6 @@ lemma mapM_x_store_pde_eq_kernel_mappings_restr:
|
|||
done
|
||||
|
||||
|
||||
(* ARMHYP remove
|
||||
lemma equal_kernel_mappings_specific_def:
|
||||
"ko_at (ArchObj (PageDirectory pd)) p s
|
||||
\<Longrightarrow> equal_kernel_mappings s
|
||||
= (\<forall>p' pd'. ko_at (ArchObj (PageDirectory pd')) p' s
|
||||
\<longrightarrow> (\<forall>w \<in> kernel_mapping_slots. pd' w = pd w))"
|
||||
apply (rule iffI)
|
||||
apply (clarsimp simp: equal_kernel_mappings_def)
|
||||
apply (clarsimp simp: equal_kernel_mappings_def)
|
||||
apply (subgoal_tac "pda w = pd w \<and> pd' w = pd w")
|
||||
apply (erule conjE, erule(1) trans[OF _ sym])
|
||||
apply blast
|
||||
done *)
|
||||
|
||||
lemma copy_global_equal_kernel_mappings_restricted:
|
||||
"is_aligned pd pd_bits \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. equal_kernel_mappings (s \<lparr> kheap := restrict_map (kheap s) (- (insert pd S)) \<rparr>)
|
||||
|
|
@ -932,17 +918,6 @@ lemma valid_vspace_obj_pres:
|
|||
apply (erule allEI)
|
||||
apply (erule (1) obj_at_valid_pde[OF _ obj_at_pres])
|
||||
done
|
||||
(*
|
||||
lemma valid_arch_obj_pres:
|
||||
"valid_arch_obj ao s \<Longrightarrow> valid_arch_obj ao s'"
|
||||
apply (cases ao, simp_all)
|
||||
apply (simp add: obj_at_pres)
|
||||
apply (erule allEI)
|
||||
apply (erule (1) obj_at_valid_pte[OF _ obj_at_pres])
|
||||
apply (erule allEI)
|
||||
apply (erule (1) obj_at_valid_pde[OF _ obj_at_pres])
|
||||
done
|
||||
*)
|
||||
|
||||
lemma valid_kernel_mappings:
|
||||
"valid_kernel_mappings s \<Longrightarrow> valid_kernel_mappings s'"
|
||||
|
|
|
|||
|
|
@ -17,8 +17,8 @@ context Arch begin global_naming ARM
|
|||
named_theorems Untyped_AI_assms
|
||||
|
||||
lemma of_bl_nat_to_cref[Untyped_AI_assms]:
|
||||
"\<lbrakk> x < 2 ^ bits; bits < 32 \<rbrakk>
|
||||
\<Longrightarrow> (of_bl (nat_to_cref bits x) :: word32) = of_nat x"
|
||||
"\<lbrakk> x < 2 ^ bits; bits < word_bits \<rbrakk>
|
||||
\<Longrightarrow> (of_bl (nat_to_cref bits x) :: machine_word) = of_nat x"
|
||||
apply (clarsimp intro!: less_mask_eq
|
||||
simp: nat_to_cref_def of_drop_to_bl
|
||||
word_size word_less_nat_alt word_bits_def)
|
||||
|
|
@ -43,9 +43,9 @@ lemma cnode_cap_ex_cte[Untyped_AI_assms]:
|
|||
|
||||
|
||||
lemma inj_on_nat_to_cref[Untyped_AI_assms]:
|
||||
"bits < 32 \<Longrightarrow> inj_on (nat_to_cref bits) {..< 2 ^ bits}"
|
||||
"bits < word_bits \<Longrightarrow> inj_on (nat_to_cref bits) {..< 2 ^ bits}"
|
||||
apply (rule inj_onI)
|
||||
apply (drule arg_cong[where f="\<lambda>x. replicate (32 - bits) False @ x"])
|
||||
apply (drule arg_cong[where f="\<lambda>x. replicate (word_bits - bits) False @ x"])
|
||||
apply (subst(asm) word_bl.Abs_inject[where 'a=32, symmetric])
|
||||
apply (simp add: nat_to_cref_def word_bits_def)
|
||||
apply (simp add: nat_to_cref_def word_bits_def)
|
||||
|
|
@ -53,7 +53,7 @@ lemma inj_on_nat_to_cref[Untyped_AI_assms]:
|
|||
apply (erule word_unat.Abs_eqD)
|
||||
apply (simp only: unats_def mem_simps)
|
||||
apply (erule order_less_le_trans)
|
||||
apply (rule power_increasing, simp+)
|
||||
apply (rule power_increasing, simp_all add: word_bits_def)
|
||||
apply (simp only: unats_def mem_simps)
|
||||
apply (erule order_less_le_trans)
|
||||
apply (rule power_increasing, simp+)
|
||||
|
|
@ -302,13 +302,14 @@ 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]:
|
||||
"\<lbrakk>2\<le> sz; sz\<le> word_bits;ptr && ~~ mask sz = ptr\<rbrakk> \<Longrightarrow> delete_objects ptr sz =
|
||||
do y \<leftarrow> modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz});
|
||||
modify (detype {ptr && ~~ mask sz..ptr + 2 ^ sz - 1})
|
||||
od"
|
||||
apply (clarsimp simp:delete_objects_def freeMemory_def word_size_def)
|
||||
"\<lbrakk>word_size_bits \<le> sz; sz \<le> word_bits; ptr && ~~ mask sz = ptr\<rbrakk>
|
||||
\<Longrightarrow> delete_objects ptr sz =
|
||||
do y \<leftarrow> modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz});
|
||||
modify (detype {ptr && ~~ mask sz..ptr + 2 ^ sz - 1})
|
||||
od"
|
||||
apply (clarsimp simp: delete_objects_def freeMemory_def)
|
||||
apply (subgoal_tac "is_aligned (ptr &&~~ mask sz) sz")
|
||||
apply (subst mapM_storeWord_clear_um[simplified word_size_def word_size_bits_def])
|
||||
apply (subst mapM_storeWord_clear_um)
|
||||
apply (simp)
|
||||
apply simp
|
||||
apply (simp add:range_cover_def)
|
||||
|
|
@ -528,11 +529,10 @@ 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)?) (* FIXME *)
|
||||
qed
|
||||
|
||||
proof goal_cases
|
||||
interpret Arch .
|
||||
case 1 show ?case
|
||||
by (unfold_locales; (fact Untyped_AI_assms)?)
|
||||
qed
|
||||
|
||||
end
|
||||
|
|
@ -2487,7 +2487,7 @@ lemma set_vcpu_pspace_respects_device_region[wp]:
|
|||
set_vcpu p vcpu
|
||||
\<lbrace>\<lambda>s. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_vcpu_def)
|
||||
apply (wp get_object_wp set_object_pspace_respect_device_region)
|
||||
apply (wp get_object_wp set_object_pspace_respects_device_region)
|
||||
including unfold_objects_asm by (clarsimp simp: a_type_def)
|
||||
|
||||
lemma set_vcpu_cap_refs_in_kernel_window[wp]:
|
||||
|
|
@ -4903,11 +4903,11 @@ lemma vcpu_save_register_pspace_respects_device_region[wp]:
|
|||
|
||||
crunch pspace_respects_device_region[wp]: vcpu_disable, vcpu_restore, vcpu_enable "pspace_respects_device_region"
|
||||
(simp: crunch_simps respects_device_region_vcpu_helper vcpuregs_sets vcpuregs_gets
|
||||
wp: crunch_wps set_object_pspace_respect_device_region pspace_respects_device_region_dmo)
|
||||
wp: crunch_wps set_object_pspace_respects_device_region pspace_respects_device_region_dmo)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: perform_page_invocation "pspace_respects_device_region"
|
||||
(simp: crunch_simps respects_device_region_vcpu_helper vcpuregs_sets vcpuregs_gets
|
||||
wp: crunch_wps set_object_pspace_respect_device_region pspace_respects_device_region_dmo)
|
||||
wp: crunch_wps set_object_pspace_respects_device_region pspace_respects_device_region_dmo)
|
||||
|
||||
(* FIXME move to WordLemma *)
|
||||
lemma word_shift_by_3:
|
||||
|
|
|
|||
|
|
@ -187,12 +187,6 @@ locale CNodeInv_AI =
|
|||
"\<And>(s::'state_ext state) ptr zbits n m irqn.
|
||||
\<lbrakk> s \<turnstile> Zombie ptr zbits n; invs s; m < n \<rbrakk>
|
||||
\<Longrightarrow> (ptr, nat_to_cref (zombie_cte_bits zbits) m) \<in> cte_refs (Zombie ptr zbits n) irqn"
|
||||
(* assumes finalise_cap_makes_halted:
|
||||
"\<And>cap ex slot.
|
||||
\<lbrace>invs and valid_cap cap and (\<lambda>s. ex = is_final_cap' cap s)
|
||||
and cte_wp_at (op = cap) slot\<rbrace>
|
||||
finalise_cap cap ex
|
||||
\<lbrace>\<lambda>rv (s::'state_ext state). \<forall>t \<in> obj_refs (fst rv). halted_if_tcb t s\<rbrace>" *)
|
||||
assumes finalise_cap_emptyable[wp]:
|
||||
"\<And>sl c f.
|
||||
\<lbrace>emptyable sl and (invs and valid_mdb)\<rbrace>
|
||||
|
|
|
|||
|
|
@ -2536,7 +2536,7 @@ end
|
|||
context p_arch_update_eq begin
|
||||
|
||||
interpretation Arch_p_arch_update_eq f ..
|
||||
(* do we need this?*)
|
||||
|
||||
lemma valid_arch_objs_update [iff]:
|
||||
"valid_arch_objs (f s) = valid_arch_objs s"
|
||||
by (simp add: valid_arch_objs_def valid_vspace_objs_def)
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ lemma arch_obj_pred_a_type[intro, simp]: "arch_obj_pred (\<lambda>ko. a_type ko
|
|||
|
||||
lemma
|
||||
arch_obj_pred_arch_obj_l[intro, simp]: "arch_obj_pred (\<lambda>ko. ArchObj ako = ko)" and
|
||||
arch_obj_pred_arch_obj_r[intro, simp]: "arch_obj_pred (\<lambda>ko. ko = ArchObj ako)"
|
||||
arch_obj_pred_arch_obj_r[intro, simp]: "arch_obj_pred (\<lambda>ko. ko = ArchObj ako)"
|
||||
by (auto simp add: arch_obj_pred_defs)
|
||||
|
||||
lemma arch_obj_pred_fun_lift: "arch_obj_pred (\<lambda>ko. F (arch_obj_fun_lift P N ko))"
|
||||
|
|
@ -111,11 +111,6 @@ locale arch_only_obj_pred =
|
|||
fixes P :: "kernel_object \<Rightarrow> bool"
|
||||
assumes arch_only: "arch_obj_pred P"
|
||||
|
||||
locale vspace_only_obj_pred =
|
||||
fixes P :: "kernel_object \<Rightarrow> bool"
|
||||
fixes vspace_obj_pred :: "(kernel_object \<Rightarrow> bool) \<Rightarrow> bool"
|
||||
assumes vspace_only: "vspace_obj_pred P"
|
||||
|
||||
lemma set_object_typ_at:
|
||||
"\<lbrace>\<lambda>s. typ_at (a_type ko) p s \<and> P (typ_at T p' s)\<rbrace>
|
||||
set_object p ko \<lbrace>\<lambda>rv s. P (typ_at T p' s)\<rbrace>"
|
||||
|
|
|
|||
|
|
@ -1255,17 +1255,6 @@ lemma set_object_non_pagetable:
|
|||
apply (clarsimp simp: obj_at_def)
|
||||
by (rule vspace_obj_predE)
|
||||
|
||||
(*
|
||||
lemma set_object_vspace_objs_non_pagetable:
|
||||
"\<lbrace>valid_vspace_objs and K (non_vspace_obj ko) and obj_at non_vspace_obj p\<rbrace>
|
||||
set_object p ko
|
||||
\<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
apply (rule assert_pre)
|
||||
apply (rule hoare_pre)
|
||||
apply (rule valid_vspace_objs_lift_weak)
|
||||
apply (wpsimp wp: set_object_non_pagetable)+
|
||||
done*)
|
||||
|
||||
lemma set_object_memory[wp]:
|
||||
"\<lbrace>\<lambda>s. P (underlying_memory (machine_state s))\<rbrace>
|
||||
set_object p ko
|
||||
|
|
@ -1289,51 +1278,48 @@ lemma valid_arch_state[wp]:"\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lamb
|
|||
end
|
||||
|
||||
|
||||
(* ARMHYP try non_vspace version for now, assuming that these locales are used only for vspace properties *)
|
||||
locale non_vspace_op = fixes f
|
||||
assumes (*aobj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>" and *)
|
||||
vsobj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
assumes vsobj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>" and
|
||||
arch_state'[wp]: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
|
||||
sublocale non_aobj_op < non_vspace_op
|
||||
apply (unfold_locales)
|
||||
apply (auto simp: vspace_pred_imp arch_state aobj_at)
|
||||
done
|
||||
apply (unfold_locales)
|
||||
apply (auto simp: vspace_pred_imp arch_state aobj_at)
|
||||
done
|
||||
|
||||
context non_vspace_op begin
|
||||
|
||||
lemma valid_vspace_obj[wp]:"\<lbrace>valid_vspace_objs\<rbrace> f \<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
by (rule valid_vspace_objs_lift_weak; wp vsobj_at; simp)
|
||||
by (rule valid_vspace_objs_lift_weak; wp vsobj_at; simp)
|
||||
|
||||
lemma vs_lookup[wp]: "\<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> f \<lbrace>\<lambda>_ s. P (vs_lookup s)\<rbrace>"
|
||||
by (rule vs_lookup_vspace_obj_at_lift; wp vsobj_at; simp)
|
||||
by (rule vs_lookup_vspace_obj_at_lift; wp vsobj_at; simp)
|
||||
|
||||
lemma vs_lookup_pages[wp]: "\<lbrace>\<lambda>s. P (vs_lookup_pages s)\<rbrace> f \<lbrace>\<lambda>_ s. P (vs_lookup_pages s)\<rbrace>"
|
||||
by (rule vs_lookup_pages_vspace_obj_at_lift; wp vsobj_at; simp)
|
||||
by (rule vs_lookup_pages_vspace_obj_at_lift; wp vsobj_at; simp)
|
||||
|
||||
lemma valid_global_objs[wp]: "\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>_. valid_global_objs\<rbrace>"
|
||||
by (rule valid_global_objs_lift_weak, (wp vsobj_at)+)
|
||||
by (rule valid_global_objs_lift_weak, (wp vsobj_at)+)
|
||||
|
||||
lemma valid_global_vspace_mappings[wp]:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>_. valid_global_vspace_mappings\<rbrace>"
|
||||
by (rule valid_global_vspace_mappings_lift, (wp vsobj_at)+)
|
||||
by (rule valid_global_vspace_mappings_lift, (wp vsobj_at)+)
|
||||
|
||||
lemma valid_asid_map[wp]: "\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>_. valid_asid_map\<rbrace>"
|
||||
by (rule valid_asid_map_lift, (wp vsobj_at)+)
|
||||
by (rule valid_asid_map_lift, (wp vsobj_at)+)
|
||||
|
||||
lemma valid_kernel_mappings[wp]: "\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>_. valid_kernel_mappings\<rbrace>"
|
||||
by (rule valid_kernel_mappings_lift, (wp vsobj_at)+)
|
||||
by (rule valid_kernel_mappings_lift, (wp vsobj_at)+)
|
||||
|
||||
lemma equal_kernel_mappings[wp]: "\<lbrace>equal_kernel_mappings\<rbrace> f \<lbrace>\<lambda>_. equal_kernel_mappings\<rbrace>"
|
||||
by (rule equal_kernel_mappings_lift, wp vsobj_at)
|
||||
by (rule equal_kernel_mappings_lift, wp vsobj_at)
|
||||
|
||||
lemma valid_vso_at[wp]:"\<lbrace>valid_vso_at p\<rbrace> f \<lbrace>\<lambda>_. valid_vso_at p\<rbrace>"
|
||||
by (rule valid_vso_at_lift_aobj_at; wp vsobj_at; simp)
|
||||
by (rule valid_vso_at_lift_aobj_at; wp vsobj_at; simp)
|
||||
|
||||
lemma in_user_frame[wp]:"\<lbrace>in_user_frame p\<rbrace> f \<lbrace>\<lambda>_. in_user_frame p\<rbrace>"
|
||||
by (rule in_user_frame_obj_pred_lift; wp vsobj_at; simp)
|
||||
by (rule in_user_frame_obj_pred_lift; wp vsobj_at; simp)
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -1346,8 +1332,8 @@ locale non_vspace_non_mem_op = non_vspace_op f + non_mem_op f for f
|
|||
begin
|
||||
|
||||
lemma valid_machine_state[wp]: "\<lbrace>valid_machine_state\<rbrace> f \<lbrace>\<lambda>rv. valid_machine_state\<rbrace>"
|
||||
unfolding valid_machine_state_def
|
||||
by (wp hoare_vcg_disj_lift hoare_vcg_all_lift vsobj_at memory)
|
||||
unfolding valid_machine_state_def
|
||||
by (wp hoare_vcg_disj_lift hoare_vcg_all_lift vsobj_at memory)
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -1407,15 +1393,15 @@ lemma
|
|||
apply (safe; erule rsubst[where P=P], rule cte_wp_caps_of_lift)
|
||||
by (auto simp: cte_wp_at_cases2 tcb_cnode_map_def dest!: get_tcb_SomeD)
|
||||
|
||||
interpretation (* TODO: need to do this for vcpu-related functions in some arch-theory *)
|
||||
set_endpoint: non_aobj_non_cap_non_mem_op "set_endpoint p ep" +
|
||||
set_notification: non_aobj_non_cap_non_mem_op "set_notification p ntfn" +
|
||||
sts: non_aobj_non_cap_non_mem_op "set_thread_state p st" +
|
||||
sbn: non_aobj_non_cap_non_mem_op "set_bound_notification p b" +
|
||||
as_user: non_aobj_non_cap_non_mem_op "as_user p g" +
|
||||
thread_set: non_aobj_non_mem_op "thread_set f p" +
|
||||
set_cap: non_aobj_non_mem_op "set_cap cap p'"
|
||||
apply (all \<open>unfold_locales; (wp ; fail)?\<close>)
|
||||
interpretation
|
||||
set_endpoint: non_aobj_non_cap_non_mem_op "set_endpoint p ep" +
|
||||
set_notification: non_aobj_non_cap_non_mem_op "set_notification p ntfn" +
|
||||
sts: non_aobj_non_cap_non_mem_op "set_thread_state p st" +
|
||||
sbn: non_aobj_non_cap_non_mem_op "set_bound_notification p b" +
|
||||
as_user: non_aobj_non_cap_non_mem_op "as_user p g" +
|
||||
thread_set: non_aobj_non_mem_op "thread_set f p" +
|
||||
set_cap: non_aobj_non_mem_op "set_cap cap p'"
|
||||
apply (all \<open>unfold_locales; (wp ; fail)?\<close>)
|
||||
unfolding set_endpoint_def set_notification_def set_thread_state_def
|
||||
set_bound_notification_def thread_set_def set_cap_def[simplified split_def]
|
||||
as_user_def set_mrs_def
|
||||
|
|
@ -1425,7 +1411,7 @@ interpretation (* TODO: need to do this for vcpu-related functions in some arch-
|
|||
split: Structures_A.kernel_object.splits)+
|
||||
|
||||
interpretation
|
||||
store_word_offs: non_vspace_non_cap_op "store_word_offs a b c"
|
||||
store_word_offs: non_aobj_non_cap_op "store_word_offs a b c"
|
||||
apply unfold_locales
|
||||
unfolding store_word_offs_def do_machine_op_def[abs_def]
|
||||
by (wp modify_wp | fastforce)+
|
||||
|
|
@ -1436,15 +1422,14 @@ lemma store_word_offs_obj_at_P[wp]:
|
|||
by (wp | fastforce)+
|
||||
|
||||
interpretation
|
||||
set_mrs: non_vspace_non_cap_op "set_mrs thread buf msgs"
|
||||
set_mrs: non_aobj_non_cap_op "set_mrs thread buf msgs"
|
||||
apply unfold_locales
|
||||
apply (all \<open>(wp ; fail)?\<close>)
|
||||
unfolding set_mrs_def set_object_def
|
||||
apply (all \<open>(wp mapM_x_inv_wp | wpc | simp add: zipWithM_x_mapM_x split del: if_split | clarsimp)+\<close>)
|
||||
apply (rule drop_imp)
|
||||
apply (clarsimp simp: obj_at_def get_tcb_def split: kernel_object.splits option.splits)
|
||||
subgoal for _ P'
|
||||
by (subst vspace_obj_predE[where P="P'"]) auto
|
||||
subgoal for _ P' by (subst arch_obj_predE[where P="P'"]) auto
|
||||
done
|
||||
|
||||
lemma valid_irq_handlers_lift:
|
||||
|
|
@ -1617,7 +1602,7 @@ lemma set_ntfn_minor_invs:
|
|||
apply (clarsimp elim!: rsubst[where P=sym_refs]
|
||||
intro!: ext
|
||||
dest!: obj_at_state_refs_ofD)
|
||||
done
|
||||
done
|
||||
|
||||
crunch asid_map[wp]: set_bound_notification "valid_asid_map"
|
||||
|
||||
|
|
|
|||
|
|
@ -143,7 +143,7 @@ lemma is_aligned_ptrFromPAddrD:
|
|||
|
||||
lemma some_get_page_info_umapsD:
|
||||
"\<lbrakk>get_page_info (\<lambda>obj. get_arch_obj (kheap s obj)) pml4_ref p = Some (b, a, attr, r);
|
||||
(\<exists>\<rhd> pml4_ref) s; p \<notin> kernel_mappings; valid_arch_objs s; pspace_aligned s;
|
||||
(\<exists>\<rhd> pml4_ref) s; p \<notin> kernel_mappings; valid_vspace_objs s; pspace_aligned s;
|
||||
canonical_address p;
|
||||
valid_asid_table (x64_asid_table (arch_state s)) s; valid_objs s\<rbrakk>
|
||||
\<Longrightarrow> \<exists>sz. pageBitsForSize sz = a \<and> is_aligned b a \<and> data_at sz (ptrFromPAddr b) s"
|
||||
|
|
@ -156,14 +156,14 @@ lemma some_get_page_info_umapsD:
|
|||
apply (all \<open>drule (2) vs_lookup_step_alt[OF _ _ vs_refs_pml4I],
|
||||
simp add: ucast_ucast_mask9, fastforce\<close>)
|
||||
prefer 3 subgoal
|
||||
by (rule exI[of _ X64HugePage]; frule (3) valid_arch_objs_entryD;
|
||||
by (rule exI[of _ X64HugePage]; frule (3) valid_vspace_objs_entryD;
|
||||
clarsimp simp: bit_simps vmsz_aligned_def)
|
||||
apply (all \<open>drule (2) vs_lookup_step_alt[OF _ _ vs_refs_pdptI], fastforce\<close>)
|
||||
prefer 2 subgoal
|
||||
by (rule exI[of _ X64LargePage]; frule (3) valid_arch_objs_entryD;
|
||||
by (rule exI[of _ X64LargePage]; frule (3) valid_vspace_objs_entryD;
|
||||
clarsimp simp: bit_simps vmsz_aligned_def)
|
||||
apply (drule (2) vs_lookup_step_alt[OF _ _ vs_refs_pdI], fastforce)
|
||||
by (rule exI[of _ X64SmallPage]; frule (3) valid_arch_objs_entryD;
|
||||
by (rule exI[of _ X64SmallPage]; frule (3) valid_vspace_objs_entryD;
|
||||
clarsimp simp: bit_simps vmsz_aligned_def)
|
||||
|
||||
lemma user_mem_dom_cong:
|
||||
|
|
|
|||
|
|
@ -176,34 +176,53 @@ lemmas set_asid_pool_typ_ats [wp] = abs_typ_at_lifts [OF set_asid_pool_typ_at]
|
|||
|
||||
lemma set_asid_pool_arch_objs_unmap':
|
||||
"\<lbrace>valid_arch_objs and (\<lambda>s. (\<exists>\<rhd>p) s \<longrightarrow> valid_arch_obj (ASIDPool ap) s) and
|
||||
obj_at (\<lambda>ko. \<exists>ap'. ko = ArchObj (ASIDPool ap') \<and> graph_of ap \<subseteq> graph_of ap') p\<rbrace>
|
||||
set_asid_pool p ap \<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
|
||||
obj_at (\<lambda>ko. \<exists>ap'. ko = ArchObj (ASIDPool ap') \<and> graph_of ap \<subseteq> graph_of ap') p\<rbrace>
|
||||
set_asid_pool p ap
|
||||
\<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
|
||||
unfolding set_asid_pool_def including unfold_objects
|
||||
apply (wpsimp wp: set_object_arch_objs get_object_wp)
|
||||
apply (fastforce simp: a_type_def vs_refs_def)
|
||||
done
|
||||
|
||||
lemma set_asid_pool_vspace_objs_unmap':
|
||||
"\<lbrace>valid_vspace_objs and (\<lambda>s. (\<exists>\<rhd>p) s \<longrightarrow> valid_vspace_obj (ASIDPool ap) s) and
|
||||
obj_at (\<lambda>ko. \<exists>ap'. ko = ArchObj (ASIDPool ap') \<and> graph_of ap \<subseteq> graph_of ap') p\<rbrace>
|
||||
set_asid_pool p ap \<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
unfolding set_asid_pool_def including unfold_objects
|
||||
apply (wpsimp wp: set_object_vspace_objs get_object_wp)
|
||||
apply (fastforce simp: a_type_def vs_refs_def)
|
||||
done
|
||||
|
||||
lemma set_asid_pool_arch_objs_unmap:
|
||||
"\<lbrace>valid_arch_objs and ko_at (ArchObj (ASIDPool ap)) p\<rbrace>
|
||||
set_asid_pool p (ap |` S) \<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
|
||||
set_asid_pool p (ap |` S)
|
||||
\<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
|
||||
apply (wp set_asid_pool_arch_objs_unmap')
|
||||
apply (clarsimp simp: obj_at_def graph_of_restrict_map)
|
||||
apply (drule valid_arch_objsD, simp add: obj_at_def, assumption)
|
||||
apply simp
|
||||
by (auto simp: obj_at_def dest!: ran_restrictD)
|
||||
by (auto simp: obj_at_def valid_arch_obj_def dest!: ran_restrictD)
|
||||
|
||||
lemma set_asid_pool_vspace_objs_unmap:
|
||||
"\<lbrace>valid_vspace_objs and ko_at (ArchObj (ASIDPool ap)) p\<rbrace>
|
||||
set_asid_pool p (ap |` S)
|
||||
\<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
apply (wp set_asid_pool_vspace_objs_unmap')
|
||||
apply (clarsimp simp: obj_at_def graph_of_restrict_map)
|
||||
apply (drule valid_vspace_objsD, simp add: obj_at_def, assumption)
|
||||
apply simp
|
||||
by (auto simp: obj_at_def valid_arch_obj_def dest!: ran_restrictD)
|
||||
|
||||
lemma set_asid_pool_iflive [wp]:
|
||||
"\<lbrace>\<lambda>s. if_live_then_nonz_cap s\<rbrace>
|
||||
set_asid_pool p ap
|
||||
\<lbrace>\<lambda>_ s. if_live_then_nonz_cap s\<rbrace>"
|
||||
apply (simp add: set_asid_pool_def update_object_def)
|
||||
set_asid_pool p ap
|
||||
\<lbrace>\<lambda>_ s. if_live_then_nonz_cap s\<rbrace>"
|
||||
apply (simp add: update_object_def)
|
||||
apply (wp get_object_wp set_object_iflive)
|
||||
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
|
||||
apply (clarsimp simp: obj_at_def a_type_simps)
|
||||
apply (clarsimp simp: a_type_def obj_at_def live_def hyp_live_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
done
|
||||
|
||||
|
||||
lemma set_asid_pool_zombies [wp]:
|
||||
"\<lbrace>\<lambda>s. zombies_final s\<rbrace>
|
||||
set_asid_pool p ap
|
||||
|
|
@ -387,8 +406,8 @@ lemma update_object_iflive[wp]:
|
|||
\<lbrace>\<lambda>_ s. if_live_then_nonz_cap s\<rbrace>"
|
||||
apply (simp add: update_object_def)
|
||||
apply (wp get_object_wp set_object_iflive)
|
||||
including unfold_objects
|
||||
apply (clarsimp simp: a_type_def)
|
||||
apply (clarsimp simp: a_type_def obj_at_def live_def hyp_live_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
done
|
||||
|
||||
lemma typ_at_pspace_aligned:
|
||||
|
|
@ -522,7 +541,7 @@ lemma update_aobj_valid_arch [wp]:
|
|||
by (wp valid_arch_state_lift)
|
||||
|
||||
lemma update_aobj_valid_objs [wp]:
|
||||
"\<lbrace>valid_objs and K(wellformed_arch_obj obj)\<rbrace> update_object ptr (ArchObj obj) \<lbrace>\<lambda>_. valid_objs\<rbrace>"
|
||||
"\<lbrace>valid_objs and wellformed_arch_obj obj\<rbrace> update_object ptr (ArchObj obj) \<lbrace>\<lambda>_. valid_objs\<rbrace>"
|
||||
apply (simp add: update_object_def)
|
||||
apply (wp set_object_valid_objs get_object_wp)
|
||||
apply (clarsimp simp: a_type_def split: kernel_object.split_asm if_split_asm)
|
||||
|
|
@ -585,35 +604,36 @@ lemma update_aobj_valid_global[wp]:
|
|||
by (wp valid_global_refs_cte_lift)
|
||||
|
||||
lemma update_aobj_valid_kernel_mappings[wp]:
|
||||
"\<lbrace>\<lambda>s. valid_kernel_mappings s \<and> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s))) (ArchObj obj)\<rbrace>
|
||||
"\<lbrace>\<lambda>s. valid_kernel_mappings s \<and> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s))) (ArchObj obj)\<rbrace>
|
||||
update_object ptr (ArchObj obj)
|
||||
\<lbrace>\<lambda>_ s. valid_kernel_mappings s\<rbrace>"
|
||||
apply (simp add: update_object_def)
|
||||
apply (wp set_object_v_ker_map get_object_wp)
|
||||
apply_trace (wp set_object_v_ker_map get_object_wp)
|
||||
apply (clarsimp simp: valid_kernel_mappings_def valid_kernel_mappings_if_pm_def)
|
||||
done
|
||||
|
||||
lemma valid_arch_obj_pre:
|
||||
lemma valid_vspace_obj_pre:
|
||||
"\<lbrakk>kheap s ptr = Some (ArchObj aobj);
|
||||
aa_type aobj = aa_type obj; valid_arch_obj tobj s\<rbrakk>
|
||||
\<Longrightarrow> valid_arch_obj tobj (s\<lparr>kheap := \<lambda>a. if a = ptr then Some (ArchObj obj) else kheap s a\<rparr>)"
|
||||
aa_type aobj = aa_type obj; valid_vspace_obj tobj s\<rbrakk>
|
||||
\<Longrightarrow> valid_vspace_obj tobj (s\<lparr>kheap := \<lambda>a. if a = ptr then Some (ArchObj obj) else kheap s a\<rparr>)"
|
||||
apply (case_tac tobj)
|
||||
apply (clarsimp simp: valid_arch_obj_def obj_at_def aa_type_def a_type_simps
|
||||
split: arch_kernel_obj.splits if_splits | drule(1) bspec)+
|
||||
apply (drule_tac x = x in spec, case_tac "x2 x",
|
||||
(fastforce simp: data_at_def obj_at_def a_type_simps split: pte.splits)+)+
|
||||
apply (clarsimp simp: obj_at_def aa_type_def a_type_simps
|
||||
split: arch_kernel_obj.splits if_splits | drule(1) bspec)+
|
||||
apply (drule_tac x = x in spec, case_tac "x2 x",
|
||||
(fastforce simp: data_at_def obj_at_def a_type_simps split: pte.splits)+)+
|
||||
apply (clarsimp simp: valid_arch_obj_def)
|
||||
apply (drule_tac x = x in spec, case_tac"x3 x")
|
||||
apply ((clarsimp simp: data_at_def obj_at_def a_type_simps aa_type_def
|
||||
split: pte.splits arch_kernel_obj.splits if_splits)+)[3]
|
||||
apply (clarsimp simp: valid_arch_obj_def)
|
||||
apply (drule_tac x = x in spec, case_tac"x3 x")
|
||||
apply ((clarsimp simp: data_at_def obj_at_def a_type_simps aa_type_def
|
||||
split: pte.splits arch_kernel_obj.splits if_splits)+)[3]
|
||||
apply (drule_tac x = x in spec, case_tac"x4 x")
|
||||
apply ((clarsimp simp: data_at_def obj_at_def a_type_simps aa_type_def
|
||||
split: pte.splits arch_kernel_obj.splits if_splits)+)[3]
|
||||
apply (clarsimp simp: valid_arch_obj_def)
|
||||
apply (drule_tac x = x in spec, case_tac"x4 x")
|
||||
apply ((clarsimp simp: data_at_def obj_at_def a_type_simps aa_type_def
|
||||
split: pte.splits arch_kernel_obj.splits if_splits)+)[3]
|
||||
apply (drule_tac x = x in bspec, simp, case_tac"x5 x")
|
||||
apply ((clarsimp simp: data_at_def obj_at_def a_type_simps aa_type_def
|
||||
split: pte.splits arch_kernel_obj.splits if_splits)+)[2]
|
||||
apply (clarsimp simp: valid_arch_obj_def)
|
||||
apply (drule_tac x = x in bspec, simp, case_tac"x5 x")
|
||||
apply ((clarsimp simp: data_at_def obj_at_def a_type_simps aa_type_def
|
||||
split: pte.splits arch_kernel_obj.splits if_splits)+)[3]
|
||||
done
|
||||
|
||||
lemma a_type_is_aobj:
|
||||
|
|
@ -623,7 +643,7 @@ lemma a_type_is_aobj:
|
|||
definition
|
||||
"valid_global_objs_upd ptr obj ast \<equiv> case obj of
|
||||
PageMapL4 pm \<Rightarrow> if ptr = x64_global_pml4 ast then
|
||||
empty_table (set (x64_global_pdpts ast)) (ArchObj obj) else True
|
||||
empty_table (set (second_level_tables ast)) (ArchObj obj) else True
|
||||
| PDPointerTable pdpt \<Rightarrow> if ptr \<in> set (x64_global_pdpts ast) then
|
||||
((\<forall>x. aligned_pdpte (pdpt x)
|
||||
\<and> (\<forall>r. pdpte_ref (pdpt x) = Some r \<longrightarrow> r \<in> set (x64_global_pds ast)))
|
||||
|
|
@ -681,15 +701,16 @@ lemma update_object_is_kheap_upd:
|
|||
|
||||
lemma set_pt_global_objs [wp]:
|
||||
"\<lbrace>valid_global_objs and valid_arch_state
|
||||
and (\<lambda>s. valid_global_objs_upd ptr obj (arch_state s))\<rbrace>
|
||||
update_object ptr (ArchObj obj)
|
||||
and (\<lambda>s. valid_global_objs_upd ptr obj (arch_state s))\<rbrace>
|
||||
update_object ptr (ArchObj obj)
|
||||
\<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
apply (clarsimp simp: update_object_def set_object_def valid_global_objs_def)
|
||||
apply (clarsimp simp: update_object_def set_object_def valid_global_objs_def
|
||||
second_level_tables_def)
|
||||
apply (wp get_object_wp)
|
||||
apply clarsimp
|
||||
apply (intro impI allI conjI)
|
||||
apply (simp add: valid_ao_at_def)
|
||||
apply (clarsimp simp: valid_global_objs_def obj_at_def valid_arch_obj_pre
|
||||
apply (simp add: valid_vso_at_def valid_arch_obj_def)
|
||||
apply (clarsimp simp: valid_global_objs_def obj_at_def valid_vspace_obj_pre
|
||||
dest!: a_type_is_aobj)
|
||||
apply (clarsimp dest!: a_type_is_aobj aa_type_pml4D
|
||||
simp: valid_arch_state_def aa_type_simps
|
||||
|
|
@ -701,7 +722,7 @@ lemma set_pt_global_objs [wp]:
|
|||
apply simp
|
||||
apply (simp add: a_type_simps aa_type_simps)
|
||||
apply (clarsimp dest!: a_type_is_aobj aa_type_pml4D
|
||||
simp: valid_arch_state_def aa_type_simps
|
||||
simp: valid_arch_state_def aa_type_simps second_level_tables_def
|
||||
valid_global_objs_upd_def obj_at_def)
|
||||
apply (fastforce dest: a_type_is_aobj valid_global_pdpts_typD aa_type_PDPTD
|
||||
simp: valid_arch_state_def aa_type_simps
|
||||
|
|
@ -715,8 +736,7 @@ lemma set_pt_global_objs [wp]:
|
|||
done
|
||||
|
||||
|
||||
(* It is a pity that the following lemmas can not be abstract into a form with update_object
|
||||
*)
|
||||
(* It is a pity that the following lemmas can not be abstract into a form with update_object *)
|
||||
lemma store_pte_typ_at:
|
||||
"\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> store_pte ptr pte \<lbrace>\<lambda>_ s. P (typ_at T p s)\<rbrace>"
|
||||
apply (simp add: store_pte_def set_pt_def set_object_def get_object_def)
|
||||
|
|
@ -930,7 +950,7 @@ lemmas pml4_shifting_at = pml4_shifting[OF is_aligned_pml4]
|
|||
lemma kernel_mapping_slots_empty_pml4eI:
|
||||
"\<lbrakk>equal_kernel_mappings s; valid_global_objs s; valid_arch_state s;
|
||||
kheap s p = Some (ArchObj (PageMapL4 pm)); x \<in> kernel_mapping_slots\<rbrakk> \<Longrightarrow>
|
||||
(\<forall>r. pml4e_ref (pm x) = Some r \<longrightarrow> r \<in> set (x64_global_pdpts (arch_state s)))"
|
||||
(\<forall>r. pml4e_ref (pm x) = Some r \<longrightarrow> r \<in> set (second_level_tables (arch_state s)))"
|
||||
apply (clarsimp simp: invs_def valid_state_def equal_kernel_mappings_def valid_global_objs_def)
|
||||
apply (erule_tac x=p in allE, erule_tac x="x64_global_pml4 (arch_state s)" in allE)
|
||||
including unfold_objects
|
||||
|
|
@ -1080,7 +1100,7 @@ private lemma vtable_index_mask:
|
|||
exists; so we parameterise over the vs_lookup. *)
|
||||
|
||||
private abbreviation (input)
|
||||
"pre pm_lookup \<equiv> pspace_aligned and valid_arch_objs and valid_arch_state
|
||||
"pre pm_lookup \<equiv> pspace_aligned and valid_vspace_objs and valid_arch_state
|
||||
and equal_kernel_mappings and valid_global_objs and pm_lookup
|
||||
and K (is_aligned pm pml4_bits \<and> vptr < pptr_base \<and> canonical_address vptr)"
|
||||
|
||||
|
|
@ -1100,7 +1120,7 @@ lemma lookup_pdpt_slot_wp:
|
|||
apply (clarsimp, drule spec, erule mp)
|
||||
apply (clarsimp simp: lookup_pml4_slot_def pml4_shifting)
|
||||
apply (frule (1) kernel_base_kernel_mapping_slots)
|
||||
apply (frule (2) valid_arch_objsD; clarsimp)
|
||||
apply (frule (2) valid_vspace_objsD; clarsimp)
|
||||
apply (bspec "ucast (get_pml4_index vptr)"; clarsimp)
|
||||
apply (rule conjI)
|
||||
apply (erule pd_pointer_table_pdpte_atI, simp_all)
|
||||
|
|
@ -1129,7 +1149,7 @@ lemma lookup_pd_slot_wp:
|
|||
apply (wp get_pdpte_wp lookup_pdpt_slot_wp | wpc | simp)+
|
||||
apply (clarsimp; drule spec; erule mp; clarsimp)
|
||||
apply (drule spec; erule (1) impE; clarsimp)
|
||||
apply (frule (2) valid_arch_objsD; clarsimp)
|
||||
apply (frule (2) valid_vspace_objsD; clarsimp)
|
||||
apply (drule_tac x="ucast (rv && mask pdpt_bits >> word_size_bits)" in spec; clarsimp)
|
||||
apply (rule conjI)
|
||||
apply (erule page_directory_pde_atI, simp_all)
|
||||
|
|
@ -1156,7 +1176,7 @@ lemma lookup_pt_slot_wp:
|
|||
apply (wp get_pde_wp lookup_pd_slot_wp | wpc | simp)+
|
||||
apply (clarsimp; drule spec; erule mp; clarsimp)
|
||||
apply (drule spec; erule (1) impE; clarsimp)
|
||||
apply (frule (2) valid_arch_objsD; clarsimp)
|
||||
apply (frule (2) valid_vspace_objsD; clarsimp)
|
||||
apply (drule_tac x="ucast (rv && mask pd_bits >> word_size_bits)" in spec; clarsimp)
|
||||
apply (rule conjI)
|
||||
apply (erule page_table_pte_atI, simp_all)
|
||||
|
|
@ -1294,7 +1314,7 @@ lemma data_at_vmsz_aligned:
|
|||
elim!: iffD1[OF is_aligned_ptrFromPAddr_eq, rotated])
|
||||
|
||||
lemma create_mapping_entries_valid_slots [wp]:
|
||||
"\<lbrace> pspace_aligned and valid_arch_objs and valid_arch_state and equal_kernel_mappings
|
||||
"\<lbrace> pspace_aligned and valid_vspace_objs and valid_arch_state and equal_kernel_mappings
|
||||
and valid_global_objs and (\<exists>\<rhd> pm) and data_at sz (ptrFromPAddr base)
|
||||
and K (is_aligned pm pml4_bits \<and> vptr < pptr_base \<and> canonical_address vptr
|
||||
\<and> vm_rights \<in> valid_vm_rights) \<rbrace>
|
||||
|
|
@ -1671,7 +1691,7 @@ lemma caps_of_slot_test:
|
|||
definition
|
||||
"valid_table_caps_aobj cs as obj r \<equiv> \<forall>p cap. cs p = Some cap \<longrightarrow>
|
||||
(is_pd_cap cap \<or> is_pt_cap cap \<or> is_pdpt_cap cap \<or> is_pml4_cap cap) \<longrightarrow>
|
||||
cap_asid cap = None \<longrightarrow> r \<in> obj_refs cap \<longrightarrow> empty_table (set (x64_global_pdpts as)) obj"
|
||||
cap_asid cap = None \<longrightarrow> r \<in> obj_refs cap \<longrightarrow> empty_table (set (second_level_tables as)) obj"
|
||||
|
||||
lemma a_type_of_arch:
|
||||
"a_type (ArchObj aobj) = AArch (aa_type aobj)"
|
||||
|
|
@ -1707,10 +1727,10 @@ lemma vs_ref_lvl_obj_same_type:
|
|||
by (simp add: a_type_def vs_ref_lvl_def vs_ref_lvl_arch_def aa_type_simps
|
||||
split: kernel_object.splits if_splits arch_kernel_obj.splits)
|
||||
|
||||
lemma valid_arch_obj_kheap_upd:
|
||||
"\<lbrakk>typ_at (a_type (ArchObj obj)) ptr s; valid_arch_obj ao s\<rbrakk>
|
||||
\<Longrightarrow> valid_arch_obj ao (s\<lparr>kheap := kheap s(ptr \<mapsto> ArchObj obj)\<rparr>)"
|
||||
apply (cases ao, simp_all)
|
||||
lemma valid_vspace_obj_kheap_upd:
|
||||
"\<lbrakk>typ_at (a_type (ArchObj obj)) ptr s; valid_vspace_obj ao s\<rbrakk>
|
||||
\<Longrightarrow> valid_vspace_obj ao (s\<lparr>kheap := kheap s(ptr \<mapsto> ArchObj obj)\<rparr>)"
|
||||
apply (cases ao, simp_all add: valid_arch_obj_def)
|
||||
apply (fastforce simp: a_type_simps obj_at_def valid_pte_def)+
|
||||
apply (clarsimp)
|
||||
apply (drule_tac x = x in spec)
|
||||
|
|
@ -1736,7 +1756,7 @@ lemma valid_arch_obj_kheap_upd:
|
|||
done
|
||||
|
||||
lemma update_object_valid_arch_objs[wp]:
|
||||
"\<lbrace> \<lambda>s. valid_arch_objs s
|
||||
"\<lbrace> \<lambda>s. valid_vspace_objs s
|
||||
|
||||
(* Lattice Preserving *)
|
||||
\<and> (\<forall>nref np nq stepref. ((nref, np) \<in> (vs_lookup1 s)\<^sup>* `` refs_diff vs_lookup1_on_heap_obj obj ptr s
|
||||
|
|
@ -1746,18 +1766,18 @@ lemma update_object_valid_arch_objs[wp]:
|
|||
\<longrightarrow> vs_ref_lvl (Some (ArchObj obj)) < vs_ref_lvl (kheap s np))
|
||||
|
||||
(* New reachable objs are valid *)
|
||||
\<and> (\<forall>rs. (rs \<rhd> ptr) s \<longrightarrow> valid_arch_obj obj s)
|
||||
\<and> (\<forall>rs. (rs \<rhd> ptr) s \<longrightarrow> valid_vspace_obj obj s)
|
||||
\<and> (\<forall>rs p pobj. (ko_at (ArchObj pobj) p s \<and> (rs, p)
|
||||
\<in> lookupable_refs (vs_lookup1 s) {ref. (ref \<rhd> ptr) s}
|
||||
(refs_diff vs_lookup1_on_heap_obj obj ptr s))
|
||||
\<longrightarrow> valid_arch_obj pobj s)\<rbrace>
|
||||
\<longrightarrow> valid_vspace_obj pobj s)\<rbrace>
|
||||
update_object ptr (ArchObj obj)
|
||||
\<lbrace> \<lambda>_. valid_arch_objs \<rbrace>"
|
||||
\<lbrace> \<lambda>_. valid_vspace_objs \<rbrace>"
|
||||
unfolding refs_diff_def
|
||||
apply (rule hoare_pre)
|
||||
apply (clarsimp simp: update_object_def set_object_def)
|
||||
apply (wp get_object_wp)
|
||||
apply (subst valid_arch_objs_def)
|
||||
apply (subst valid_vspace_objs_def)
|
||||
apply (clarsimp simp: vs_lookup_def del:ImageE)
|
||||
apply (drule subsetD[rotated, OF _ wellformed_order_lookup.khupd_graph_subset])
|
||||
apply (erule vs_lookup1_wellformed_order)
|
||||
|
|
@ -1778,11 +1798,11 @@ lemma update_object_valid_arch_objs[wp]:
|
|||
[where s = "s\<lparr>kheap := kheap s(ptr \<mapsto> ArchObj obj)\<rparr>" for s,simplified])
|
||||
apply (clarsimp simp: obj_at_def cong:vs_ref_lvl_obj_same_type)
|
||||
apply clarsimp
|
||||
apply (rule valid_arch_obj_kheap_upd)
|
||||
apply (rule valid_vspace_obj_kheap_upd)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (clarsimp dest!:a_type_is_aobj)
|
||||
apply (erule disjE)
|
||||
apply (drule_tac ao = "if p = ptr then aobj else ao" in valid_arch_objsD[rotated -1])
|
||||
apply (drule_tac ao = "if p = ptr then aobj else ao" in valid_vspace_objsD[rotated -1])
|
||||
apply (simp add: vs_lookup_def)
|
||||
apply (simp add: obj_at_def split: if_split_asm)
|
||||
apply (clarsimp split: if_split_asm simp: obj_at_def)
|
||||
|
|
@ -1801,7 +1821,7 @@ lemma valid_vs_lookup_fullD:
|
|||
by (simp add: valid_vs_lookup_def)
|
||||
|
||||
lemma update_object_valid_vs_lookup[wp]:
|
||||
"\<lbrace> \<lambda>s. valid_arch_objs s \<and> valid_vs_lookup s \<and> valid_asid_table (x64_asid_table (arch_state s)) s
|
||||
"\<lbrace> \<lambda>s. valid_vspace_objs s \<and> valid_vs_lookup s \<and> valid_asid_table (x64_asid_table (arch_state s)) s
|
||||
|
||||
(* Lattice Preserving *)
|
||||
\<and> (\<forall>nref np nq stepref. ((nref, np) \<in> (vs_lookup_pages1 s)\<^sup>* `` refs_diff vs_lookup_pages1_on_heap_obj obj ptr s
|
||||
|
|
@ -1852,7 +1872,7 @@ lemma update_object_valid_vs_lookup[wp]:
|
|||
done
|
||||
|
||||
lemma update_object_valid_arch_caps[wp]:
|
||||
"\<lbrace> \<lambda>s. valid_arch_objs s \<and> valid_arch_caps s
|
||||
"\<lbrace> \<lambda>s. valid_vspace_objs s \<and> valid_arch_caps s
|
||||
|
||||
\<and> valid_table_caps_aobj (caps_of_state s) (arch_state s) (ArchObj obj) ptr
|
||||
\<and> valid_asid_table (x64_asid_table (arch_state s)) s
|
||||
|
|
@ -1877,6 +1897,16 @@ lemma update_object_valid_arch_caps[wp]:
|
|||
crunch valid_irq_states[wp]: update_object "valid_irq_states"
|
||||
(wp: crunch_wps)
|
||||
|
||||
lemma update_object_state_hyp_refs[wp]:
|
||||
"\<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>
|
||||
update_object ptr obj
|
||||
\<lbrace>\<lambda>_ s. P (state_hyp_refs_of s)\<rbrace>"
|
||||
apply (wpsimp simp: update_object_def set_object_def wp: get_object_wp)
|
||||
including unfold_objects
|
||||
apply clarsimp
|
||||
apply (erule rsubst [where P=P])
|
||||
by (auto simp: state_hyp_refs_of_def split: option.splits)
|
||||
|
||||
lemma update_object_invs[wp]:
|
||||
"\<lbrace> \<lambda>s. invs s \<and> valid_table_caps_aobj (caps_of_state s) (arch_state s) (ArchObj obj) ptr
|
||||
\<and> (aa_type obj \<noteq> AASIDPool \<longrightarrow> ptr \<notin> global_refs s)
|
||||
|
|
@ -1884,9 +1914,9 @@ lemma update_object_invs[wp]:
|
|||
\<longrightarrow> ([VSRef (ucast (asid_high_bits_of a)) None], ptr) \<in> vs_asid_refs (x64_asid_table (arch_state s))
|
||||
\<longrightarrow> (VSRef (a && mask asid_low_bits) (Some AASIDPool), p) \<notin> set_diff (vs_refs (ArchObj obj)) (vs_refs (ArchObj aobj)))
|
||||
\<and> obj_at (\<lambda>ko. case obj of PageMapL4 pm \<Rightarrow> \<exists>pm'. ko = ArchObj (PageMapL4 pm') \<and> (\<forall>x\<in>kernel_mapping_slots. pm x = pm' x) | _ \<Rightarrow> True) ptr s
|
||||
\<and> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s))) (ArchObj obj)
|
||||
\<and> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s))) (ArchObj obj)
|
||||
\<and> valid_global_objs_upd ptr obj (arch_state s)
|
||||
\<and> ((\<exists>\<rhd> ptr) s \<longrightarrow> (valid_arch_obj obj s)) \<and> (wellformed_arch_obj obj)
|
||||
\<and> ((\<exists>\<rhd> ptr) s \<longrightarrow> (valid_vspace_obj obj s)) \<and> (wellformed_arch_obj obj s)
|
||||
|
||||
(* Lattice Preserving *)
|
||||
\<and> (\<forall>nref np nq stepref. ((nref, np) \<in> (vs_lookup1 s)\<^sup>* `` refs_diff vs_lookup1_on_heap_obj obj ptr s
|
||||
|
|
@ -1905,7 +1935,7 @@ lemma update_object_invs[wp]:
|
|||
\<and> (\<forall>rs p pobj. (ko_at (ArchObj pobj) p s \<and> (rs, p)
|
||||
\<in> lookupable_refs (vs_lookup1 s) {ref. (ref \<rhd> ptr) s}
|
||||
(refs_diff vs_lookup1_on_heap_obj obj ptr s))
|
||||
\<longrightarrow> valid_arch_obj pobj s)
|
||||
\<longrightarrow> valid_vspace_obj pobj s)
|
||||
(* New reachable objs are vs_lookup valid *)
|
||||
\<and> (\<forall>rs p pobj. ((rs, p)
|
||||
\<in> lookupable_refs (vs_lookup_pages1 s) {ref. (ref \<unrhd> ptr) s}
|
||||
|
|
@ -1915,8 +1945,8 @@ lemma update_object_invs[wp]:
|
|||
update_object ptr (ArchObj obj)
|
||||
\<lbrace> \<lambda>_. invs \<rbrace>"
|
||||
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
|
||||
apply (wp valid_irq_node_typ valid_irq_handlers_lift update_aobj_valid_global_vspace_mappings)
|
||||
apply (elim conjE, assumption | intro conjI | simp add: valid_arch_state_def)+
|
||||
apply_trace (wp valid_irq_node_typ valid_irq_handlers_lift update_aobj_valid_global_vspace_mappings)
|
||||
apply (clarsimp simp: valid_arch_state_def)
|
||||
done
|
||||
|
||||
lemma valid_global_refsD2:
|
||||
|
|
@ -1974,7 +2004,7 @@ lemma valid_asid_table_ran:
|
|||
|
||||
|
||||
lemma vs_lookup_pages_pt_eq:
|
||||
"\<lbrakk>valid_arch_objs s;
|
||||
"\<lbrakk>valid_vspace_objs s;
|
||||
\<forall>p\<in>ran (x64_asid_table (arch_state s)). asid_pool_at p s;
|
||||
page_table_at p s\<rbrakk>
|
||||
\<Longrightarrow> (ref \<unrhd> p) s = (ref \<rhd> p) s"
|
||||
|
|
@ -2197,6 +2227,20 @@ lemma valid_arch_objs_arch_update:
|
|||
apply simp
|
||||
done
|
||||
|
||||
lemma valid_vspace_objs_arch_update:
|
||||
"x64_asid_table (f (arch_state s)) = x64_asid_table (arch_state s) \<Longrightarrow>
|
||||
valid_vspace_objs (arch_state_update f s) = valid_vspace_objs s"
|
||||
apply (rule iffI)
|
||||
apply (erule valid_vspace_objs_stateI)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply simp
|
||||
apply simp
|
||||
apply (erule valid_vspace_objs_stateI)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply simp
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma unique_table_caps_pml4E:
|
||||
"\<lbrakk> unique_table_caps cs; cs p = Some cap; cap_asid cap = None;
|
||||
cs p' = Some cap'; cap_asid cap' = Some v; is_pml4_cap cap;
|
||||
|
|
@ -2269,8 +2313,8 @@ lemma vs_refs_pages_subset: "vs_refs ko \<subseteq> vs_refs_pages ko"
|
|||
|
||||
lemma vs_refs_pages_subset2:
|
||||
"\<lbrakk>vs_refs_pages ko \<subseteq> vs_refs_pages ko';
|
||||
(\<forall>ao. (ko = ArchObj ao) \<longrightarrow> valid_arch_obj ao s);
|
||||
(\<forall>ao'. (ko' = ArchObj ao') \<longrightarrow> valid_arch_obj ao' s)\<rbrakk>
|
||||
(\<forall>ao. (ko = ArchObj ao) \<longrightarrow> valid_vspace_obj ao s);
|
||||
(\<forall>ao'. (ko' = ArchObj ao') \<longrightarrow> valid_vspace_obj ao' s)\<rbrakk>
|
||||
\<Longrightarrow> vs_refs ko \<subseteq> vs_refs ko'"
|
||||
apply clarsimp
|
||||
apply (drule (1) subsetD[OF _ subsetD[OF vs_refs_pages_subset]])
|
||||
|
|
@ -2380,14 +2424,14 @@ lemma refs_diff_empty_simps_vslookup_pages1[simp]:
|
|||
done
|
||||
|
||||
lemma empty_table_empty_vs_refs_pages[simp]:
|
||||
"empty_table (set (x64_global_pdpts (arch_state s))) ko \<Longrightarrow> vs_refs_pages ko = {}"
|
||||
"empty_table (set (second_level_tables (arch_state s))) ko \<Longrightarrow> vs_refs_pages ko = {}"
|
||||
apply (clarsimp simp: empty_table_def split: kernel_object.splits arch_kernel_obj.splits)
|
||||
apply (clarsimp simp: vs_refs_pages_def graph_of_def pte_ref_pages_def pde_ref_pages_def
|
||||
pdpte_ref_pages_def pml4e_ref_pages_def)+
|
||||
done
|
||||
|
||||
lemma empty_table_empty_vs_refs[simp]:
|
||||
"empty_table (set (x64_global_pdpts (arch_state s))) ko \<Longrightarrow> vs_refs ko = {}"
|
||||
"empty_table (set (second_level_tables (arch_state s))) ko \<Longrightarrow> vs_refs ko = {}"
|
||||
using local.vs_refs_pages_subset
|
||||
by (fastforce simp: local.vs_refs_pages_subset)
|
||||
|
||||
|
|
@ -2414,7 +2458,7 @@ lemmas empty_table_lookup_refs_pages_refl = empty_vs_refs_pages_lookup_refs_page
|
|||
lemma empty_table_cap_asid_None:
|
||||
"\<lbrakk>cte_wp_at (\<lambda>cap. (is_pd_cap cap \<or> is_pt_cap cap \<or> is_pdpt_cap cap \<or> is_pml4_cap cap)
|
||||
\<and> cap_asid cap = None \<and> ptr \<in> obj_refs cap) slot s; kheap s ptr = Some ko; invs s\<rbrakk>
|
||||
\<Longrightarrow> empty_table (set (x64_global_pdpts (arch_state s))) ko"
|
||||
\<Longrightarrow> empty_table (set (second_level_tables (arch_state s))) ko"
|
||||
apply (clarsimp simp: valid_table_caps_def cte_wp_at_caps_of_state simp del: split_paired_All dest!: invs_valid_table_caps)
|
||||
apply (drule_tac x = ptr in spec)
|
||||
apply (drule_tac x = slot in spec)
|
||||
|
|
@ -2429,7 +2473,7 @@ lemma empty_refs_pages_cap_lookup_refs_pages_empty:
|
|||
done
|
||||
|
||||
lemma unmapped_cap_lookup_refs_pages_empty:
|
||||
"\<lbrakk>empty_table (set (x64_global_pdpts (arch_state s))) ko; ((a,b), tref, p) \<in> (vs_lookup_pages1 s)^+; kheap s b = Some ko\<rbrakk>
|
||||
"\<lbrakk>empty_table (set (second_level_tables (arch_state s))) ko; ((a,b), tref, p) \<in> (vs_lookup_pages1 s)^+; kheap s b = Some ko\<rbrakk>
|
||||
\<Longrightarrow> False"
|
||||
apply (erule(1) empty_refs_pages_cap_lookup_refs_pages_empty[rotated])
|
||||
apply simp
|
||||
|
|
@ -2443,7 +2487,7 @@ lemma empty_refs_cap_lookup_refs_empty:
|
|||
done
|
||||
|
||||
lemma unmapped_cap_lookup_refs_empty:
|
||||
"\<lbrakk>empty_table (set (x64_global_pdpts (arch_state s))) ko; ((a,b), tref, p) \<in> (vs_lookup1 s)^+; kheap s b = Some ko\<rbrakk>
|
||||
"\<lbrakk>empty_table (set (second_level_tables (arch_state s))) ko; ((a,b), tref, p) \<in> (vs_lookup1 s)^+; kheap s b = Some ko\<rbrakk>
|
||||
\<Longrightarrow> False"
|
||||
apply (erule(1) empty_refs_cap_lookup_refs_empty[rotated])
|
||||
apply simp
|
||||
|
|
@ -2459,29 +2503,30 @@ lemma invs_valid_kernel_mappings:
|
|||
|
||||
lemma valid_kernel_mappings_if_pm_pml4e:
|
||||
"\<lbrakk>valid_kernel_mappings s; kheap s p = Some (ArchObj (PageMapL4 pm));
|
||||
\<forall>r. pml4e_ref pml4e = Some r \<longrightarrow> (r \<in> set (x64_global_pdpts (arch_state s))) = (slot \<in> kernel_mapping_slots)\<rbrakk>
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s)))
|
||||
\<forall>r. pml4e_ref pml4e = Some r \<longrightarrow> (r \<in> set (second_level_tables (arch_state s))) = (slot \<in> kernel_mapping_slots)\<rbrakk>
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s)))
|
||||
(ArchObj (PageMapL4 (pm(slot := pml4e))))"
|
||||
by (fastforce simp: pml4e_ref_def valid_kernel_mappings_if_pm_def valid_kernel_mappings_def
|
||||
dest!: bspec split: option.split_asm pml4e.split_asm)
|
||||
second_level_tables_def
|
||||
dest!: bspec split: option.split_asm pml4e.split_asm)
|
||||
|
||||
lemma valid_kernel_mappings_if_pm_pte:
|
||||
"\<lbrakk>valid_kernel_mappings s; kheap s p = Some (ArchObj (PageTable pt))\<rbrakk>
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s)))
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s)))
|
||||
(ArchObj (PageTable (pt(slot := pte))))"
|
||||
by (fastforce simp: valid_kernel_mappings_if_pm_def valid_kernel_mappings_def pml4e_ref_def
|
||||
dest!: bspec split: option.split_asm pml4e.split_asm)
|
||||
|
||||
lemma valid_kernel_mappings_if_pm_pde:
|
||||
"\<lbrakk>valid_kernel_mappings s; kheap s p = Some (ArchObj (PageDirectory pd))\<rbrakk>
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s)))
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s)))
|
||||
(ArchObj (PageDirectory (pd(slot := pde))))"
|
||||
by (fastforce simp: valid_kernel_mappings_if_pm_def valid_kernel_mappings_def pml4e_ref_def
|
||||
dest!: bspec split: option.split_asm pml4e.split_asm)
|
||||
|
||||
lemma valid_kernel_mappings_if_pm_pdpte:
|
||||
"\<lbrakk>valid_kernel_mappings s; kheap s p = Some (ArchObj (PDPointerTable pdpt))\<rbrakk>
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s)))
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s)))
|
||||
(ArchObj (PDPointerTable (pdpt(slot := pdpte))))"
|
||||
by (fastforce simp: valid_kernel_mappings_if_pm_def valid_kernel_mappings_def pml4e_ref_def
|
||||
dest!: bspec split: option.split_asm pml4e.split_asm)
|
||||
|
|
@ -2508,7 +2553,8 @@ lemma valid_global_objs_upd_invalid_pml4e:
|
|||
"\<lbrakk>valid_global_objs s; kheap s p = Some (ArchObj (PageMapL4 pm)); pml4e_ref_pages pml4e = None \<or> p\<notin> global_refs s\<rbrakk>
|
||||
\<Longrightarrow> valid_global_objs_upd p (PageMapL4 (pm(slot := pml4e))) (arch_state s)"
|
||||
by (clarsimp simp: valid_global_objs_def valid_global_objs_upd_def obj_at_def valid_ao_at_def
|
||||
empty_table_def global_refs_def pml4e_ref_pages_def pml4e_ref_def split: pml4e.split_asm)
|
||||
empty_table_def global_refs_def pml4e_ref_pages_def pml4e_ref_def
|
||||
split: pml4e.split_asm)
|
||||
|
||||
definition
|
||||
"valid_table_caps_entry cs as obj r \<equiv> \<forall>p cap. cs p = Some cap \<longrightarrow>
|
||||
|
|
@ -2650,15 +2696,15 @@ lemmas aobj_upd_invalid_slots_simps = valid_kernel_mappings_if_pm_pml4e valid_gl
|
|||
|
||||
lemmas pde_ref_simps[simp] = pde_ref_def[split_simps pde.split] pde_ref_pages_def[split_simps pde.split]
|
||||
|
||||
lemma valid_arch_obj_from_invs:
|
||||
"\<lbrakk>(ref \<rhd> p) s; kheap s p = Some (ArchObj ao); invs s\<rbrakk> \<Longrightarrow> valid_arch_obj ao s"
|
||||
apply (erule valid_arch_objsD)
|
||||
lemma valid_vspace_obj_from_invs:
|
||||
"\<lbrakk>(ref \<rhd> p) s; kheap s p = Some (ArchObj ao); invs s\<rbrakk> \<Longrightarrow> valid_vspace_obj ao s"
|
||||
apply (erule valid_vspace_objsD)
|
||||
apply (simp add: obj_at_def)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma valid_obj_from_invs:
|
||||
"\<lbrakk>kheap s p = Some (ArchObj ao); invs s\<rbrakk> \<Longrightarrow> wellformed_arch_obj ao"
|
||||
"\<lbrakk>kheap s p = Some (ArchObj ao); invs s\<rbrakk> \<Longrightarrow> wellformed_arch_obj ao s"
|
||||
by (auto simp: valid_obj_def valid_objs_def obj_at_def dom_def dest!:invs_valid_objs)
|
||||
|
||||
lemmas vs_ref_lvl_obj_simps[simp] = vs_ref_lvl_def[split_simps kernel_object.split option.split]
|
||||
|
|
@ -2720,15 +2766,17 @@ lemma store_pte_invs:
|
|||
and (\<lambda>s. p && ~~ mask pt_bits \<notin> global_refs s \<and> wellformed_pte pte)\<rbrace>
|
||||
store_pte p pte \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (simp add: store_pte_def)
|
||||
apply (wp)
|
||||
apply (intro impI allI conjI valid_table_caps_aobj_upd_invalid_pte invs_valid_table_caps , simp_all add: obj_at_def)
|
||||
apply_trace (wp)
|
||||
apply_trace (intro impI allI conjI valid_table_caps_aobj_upd_invalid_pte invs_valid_table_caps,
|
||||
simp_all add: obj_at_def)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm
|
||||
dest: valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pte)+
|
||||
apply (fastforce dest!: valid_arch_obj_from_invs)
|
||||
apply (fastforce dest!: valid_vspace_obj_from_invs)
|
||||
apply (clarsimp dest!: valid_obj_from_invs)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pte)+
|
||||
apply (rule ccontr)
|
||||
apply (drule valid_pte_ref_obj_at_empty_vs_refs_pages)
|
||||
|
|
@ -2895,13 +2943,13 @@ lemma set_asid_pool_global_objs [wp]:
|
|||
apply (wp get_object_wp)
|
||||
apply (clarsimp simp del: fun_upd_apply
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
apply (clarsimp simp: valid_global_objs_def valid_ao_at_def simp del: fun_upd_apply)
|
||||
apply (clarsimp simp: valid_global_objs_def valid_vso_at_def simp del: fun_upd_apply)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (rule conjI)
|
||||
subgoal by (clarsimp simp: valid_arch_state_def obj_at_def a_type_def)
|
||||
apply clarsimp
|
||||
apply (erule (1) valid_arch_obj_same_type[simplified])
|
||||
apply (erule (1) valid_vspace_obj_same_type[simplified])
|
||||
subgoal by (simp add: a_type_def)
|
||||
apply (rule conjI)
|
||||
subgoal by (clarsimp simp: obj_at_def valid_arch_state_def a_type_def)
|
||||
|
|
@ -2983,8 +3031,17 @@ lemma set_asid_pool_table_caps [wp]:
|
|||
apply (rule hoare_lift_Pf2 [where f=caps_of_state];wp?)
|
||||
apply (simp add: set_asid_pool_def set_object_def update_object_def)
|
||||
apply (wp get_object_wp)
|
||||
by (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
|
||||
(fastforce simp: obj_at_def empty_table_def a_type_simps)
|
||||
apply (clarsimp simp: obj_at_def a_type_simps
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
apply (intro conjI impI; (drule spec | drule (1) mp | elim conjE exE)+;
|
||||
simp add: empty_table_def)
|
||||
done
|
||||
|
||||
lemma set_asid_pool_zombies_state_hyp_refs [wp]:
|
||||
"\<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>
|
||||
set_asid_pool p ap
|
||||
\<lbrace>\<lambda>_ s. P (state_hyp_refs_of s)\<rbrace>"
|
||||
by (simp add: update_object_state_hyp_refs)
|
||||
|
||||
lemma set_asid_pool_invs_restrict:
|
||||
"\<lbrace>invs and ko_at (ArchObj (ASIDPool ap)) p and
|
||||
|
|
@ -2993,12 +3050,11 @@ lemma set_asid_pool_invs_restrict:
|
|||
x64_asid_map (arch_state s) asid = None)\<rbrace>
|
||||
set_asid_pool p (ap |` S) \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (simp add: invs_def valid_state_def valid_pspace_def
|
||||
valid_arch_caps_def del: set_asid_pool_def set_arch_obj_simps(5))
|
||||
apply (rule hoare_pre,
|
||||
wp add: valid_irq_node_typ set_asid_pool_typ_at
|
||||
set_asid_pool_arch_objs_unmap valid_irq_handlers_lift
|
||||
valid_arch_caps_def del: set_asid_pool_simpler_def)
|
||||
apply (wp valid_irq_node_typ set_asid_pool_typ_at
|
||||
set_asid_pool_vspace_objs_unmap valid_irq_handlers_lift
|
||||
set_asid_pool_vs_lookup_unmap set_asid_pool_restrict_asid_map
|
||||
| simp del: set_arch_obj_simps(5))+
|
||||
| simp del: set_asid_pool_simpler_def)+
|
||||
done
|
||||
|
||||
lemma set_asid_pool_invs_unmap:
|
||||
|
|
@ -3021,7 +3077,7 @@ lemma vs_refs_empty_from_pages_empty:
|
|||
|
||||
lemma empty_refs_is_valid:
|
||||
"\<lbrakk>vs_refs_pages (ArchObj ao) = {};
|
||||
valid_arch_state s\<rbrakk> \<Longrightarrow> valid_arch_obj ao s"
|
||||
valid_arch_state s\<rbrakk> \<Longrightarrow> valid_vspace_obj ao s"
|
||||
apply (case_tac ao)
|
||||
apply (simp_all add: vs_refs_pages_def ran_def graph_of_def)
|
||||
apply (clarsimp, drule_tac x = x in spec, clarsimp simp: pte_ref_pages_def split: pte.splits)
|
||||
|
|
@ -3044,12 +3100,12 @@ lemma store_pde_invs:
|
|||
apply (wp)
|
||||
apply (intro impI allI conjI valid_table_caps_aobj_upd_invalid_pde invs_valid_table_caps , simp_all add: obj_at_def)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pde)+
|
||||
apply (fastforce dest!: valid_arch_obj_from_invs)
|
||||
apply (fastforce dest!: valid_vspace_obj_from_invs)
|
||||
apply (clarsimp dest!: valid_obj_from_invs)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pde)+
|
||||
apply (rule ccontr)
|
||||
apply (clarsimp dest!: ref_pages_Some)
|
||||
|
|
@ -3089,12 +3145,12 @@ lemma store_pdpte_invs:
|
|||
apply (wp)
|
||||
apply (intro impI allI conjI valid_table_caps_aobj_upd_invalid_pdpte invs_valid_table_caps , simp_all add: obj_at_def)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pdpte)+
|
||||
apply (fastforce dest!: valid_arch_obj_from_invs)
|
||||
apply (fastforce dest!: valid_vspace_obj_from_invs)
|
||||
apply (clarsimp dest!: valid_obj_from_invs)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pde)+
|
||||
apply (rule ccontr)
|
||||
apply (clarsimp dest!: ref_pages_Some)
|
||||
|
|
@ -3123,8 +3179,8 @@ lemma store_pdpte_invs:
|
|||
lemma store_pml4e_invs:
|
||||
"\<lbrace>invs and (\<lambda>s. valid_pml4e pml4e s) and
|
||||
(\<lambda>s. \<forall>ptr. pml4e_ref_pages pml4e = Some ptr \<longrightarrow> (
|
||||
(ptr \<in> set (x64_global_pdpts (arch_state s))) = (ucast (p && mask pml4_bits >> word_size_bits) \<in> kernel_mapping_slots)
|
||||
\<and> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) ptr s
|
||||
(ptr \<in> set (second_level_tables (arch_state s))) = (ucast (p && mask pml4_bits >> word_size_bits) \<in> kernel_mapping_slots)
|
||||
\<and> obj_at (empty_table (set (second_level_tables (arch_state s)))) ptr s
|
||||
\<and> (\<forall>slot cap. caps_of_state s slot = Some cap \<longrightarrow> is_pml4_cap cap \<longrightarrow> p && ~~ mask pml4_bits \<in> obj_refs cap \<longrightarrow> cap_asid cap \<noteq> None)
|
||||
\<and> (\<forall>ref. (ref \<unrhd> (p && ~~ mask pml4_bits)) s
|
||||
\<longrightarrow> (\<exists>slot. cte_wp_at (\<lambda>cap. ptr \<in> obj_refs cap \<and> vs_cap_ref cap = Some (VSRef ((p && mask pml4_bits >> word_size_bits) && mask ptTranslationBits) (Some APageMapL4) #ref))
|
||||
|
|
@ -3137,17 +3193,17 @@ lemma store_pml4e_invs:
|
|||
apply (wp)
|
||||
apply (intro impI allI conjI valid_table_caps_aobj_upd_invalid_pml4e invs_valid_table_caps , simp_all add: obj_at_def)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pml4e valid_kernel_mappings_if_pm_pml4e)+
|
||||
apply fastforce
|
||||
apply (clarsimp dest!: ref_pages_Some)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pde)+
|
||||
apply (fastforce dest!: valid_arch_obj_from_invs)
|
||||
apply (fastforce dest!: valid_vspace_obj_from_invs)
|
||||
apply (clarsimp dest!: valid_obj_from_invs)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_aobj_upd_invalid_pde)+
|
||||
apply (rule ccontr)
|
||||
apply (clarsimp dest!: ref_pages_Some)
|
||||
|
|
@ -3160,15 +3216,18 @@ lemma store_pml4e_invs:
|
|||
apply (drule vs_lookup_pages1_wellformed.lookup1_cut, fastforce, fastforce)
|
||||
apply (clarsimp split: option.split_asm if_split_asm simp: aa_type_simps)
|
||||
apply (drule(1) valid_pml4e_vs_ref_page_lvl_simps, simp)
|
||||
apply (clarsimp split: if_split_asm option.split_asm dest!:ref_pages_Some simp: lookupable_refs_def)
|
||||
apply (clarsimp simp: lookupable_refs_def dest!: ref_pages_Some
|
||||
split: if_split_asm option.split_asm)
|
||||
apply (frule(2) empty_table_lookup_refs_refl)
|
||||
apply clarsimp
|
||||
apply (erule local.empty_table_is_valid)
|
||||
apply (erule empty_table_is_valid)
|
||||
apply fastforce
|
||||
apply (clarsimp split: if_split_asm option.split_asm dest!:ref_pages_Some simp: lookupable_refs_def)
|
||||
apply (clarsimp simp: lookupable_refs_def dest!:ref_pages_Some
|
||||
split: if_split_asm option.split_asm)
|
||||
apply (frule(2) empty_table_lookup_refs_pages_refl)
|
||||
apply clarsimp
|
||||
apply (clarsimp split: if_split_asm option.split_asm dest!:ref_pages_Some simp: lookupable_refs_def)
|
||||
apply (clarsimp simp: lookupable_refs_def dest!:ref_pages_Some
|
||||
split: if_split_asm option.split_asm)
|
||||
apply (drule(2) empty_table_lookup_refs_pages_refl)
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state ucast_ucast_mask ptTranslationBits_def)
|
||||
done
|
||||
|
|
|
|||
|
|
@ -334,18 +334,23 @@ lemma obj_at [simp]:
|
|||
"obj_at P p s' = obj_at P p s"
|
||||
by (simp add: s'_def)
|
||||
|
||||
lemma vs_lookup_neq: "\<lbrakk>(rs \<rhd> p) s' ; p \<noteq> ap\<rbrakk> \<Longrightarrow> (rs \<rhd> p) s"
|
||||
by (clarsimp simp: vs_lookup')
|
||||
|
||||
lemma arch_objs':
|
||||
"valid_arch_objs s \<Longrightarrow> valid_arch_objs s'"
|
||||
lemma vspace_objs':
|
||||
"valid_vspace_objs s \<Longrightarrow> valid_vspace_objs s'"
|
||||
using ko
|
||||
apply (clarsimp simp: valid_arch_objs_def vs_lookup')
|
||||
apply (fastforce simp: obj_at_def)
|
||||
apply (clarsimp simp: valid_vspace_objs_def)
|
||||
apply (erule_tac x=p in allE)
|
||||
apply (case_tac "p = ap";
|
||||
case_tac ao;
|
||||
fastforce simp: obj_at_def s'_def
|
||||
intro: vs_lookup_neq)
|
||||
done
|
||||
|
||||
|
||||
lemma global_objs':
|
||||
"valid_global_objs s \<Longrightarrow> valid_global_objs s'"
|
||||
apply (clarsimp simp: valid_global_objs_def valid_ao_at_def)
|
||||
apply (clarsimp simp: valid_global_objs_def valid_ao_at_def second_level_tables_def)
|
||||
apply (auto simp: s'_def)
|
||||
done
|
||||
|
||||
|
|
@ -366,7 +371,7 @@ lemma valid_vs_lookup':
|
|||
lemma valid_table_caps':
|
||||
"\<lbrakk> valid_table_caps s \<rbrakk>
|
||||
\<Longrightarrow> valid_table_caps s'"
|
||||
apply (simp add: valid_table_caps_def caps_of_state_s')
|
||||
apply (simp add: valid_table_caps_def caps_of_state_s' second_level_tables_def)
|
||||
apply (simp add: s'_def)
|
||||
done
|
||||
|
||||
|
|
@ -490,7 +495,7 @@ lemma retype_region_no_cap_to_obj:
|
|||
lemma valid_table_caps_asid_upd [iff]:
|
||||
"valid_table_caps (s\<lparr>arch_state := (x64_asid_table_update f (arch_state s))\<rparr>) =
|
||||
valid_table_caps s"
|
||||
by (simp add: valid_table_caps_def)
|
||||
by (simp add: valid_table_caps_def second_level_tables_def)
|
||||
|
||||
|
||||
lemma vs_asid_ref_upd:
|
||||
|
|
@ -512,7 +517,6 @@ lemma set_cap_reachable_pg_cap:
|
|||
"\<lbrace>\<lambda>s. P (reachable_pg_cap cap s)\<rbrace> set_cap x y \<lbrace>\<lambda>_ s. P (reachable_pg_cap cap s)\<rbrace>"
|
||||
by (unfold reachable_pg_cap_def, wp hoare_vcg_ex_lift set_cap.vs_lookup_pages)
|
||||
|
||||
|
||||
lemma cap_insert_simple_arch_caps_ap:
|
||||
"\<lbrace>valid_arch_caps and (\<lambda>s. cte_wp_at (safe_parent_for (cdt s) src cap) src s)
|
||||
and no_cap_to_obj_with_diff_ref cap {dest}
|
||||
|
|
@ -532,7 +536,7 @@ lemma cap_insert_simple_arch_caps_ap:
|
|||
apply (wp hoare_vcg_imp_lift hoare_vcg_ball_lift set_free_index_final_cap
|
||||
hoare_vcg_disj_lift set_cap_reachable_pg_cap set_cap.vs_lookup_pages
|
||||
| clarsimp)+
|
||||
apply (wp set_cap_arch_obj set_cap_valid_table_caps hoare_vcg_ball_lift
|
||||
apply_trace (wp set_cap_arch_obj set_cap_valid_table_caps hoare_vcg_ball_lift
|
||||
get_cap_wp static_imp_wp)+
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps)
|
||||
apply (rule conjI)
|
||||
|
|
@ -563,17 +567,17 @@ lemma valid_asid_map_asid_upd_strg:
|
|||
apply (erule (1) asid_update.valid_asid_map')
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_asid_upd_strg:
|
||||
"valid_arch_objs s \<and>
|
||||
lemma valid_vspace_objs_asid_upd_strg:
|
||||
"valid_vspace_objs s \<and>
|
||||
ko_at (ArchObj (ASIDPool empty)) ap s \<and>
|
||||
x64_asid_table (arch_state s) asid = None \<longrightarrow>
|
||||
valid_arch_objs (s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := x64_asid_table (arch_state s)(asid \<mapsto> ap)\<rparr>\<rparr>)"
|
||||
valid_vspace_objs (s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := x64_asid_table (arch_state s)(asid \<mapsto> ap)\<rparr>\<rparr>)"
|
||||
apply clarsimp
|
||||
apply (subgoal_tac "asid_update ap asid s")
|
||||
prefer 2
|
||||
apply unfold_locales[1]
|
||||
apply assumption+
|
||||
apply (erule (1) asid_update.arch_objs')
|
||||
apply (erule (1) asid_update.vspace_objs')
|
||||
done
|
||||
|
||||
lemma valid_global_objs_asid_upd_strg:
|
||||
|
|
@ -602,7 +606,7 @@ lemma cap_insert_ap_invs:
|
|||
\<lbrace>\<lambda>rv s. invs (s\<lparr>arch_state := arch_state s
|
||||
\<lparr>x64_asid_table := (x64_asid_table \<circ> arch_state) s(asid_high_bits_of asid \<mapsto> ap)\<rparr>\<rparr>)\<rbrace>"
|
||||
apply (simp add: invs_def valid_state_def valid_pspace_def)
|
||||
apply (strengthen valid_arch_state_strg valid_arch_objs_asid_upd_strg
|
||||
apply (strengthen valid_arch_state_strg valid_vspace_objs_asid_upd_strg
|
||||
valid_asid_map_asid_upd_strg )
|
||||
apply (simp cong: conj_cong)
|
||||
apply (rule hoare_pre)
|
||||
|
|
@ -911,10 +915,10 @@ lemma sts_valid_page_inv[wp]:
|
|||
crunch global_refs_inv[wp]: set_thread_state "\<lambda>s. P (global_refs s)"
|
||||
|
||||
lemma sts_empty_table[wp]:
|
||||
"\<lbrace>\<lambda>s. obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s\<rbrace>
|
||||
"\<lbrace>\<lambda>s. obj_at (empty_table (set (second_level_tables (arch_state s)))) p s\<rbrace>
|
||||
set_thread_state t st
|
||||
\<lbrace>\<lambda>rv s. obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s\<rbrace>"
|
||||
by (rule hoare_lift_Pf[OF sts.aobj_at[OF arch_obj_pred_empty_table] sts.arch_state])
|
||||
\<lbrace>\<lambda>rv s. obj_at (empty_table (set (second_level_tables (arch_state s)))) p s\<rbrace>"
|
||||
by (rule hoare_lift_Pf[OF sts.aobj_at[OF empty_table.arch_only] sts.arch_state])
|
||||
|
||||
lemma sts_valid_vspace_table_inv[wp]:
|
||||
"\<And>i. \<lbrace>valid_pdpti i\<rbrace> set_thread_state t st \<lbrace>\<lambda>rv. valid_pdpti i\<rbrace>"
|
||||
|
|
@ -1089,7 +1093,7 @@ lemma find_vspace_for_asid_shifting_voodoo:
|
|||
*)
|
||||
|
||||
lemma find_vspace_for_asid_ref_offset_voodoo:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and
|
||||
K (ref = [VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
VSRef (ucast (asid_high_bits_of asid)) None])\<rbrace>
|
||||
find_vspace_for_asid asid
|
||||
|
|
@ -1164,7 +1168,7 @@ private method ref_is_unique =
|
|||
valid_arch_state_def bit_simps\<close>)
|
||||
|
||||
lemma create_mapping_entries_same_refs:
|
||||
"\<lbrace>valid_arch_state and valid_arch_objs and valid_vs_lookup
|
||||
"\<lbrace>valid_arch_state and valid_vspace_objs and valid_vs_lookup
|
||||
and (\<lambda>s. unique_table_refs (caps_of_state s))
|
||||
and pspace_aligned and valid_objs and valid_kernel_mappings and \<exists>\<rhd> pm
|
||||
and (\<lambda>s. \<exists>pm_cap pm_cptr. cte_wp_at (diminished pm_cap) pm_cptr s
|
||||
|
|
@ -1186,7 +1190,7 @@ lemma create_mapping_entries_same_refs:
|
|||
clarsimp simp: acap_rights_update_def split: cap.splits arch_cap.splits\<close>)
|
||||
apply (all \<open>frule valid_objs_caps\<close>)
|
||||
apply (all \<open>frule (1) is_aligned_pml4; clarsimp simp: pml4_shifting\<close>)
|
||||
apply (all \<open>frule (2) valid_arch_objsD[where ao="PageMapL4 t" for t, rotated]; clarsimp\<close>)
|
||||
apply (all \<open>frule (2) valid_vspace_objsD[where ao="PageMapL4 t" for t, rotated]; clarsimp\<close>)
|
||||
apply (all \<open>frule (1) iffD2[OF Compl_iff, OF kernel_base_kernel_mapping_slots];
|
||||
drule (1) bspec; clarsimp\<close>)
|
||||
apply (all \<open>frule (1) is_aligned_pdpt; clarsimp simp: pdpt_shifting\<close>)
|
||||
|
|
@ -1194,21 +1198,22 @@ lemma create_mapping_entries_same_refs:
|
|||
apply (all \<open>frule (1) vs_lookup_and_unique_refs;
|
||||
try_solve \<open>simp add: table_cap_ref_def obj_refs_def\<close>; clarsimp\<close>)
|
||||
prefer 3 subgoal by (ref_is_unique; rule not_kernel_slot_not_global_pml4; simp add: obj_at_def)
|
||||
apply (all \<open>frule (2) valid_arch_objsD[where ao="PDPointerTable t" for t, rotated]; clarsimp\<close>)
|
||||
apply (all \<open>frule (2) valid_vspace_objsD[where ao="PDPointerTable t" for t, rotated]; clarsimp\<close>)
|
||||
apply (all \<open>drule spec[of _ "ucast (get_pdpt_index vaddr)"]; clarsimp\<close>)
|
||||
apply (all \<open>frule (1) is_aligned_pd; clarsimp simp: pd_shifting\<close>)
|
||||
apply (all \<open>frule (2) vs_lookup_step[OF _ vs_lookup1I[OF _ vs_refs_get_pdpt_index refl]]\<close>)
|
||||
prefer 2 subgoal by (ref_is_unique; clarsimp dest!: valid_global_pdptsD2 simp: obj_at_def)
|
||||
apply (frule (2) valid_arch_objsD[where ao="PageDirectory t" for t, rotated]; clarsimp)
|
||||
prefer 2 subgoal by (ref_is_unique; clarsimp dest!: valid_global_pdptsD2
|
||||
simp: obj_at_def second_level_tables_def)
|
||||
apply (frule (2) valid_vspace_objsD[where ao="PageDirectory t" for t, rotated]; clarsimp)
|
||||
apply (drule spec[of _ "ucast (get_pd_index vaddr)"]; clarsimp)
|
||||
apply (frule (1) is_aligned_pt; clarsimp simp: pt_shifting)
|
||||
apply (frule (2) vs_lookup_step[OF _ vs_lookup1I[OF _ vs_refs_get_pd_index refl]])
|
||||
by (ref_is_unique; clarsimp dest!: valid_global_pdptsD2 simp: obj_at_def)
|
||||
by (ref_is_unique; clarsimp dest!: valid_global_pdptsD2 simp: obj_at_def second_level_tables_def)
|
||||
|
||||
end
|
||||
|
||||
lemma create_mapping_entries_same_refs_ex:
|
||||
"\<lbrace>valid_arch_state and valid_arch_objs and valid_vs_lookup and (\<lambda>s. unique_table_refs (caps_of_state s))
|
||||
"\<lbrace>valid_arch_state and valid_vspace_objs and valid_vs_lookup and (\<lambda>s. unique_table_refs (caps_of_state s))
|
||||
and pspace_aligned and valid_objs and valid_kernel_mappings and \<exists>\<rhd> pm and
|
||||
(\<lambda>s. \<exists>dev pm_cap pm_cptr asid rights' mt. cte_wp_at (diminished pm_cap) pm_cptr s
|
||||
\<and> pm_cap = ArchObjectCap (PML4Cap pm (Some asid))
|
||||
|
|
@ -1246,7 +1251,7 @@ lemma cte_wp_at_page_cap_weaken:
|
|||
|
||||
|
||||
lemma find_vspace_for_asid_lookup_vspace_wp:
|
||||
"\<lbrace> \<lambda>s. valid_arch_objs s \<and> (\<forall>pm. vspace_at_asid asid pm s \<and> page_map_l4_at pm s
|
||||
"\<lbrace> \<lambda>s. valid_vspace_objs s \<and> (\<forall>pm. vspace_at_asid asid pm s \<and> page_map_l4_at pm s
|
||||
\<and> (\<exists>\<rhd> pm) s \<longrightarrow> Q pm s) \<rbrace> find_vspace_for_asid asid \<lbrace> Q \<rbrace>, -"
|
||||
apply (rule hoare_post_imp_R)
|
||||
apply (rule hoare_vcg_conj_lift_R[OF find_vspace_for_asid_page_map_l4])
|
||||
|
|
@ -1306,7 +1311,8 @@ lemma and_not_mask_pml4_not_kernel_mapping_slots:
|
|||
done
|
||||
|
||||
lemma decode_page_invocation_wf[wp]:
|
||||
"arch_cap = PageCap dev word rights map_type vmpage_size option \<Longrightarrow> \<lbrace>invs and valid_cap (ArchObjectCap arch_cap) and
|
||||
"arch_cap = PageCap dev word rights map_type vmpage_size option \<Longrightarrow>
|
||||
\<lbrace>invs and valid_cap (ArchObjectCap arch_cap) and
|
||||
cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and
|
||||
(\<lambda>s. \<forall>x \<in> set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\<rbrace>
|
||||
decode_page_invocation label args slot arch_cap excaps
|
||||
|
|
@ -1322,10 +1328,10 @@ lemma decode_page_invocation_wf[wp]:
|
|||
find_vspace_for_asid_lookup_vspace_wp
|
||||
| wpc
|
||||
| simp add: valid_arch_inv_def valid_page_inv_def is_pg_cap_def)+)
|
||||
apply (clarsimp simp: neq_Nil_conv invs_arch_objs)
|
||||
apply (clarsimp simp: neq_Nil_conv invs_vspace_objs)
|
||||
apply (frule diminished_cte_wp_at_valid_cap[where p="(a, b)" for a b], clarsimp)
|
||||
apply (frule diminished_cte_wp_at_valid_cap[where p=slot], clarsimp)
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def conj_ac
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state mask_cap_def
|
||||
diminished_def[where cap="ArchObjectCap (PageCap d x y t z w)" for d x y t z w]
|
||||
linorder_not_le aligned_sum_less_kernel_base
|
||||
dest!: diminished_pm_capD)
|
||||
|
|
@ -1379,7 +1385,8 @@ lemma decode_page_invocation_wf[wp]:
|
|||
done
|
||||
|
||||
lemma decode_page_table_invocation_wf[wp]:
|
||||
"arch_cap = PageTableCap pt_ptr pt_map_data \<Longrightarrow> \<lbrace>invs and valid_cap (ArchObjectCap arch_cap) and
|
||||
"arch_cap = PageTableCap pt_ptr pt_map_data \<Longrightarrow>
|
||||
\<lbrace>invs and valid_cap (ArchObjectCap arch_cap) and
|
||||
cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and
|
||||
(\<lambda>s. \<forall>x \<in> set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\<rbrace>
|
||||
decode_page_table_invocation label args slot arch_cap excaps
|
||||
|
|
@ -1415,7 +1422,8 @@ lemma decode_page_table_invocation_wf[wp]:
|
|||
done
|
||||
|
||||
lemma decode_page_directory_invocation_wf[wp]:
|
||||
"arch_cap = PageDirectoryCap pd_ptr pd_map_data \<Longrightarrow> \<lbrace>invs and valid_cap (ArchObjectCap arch_cap) and
|
||||
"arch_cap = PageDirectoryCap pd_ptr pd_map_data \<Longrightarrow>
|
||||
\<lbrace>invs and valid_cap (ArchObjectCap arch_cap) and
|
||||
cte_wp_at (diminished (ArchObjectCap arch_cap)) slot and
|
||||
(\<lambda>s. \<forall>x \<in> set excaps. cte_wp_at (diminished (fst x)) (snd x) s)\<rbrace>
|
||||
decode_page_directory_invocation label args slot arch_cap excaps
|
||||
|
|
|
|||
|
|
@ -30,6 +30,8 @@ crunch (bcorres)bcorres[wp]: invoke_untyped truncate_state
|
|||
|
||||
crunch (bcorres)bcorres[wp]: set_mcpriority,arch_tcb_set_ipc_buffer truncate_state
|
||||
|
||||
crunch (bcorres)bcorres[wp, BCorres2_AI_assms]: arch_get_sanitise_register_info truncate_state
|
||||
|
||||
lemma invoke_tcb_bcorres[wp]:
|
||||
fixes a
|
||||
shows "bcorres (invoke_tcb a) (invoke_tcb a)"
|
||||
|
|
|
|||
|
|
@ -489,21 +489,24 @@ lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]:
|
|||
\<lbrace>\<lambda>rv s. \<forall>t \<in> obj_refs (fst rv). halted_if_tcb t s\<rbrace>"
|
||||
apply (case_tac cap, simp_all)
|
||||
apply (wp unbind_notification_valid_objs
|
||||
| clarsimp simp: o_def valid_cap_def cap_table_at_typ
|
||||
is_tcb obj_at_def
|
||||
| clarsimp simp: halted_if_tcb_def
|
||||
split: option.split
|
||||
| intro impI conjI
|
||||
| rule hoare_drop_imp)+
|
||||
apply (fastforce simp: pred_tcb_at_def obj_at_def is_tcb
|
||||
dest!: final_zombie_not_live)
|
||||
| clarsimp simp: o_def valid_cap_def cap_table_at_typ
|
||||
is_tcb obj_at_def
|
||||
| clarsimp simp: halted_if_tcb_def
|
||||
split: option.split
|
||||
| intro impI conjI
|
||||
| rule hoare_drop_imp)+
|
||||
apply (drule_tac final_zombie_not_live; (assumption | simp add: invs_iflive)?)
|
||||
apply (clarsimp simp: pred_tcb_at_def is_tcb obj_at_def live_def, elim disjE)
|
||||
apply (clarsimp; case_tac "tcb_state tcb"; simp)+
|
||||
apply (rename_tac arch_cap)
|
||||
apply (case_tac arch_cap, simp_all add: arch_finalise_cap_def)
|
||||
apply (wp
|
||||
| clarsimp simp: valid_cap_def split: option.split bool.split
|
||||
| intro impI conjI)+
|
||||
| clarsimp simp: valid_cap_def obj_at_def is_tcb_def is_cap_table_def
|
||||
split: option.splits bool.split
|
||||
| intro impI conjI)+
|
||||
done
|
||||
|
||||
lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof
|
||||
|
||||
crunch emptyable[wp,CNodeInv_AI_assms]: finalise_cap "\<lambda>s. emptyable sl s"
|
||||
(simp: crunch_simps rule: emptyable_lift
|
||||
|
|
@ -952,31 +955,14 @@ lemma cap_move_invs[wp, CNodeInv_AI_assms]:
|
|||
unfolding invs_def valid_state_def valid_pspace_def
|
||||
apply (simp add: pred_conj_def conj_comms [where Q = "valid_mdb S" for S])
|
||||
apply wp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_zombies_final)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_if_live)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_if_unsafe)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_irq_handlers)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_replies)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_valid_arch_caps)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_valid_global_objs)
|
||||
apply clarsimp
|
||||
apply (rule hoare_vcg_mp)
|
||||
apply (rule hoare_pre, rule cap_move_valid_ioc)
|
||||
apply clarsimp
|
||||
apply simp
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_zombies_final)
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_if_live)
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_if_unsafe)
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_irq_handlers)
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_replies)
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_valid_arch_caps)
|
||||
apply (rule hoare_vcg_mp, wpsimp wp: cap_move_valid_ioc)
|
||||
apply clarsimp
|
||||
apply (rule hoare_drop_imps)+
|
||||
apply (simp add: cap_move_def set_cdt_def)
|
||||
apply (rule hoare_pre)
|
||||
|
|
|
|||
|
|
@ -103,7 +103,7 @@ where
|
|||
\<and> (is_vspace_table_cap newcap
|
||||
\<longrightarrow> cap_asid newcap = None
|
||||
\<longrightarrow> (\<forall> r \<in> obj_refs newcap.
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) r s))
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) r s))
|
||||
(* If newcap is vspace table cap such that either:
|
||||
- newcap and cap have different types or different obj_refs, or
|
||||
- newcap is unmapped while cap is mapped, *)
|
||||
|
|
@ -185,7 +185,7 @@ crunch arch[wp]: set_cap "\<lambda>s. P (arch_state s)" (simp: split_def)
|
|||
lemma set_cap_valid_table_caps:
|
||||
"\<lbrace>\<lambda>s. valid_table_caps s
|
||||
\<and> ((is_vspace_table_cap cap) \<longrightarrow> cap_asid cap = None
|
||||
\<longrightarrow> (\<forall>r \<in> obj_refs cap. obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) r s))\<rbrace>
|
||||
\<longrightarrow> (\<forall>r \<in> obj_refs cap. obj_at (empty_table (set (second_level_tables (arch_state s)))) r s))\<rbrace>
|
||||
set_cap cap ptr
|
||||
\<lbrace>\<lambda>rv. valid_table_caps\<rbrace>"
|
||||
apply (simp add: valid_table_caps_def)
|
||||
|
|
@ -255,7 +255,7 @@ lemma set_cap_valid_arch_caps:
|
|||
\<or> (\<forall>oref \<in> obj_refs cap'. \<not> (vref \<unrhd> oref) s))
|
||||
\<and> no_cap_to_obj_with_diff_ref cap {ptr} s
|
||||
\<and> (is_vspace_table_cap cap \<longrightarrow> cap_asid cap = None
|
||||
\<longrightarrow> (\<forall>r \<in> obj_refs cap. obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) r s))
|
||||
\<longrightarrow> (\<forall>r \<in> obj_refs cap. obj_at (empty_table (set (second_level_tables (arch_state s)))) r s))
|
||||
\<and> (is_vspace_table_cap cap
|
||||
\<longrightarrow> (\<forall>oldcap. caps_of_state s ptr = Some oldcap \<longrightarrow>
|
||||
same_vspace_table_cap_type cap oldcap
|
||||
|
|
@ -274,7 +274,7 @@ lemma set_cap_valid_arch_caps:
|
|||
lemma valid_table_capsD:
|
||||
"\<lbrakk> cte_wp_at (op = cap) ptr s; valid_table_caps s;
|
||||
is_vspace_table_cap cap; cap_asid cap = None \<rbrakk>
|
||||
\<Longrightarrow> \<forall>r \<in> obj_refs cap. obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) r s"
|
||||
\<Longrightarrow> \<forall>r \<in> obj_refs cap. obj_at (empty_table (set (second_level_tables (arch_state s)))) r s"
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state valid_table_caps_def)
|
||||
apply (cases ptr, fastforce)
|
||||
done
|
||||
|
|
@ -333,5 +333,21 @@ lemma obj_ref_none_no_asid:
|
|||
"obj_refs new_cap = {} \<longrightarrow> table_cap_ref new_cap = None"
|
||||
by (simp add: table_cap_ref_def split: cap.split arch_cap.split)+
|
||||
|
||||
lemma set_cap_hyp_refs_of [wp]:
|
||||
"\<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>
|
||||
set_cap cp p
|
||||
\<lbrace>\<lambda>rv s. P (state_hyp_refs_of s)\<rbrace>"
|
||||
apply (simp add: set_cap_def set_object_def split_def)
|
||||
apply (wp get_object_wp | wpc)+
|
||||
apply (auto elim!: rsubst[where P=P]
|
||||
simp: state_hyp_refs_of_def obj_at_def
|
||||
intro!: ext
|
||||
split: if_split_asm)
|
||||
done
|
||||
|
||||
lemma state_hyp_refs_of_revokable[simp]:
|
||||
"state_hyp_refs_of (s \<lparr> is_original_cap := m \<rparr>) = state_hyp_refs_of s"
|
||||
by (rule revokable_update.state_hyp_refs_update)
|
||||
|
||||
end
|
||||
end
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ lemma cte_at_length_limit:
|
|||
(* FIXME: move? *)
|
||||
lemma getActiveIRQ_wp [CSpace_AI_assms]:
|
||||
"irq_state_independent_A P \<Longrightarrow>
|
||||
valid P (do_machine_op getActiveIRQ) (\<lambda>_. P)"
|
||||
valid P (do_machine_op (getActiveIRQ in_kernel)) (\<lambda>_. P)"
|
||||
apply (simp add: getActiveIRQ_def do_machine_op_def split_def exec_gets
|
||||
select_f_select[simplified liftM_def]
|
||||
select_modify_comm gets_machine_state_modify)
|
||||
|
|
@ -108,7 +108,7 @@ lemma set_free_index_invs [CSpace_AI_assms]:
|
|||
set_cap_idle update_cap_ifunsafe)
|
||||
apply (simp add:valid_irq_node_def)
|
||||
apply wps
|
||||
apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap.valid_arch_obj set_cap_valid_arch_caps
|
||||
apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap.valid_vspace_obj set_cap_valid_arch_caps
|
||||
set_cap.valid_global_objs set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at
|
||||
set_cap_cap_refs_respects_device_region_spec[where ptr = cref])
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state)
|
||||
|
|
|
|||
|
|
@ -29,12 +29,10 @@ crunch domain_list_inv [wp, DetSchedDomainTime_AI_assms]:
|
|||
arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread,
|
||||
handle_arch_fault_reply, init_arch_objects, arch_tcb_set_ipc_buffer,
|
||||
arch_invoke_irq_control, handle_vm_fault,
|
||||
prepare_thread_delete, handle_hypervisor_fault
|
||||
prepare_thread_delete, handle_hypervisor_fault,
|
||||
make_arch_fault_msg, arch_get_sanitise_register_info, handle_reserved_irq
|
||||
"\<lambda>s. P (domain_list s)"
|
||||
|
||||
crunch domain_list_inv [wp, DetSchedDomainTime_AI_assms]: arch_perform_invocation "\<lambda>s. P (domain_list s)"
|
||||
(wp: crunch_wps check_cap_inv)
|
||||
|
||||
crunch domain_time_inv [wp, DetSchedDomainTime_AI_assms]: arch_finalise_cap "\<lambda>s. P (domain_time s)"
|
||||
(wp: hoare_drop_imps mapM_wp subset_refl simp: crunch_simps)
|
||||
|
||||
|
|
@ -42,9 +40,23 @@ crunch domain_time_inv [wp, DetSchedDomainTime_AI_assms]:
|
|||
arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread,
|
||||
handle_arch_fault_reply, init_arch_objects, arch_tcb_set_ipc_buffer,
|
||||
arch_invoke_irq_control, handle_vm_fault,
|
||||
prepare_thread_delete, handle_hypervisor_fault
|
||||
prepare_thread_delete, handle_hypervisor_fault,
|
||||
make_arch_fault_msg, arch_get_sanitise_register_info, handle_reserved_irq
|
||||
"\<lambda>s. P (domain_time s)"
|
||||
|
||||
end
|
||||
|
||||
global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI
|
||||
proof goal_cases
|
||||
interpret Arch .
|
||||
case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?)
|
||||
qed
|
||||
|
||||
context Arch begin global_naming ARM
|
||||
|
||||
crunch domain_list_inv [wp, DetSchedDomainTime_AI_assms]: arch_perform_invocation "\<lambda>s. P (domain_list s)"
|
||||
(wp: crunch_wps check_cap_inv)
|
||||
|
||||
crunch domain_time_inv [wp, DetSchedDomainTime_AI_assms]: arch_perform_invocation "\<lambda>s. P (domain_time s)"
|
||||
(wp: crunch_wps check_cap_inv)
|
||||
|
||||
|
|
@ -75,7 +87,7 @@ lemma handle_interrupt_valid_domain_time [DetSchedDomainTime_AI_assms]:
|
|||
|
||||
end
|
||||
|
||||
global_interpretation DetSchedDomainTime_AI?: DetSchedDomainTime_AI
|
||||
global_interpretation DetSchedDomainTime_AI_2?: DetSchedDomainTime_AI_2
|
||||
proof goal_cases
|
||||
interpret Arch .
|
||||
case 1 show ?case by (unfold_locales; (fact DetSchedDomainTime_AI_assms)?)
|
||||
|
|
|
|||
|
|
@ -17,17 +17,23 @@ context Arch begin global_naming X64
|
|||
named_theorems DetSchedSchedule_AI_assms
|
||||
|
||||
crunch valid_etcbs [wp, DetSchedSchedule_AI_assms]:
|
||||
arch_switch_to_idle_thread, arch_switch_to_thread valid_etcbs
|
||||
arch_switch_to_idle_thread, arch_switch_to_thread, arch_get_sanitise_register_info valid_etcbs
|
||||
(simp: whenE_def ignore: )
|
||||
|
||||
crunch valid_queues [wp, DetSchedSchedule_AI_assms]:
|
||||
switch_to_idle_thread, switch_to_thread valid_queues
|
||||
switch_to_idle_thread, switch_to_thread, arch_get_sanitise_register_info valid_queues
|
||||
(simp: whenE_def ignore: set_tcb_queue tcb_sched_action )
|
||||
|
||||
crunch weak_valid_sched_action [wp, DetSchedSchedule_AI_assms]:
|
||||
switch_to_idle_thread, switch_to_thread "weak_valid_sched_action"
|
||||
switch_to_idle_thread, switch_to_thread, arch_get_sanitise_register_info "weak_valid_sched_action"
|
||||
(simp: whenE_def ignore: )
|
||||
|
||||
crunch ct_not_in_q[wp]: set_vm_root "ct_not_in_q"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
|
||||
crunch ct_not_in_q'[wp]: set_vm_root "\<lambda>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]:
|
||||
"\<lbrace>valid_queues and valid_idle\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_not_in_q\<rbrace>"
|
||||
apply (simp add: switch_to_idle_thread_def)
|
||||
|
|
@ -38,6 +44,10 @@ lemma switch_to_idle_thread_ct_not_in_q [wp, DetSchedSchedule_AI_assms]:
|
|||
valid_idle_def pred_tcb_at_def obj_at_def)
|
||||
done
|
||||
|
||||
crunch valid_sched_action'[wp]: set_vm_root "\<lambda>s. valid_sched_action_2 (scheduler_action s)
|
||||
(ekheap 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]:
|
||||
"\<lbrace>valid_sched_action and valid_idle\<rbrace>
|
||||
switch_to_idle_thread
|
||||
|
|
@ -50,22 +60,30 @@ lemma switch_to_idle_thread_valid_sched_action [wp, DetSchedSchedule_AI_assms]:
|
|||
pred_tcb_at_def obj_at_def)
|
||||
done
|
||||
|
||||
crunch ct_in_cur_domain'[wp]: set_vm_root "\<lambda>s. ct_in_cur_domain_2 t (idle_thread s)
|
||||
(scheduler_action s) (cur_domain s) (ekheap s)"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
|
||||
lemma switch_to_idle_thread_ct_in_cur_domain [wp, DetSchedSchedule_AI_assms]:
|
||||
"\<lbrace>\<top>\<rbrace> switch_to_idle_thread \<lbrace>\<lambda>_. ct_in_cur_domain\<rbrace>"
|
||||
by (simp add: switch_to_idle_thread_def arch_switch_to_idle_thread_def do_machine_op_def
|
||||
split_def ct_in_cur_domain_def
|
||||
| wp)+
|
||||
|
||||
crunch ct_not_in_q [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread ct_not_in_q
|
||||
crunch ct_not_in_q [wp, DetSchedSchedule_AI_assms]:
|
||||
arch_switch_to_thread, arch_get_sanitise_register_info ct_not_in_q
|
||||
(simp: whenE_def ignore: )
|
||||
|
||||
crunch is_activatable [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread "is_activatable t"
|
||||
crunch is_activatable [wp, DetSchedSchedule_AI_assms]:
|
||||
arch_switch_to_thread, arch_get_sanitise_register_info "is_activatable t"
|
||||
(simp: whenE_def ignore: )
|
||||
|
||||
crunch valid_sched_action [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread valid_sched_action
|
||||
crunch valid_sched_action [wp, DetSchedSchedule_AI_assms]:
|
||||
arch_switch_to_thread, arch_get_sanitise_register_info valid_sched_action
|
||||
(simp: whenE_def ignore: )
|
||||
|
||||
crunch valid_sched [wp, DetSchedSchedule_AI_assms]: arch_switch_to_thread valid_sched
|
||||
crunch valid_sched [wp, DetSchedSchedule_AI_assms]:
|
||||
arch_switch_to_thread, arch_get_sanitise_register_info valid_sched
|
||||
(simp: whenE_def ignore: )
|
||||
|
||||
crunch exst[wp]: set_vm_root "\<lambda>s. P (exst s)"
|
||||
|
|
@ -288,8 +306,15 @@ crunch valid_sched [wp, DetSchedSchedule_AI_assms]: arch_invoke_irq_control "val
|
|||
crunch valid_list [wp, DetSchedSchedule_AI_assms]:
|
||||
arch_activate_idle_thread, arch_switch_to_thread, arch_switch_to_idle_thread "valid_list"
|
||||
|
||||
crunch cur_tcb [wp, DetSchedSchedule_AI_assms]: handle_arch_fault_reply, handle_vm_fault cur_tcb
|
||||
crunch cur_tcb [wp, DetSchedSchedule_AI_assms]:
|
||||
handle_arch_fault_reply, handle_vm_fault, arch_get_sanitise_register_info cur_tcb
|
||||
|
||||
crunch not_cur_thread [wp, DetSchedSchedule_AI_assms]: make_arch_fault_msg, arch_get_sanitise_register_info "not_cur_thread t'"
|
||||
crunch valid_sched [wp, DetSchedSchedule_AI_assms]: make_arch_fault_msg valid_sched
|
||||
crunch ready_queues [wp, DetSchedSchedule_AI_assms]: make_arch_fault_msg, arch_get_sanitise_register_info "\<lambda>s. P (ready_queues s)"
|
||||
crunch valid_etcbs [wp, DetSchedSchedule_AI_assms]: make_arch_fault_msg valid_etcbs
|
||||
|
||||
crunch scheduler_action [wp, DetSchedSchedule_AI_assms]: make_arch_fault_msg, arch_get_sanitise_register_info "\<lambda>s. P (scheduler_action s)"
|
||||
end
|
||||
|
||||
global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI
|
||||
|
|
@ -300,17 +325,22 @@ global_interpretation DetSchedSchedule_AI?: DetSchedSchedule_AI
|
|||
|
||||
context Arch begin global_naming X64
|
||||
|
||||
lemma handle_hyp_fault_valid_sched[wp]:
|
||||
lemma handle_hyp_fault_valid_sched[wp, DetSchedSchedule_AI_assms]:
|
||||
"\<lbrace>valid_sched and invs and st_tcb_at active t and not_queued t and scheduler_act_not t\<rbrace>
|
||||
handle_hypervisor_fault t fault \<lbrace>\<lambda>_. valid_sched\<rbrace>"
|
||||
by (cases fault; wpsimp wp: handle_fault_valid_sched simp: valid_fault_def)
|
||||
|
||||
lemma handle_reserved_irq_valid_sched[wp, DetSchedSchedule_AI_assms]:
|
||||
"\<lbrace>valid_sched and invs and (\<lambda>s. irq \<in> non_kernel_IRQs \<longrightarrow> scheduler_act_sane s \<and> ct_not_queued s)\<rbrace>
|
||||
handle_reserved_irq irq \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
|
||||
unfolding handle_reserved_irq_def by (wpsimp simp: non_kernel_IRQs_def)
|
||||
|
||||
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)?)
|
||||
case 1 show ?case by (unfold_locales; (fact DetSchedSchedule_AI_assms)?)
|
||||
qed
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@ crunch valid_list[wp]: update_object valid_list
|
|||
(wp: get_object_wp)
|
||||
|
||||
crunch valid_list[wp, Deterministic_AI_assms]:
|
||||
cap_swap_for_delete,set_cap,finalise_cap,arch_tcb_set_ipc_buffer valid_list
|
||||
cap_swap_for_delete,set_cap,finalise_cap,arch_tcb_set_ipc_buffer,arch_get_sanitise_register_info
|
||||
valid_list
|
||||
(wp: crunch_wps simp: unless_def crunch_simps)
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -132,6 +132,10 @@ lemma region_in_kernel_window_delete_objects[wp]:
|
|||
\<lbrace>\<lambda>_. region_in_kernel_window S\<rbrace>"
|
||||
by (wp | simp add: delete_objects_def do_machine_op_def split_def)+
|
||||
|
||||
lemma state_hyp_refs_of_detype:
|
||||
"state_hyp_refs_of (detype S s) = (\<lambda>x. if x \<in> S then {} else state_hyp_refs_of s x)"
|
||||
by (rule ext, simp add: state_hyp_refs_of_def detype_def)
|
||||
|
||||
lemma of_bl_length2:
|
||||
"length xs < word_bits - cte_level_bits \<Longrightarrow> of_bl xs * 32 < (2 :: machine_word) ^ (length xs + 5)"
|
||||
apply (simp add: power_add cte_level_bits_def)
|
||||
|
|
@ -159,6 +163,30 @@ context detype_locale_arch begin
|
|||
|
||||
named_theorems detype_invs_proofs
|
||||
|
||||
lemma state_hyp_refs: "state_hyp_refs_of (detype (untyped_range cap) s) = state_hyp_refs_of s"
|
||||
apply (rule ext, clarsimp simp add: state_hyp_refs_of_detype)
|
||||
apply (rule sym, rule equals0I, drule state_hyp_refs_of_elemD)
|
||||
apply (drule live_okE, rule hyp_refs_of_live, clarsimp)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma hyp_refsym : "sym_refs (state_hyp_refs_of s)"
|
||||
using invs by (simp add: invs_def valid_state_def valid_pspace_def)
|
||||
|
||||
lemma hyp_refs_of: "\<And>obj p. \<lbrakk> ko_at obj p s \<rbrakk> \<Longrightarrow> hyp_refs_of obj \<subseteq> (UNIV - untyped_range cap \<times> UNIV)"
|
||||
by (fastforce intro: hyp_refs_of_live dest!: hyp_sym_refs_ko_atD[OF _ hyp_refsym] live_okE)
|
||||
|
||||
lemma wellformed_arch_obj[detype_invs_proofs]:
|
||||
"\<And>p ao. \<lbrakk>ko_at (ArchObj ao) p s; wellformed_arch_obj ao s\<rbrakk>
|
||||
\<Longrightarrow> wellformed_arch_obj ao (detype (untyped_range cap) s)"
|
||||
apply (frule hyp_refs_of)
|
||||
apply (auto simp: wellformed_arch_obj_def split: arch_kernel_obj.splits option.splits)
|
||||
done
|
||||
|
||||
lemma sym_hyp_refs_detype[detype_invs_proofs]:
|
||||
"sym_refs (state_hyp_refs_of (detype (untyped_range cap) s))"
|
||||
using hyp_refsym by (simp add: state_hyp_refs)
|
||||
|
||||
lemma valid_cap[detype_invs_proofs]:
|
||||
"\<And>cap'. \<lbrakk> s \<turnstile> cap'; obj_reply_refs cap' \<subseteq> (UNIV - untyped_range cap) \<rbrakk>
|
||||
\<Longrightarrow> detype (untyped_range cap) s \<turnstile> cap'"
|
||||
|
|
@ -180,6 +208,20 @@ lemma valid_idle_detype[detype_invs_proofs]: "valid_idle (detype (untyped_range
|
|||
lemma valid_vs_lookup: "valid_vs_lookup s"
|
||||
using valid_arch_caps by (simp add: valid_arch_caps_def)
|
||||
|
||||
lemma hyp_live_strg:
|
||||
"hyp_live ko \<Longrightarrow> live ko"
|
||||
by (cases ko; simp add: live_def hyp_live_def)
|
||||
|
||||
lemma obj_at_hyp_live_strg:
|
||||
"obj_at hyp_live p s \<Longrightarrow> obj_at live p s"
|
||||
by (erule obj_at_weakenE, rule hyp_live_strg)
|
||||
|
||||
lemma tcb_arch_detype[detype_invs_proofs]:
|
||||
"\<lbrakk>ko_at (TCB t) p s; valid_arch_tcb (tcb_arch t) s\<rbrakk>
|
||||
\<Longrightarrow> valid_arch_tcb (tcb_arch t) (detype (untyped_range cap) s)"
|
||||
apply (clarsimp simp: valid_arch_tcb_def)
|
||||
done
|
||||
|
||||
lemma valid_arch_state_detype[detype_invs_proofs]:
|
||||
"valid_arch_state (detype (untyped_range cap) s)"
|
||||
using valid_vs_lookup valid_arch_state ut_mdb valid_global_refsD [OF globals cap] cap
|
||||
|
|
@ -298,9 +340,9 @@ private method crush for i =
|
|||
rule exI[of _ i];
|
||||
fastforce)
|
||||
|
||||
lemma valid_arch_obj:
|
||||
"\<And>ao p. \<lbrakk> valid_arch_obj ao s; ko_at (ArchObj ao) p s; (\<exists>\<rhd>p) s \<rbrakk> \<Longrightarrow>
|
||||
valid_arch_obj ao (detype (untyped_range cap) s)"
|
||||
lemma valid_vspace_obj:
|
||||
"\<And>ao p. \<lbrakk> valid_vspace_obj ao s; ko_at (ArchObj ao) p s; (\<exists>\<rhd>p) s \<rbrakk> \<Longrightarrow>
|
||||
valid_vspace_obj ao (detype (untyped_range cap) s)"
|
||||
apply (case_tac ao; simp; erule allEI ballEI; clarsimp simp: ran_def;
|
||||
drule vs_lookup_pages_vs_lookupI)
|
||||
subgoal for p t r ref i by (crush i)
|
||||
|
|
@ -312,14 +354,14 @@ lemma valid_arch_obj:
|
|||
|
||||
end
|
||||
|
||||
lemma valid_arch_obj_detype[detype_invs_proofs]: "valid_arch_objs (detype (untyped_range cap) s)"
|
||||
lemma valid_vspace_obj_detype[detype_invs_proofs]: "valid_vspace_objs (detype (untyped_range cap) s)"
|
||||
proof -
|
||||
have "valid_arch_objs s"
|
||||
have "valid_vspace_objs s"
|
||||
using invs by fastforce
|
||||
thus ?thesis
|
||||
unfolding valid_arch_objs_def
|
||||
unfolding valid_vspace_objs_def
|
||||
apply (simp add: vs_lookup)
|
||||
apply (auto intro: valid_arch_obj)
|
||||
apply (auto intro: valid_vspace_obj)
|
||||
done
|
||||
qed
|
||||
|
||||
|
|
@ -332,10 +374,9 @@ end
|
|||
|
||||
|
||||
sublocale detype_locale < detype_locale_gen_1
|
||||
proof goal_cases
|
||||
interpret detype_locale_arch ..
|
||||
case 1 show ?case
|
||||
by (intro_locales; (unfold_locales; fact detype_invs_proofs)?)
|
||||
proof goal_cases
|
||||
interpret detype_locale_arch ..
|
||||
case 1 show ?case by (unfold_locales; fact detype_invs_proofs)
|
||||
qed
|
||||
|
||||
|
||||
|
|
@ -379,7 +420,7 @@ lemma pml4_at_global_pml4: "page_map_l4_at (x64_global_pml4 (arch_state s)) s"
|
|||
lemma valid_global_objs_detype[detype_invs_proofs]:
|
||||
"valid_global_objs (detype (untyped_range cap) s)"
|
||||
using valid_global_objs valid_global_refsD [OF globals cap]
|
||||
apply (simp add: valid_global_objs_def valid_ao_at_def arch_state_det)
|
||||
apply (simp add: valid_global_objs_def valid_vso_at_def arch_state_det)
|
||||
apply (intro conjI; elim conjE exEI;
|
||||
clarsimp simp: global_refs_def cap_range_def arch_state_det)
|
||||
using pml4_at_global_pml4
|
||||
|
|
|
|||
|
|
@ -20,8 +20,8 @@ lemma obj_at_not_live_valid_arch_cap_strg [Finalise_AI_asms]:
|
|||
"(s \<turnstile> ArchObjectCap cap \<and> aobj_ref cap = Some r)
|
||||
\<longrightarrow> obj_at (\<lambda>ko. \<not> live ko) r s"
|
||||
by (clarsimp simp: valid_cap_def obj_at_def
|
||||
a_type_arch_live
|
||||
split: arch_cap.split_asm if_split_asm)
|
||||
a_type_arch_live live_def hyp_live_def
|
||||
split: arch_cap.split_asm if_splits)
|
||||
|
||||
global_naming X64
|
||||
|
||||
|
|
@ -46,7 +46,7 @@ lemma reachable_pg_cap_update[simp]:
|
|||
(* FIXME x64: this needs stuff about equality between vs_lookup and vs_lookup_pages
|
||||
for PageMapL4, PDPTs *)
|
||||
lemma vs_lookup_pages_eq:
|
||||
"\<lbrakk>valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s;
|
||||
"\<lbrakk>valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s;
|
||||
valid_cap cap s; table_cap_ref cap = Some vref; oref \<in> obj_refs cap\<rbrakk>
|
||||
\<Longrightarrow> (vref \<unrhd> oref) s = (vref \<rhd> oref) s"
|
||||
apply (clarsimp simp: table_cap_ref_def
|
||||
|
|
@ -79,11 +79,11 @@ lemma invs_x64_asid_table_unmap:
|
|||
\<and> tab = x64_asid_table (arch_state s)
|
||||
\<longrightarrow> invs (s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := tab(asid_high_bits_of base := None)\<rparr>\<rparr>)"
|
||||
apply (clarsimp simp: invs_def valid_state_def valid_arch_caps_def)
|
||||
apply (strengthen valid_asid_map_unmap valid_arch_objs_unmap_strg
|
||||
apply (strengthen valid_asid_map_unmap valid_vspace_objs_unmap_strg
|
||||
valid_vs_lookup_unmap_strg valid_arch_state_unmap_strg)
|
||||
apply (simp add: valid_irq_node_def valid_kernel_mappings_def
|
||||
valid_global_objs_arch_update)
|
||||
apply (simp add: valid_table_caps_def valid_machine_state_def)
|
||||
apply (simp add: valid_table_caps_def valid_machine_state_def second_level_tables_def)
|
||||
done
|
||||
|
||||
crunch asid_map[wp]: do_machine_op "valid_asid_map"
|
||||
|
|
@ -447,7 +447,7 @@ lemma arch_finalise_cap_replaceable[wp]:
|
|||
shows
|
||||
"\<lbrace>\<lambda>s. s \<turnstile> cap.ArchObjectCap cap \<and>
|
||||
x = is_final_cap' (cap.ArchObjectCap cap) s \<and>
|
||||
pspace_aligned s \<and> valid_arch_objs s \<and> valid_objs s \<and>
|
||||
pspace_aligned s \<and> valid_vspace_objs s \<and> valid_objs s \<and>
|
||||
valid_arch_state s\<rbrace>
|
||||
arch_finalise_cap cap x
|
||||
\<lbrace>\<lambda>rv s. replaceable s sl rv (cap.ArchObjectCap cap)\<rbrace>"
|
||||
|
|
@ -527,24 +527,38 @@ lemma (* suspend_no_cap_to_obj_ref *)[wp,Finalise_AI_asms]:
|
|||
dest!: obj_ref_none_no_asid[rule_format])
|
||||
done
|
||||
|
||||
lemma suspend_unlive':
|
||||
"\<lbrace>bound_tcb_at (op = None) t and valid_mdb and valid_objs and tcb_at t \<rbrace>
|
||||
suspend t
|
||||
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live) t\<rbrace>"
|
||||
apply (simp add: suspend_def set_thread_state_def set_object_def)
|
||||
apply (wp | simp only: obj_at_exst_update)+
|
||||
apply (simp add: obj_at_def)
|
||||
apply (rule_tac Q="\<lambda>_. bound_tcb_at (op = None) t" in hoare_strengthen_post)
|
||||
apply wp
|
||||
apply (auto simp: pred_tcb_def2 live_def hyp_live_def dest: refs_of_live)
|
||||
done
|
||||
|
||||
lemma (* finalise_cap_replaceable *) [Finalise_AI_asms]:
|
||||
"\<lbrace>\<lambda>s. s \<turnstile> cap \<and> x = is_final_cap' cap s \<and> valid_mdb s
|
||||
\<and> cte_wp_at (op = cap) sl s \<and> valid_objs s \<and> sym_refs (state_refs_of s)
|
||||
\<and> (cap_irqs cap \<noteq> {} \<longrightarrow> if_unsafe_then_cap s \<and> valid_global_refs s)
|
||||
\<and> (is_arch_cap cap \<longrightarrow> pspace_aligned s \<and>
|
||||
valid_arch_objs s \<and>
|
||||
valid_vspace_objs s \<and>
|
||||
valid_arch_state s)\<rbrace>
|
||||
finalise_cap cap x
|
||||
\<lbrace>\<lambda>rv s. replaceable s sl (fst rv) cap\<rbrace>"
|
||||
including no_pre
|
||||
apply (cases cap, simp_all add: replaceable_def reachable_pg_cap_def
|
||||
split del: if_split)
|
||||
prefer 10
|
||||
(* TS: this seems to be necessary for deleting_irq_handler,
|
||||
kind of nasty, not sure how to sidestep *)
|
||||
apply ((wp suspend_unlive[unfolded o_def]
|
||||
apply (rule hoare_pre)
|
||||
apply ((wp suspend_unlive'[unfolded o_def]
|
||||
suspend_final_cap[where sl=sl]
|
||||
unbind_maybe_notification_not_bound
|
||||
get_ntfn_ko
|
||||
get_ntfn_ko hoare_vcg_conj_lift
|
||||
unbind_notification_valid_objs
|
||||
| clarsimp simp: o_def dom_tcb_cap_cases_lt_ARCH
|
||||
ran_tcb_cap_cases is_cap_simps
|
||||
|
|
@ -568,16 +582,14 @@ lemma (* finalise_cap_replaceable *) [Finalise_AI_asms]:
|
|||
(wp_once hoare_drop_imps)?,
|
||||
wp_once deleting_irq_handler_empty)
|
||||
| wpc
|
||||
| simp add: valid_cap_simps)+)
|
||||
apply (rule hoare_chain)
|
||||
apply (rule arch_finalise_cap_replaceable[where sl=sl])
|
||||
apply assumption
|
||||
| simp add: valid_cap_simps is_nondevice_page_cap_simps)+)
|
||||
apply (rule hoare_chain)
|
||||
apply (rule arch_finalise_cap_replaceable[where sl=sl])
|
||||
apply (clarsimp simp: replaceable_def reachable_pg_cap_def
|
||||
o_def cap_range_def
|
||||
o_def cap_range_def valid_arch_state_def
|
||||
ran_tcb_cap_cases is_cap_simps
|
||||
obj_irq_refs_subset vs_cap_ref_def)+
|
||||
apply (fastforce split: option.splits vmpage_size.splits)
|
||||
apply (simp add: is_arch_cap_def)
|
||||
apply (fastforce split: option.splits vmpage_size.splits)
|
||||
done
|
||||
|
||||
lemma (* deleting_irq_handler_cte_preserved *)[Finalise_AI_asms]:
|
||||
|
|
@ -935,7 +947,7 @@ lemma replaceable_reset_pt:
|
|||
cte_wp_at (op = (ArchObjectCap cap)) slot s \<and>
|
||||
(\<forall>vs. vs_cap_ref (ArchObjectCap cap) = Some vs \<longrightarrow> \<not> (vs \<unrhd> p) s) \<and>
|
||||
is_final_cap' (ArchObjectCap cap) s \<and>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
replaceable s slot (ArchObjectCap (PageTableCap p None))
|
||||
(ArchObjectCap cap)"
|
||||
apply (elim conjE)
|
||||
|
|
@ -960,7 +972,7 @@ lemma replaceable_reset_pd:
|
|||
cte_wp_at (op = (ArchObjectCap cap)) slot s \<and>
|
||||
(\<forall>vs. vs_cap_ref (ArchObjectCap cap) = Some vs \<longrightarrow> \<not> (vs \<unrhd> p) s) \<and>
|
||||
is_final_cap' (ArchObjectCap cap) s \<and>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
replaceable s slot (ArchObjectCap (PageDirectoryCap p None))
|
||||
(ArchObjectCap cap)"
|
||||
apply (elim conjE)
|
||||
|
|
@ -985,7 +997,7 @@ lemma replaceable_reset_pdpt:
|
|||
cte_wp_at (op = (ArchObjectCap cap)) slot s \<and>
|
||||
(\<forall>vs. vs_cap_ref (ArchObjectCap cap) = Some vs \<longrightarrow> \<not> (vs \<unrhd> p) s) \<and>
|
||||
is_final_cap' (ArchObjectCap cap) s \<and>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
replaceable s slot (ArchObjectCap (PDPointerTableCap p None))
|
||||
(ArchObjectCap cap)"
|
||||
apply (elim conjE)
|
||||
|
|
@ -1010,7 +1022,7 @@ lemma replaceable_reset_pml4:
|
|||
cte_wp_at (op = (ArchObjectCap cap)) slot s \<and>
|
||||
(\<forall>vs. vs_cap_ref (ArchObjectCap cap) = Some vs \<longrightarrow> \<not> (vs \<unrhd> p) s) \<and>
|
||||
is_final_cap' (ArchObjectCap cap) s \<and>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) p s\<rbrakk> \<Longrightarrow>
|
||||
replaceable s slot (ArchObjectCap (PML4Cap p None))
|
||||
(ArchObjectCap cap)"
|
||||
apply (elim conjE)
|
||||
|
|
@ -1100,7 +1112,7 @@ lemma obj_at_empty_tableI:
|
|||
"invs s \<and>
|
||||
(\<forall>x. x \<notin> kernel_mapping_slots \<longrightarrow>
|
||||
pml4e_wp_at (\<lambda>pde. pde = InvalidPML4E) p x s)
|
||||
\<Longrightarrow> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) p s"
|
||||
\<Longrightarrow> obj_at (empty_table (set (second_level_tables (arch_state s)))) p s"
|
||||
apply safe
|
||||
apply (simp add: obj_at_def empty_table_def pml4e_wp_at_def)
|
||||
(* Boring cases *)
|
||||
|
|
@ -1204,7 +1216,7 @@ lemma vs_cap_ref_PageCap_None_Some[simp]:
|
|||
by (case_tac sz; simp add: vs_cap_ref_simps split_def)
|
||||
|
||||
lemma arch_finalise_case_no_lookup:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_objs and
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_objs and
|
||||
valid_cap (cap.ArchObjectCap acap) and valid_arch_state
|
||||
and K (aobj_ref acap = Some w \<and> is_final)\<rbrace>
|
||||
arch_finalise_cap acap is_final
|
||||
|
|
@ -1418,15 +1430,15 @@ lemma valid_arch_state_table_strg:
|
|||
|
||||
lemma valid_table_caps_table [simp]:
|
||||
"valid_table_caps (s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := x64_asid_table'\<rparr>\<rparr>) = valid_table_caps s"
|
||||
by (simp add: valid_table_caps_def)
|
||||
by (simp add: valid_table_caps_def second_level_tables_def)
|
||||
|
||||
lemma valid_global_objs_table [simp]:
|
||||
"valid_global_objs (s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := x64_asid_table'\<rparr>\<rparr>) = valid_global_objs s"
|
||||
by (simp add: valid_global_objs_def)
|
||||
by (simp add: valid_global_objs_def second_level_tables_def)
|
||||
|
||||
lemma valid_kernel_mappings [iff]:
|
||||
"valid_kernel_mappings (s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := x64_asid_table'\<rparr>\<rparr>) = valid_kernel_mappings s"
|
||||
by (simp add: valid_kernel_mappings_def)
|
||||
by (simp add: valid_kernel_mappings_def second_level_tables_def)
|
||||
|
||||
lemma vs_asid_refs_updateD:
|
||||
"(ref', p') \<in> vs_asid_refs (table (x \<mapsto> p))
|
||||
|
|
@ -1507,17 +1519,17 @@ lemma vs_lookup_pages_empty_table:
|
|||
done
|
||||
|
||||
lemma set_asid_pool_empty_table_objs:
|
||||
"\<lbrace>valid_arch_objs and asid_pool_at p\<rbrace>
|
||||
"\<lbrace>valid_vspace_objs and asid_pool_at p\<rbrace>
|
||||
set_asid_pool p empty
|
||||
\<lbrace>\<lambda>rv s. valid_arch_objs
|
||||
\<lbrace>\<lambda>rv s. valid_vspace_objs
|
||||
(s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table :=
|
||||
x64_asid_table (arch_state s)(asid_high_bits_of word2 \<mapsto> p)\<rparr>\<rparr>)\<rbrace>"
|
||||
apply (simp add: set_asid_pool_def set_object_def update_object_def)
|
||||
apply (wp get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def valid_arch_objs_def
|
||||
apply (clarsimp simp: obj_at_def valid_vspace_objs_def
|
||||
simp del: fun_upd_apply
|
||||
split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
|
||||
apply (rule valid_arch_obj_same_type)
|
||||
apply (rule valid_vspace_obj_same_type)
|
||||
prefer 2
|
||||
apply simp
|
||||
prefer 2
|
||||
|
|
|
|||
|
|
@ -304,6 +304,11 @@ definition "data_at \<equiv>
|
|||
\<lambda>sz p s. typ_at (AArch (AUserData sz)) p s
|
||||
\<or> typ_at (AArch (ADeviceData sz)) p s"
|
||||
|
||||
definition
|
||||
valid_arch_tcb :: "arch_tcb \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_arch_tcb \<equiv> \<lambda>a. \<top>"
|
||||
|
||||
(* Validity of vspace table entries, defined shallowly. *)
|
||||
|
||||
primrec
|
||||
|
|
@ -373,17 +378,18 @@ definition
|
|||
"kernel_mapping_slots \<equiv> {x. x \<ge> ucast (pptr_base >> pml4_shift_bits)}"
|
||||
|
||||
primrec
|
||||
valid_arch_obj :: "arch_kernel_obj \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
valid_vspace_obj :: "arch_kernel_obj \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_arch_obj (ASIDPool pool) =
|
||||
"valid_vspace_obj (ASIDPool pool) =
|
||||
(\<lambda>s. \<forall>x \<in> ran pool. typ_at (AArch APageMapL4) x s)"
|
||||
| "valid_arch_obj (PageMapL4 pm) =
|
||||
| "valid_vspace_obj (PageMapL4 pm) =
|
||||
(\<lambda>s. \<forall>x \<in> -kernel_mapping_slots. valid_pml4e (pm x) s)"
|
||||
| "valid_arch_obj (PDPointerTable pdpt) = (\<lambda>s. \<forall>x. valid_pdpte (pdpt x) s)"
|
||||
| "valid_arch_obj (PageDirectory pd) = (\<lambda>s. \<forall>x. valid_pde (pd x) s)"
|
||||
| "valid_arch_obj (PageTable pt) = (\<lambda>s. \<forall>x. valid_pte (pt x) s)"
|
||||
| "valid_arch_obj (DataPage dev sz) = \<top>"
|
||||
| "valid_vspace_obj (PDPointerTable pdpt) = (\<lambda>s. \<forall>x. valid_pdpte (pdpt x) s)"
|
||||
| "valid_vspace_obj (PageDirectory pd) = (\<lambda>s. \<forall>x. valid_pde (pd x) s)"
|
||||
| "valid_vspace_obj (PageTable pt) = (\<lambda>s. \<forall>x. valid_pte (pt x) s)"
|
||||
| "valid_vspace_obj (DataPage dev sz) = \<top>"
|
||||
|
||||
definition "valid_arch_obj \<equiv> valid_vspace_obj"
|
||||
|
||||
(* FIXME x64: check hardware to see if any bits are forbidden *)
|
||||
definition
|
||||
|
|
@ -421,15 +427,20 @@ where
|
|||
| _ \<Rightarrow> True"
|
||||
|
||||
definition
|
||||
wellformed_arch_obj :: "arch_kernel_obj \<Rightarrow> bool"
|
||||
wellformed_vspace_obj :: "arch_kernel_obj \<Rightarrow> bool"
|
||||
where
|
||||
"wellformed_arch_obj ao \<equiv> case ao of
|
||||
"wellformed_vspace_obj ao \<equiv> case ao of
|
||||
PageTable pt \<Rightarrow> (\<forall>pte\<in>range pt. wellformed_pte pte)
|
||||
| PageDirectory pd \<Rightarrow> (\<forall>pde\<in>range pd. wellformed_pde pde)
|
||||
| PDPointerTable pdpt \<Rightarrow> (\<forall>pdpte\<in>range pdpt. wellformed_pdpte pdpte)
|
||||
| PageMapL4 pm \<Rightarrow> (\<forall>pml4e\<in>range pm. wellformed_pml4e pml4e)
|
||||
| _ \<Rightarrow> True"
|
||||
|
||||
definition
|
||||
wellformed_arch_obj :: "arch_kernel_obj \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"wellformed_arch_obj ao s \<equiv> wellformed_vspace_obj ao"
|
||||
|
||||
lemmas
|
||||
wellformed_pte_simps[simp] =
|
||||
wellformed_pte_def[split_simps pte.split]
|
||||
|
|
@ -450,6 +461,13 @@ lemmas
|
|||
wellformed_arch_obj_simps[simp] =
|
||||
wellformed_arch_obj_def[split_simps arch_kernel_obj.split]
|
||||
|
||||
lemmas
|
||||
wellformed_vspace_obj_simps[simp] =
|
||||
wellformed_vspace_obj_def[split_simps arch_kernel_obj.split]
|
||||
|
||||
lemma wellformed_arch_pspace: "\<And>ao. \<lbrakk>wellformed_arch_obj ao s; kheap s = kheap s'\<rbrakk>
|
||||
\<Longrightarrow> wellformed_arch_obj ao s'" by simp
|
||||
|
||||
section "Virtual Memory"
|
||||
|
||||
definition
|
||||
|
|
@ -556,9 +574,7 @@ definition "second_level_tables \<equiv> arch_state.x64_global_pdpts"
|
|||
end
|
||||
|
||||
context begin interpretation Arch .
|
||||
|
||||
requalify_consts vs_lookup
|
||||
|
||||
end
|
||||
|
||||
abbreviation
|
||||
|
|
@ -572,12 +588,22 @@ abbreviation
|
|||
is_reachable_abbr :: "obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> bool" ("\<exists>\<rhd> _" [80] 81) where
|
||||
"\<exists>\<rhd> p \<equiv> \<lambda>s. \<exists>ref. (ref \<rhd> p) s"
|
||||
|
||||
definition
|
||||
valid_vspace_objs :: "'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_vspace_objs \<equiv> \<lambda>s. \<forall>p rs ao. (rs \<rhd> p) s \<longrightarrow> ko_at (ArchObj ao) p s \<longrightarrow> valid_vspace_obj ao s"
|
||||
|
||||
definition
|
||||
valid_arch_objs :: "'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_arch_objs \<equiv> \<lambda>s. \<forall>p rs ao. (rs \<rhd> p) s \<longrightarrow> ko_at (ArchObj ao) p s \<longrightarrow> valid_arch_obj ao s"
|
||||
|
||||
|
||||
lemma valid_arch_imp_valid_vspace_obj: "valid_arch_obj ko s \<Longrightarrow> valid_vspace_obj ko s"
|
||||
by (clarsimp simp: valid_arch_obj_def valid_vspace_obj_def)
|
||||
|
||||
lemma valid_arch_imp_valid_vspace_objs: "valid_arch_objs s \<Longrightarrow> valid_vspace_objs s"
|
||||
by (clarsimp simp: valid_arch_objs_def valid_vspace_objs_def valid_arch_imp_valid_vspace_obj)
|
||||
|
||||
definition
|
||||
pde_ref_pages :: "pde \<Rightarrow> obj_ref option"
|
||||
where
|
||||
|
|
@ -676,6 +702,12 @@ abbreviation
|
|||
|
||||
context Arch begin global_naming X64
|
||||
|
||||
definition
|
||||
"vspace_obj_fun_lift \<equiv> arch_obj_fun_lift"
|
||||
|
||||
lemmas vspace_obj_fun_lift_expand[simp]
|
||||
= arch_obj_fun_lift_expand[folded vspace_obj_fun_lift_def]
|
||||
|
||||
definition
|
||||
pde_mapping_bits :: "nat"
|
||||
where
|
||||
|
|
@ -724,7 +756,7 @@ where
|
|||
declare valid_pt_kernel_mappings_arch_def[simp]
|
||||
|
||||
definition
|
||||
"valid_pt_kernel_mappings vref uses = arch_obj_fun_lift (valid_pt_kernel_mappings_arch vref uses) False"
|
||||
"valid_pt_kernel_mappings vref uses = vspace_obj_fun_lift (valid_pt_kernel_mappings_arch vref uses) False"
|
||||
|
||||
definition
|
||||
valid_pde_kernel_mappings :: "pde \<Rightarrow> vspace_ref \<Rightarrow> x64_vspace_region_uses \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
|
|
@ -756,7 +788,7 @@ where
|
|||
declare valid_pd_kernel_mappings_arch_def[simp]
|
||||
|
||||
definition
|
||||
"valid_pd_kernel_mappings vref uses = (\<lambda>s. arch_obj_fun_lift (valid_pd_kernel_mappings_arch vref uses s) False)"
|
||||
"valid_pd_kernel_mappings vref uses = (\<lambda>s. vspace_obj_fun_lift (valid_pd_kernel_mappings_arch vref uses s) False)"
|
||||
|
||||
definition
|
||||
valid_pdpte_kernel_mappings :: "pdpte \<Rightarrow> vspace_ref \<Rightarrow> x64_vspace_region_uses \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
|
|
@ -788,7 +820,7 @@ where
|
|||
declare valid_pdpt_kernel_mappings_arch_def[simp]
|
||||
|
||||
definition
|
||||
"valid_pdpt_kernel_mappings vref uses = (\<lambda>s. arch_obj_fun_lift (valid_pdpt_kernel_mappings_arch vref uses s) False)"
|
||||
"valid_pdpt_kernel_mappings vref uses = (\<lambda>s. vspace_obj_fun_lift (valid_pdpt_kernel_mappings_arch vref uses s) False)"
|
||||
|
||||
definition
|
||||
valid_pml4e_kernel_mappings :: "pml4e \<Rightarrow> vspace_ref \<Rightarrow> x64_vspace_region_uses \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
|
|
@ -814,7 +846,7 @@ where
|
|||
declare valid_pml4_kernel_mappings_arch_def[simp]
|
||||
|
||||
definition
|
||||
"valid_pml4_kernel_mappings uses = (\<lambda>s. arch_obj_fun_lift (valid_pml4_kernel_mappings_arch uses s) False)"
|
||||
"valid_pml4_kernel_mappings uses = (\<lambda>s. vspace_obj_fun_lift (valid_pml4_kernel_mappings_arch uses s) False)"
|
||||
|
||||
definition
|
||||
valid_global_vspace_mappings :: "'z::state_ext state \<Rightarrow> bool"
|
||||
|
|
@ -823,6 +855,17 @@ where
|
|||
obj_at (valid_pml4_kernel_mappings (x64_kernel_vspace (arch_state s)) s)
|
||||
(x64_global_pml4 (arch_state s)) s"
|
||||
|
||||
fun
|
||||
is_vspace_typ :: "a_type \<Rightarrow> bool"
|
||||
where
|
||||
"is_vspace_typ (AArch _) = True"
|
||||
| "is_vspace_typ _ = False"
|
||||
|
||||
definition
|
||||
valid_vso_at :: "obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_vso_at p \<equiv> \<lambda>s. \<exists>ao. ko_at (ArchObj ao) p s \<and> valid_vspace_obj ao s"
|
||||
|
||||
definition
|
||||
valid_ao_at :: "obj_ref \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
|
|
@ -834,7 +877,6 @@ definition
|
|||
PageMapL4 pm \<Rightarrow>
|
||||
\<forall>x. (\<forall>r. pml4e_ref (pm x) = Some r \<longrightarrow> r \<in> S) \<and>
|
||||
(x \<notin> kernel_mapping_slots \<longrightarrow> pm x = InvalidPML4E)
|
||||
|
||||
| PDPointerTable pdpt \<Rightarrow> \<forall>x. pdpt x = InvalidPDPTE
|
||||
| PageDirectory pd \<Rightarrow> \<forall>x. pd x = InvalidPDE
|
||||
| PageTable pt \<Rightarrow> \<forall>x. pt x = InvalidPTE
|
||||
|
|
@ -896,8 +938,8 @@ definition
|
|||
valid_global_objs :: "'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_global_objs \<equiv>
|
||||
\<lambda>s. valid_ao_at (x64_global_pml4 (arch_state s)) s \<and>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s))))
|
||||
\<lambda>s. valid_vso_at (x64_global_pml4 (arch_state s)) s \<and>
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s))))
|
||||
(x64_global_pml4 (arch_state s)) s \<and>
|
||||
(\<forall>p\<in>set (x64_global_pdpts (arch_state s)).
|
||||
\<exists>pdpt. ko_at (ArchObj (PDPointerTable pdpt)) p s \<and>
|
||||
|
|
@ -938,6 +980,18 @@ where
|
|||
"valid_global_pdpts \<equiv> \<lambda>s.
|
||||
\<forall>p \<in> set (x64_global_pdpts (arch_state s)). typ_at (AArch APDPointerTable) p s"
|
||||
|
||||
(* arch_live/hyp_live stub *)
|
||||
|
||||
definition
|
||||
arch_live :: "arch_kernel_obj \<Rightarrow> bool"
|
||||
where
|
||||
"arch_live ao \<equiv> False"
|
||||
|
||||
definition
|
||||
hyp_live :: "kernel_object \<Rightarrow> bool"
|
||||
where
|
||||
"hyp_live ko \<equiv> False"
|
||||
|
||||
definition
|
||||
valid_arch_state :: "'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
|
|
@ -1002,16 +1056,13 @@ definition
|
|||
"is_page_cap cap \<equiv> \<exists>d p R tp sz m. cap = PageCap d p R tp sz m"
|
||||
|
||||
definition
|
||||
"is_pml4_cap c \<equiv>
|
||||
\<exists>p asid. c = ArchObjectCap (PML4Cap p asid)"
|
||||
"is_pml4_cap c \<equiv> \<exists>p asid. c = ArchObjectCap (PML4Cap p asid)"
|
||||
|
||||
definition
|
||||
"is_pdpt_cap c \<equiv>
|
||||
\<exists>p asid. c = ArchObjectCap (PDPointerTableCap p asid)"
|
||||
"is_pdpt_cap c \<equiv> \<exists>p asid. c = ArchObjectCap (PDPointerTableCap p asid)"
|
||||
|
||||
definition
|
||||
"is_pd_cap c \<equiv>
|
||||
\<exists>p asid. c = ArchObjectCap (PageDirectoryCap p asid)"
|
||||
"is_pd_cap c \<equiv> \<exists>p asid. c = ArchObjectCap (PageDirectoryCap p asid)"
|
||||
|
||||
definition
|
||||
"is_pt_cap c \<equiv> \<exists>p asid. c = ArchObjectCap (PageTableCap p asid)"
|
||||
|
|
@ -1082,7 +1133,7 @@ definition
|
|||
(is_pd_cap cap \<or> is_pt_cap cap \<or> is_pdpt_cap cap \<or> is_pml4_cap cap) \<longrightarrow>
|
||||
cap_asid cap = None \<longrightarrow>
|
||||
r \<in> obj_refs cap \<longrightarrow>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) r s"
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) r s"
|
||||
|
||||
(* needed to preserve valid_table_caps in map
|
||||
enforces no sharing of tables *)
|
||||
|
|
@ -1141,7 +1192,7 @@ where
|
|||
"valid_kernel_mappings \<equiv>
|
||||
\<lambda>s. \<forall>ko \<in> ran (kheap s).
|
||||
valid_kernel_mappings_if_pm
|
||||
(set (x64_global_pdpts (arch_state s)) ) ko"
|
||||
(set (second_level_tables (arch_state s))) ko"
|
||||
|
||||
definition
|
||||
"valid_arch_caps \<equiv> valid_vs_lookup and valid_table_caps and
|
||||
|
|
@ -1311,6 +1362,10 @@ lemma valid_arch_objsD:
|
|||
"\<lbrakk> (ref \<rhd> p) s; ko_at (ArchObj ao) p s; valid_arch_objs s \<rbrakk> \<Longrightarrow> valid_arch_obj ao s"
|
||||
by (fastforce simp add: valid_arch_objs_def)
|
||||
|
||||
lemma valid_vspace_objsD:
|
||||
"\<lbrakk> (ref \<rhd> p) s; ko_at (ArchObj ao) p s; valid_vspace_objs s \<rbrakk> \<Longrightarrow> valid_vspace_obj ao s"
|
||||
by (fastforce simp add: valid_vspace_objs_def)
|
||||
|
||||
(* should work for unmap and non-arch ops *)
|
||||
lemma valid_arch_objs_stateI:
|
||||
assumes 1: "valid_arch_objs s"
|
||||
|
|
@ -1329,6 +1384,23 @@ lemma valid_arch_objs_stateI:
|
|||
apply (erule (3) vao)
|
||||
done
|
||||
|
||||
lemma valid_vspace_objs_stateI:
|
||||
assumes 1: "valid_vspace_objs s"
|
||||
assumes ko: "\<And>ko p. ko_at ko p s' \<Longrightarrow> obj_at (\<lambda>ko'. vs_refs ko \<subseteq> vs_refs ko') p s"
|
||||
assumes arch: "graph_of (x64_asid_table (arch_state s')) \<subseteq> graph_of (x64_asid_table (arch_state s))"
|
||||
assumes vao: "\<And>p ref ao'.
|
||||
\<lbrakk> (ref \<rhd> p) s; (ref \<rhd> p) s'; \<forall>ao. ko_at (ArchObj ao) p s \<longrightarrow> valid_vspace_obj ao s;
|
||||
ko_at (ArchObj ao') p s' \<rbrakk> \<Longrightarrow> valid_vspace_obj ao' s'"
|
||||
shows "valid_vspace_objs s'"
|
||||
using 1 unfolding valid_vspace_objs_def
|
||||
apply clarsimp
|
||||
apply (frule vs_lookup_stateI)
|
||||
apply (erule ko)
|
||||
apply (rule arch)
|
||||
apply (erule allE, erule impE, fastforce)
|
||||
apply (erule (3) vao)
|
||||
done
|
||||
|
||||
lemma valid_arch_cap_typ:
|
||||
assumes P: "\<And>T p. \<lbrace>\<lambda>s. (typ_at (AArch T) p s )\<rbrace> f \<lbrace>\<lambda>rv s. (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. valid_arch_cap c s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_cap c s\<rbrace>"
|
||||
|
|
@ -1336,9 +1408,9 @@ lemma valid_arch_cap_typ:
|
|||
apply (case_tac c, simp_all)
|
||||
by (wp P hoare_vcg_ball_lift hoare_vcg_imp_lift hoare_vcg_conj_lift | clarsimp)+
|
||||
|
||||
lemma valid_arch_obj_typ:
|
||||
lemma valid_vspace_obj_typ:
|
||||
assumes P: "\<And>p T. \<lbrace>\<lambda>s. (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. valid_arch_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_obj ob s\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. valid_vspace_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_vspace_obj ob s\<rbrace>"
|
||||
apply (cases ob, simp_all)
|
||||
apply (rule hoare_vcg_const_Ball_lift[OF P])
|
||||
apply (rule hoare_vcg_all_lift)
|
||||
|
|
@ -1357,6 +1429,13 @@ lemma valid_arch_obj_typ:
|
|||
apply (case_tac "fun x", simp_all add: hoare_vcg_prop P)
|
||||
done
|
||||
|
||||
lemma valid_arch_obj_typ:
|
||||
assumes P: "\<And>p T. \<lbrace>\<lambda>s. (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. valid_arch_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_obj ob s\<rbrace>"
|
||||
by (wpsimp simp: valid_arch_obj_def wp: valid_vspace_obj_typ P)
|
||||
|
||||
lemmas valid_arch_obj_typ_gen = valid_arch_obj_typ
|
||||
|
||||
lemma atyp_at_eq_kheap_obj:
|
||||
"typ_at (AArch AASIDPool) p s \<longleftrightarrow> (\<exists>f. kheap s p = Some (ArchObj (ASIDPool f)))"
|
||||
"typ_at (AArch APageTable) p s \<longleftrightarrow> (\<exists>pt. kheap s p = Some (ArchObj (PageTable pt)))"
|
||||
|
|
@ -1406,8 +1485,13 @@ lemmas aa_type_elims[elim!] =
|
|||
aa_type_AASIDPoolE aa_type_AUserDataE aa_type_ADeviceDataE
|
||||
aa_type_APageDirectoryE aa_type_APageTableE aa_type_APDPointerTableE aa_type_APageMapL4E
|
||||
|
||||
lemma valid_arch_obj_pspaceI:
|
||||
"\<lbrakk> valid_arch_obj obj s; kheap s = kheap s' \<rbrakk> \<Longrightarrow> valid_arch_obj obj s'"
|
||||
lemma wellformed_arch_typ:
|
||||
assumes P: "\<And>P p T. \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. wellformed_arch_obj ao s\<rbrace> f \<lbrace>\<lambda>rv s. wellformed_arch_obj ao s\<rbrace>"
|
||||
by (cases ao; clarsimp; wp)
|
||||
|
||||
lemma valid_vspace_obj_pspaceI:
|
||||
"\<lbrakk> valid_vspace_obj obj s; kheap s = kheap s' \<rbrakk> \<Longrightarrow> valid_vspace_obj obj s'"
|
||||
apply (cases obj, simp_all add: obj_at_def)
|
||||
apply (erule allEI ballEI,
|
||||
rename_tac "fun" x,
|
||||
|
|
@ -1415,6 +1499,10 @@ lemma valid_arch_obj_pspaceI:
|
|||
simp_all add: obj_at_def data_at_def)+
|
||||
done
|
||||
|
||||
lemma valid_arch_obj_pspaceI:
|
||||
"\<lbrakk> valid_arch_obj obj s; kheap s = kheap s' \<rbrakk> \<Longrightarrow> valid_arch_obj obj s'"
|
||||
by (auto simp: valid_arch_obj_def elim: valid_vspace_obj_pspaceI)
|
||||
|
||||
lemmas pageBitsForSize_simps[simp] =
|
||||
pageBitsForSize_def[split_simps vmpage_size.split]
|
||||
|
||||
|
|
@ -1498,9 +1586,17 @@ lemma valid_pml4e_update [iff]:
|
|||
"valid_pml4e pml4e (f s) = valid_pml4e pml4e s"
|
||||
by (cases pml4e) auto
|
||||
|
||||
lemma valid_vspace_obj_update [iff]:
|
||||
"valid_vspace_obj ao (f s) = valid_vspace_obj ao s"
|
||||
by (cases ao) auto
|
||||
|
||||
lemma valid_arch_obj_update [iff]:
|
||||
"valid_arch_obj ao (f s) = valid_arch_obj ao s"
|
||||
by (cases ao) auto
|
||||
by (auto simp: valid_arch_obj_def)
|
||||
|
||||
lemma valid_vso_at_update [iff]:
|
||||
"valid_vso_at p (f s) = valid_vso_at p s"
|
||||
by (simp add: valid_vso_at_def)
|
||||
|
||||
lemma valid_ao_at_update [iff]:
|
||||
"valid_ao_at p (f s) = valid_ao_at p s"
|
||||
|
|
@ -1555,6 +1651,10 @@ lemma caps_of_state_update [iff]:
|
|||
"caps_of_state (f s) = caps_of_state s"
|
||||
by (rule ext) (auto simp: caps_of_state_def)
|
||||
|
||||
lemma wellformed_arch_obj_update:
|
||||
"\<And>ao. b = ArchObj ao \<Longrightarrow> wellformed_arch_obj ao (f s) = wellformed_arch_obj ao s"
|
||||
by clarsimp
|
||||
|
||||
end
|
||||
|
||||
context Arch_arch_idle_update_eq begin
|
||||
|
|
@ -1691,9 +1791,11 @@ lemma pte_at_atyp:
|
|||
shows "\<lbrace>pte_at p\<rbrace> f \<lbrace>\<lambda>rv. pte_at p\<rbrace>"
|
||||
by (simp add: pte_at_def | wp x)+
|
||||
|
||||
lemmas abs_atyp_at_lifts =
|
||||
lemmas valid_table_entry_lifts =
|
||||
valid_pde_lift valid_pte_lift valid_pdpte_lift valid_pml4e_lift
|
||||
pde_at_atyp pte_at_atyp pdpte_at_atyp pml4e_at_atyp
|
||||
|
||||
lemmas abs_atyp_at_lifts =
|
||||
valid_table_entry_lifts pde_at_atyp pte_at_atyp pdpte_at_atyp pml4e_at_atyp
|
||||
|
||||
lemma table_size:
|
||||
"table_size = 12"
|
||||
|
|
@ -1799,7 +1901,7 @@ lemma vs_lookup1_ko_at_dest:
|
|||
\<and> aa_type ao = tp)"
|
||||
apply (drule vs_lookup1D)
|
||||
apply (clarsimp simp: obj_at_def vs_refs_def)
|
||||
apply (cases ao, simp_all add: graph_of_def)
|
||||
apply (cases ao, simp_all add: graph_of_def valid_arch_obj_def)
|
||||
apply clarsimp
|
||||
apply (drule bspec, fastforce simp: ran_def)
|
||||
apply (clarsimp simp: aa_type_def obj_at_def)
|
||||
|
|
@ -2060,6 +2162,57 @@ lemma vs_lookup_pages_ptI:
|
|||
vs_refs_pages_def graph_of_def image_def
|
||||
split: if_split_asm)
|
||||
|
||||
lemma stronger_vspace_objsD_lemma:
|
||||
"\<lbrakk>valid_vspace_objs s; r \<in> vs_lookup s; (r,r') \<in> (vs_lookup1 s)\<^sup>+ \<rbrakk>
|
||||
\<Longrightarrow> \<exists>ao. ko_at (ArchObj ao) (snd r') s \<and>
|
||||
valid_vspace_obj ao s"
|
||||
apply (erule trancl_induct)
|
||||
apply (frule vs_lookup1_is_arch)
|
||||
apply (cases r)
|
||||
apply clarsimp
|
||||
apply (frule (2) valid_vspace_objsD)
|
||||
apply (simp only: valid_arch_obj_def[symmetric])
|
||||
apply (drule (1) vs_lookup_step)
|
||||
apply (drule (2) vs_lookup1_ko_at_dest)
|
||||
apply clarsimp
|
||||
apply (drule (2) valid_vspace_objsD)
|
||||
apply (fastforce simp: valid_arch_obj_def)
|
||||
apply clarsimp
|
||||
apply (simp only: valid_arch_obj_def[symmetric])
|
||||
apply (frule (2) vs_lookup1_ko_at_dest)
|
||||
apply (drule (1) vs_lookup_trancl_step)
|
||||
apply (drule (1) vs_lookup_step)
|
||||
apply clarsimp
|
||||
apply (drule (2) valid_vspace_objsD)
|
||||
apply (fastforce simp: valid_arch_obj_def)
|
||||
done
|
||||
|
||||
lemma stronger_vspace_objsD:
|
||||
"\<lbrakk> (ref \<rhd> p) s;
|
||||
valid_vspace_objs s;
|
||||
valid_asid_table (x64_asid_table (arch_state s)) s \<rbrakk> \<Longrightarrow>
|
||||
\<exists>ao. ko_at (ArchObj ao) p s \<and>
|
||||
valid_vspace_obj ao s"
|
||||
apply (clarsimp simp: vs_lookup_def vs_asid_refs_def graph_of_def)
|
||||
apply (clarsimp simp: valid_asid_table_def)
|
||||
apply (drule bspec, fastforce simp: ran_def)
|
||||
apply (drule rtranclD)
|
||||
apply (erule disjE)
|
||||
prefer 2
|
||||
apply clarsimp
|
||||
apply (drule stronger_vspace_objsD_lemma)
|
||||
apply (erule vs_lookup_atI)
|
||||
apply assumption
|
||||
apply clarsimp
|
||||
apply clarsimp
|
||||
apply (simp add: valid_vspace_objs_def)
|
||||
apply (erule_tac x=p in allE)
|
||||
apply (erule impE)
|
||||
apply (rule exI)
|
||||
apply (erule vs_lookup_atI)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
done
|
||||
|
||||
lemma stronger_arch_objsD_lemma:
|
||||
"\<lbrakk>valid_arch_objs s; r \<in> vs_lookup s; (r,r') \<in> (vs_lookup1 s)\<^sup>+ \<rbrakk>
|
||||
\<Longrightarrow> \<exists>ao. ko_at (ArchObj ao) (snd r') s \<and>
|
||||
|
|
@ -2124,15 +2277,15 @@ lemma all_valid_pde_pt_at:
|
|||
\<Longrightarrow> typ_at (AArch APageTable) (ptrFromPAddr pt_ref) s"
|
||||
by (drule spec[where x=i]; simp)
|
||||
|
||||
(* An alternative definition for valid_arch_objs.
|
||||
(* An alternative definition for valid_vspace_objs.
|
||||
|
||||
The predicates valid_asid_table and valid_arch_objs are very compact
|
||||
The predicates valid_asid_table and valid_vspace_objs are very compact
|
||||
but sometimes hard to use.
|
||||
The lemma below basically unrolls vs_lookup.
|
||||
Though less elegant, this formulation better separates the relevant cases. *)
|
||||
lemma valid_arch_objs_alt:
|
||||
lemma valid_vspace_objs_alt:
|
||||
"(\<forall>p\<in>ran (x64_asid_table (arch_state s)). asid_pool_at p s) \<and>
|
||||
valid_arch_objs s \<longleftrightarrow>
|
||||
valid_vspace_objs s \<longleftrightarrow>
|
||||
(\<forall>a p. x64_asid_table (arch_state s) a = Some p \<longrightarrow>
|
||||
typ_at (AArch AASIDPool) p s) \<and>
|
||||
(\<forall>a p\<^sub>1 ap b p.
|
||||
|
|
@ -2189,40 +2342,40 @@ lemma valid_arch_objs_alt:
|
|||
apply (clarsimp simp: obj_at_def)
|
||||
apply (thin_tac "Ball S P" for S P)
|
||||
apply (frule vs_lookup_atI)
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: obj_at_def)
|
||||
apply assumption
|
||||
apply (simp add: obj_at_def ranI)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (thin_tac "Ball S P" for S P)
|
||||
apply (frule (2) vs_lookup_apI)
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: obj_at_def)
|
||||
apply assumption
|
||||
apply fastforce
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (thin_tac "Ball S P" for S P)
|
||||
apply (frule (5) vs_lookup_pml4I)
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: obj_at_def)
|
||||
apply assumption
|
||||
apply fastforce
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (thin_tac "Ball S P" for S P)
|
||||
apply (frule (7) vs_lookup_pdptI)
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: obj_at_def)
|
||||
apply assumption
|
||||
apply fastforce
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (thin_tac "Ball S P" for S P)
|
||||
apply (frule (9) vs_lookup_pdI)
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: obj_at_def)
|
||||
apply assumption
|
||||
apply fastforce
|
||||
apply (clarsimp simp: ran_def)
|
||||
apply (clarsimp simp: valid_arch_objs_def vs_lookup_def vs_asid_refs_def graph_of_def)
|
||||
apply (clarsimp simp: valid_vspace_objs_def vs_lookup_def vs_asid_refs_def graph_of_def)
|
||||
apply (drule spec, drule spec, erule impE, assumption)+
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (erule converse_rtranclE)
|
||||
|
|
@ -2270,7 +2423,7 @@ private lemmas exIs = exI exI_conj1
|
|||
|
||||
context
|
||||
fixes s :: "'a::state_ext state"
|
||||
assumes valid_objs: "valid_arch_objs s"
|
||||
assumes valid_objs: "valid_vspace_objs s"
|
||||
assumes asid_table: "\<forall>p\<in>ran (x64_asid_table (arch_state s)). asid_pool_at p s"
|
||||
begin
|
||||
|
||||
|
|
@ -2283,7 +2436,7 @@ lemma valid_arch_objs_alt2:
|
|||
\<and> (\<forall> j p\<^sub>1. ap j = Some p\<^sub>1 \<longrightarrow>
|
||||
(\<exists> pm. ako_at (PageMapL4 pm) p\<^sub>1 s
|
||||
\<and> (\<forall> k. k \<notin> kernel_mapping_slots \<longrightarrow> valid_pml4e_rec (pm k) s))))"
|
||||
using iffD1[OF valid_arch_objs_alt, OF conjI[OF asid_table valid_objs]]
|
||||
using iffD1[OF valid_vspace_objs_alt, OF conjI[OF asid_table valid_objs]]
|
||||
apply (clarsimp simp: valid_pml4e_def valid_pdpte_def valid_pde_def valid_pte_def)
|
||||
apply (drule_tac x=i in spec; clarsimp simp: obj_at_def)+
|
||||
apply (drule_tac x=j in spec; clarsimp simp: obj_at_def pml4e_ref_def split: pml4e.splits)+
|
||||
|
|
@ -2329,7 +2482,7 @@ end
|
|||
lemma vs_lookup_vs_lookup_pagesI':
|
||||
assumes "(r \<unrhd> p) s"
|
||||
"asid_pool_at p s \<or> vspace_table_at p s"
|
||||
"valid_arch_objs s"
|
||||
"valid_vspace_objs s"
|
||||
"valid_asid_table (x64_asid_table (arch_state s)) s"
|
||||
shows "(r \<rhd> p) s"
|
||||
using assms by (simp add: valid_asid_table_def vs_lookup_vs_lookup_pagesI'')
|
||||
|
|
@ -2337,12 +2490,12 @@ lemma vs_lookup_vs_lookup_pagesI':
|
|||
lemma valid_arch_objsD':
|
||||
assumes lkp: "(ref \<unrhd> p) s"
|
||||
assumes koa: "ko_at (ArchObj ako) p s"
|
||||
assumes vao: "valid_arch_objs s"
|
||||
assumes vao: "valid_vspace_objs s"
|
||||
assumes vat: "valid_asid_table (x64_asid_table (arch_state s)) s"
|
||||
shows "valid_arch_obj ako s"
|
||||
shows "valid_vspace_obj ako s"
|
||||
proof -
|
||||
note lku = vs_lookup_vs_lookup_pagesI'[OF lkp _ vao vat]
|
||||
note vao = valid_arch_objsD[OF lku koa vao]
|
||||
note vao = valid_vspace_objsD[OF lku koa vao]
|
||||
show ?thesis using koa
|
||||
by - (cases ako; (rule vao; clarsimp simp: obj_at_def a_type_def; fail)?; clarsimp)
|
||||
qed
|
||||
|
|
@ -2367,7 +2520,7 @@ lemma vs_lookupE:
|
|||
NOTE: effectively rely on valid_objs and valid_asid_table *)
|
||||
lemma vs_lookupE_alt:
|
||||
assumes vl: "(ref \<rhd> p) s"
|
||||
assumes va: "valid_arch_objs s"
|
||||
assumes va: "valid_vspace_objs s"
|
||||
assumes vt: "(\<forall>p\<in>ran (x64_asid_table (arch_state s)). asid_pool_at p s)"
|
||||
assumes 0: "\<And>a. x64_asid_table (arch_state s) a = Some p \<Longrightarrow>
|
||||
typ_at (AArch AASIDPool) p s \<Longrightarrow>
|
||||
|
|
@ -2408,7 +2561,7 @@ lemma vs_lookupE_alt:
|
|||
VSRef (ucast b) (Some AASIDPool), VSRef (ucast a) None] p"
|
||||
shows "R ref p"
|
||||
proof -
|
||||
note vao = valid_arch_objs_alt[THEN iffD1, OF conjI[OF vt va]]
|
||||
note vao = valid_vspace_objs_alt[THEN iffD1, OF conjI[OF vt va]]
|
||||
note vat = vao[THEN conjunct1, rule_format]
|
||||
note vap = vao[THEN conjunct2, THEN conjunct1, rule_format]
|
||||
note vpm = vao[THEN conjunct2, THEN conjunct2, THEN conjunct1, rule_format]
|
||||
|
|
@ -2458,7 +2611,7 @@ qed
|
|||
|
||||
lemma vs_lookup_pagesE_alt:
|
||||
assumes vl: "(ref \<unrhd> p) s"
|
||||
assumes va: "valid_arch_objs s"
|
||||
assumes va: "valid_vspace_objs s"
|
||||
assumes vt: "(\<forall>p\<in>ran (x64_asid_table (arch_state s)). asid_pool_at p s)"
|
||||
assumes 0: "\<And>a. x64_asid_table (arch_state s) a = Some p \<Longrightarrow>
|
||||
typ_at (AArch AASIDPool) p s \<Longrightarrow>
|
||||
|
|
@ -2515,7 +2668,7 @@ lemma vs_lookup_pagesE_alt:
|
|||
VSRef (ucast b) (Some AASIDPool), VSRef (ucast a) None] p"
|
||||
shows "R ref p"
|
||||
proof -
|
||||
note vao = valid_arch_objs_alt[THEN iffD1, OF conjI[OF vt va]]
|
||||
note vao = valid_vspace_objs_alt[THEN iffD1, OF conjI[OF vt va]]
|
||||
note vat = vao[THEN conjunct1, rule_format]
|
||||
note vap = vao[THEN conjunct2, THEN conjunct1, rule_format]
|
||||
note vpm = vao[THEN conjunct2, THEN conjunct2, THEN conjunct1, rule_format]
|
||||
|
|
@ -2628,9 +2781,9 @@ lemma aa_type_pdD:
|
|||
split: arch_kernel_obj.splits if_split_asm)
|
||||
|
||||
lemma empty_table_is_valid:
|
||||
"\<lbrakk>empty_table (set (x64_global_pdpts (arch_state s))) (ArchObj ao);
|
||||
"\<lbrakk>empty_table (set (second_level_tables (arch_state s))) (ArchObj ao);
|
||||
valid_arch_state s\<rbrakk>
|
||||
\<Longrightarrow> valid_arch_obj ao s"
|
||||
\<Longrightarrow> valid_vspace_obj ao s"
|
||||
by (cases ao, simp_all add: empty_table_def)
|
||||
|
||||
lemma empty_table_pml4e_refD:
|
||||
|
|
@ -2651,7 +2804,7 @@ lemma valid_global_pdptsD:
|
|||
lemma valid_table_caps_pdD:
|
||||
"\<lbrakk> caps_of_state s p = Some (ArchObjectCap (PageDirectoryCap pd None));
|
||||
valid_table_caps s \<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) pd s"
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) pd s"
|
||||
apply (clarsimp simp: valid_table_caps_def simp del: split_paired_All)
|
||||
apply (erule allE)+
|
||||
apply (erule (1) impE)
|
||||
|
|
@ -2702,7 +2855,7 @@ lemma vs_lookup_pages_induct:
|
|||
done
|
||||
|
||||
lemma vs_ref_order:
|
||||
"\<lbrakk> (r \<rhd> p) s; valid_arch_objs s; valid_arch_state s \<rbrakk>
|
||||
"\<lbrakk> (r \<rhd> p) s; valid_vspace_objs s; valid_arch_state s \<rbrakk>
|
||||
\<Longrightarrow> \<exists>tp. r \<noteq> [] \<and> typ_at (AArch tp) p s \<and>
|
||||
rev (Some tp # map vs_ref_aatype r)
|
||||
\<le> [None, Some AASIDPool, Some APageMapL4, Some APDPointerTable,
|
||||
|
|
@ -2713,14 +2866,14 @@ lemma vs_ref_order:
|
|||
apply (clarsimp simp: vs_refs_def a_type_simps
|
||||
split: kernel_object.split_asm arch_kernel_obj.split_asm
|
||||
dest!: graph_ofD)
|
||||
apply (drule valid_arch_objsD, simp add: obj_at_def, assumption)
|
||||
apply (drule valid_vspace_objsD, simp add: obj_at_def, assumption)
|
||||
apply (case_tac rs; simp)
|
||||
apply (case_tac list; simp add: ranI)
|
||||
apply (case_tac lista; simp add: ranI)
|
||||
apply (case_tac listb; simp)
|
||||
apply (case_tac listc; simp)
|
||||
apply (frule prefix_length_le, clarsimp)
|
||||
apply (drule valid_arch_objsD, simp add: obj_at_def, assumption)
|
||||
apply (drule valid_vspace_objsD, simp add: obj_at_def, assumption)
|
||||
apply (clarsimp simp: pde_ref_def split: pde.split_asm)
|
||||
apply (drule_tac x=a in spec, simp)
|
||||
apply (case_tac rs; simp)
|
||||
|
|
@ -2729,7 +2882,7 @@ lemma vs_ref_order:
|
|||
apply (case_tac listb; simp)
|
||||
apply (case_tac listc; simp)
|
||||
apply (frule prefix_length_le, clarsimp)
|
||||
apply (drule valid_arch_objsD, simp add: obj_at_def, assumption)
|
||||
apply (drule valid_vspace_objsD, simp add: obj_at_def, assumption)
|
||||
apply (clarsimp simp: pdpte_ref_def split: pdpte.split_asm)
|
||||
apply (drule_tac x=a in spec, simp)
|
||||
apply (case_tac rs; simp)
|
||||
|
|
@ -2738,7 +2891,7 @@ lemma vs_ref_order:
|
|||
apply (case_tac listb; simp)
|
||||
apply (case_tac listc; simp)
|
||||
apply (frule prefix_length_le, clarsimp)
|
||||
apply (drule valid_arch_objsD, simp add: obj_at_def, assumption)
|
||||
apply (drule valid_vspace_objsD, simp add: obj_at_def, assumption)
|
||||
apply (clarsimp simp: pml4e_ref_def split: pml4e.split_asm if_split_asm)
|
||||
apply (drule_tac x=a in bspec, simp)
|
||||
apply (case_tac rs; simp)
|
||||
|
|
@ -2772,10 +2925,10 @@ lemma valid_pml4e_lift2:
|
|||
assumes x: "\<And>T p. \<lbrace>Q and typ_at (AArch T) p\<rbrace> f \<lbrace>\<lambda>rv. typ_at (AArch T) p\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_pml4e pde s\<rbrace> f \<lbrace>\<lambda>rv s. valid_pml4e pde s\<rbrace>"
|
||||
by (cases pde) (simp | wp x)+
|
||||
|
||||
lemma valid_arch_obj_typ2:
|
||||
|
||||
lemma valid_vspace_obj_typ2:
|
||||
assumes P: "\<And>P p T. \<lbrace>\<lambda>s. Q s \<and> P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_arch_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_obj ob s\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_vspace_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_vspace_obj ob s\<rbrace>"
|
||||
apply (cases ob, simp_all)
|
||||
by (wp hoare_vcg_all_lift hoare_vcg_ball_lift valid_pte_lift2 hoare_vcg_const_Ball_lift[OF P]
|
||||
valid_pde_lift2 valid_pdpte_lift2 valid_pml4e_lift2 P
|
||||
|
|
@ -2783,10 +2936,18 @@ lemma valid_arch_obj_typ2:
|
|||
| assumption
|
||||
| rule hoare_pre)+
|
||||
|
||||
lemma valid_arch_obj_typ2:
|
||||
assumes P: "\<And>P p T. \<lbrace>\<lambda>s. Q s \<and> P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. Q s \<and> valid_arch_obj ob s\<rbrace> f \<lbrace>\<lambda>rv s. valid_arch_obj ob s\<rbrace>"
|
||||
using assms unfolding valid_arch_obj_def by (rule valid_vspace_obj_typ2)
|
||||
|
||||
lemma valid_arch_objsI [intro?]:
|
||||
"(\<And>p ao. \<lbrakk> (\<exists>\<rhd> p) s; ko_at (ArchObj ao) p s \<rbrakk> \<Longrightarrow> valid_arch_obj ao s) \<Longrightarrow> valid_arch_objs s"
|
||||
by (simp add: valid_arch_objs_def)
|
||||
|
||||
lemma valid_vspace_objsI [intro?]:
|
||||
"(\<And>p ao. \<lbrakk> (\<exists>\<rhd> p) s; ko_at (ArchObj ao) p s \<rbrakk> \<Longrightarrow> valid_vspace_obj ao s) \<Longrightarrow> valid_vspace_objs s"
|
||||
by (simp add: valid_vspace_objs_def)
|
||||
|
||||
lemma vs_lookup1_stateI2:
|
||||
assumes 1: "(r \<rhd>1 r') s"
|
||||
|
|
@ -2969,21 +3130,33 @@ lemma in_user_frame_lift:
|
|||
by (wp hoare_vcg_ex_lift typ_at)
|
||||
|
||||
lemma wellformed_arch_default:
|
||||
"wellformed_arch_obj (default_arch_object aobject_type dev us)"
|
||||
"wellformed_arch_obj (default_arch_object aobject_type dev us) s"
|
||||
unfolding wellformed_arch_obj_def default_arch_object_def
|
||||
by (cases aobject_type; simp)
|
||||
|
||||
lemma valid_arch_obj_default':
|
||||
"valid_arch_obj (default_arch_object aobject_type dev us) s"
|
||||
unfolding default_arch_object_def
|
||||
by (cases aobject_type; simp add: valid_arch_obj_def)
|
||||
|
||||
lemma valid_vspace_obj_default':
|
||||
"valid_vspace_obj (default_arch_object aobject_type dev us) s"
|
||||
unfolding default_arch_object_def
|
||||
by (cases aobject_type; simp)
|
||||
|
||||
lemma valid_vspace_obj_entryD:
|
||||
shows valid_vspace_obj_pml4eD: "\<lbrakk>valid_vspace_obj (PageMapL4 pm) s; pm i = pml4e; i \<notin> kernel_mapping_slots\<rbrakk> \<Longrightarrow> valid_pml4e pml4e s"
|
||||
and valid_vspace_obj_pdpteD: "\<lbrakk>valid_vspace_obj (PDPointerTable pdpt) s; pdpt i = pdpte\<rbrakk> \<Longrightarrow> valid_pdpte pdpte s"
|
||||
and valid_vspace_obj_pdeD : "\<lbrakk>valid_vspace_obj (PageDirectory pd) s; pd i = pde\<rbrakk> \<Longrightarrow> valid_pde pde s"
|
||||
and valid_vspace_obj_pteD : "\<lbrakk>valid_vspace_obj (PageTable pt) s; pt i = pte\<rbrakk> \<Longrightarrow> valid_pte pte s"
|
||||
by fastforce+
|
||||
|
||||
lemma valid_arch_obj_entryD:
|
||||
shows valid_arch_obj_pml4eD: "\<lbrakk>valid_arch_obj (PageMapL4 pm) s; pm i = pml4e; i \<notin> kernel_mapping_slots\<rbrakk> \<Longrightarrow> valid_pml4e pml4e s"
|
||||
and valid_arch_obj_pdpteD: "\<lbrakk>valid_arch_obj (PDPointerTable pdpt) s; pdpt i = pdpte\<rbrakk> \<Longrightarrow> valid_pdpte pdpte s"
|
||||
and valid_arch_obj_pdeD : "\<lbrakk>valid_arch_obj (PageDirectory pd) s; pd i = pde\<rbrakk> \<Longrightarrow> valid_pde pde s"
|
||||
and valid_arch_obj_pteD : "\<lbrakk>valid_arch_obj (PageTable pt) s; pt i = pte\<rbrakk> \<Longrightarrow> valid_pte pte s"
|
||||
by fastforce+
|
||||
using valid_vspace_obj_entryD unfolding valid_arch_obj_def by auto
|
||||
|
||||
lemmas valid_arch_objsD_alt'
|
||||
= valid_arch_objsD[simplified obj_at_def, simplified]
|
||||
|
|
@ -2991,6 +3164,12 @@ lemmas valid_arch_objsD_alt'
|
|||
lemmas valid_arch_objs_entryD
|
||||
= valid_arch_obj_entryD[OF valid_arch_objsD_alt']
|
||||
|
||||
lemmas valid_vspace_objsD_alt'
|
||||
= valid_vspace_objsD[simplified obj_at_def, simplified]
|
||||
|
||||
lemmas valid_vspace_objs_entryD
|
||||
= valid_vspace_obj_entryD[OF valid_vspace_objsD_alt']
|
||||
|
||||
lemmas vs_lookup_step_alt
|
||||
= vs_lookup_step[OF _ vs_lookup1I[OF _ _ refl], simplified obj_at_def, simplified]
|
||||
|
||||
|
|
@ -3012,18 +3191,205 @@ lemma vs_refs_pdptI:
|
|||
apply (rule ccontr, auto)
|
||||
done
|
||||
|
||||
end
|
||||
text {* arch specific symrefs *} (* hyp_ref stubs : for compatibility with arm-hyp *)
|
||||
|
||||
(*
|
||||
context p_arch_update_eq begin
|
||||
definition
|
||||
tcb_hyp_refs :: "arch_tcb \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"tcb_hyp_refs atcb \<equiv> {}"
|
||||
|
||||
interpretation Arch_p_arch_update_eq f by unfold_locales
|
||||
lemma tcb_hyp_refs_of_simps[simp]: "tcb_hyp_refs atcb = {}"
|
||||
by (auto simp: tcb_hyp_refs_def)
|
||||
|
||||
lemma valid_global_pdpt_update [iff]:
|
||||
"valid_global_pdpt mp (f s) = valid_global_pdpt mp s"
|
||||
by (simp add: valid_global_pdpt_def arch)
|
||||
definition
|
||||
refs_of_a :: "arch_kernel_obj \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"refs_of_a x \<equiv> {}"
|
||||
|
||||
lemma refs_of_a_simps[simp]: "refs_of_a ao = {}"
|
||||
by (auto simp: refs_of_a_def)
|
||||
|
||||
definition
|
||||
hyp_refs_of :: "kernel_object \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"hyp_refs_of x \<equiv> case x of
|
||||
CNode sz fun => {}
|
||||
| TCB tcb => tcb_hyp_refs (tcb_arch tcb)
|
||||
| Endpoint ep => {}
|
||||
| Notification ntfn => {}
|
||||
| ArchObj ao => refs_of_a ao"
|
||||
|
||||
lemma hyp_refs_of_simps[simp]: "hyp_refs_of obj = {}"
|
||||
by (auto simp: hyp_refs_of_def split: kernel_object.splits)
|
||||
|
||||
definition
|
||||
state_hyp_refs_of :: "'z::state_ext state \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"state_hyp_refs_of s \<equiv> \<lambda>x. case (kheap s x) of Some ko \<Rightarrow> hyp_refs_of ko | None \<Rightarrow> {}"
|
||||
|
||||
definition
|
||||
state_refs_of_a :: "'z::state_ext state \<Rightarrow> obj_ref \<Rightarrow> (obj_ref \<times> reftype) set"
|
||||
where
|
||||
"state_refs_of_a s \<equiv> \<lambda>x. case (kheap s x) of
|
||||
Some ko \<Rightarrow> (case ko of ArchObj ao \<Rightarrow> refs_of_a ao | _ \<Rightarrow> {})
|
||||
| None \<Rightarrow> {}"
|
||||
|
||||
lemma state_hyp_refs_of_elemD:
|
||||
"\<lbrakk> ref \<in> state_hyp_refs_of s x \<rbrakk> \<Longrightarrow> obj_at (\<lambda>obj. ref \<in> hyp_refs_of obj) x s"
|
||||
by (clarsimp simp add: state_hyp_refs_of_def obj_at_def
|
||||
split: option.splits)
|
||||
|
||||
lemma state_hyp_refs_of_eqD:
|
||||
"\<lbrakk> state_hyp_refs_of s x = S; S \<noteq> {} \<rbrakk> \<Longrightarrow> obj_at (\<lambda>obj. hyp_refs_of obj = S) x s"
|
||||
by (clarsimp simp add: state_hyp_refs_of_def obj_at_def
|
||||
split: option.splits)
|
||||
|
||||
lemma obj_at_state_hyp_refs_ofD:
|
||||
"obj_at P p s \<Longrightarrow> \<exists>ko. P ko \<and> state_hyp_refs_of s p = hyp_refs_of ko"
|
||||
apply (clarsimp simp: obj_at_def state_hyp_refs_of_def)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma ko_at_state_hyp_refs_ofD:
|
||||
"ko_at ko p s \<Longrightarrow> state_hyp_refs_of s p = hyp_refs_of ko"
|
||||
by (clarsimp dest!: obj_at_state_hyp_refs_ofD)
|
||||
|
||||
lemma hyp_sym_refs_obj_atD:
|
||||
"\<lbrakk> obj_at P p s; sym_refs (state_hyp_refs_of s) \<rbrakk> \<Longrightarrow>
|
||||
\<exists>ko. P ko \<and> state_hyp_refs_of s p = hyp_refs_of ko \<and>
|
||||
(\<forall>(x, tp)\<in>hyp_refs_of ko. obj_at (\<lambda>ko. (p, symreftype tp) \<in> hyp_refs_of ko) x s)"
|
||||
apply (drule obj_at_state_hyp_refs_ofD)
|
||||
apply (erule exEI, clarsimp)
|
||||
done
|
||||
|
||||
lemma hyp_sym_refs_ko_atD:
|
||||
"\<lbrakk> ko_at ko p s; sym_refs (state_hyp_refs_of s) \<rbrakk> \<Longrightarrow>
|
||||
state_hyp_refs_of s p = hyp_refs_of ko \<and>
|
||||
(\<forall>(x, tp)\<in>hyp_refs_of ko. obj_at (\<lambda>ko. (p, symreftype tp) \<in> hyp_refs_of ko) x s)"
|
||||
by (drule(1) hyp_sym_refs_obj_atD, simp)
|
||||
|
||||
lemma state_hyp_refs_of_pspaceI:
|
||||
"\<lbrakk> P (state_hyp_refs_of s); kheap s = kheap s' \<rbrakk> \<Longrightarrow> P (state_hyp_refs_of s')"
|
||||
unfolding state_hyp_refs_of_def
|
||||
by simp
|
||||
|
||||
lemma state_hyp_refs_update[iff]:
|
||||
"kheap (f s) = kheap s \<Longrightarrow> state_hyp_refs_of (f s) = state_hyp_refs_of s"
|
||||
by (clarsimp simp: state_hyp_refs_of_def
|
||||
split: option.splits cong: option.case_cong)
|
||||
|
||||
lemma hyp_refs_of_hyp_live:
|
||||
"hyp_refs_of ko \<noteq> {} \<Longrightarrow> hyp_live ko"
|
||||
apply (cases ko, simp_all add: hyp_refs_of_def)
|
||||
done
|
||||
|
||||
lemma hyp_refs_of_hyp_live_obj:
|
||||
"\<lbrakk> obj_at P p s; \<And>ko. \<lbrakk> P ko; hyp_refs_of ko = {} \<rbrakk> \<Longrightarrow> False \<rbrakk> \<Longrightarrow> obj_at hyp_live p s"
|
||||
by (fastforce simp: obj_at_def hyp_refs_of_hyp_live)
|
||||
|
||||
(* use tcb_arch_ref to handle obj_refs in tcb_arch: currently there is a vcpu ref only *)
|
||||
|
||||
definition tcb_arch_ref :: "tcb \<Rightarrow> obj_ref option"
|
||||
where "tcb_arch_ref t \<equiv> None"
|
||||
|
||||
lemma valid_tcb_arch_ref_lift:
|
||||
"tcb_arch_ref t = tcb_arch_ref t' \<Longrightarrow> valid_arch_tcb (tcb_arch t) = valid_arch_tcb (tcb_arch t')"
|
||||
by (simp add: valid_arch_tcb_def tcb_arch_ref_def)
|
||||
|
||||
lemma valid_arch_tcb_context_update[simp]:
|
||||
"valid_arch_tcb (tcb_context_update f t) = valid_arch_tcb t"
|
||||
unfolding valid_arch_tcb_def obj_at_def by simp
|
||||
|
||||
lemma valid_arch_arch_tcb_context_set[simp]:
|
||||
"valid_arch_tcb (arch_tcb_context_set a t) = valid_arch_tcb t"
|
||||
by (simp add: arch_tcb_context_set_def)
|
||||
|
||||
lemma tcb_arch_ref_context_update:
|
||||
"tcb_arch_ref (t\<lparr>tcb_arch := (arch_tcb_context_set a (tcb_arch t))\<rparr>) = tcb_arch_ref t"
|
||||
by (simp add: tcb_arch_ref_def arch_tcb_context_set_def)
|
||||
|
||||
lemma tcb_arch_ref_ipc_buffer_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_ipc_buffer_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_mcpriority_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_mcpriority_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_ctable_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_ctable_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_vtable_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_vtable_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_reply_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_reply_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_caller_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_caller_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_ipcframe_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_ipcframe_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_state_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_state_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_fault_handler_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_fault_handler_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_fault_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_fault_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
lemma tcb_arch_ref_bound_notification_update: "\<And>tcb.
|
||||
tcb_arch_ref (tcb_bound_notification_update f tcb) = tcb_arch_ref tcb"
|
||||
by (simp add: tcb_arch_ref_def)
|
||||
|
||||
|
||||
lemmas tcb_arch_ref_simps[simp] = tcb_arch_ref_ipc_buffer_update tcb_arch_ref_mcpriority_update
|
||||
tcb_arch_ref_ctable_update tcb_arch_ref_vtable_update tcb_arch_ref_reply_update
|
||||
tcb_arch_ref_caller_update tcb_arch_ref_ipcframe_update tcb_arch_ref_state_update
|
||||
tcb_arch_ref_fault_handler_update tcb_arch_ref_fault_update tcb_arch_ref_bound_notification_update
|
||||
tcb_arch_ref_context_update
|
||||
|
||||
lemma hyp_live_tcb_def: "hyp_live (TCB tcb) = bound (tcb_arch_ref tcb)"
|
||||
by (clarsimp simp: hyp_live_def tcb_arch_ref_def)
|
||||
|
||||
lemma hyp_live_tcb_simps[simp]:
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_ipc_buffer_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_mcpriority_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_ctable_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_vtable_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_reply_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_caller_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_ipcframe_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_state_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_fault_handler_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_fault_update f tcb)) = hyp_live (TCB tcb)"
|
||||
"\<And>tcb f. hyp_live (TCB (tcb_bound_notification_update f tcb)) = hyp_live (TCB tcb)"
|
||||
by (simp_all add: hyp_live_tcb_def)
|
||||
|
||||
|
||||
lemma valid_arch_tcb_pspaceI:
|
||||
"\<lbrakk> valid_arch_tcb t s; kheap s = kheap s' \<rbrakk> \<Longrightarrow> valid_arch_tcb t s'"
|
||||
unfolding valid_arch_tcb_def obj_at_def by (simp)
|
||||
|
||||
lemma valid_arch_tcb_typ_at:
|
||||
"\<lbrakk> valid_arch_tcb t s; \<And>T p. typ_at T p s \<Longrightarrow> typ_at T p s' \<rbrakk> \<Longrightarrow> valid_arch_tcb t s'"
|
||||
by (simp add: valid_arch_tcb_def)
|
||||
|
||||
lemma valid_arch_tcb_lift:
|
||||
"(\<And>T p. f \<lbrace>typ_at T p\<rbrace>) \<Longrightarrow> f \<lbrace>valid_arch_tcb t\<rbrace>"
|
||||
unfolding valid_arch_tcb_def
|
||||
by (wp hoare_vcg_all_lift hoare_vcg_imp_lift; simp)
|
||||
|
||||
end
|
||||
*)
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -420,6 +420,15 @@ lemma do_normal_transfer_tcb_caps:
|
|||
| simp add:imp)+
|
||||
done
|
||||
|
||||
lemma set_cap_valid_arch_objs [wp, Ipc_AI_assms]:
|
||||
"\<lbrace>valid_arch_objs\<rbrace> set_cap a b \<lbrace>\<lambda>_. valid_arch_objs \<rbrace>"
|
||||
apply (rule valid_arch_objs_lift)
|
||||
apply (wp set_cap_typ_at)+
|
||||
apply (rule set_cap.aobj_at)
|
||||
apply (fastforce simp: arch_obj_pred_def non_arch_obj_def
|
||||
split: kernel_object.split arch_kernel_obj.splits)
|
||||
done
|
||||
|
||||
lemma do_ipc_transfer_tcb_caps [Ipc_AI_assms]:
|
||||
assumes imp: "\<And>c. P c \<Longrightarrow> \<not> is_untyped_cap c"
|
||||
shows
|
||||
|
|
@ -434,12 +443,28 @@ lemma do_ipc_transfer_tcb_caps [Ipc_AI_assms]:
|
|||
|
||||
lemma setup_caller_cap_valid_global_objs[wp, Ipc_AI_assms]:
|
||||
"\<lbrace>valid_global_objs\<rbrace> setup_caller_cap send recv \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
apply (wp valid_global_objs_lift valid_ao_at_lift)
|
||||
apply (wp valid_global_objs_lift valid_vso_at_lift)
|
||||
apply (simp_all add: setup_caller_cap_def)
|
||||
apply (wp sts_obj_at_impossible | simp add: tcb_not_empty_table)+
|
||||
done
|
||||
|
||||
crunch typ_at[Ipc_AI_assms]: handle_arch_fault_reply "P (typ_at T p s)"
|
||||
lemma transfer_caps_loop_valid_vspace_objs[wp, Ipc_AI_assms]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace>
|
||||
transfer_caps_loop ep buffer n caps slots mi
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
apply (induct caps arbitrary: slots n mi, simp)
|
||||
apply (clarsimp simp: Let_def split_def whenE_def
|
||||
cong: if_cong list.case_cong
|
||||
split del: if_split)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp hoare_vcg_const_imp_lift hoare_vcg_const_Ball_lift
|
||||
derive_cap_is_derived_foo
|
||||
hoare_drop_imps
|
||||
| assumption | simp split del: if_split)+
|
||||
done
|
||||
|
||||
crunch inv[Ipc_AI_assms]: make_arch_fault_msg "P"
|
||||
crunch typ_at[Ipc_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "P (typ_at T p s)"
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -479,12 +504,19 @@ lemma do_ipc_transfer_respects_device_region[Ipc_AI_cont_assms]:
|
|||
apply auto
|
||||
done
|
||||
|
||||
lemma set_mrs_state_hyp_refs_of[wp]:
|
||||
"\<lbrace>\<lambda> s. P (state_hyp_refs_of s)\<rbrace> set_mrs thread buf msgs \<lbrace>\<lambda>_ s. P (state_hyp_refs_of s)\<rbrace>"
|
||||
by (wp set_mrs_thread_set_dmo thread_set_hyp_refs_trivial | simp)+
|
||||
|
||||
crunch state_hyp_refs_of[wp, Ipc_AI_cont_assms]: do_ipc_transfer "\<lambda> s. P (state_hyp_refs_of s)"
|
||||
(wp: crunch_wps simp: zipWithM_x_mapM)
|
||||
|
||||
end
|
||||
|
||||
interpretation Ipc_AI?: Ipc_AI_cont
|
||||
proof goal_cases
|
||||
interpret Arch .
|
||||
case 1 show ?case by (unfold_locales;(fact Ipc_AI_cont_assms)?)
|
||||
case 1 show ?case by (unfold_locales; (fact Ipc_AI_cont_assms)?)
|
||||
qed
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -14,17 +14,94 @@ begin
|
|||
|
||||
context Arch begin global_naming X64
|
||||
|
||||
sublocale
|
||||
empty_table: arch_only_obj_pred "empty_table S" for S
|
||||
by (unfold_locales, simp add: empty_table_def del: arch_obj_fun_lift_expand)
|
||||
definition "non_vspace_obj \<equiv> non_arch_obj"
|
||||
definition "vspace_obj_pred \<equiv> arch_obj_pred"
|
||||
|
||||
sublocale
|
||||
vs_refs: arch_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by (unfold_locales, simp add: vs_refs_def del: vs_refs_arch_def)
|
||||
end
|
||||
|
||||
sublocale
|
||||
vs_refs_pages: arch_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko"
|
||||
by (unfold_locales, simp add: vs_refs_pages_def del: vs_refs_pages_arch_def)
|
||||
locale vspace_only_obj_pred = Arch +
|
||||
fixes P :: "kernel_object \<Rightarrow> bool"
|
||||
assumes vspace_only: "vspace_obj_pred P"
|
||||
|
||||
sublocale vspace_only_obj_pred < arch_only_obj_pred
|
||||
using vspace_only[unfolded vspace_obj_pred_def] by unfold_locales
|
||||
|
||||
context Arch begin global_naming ARM
|
||||
|
||||
sublocale empty_table: vspace_only_obj_pred "empty_table S" for S
|
||||
by unfold_locales (simp add: vspace_obj_pred_def empty_table_def del: arch_obj_fun_lift_expand)
|
||||
|
||||
sublocale vs_refs: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs ko"
|
||||
by unfold_locales (simp add: vspace_obj_pred_def vs_refs_def del: arch_obj_fun_lift_expand)
|
||||
|
||||
sublocale vs_refs_pages: vspace_only_obj_pred "\<lambda>ko. x \<in> vs_refs_pages ko"
|
||||
by unfold_locales (simp add: vspace_obj_pred_def vs_refs_pages_def del: arch_obj_fun_lift_expand)
|
||||
|
||||
lemma valid_vspace_objs_lift:
|
||||
assumes x: "\<And>P. \<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> f \<lbrace>\<lambda>_ s. P (vs_lookup s)\<rbrace>"
|
||||
assumes y: "\<And>ako p. \<lbrace>\<lambda>s. \<not> ko_at (ArchObj ako) p s\<rbrace> f \<lbrace>\<lambda>rv s. \<not> ko_at (ArchObj ako) p s\<rbrace>"
|
||||
assumes z: "\<And>p T. \<lbrace>typ_at (AArch T) p\<rbrace> f \<lbrace>\<lambda>rv. typ_at (AArch T) p\<rbrace>"
|
||||
shows "\<lbrace>valid_vspace_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
apply (simp add: valid_vspace_objs_def)
|
||||
apply (rule hoare_vcg_all_lift, wp hoare_convert_imp[OF x]; (rule hoare_vcg_all_lift | assumption))
|
||||
apply (rule hoare_convert_imp[OF y])
|
||||
apply (rule valid_vspace_obj_typ[OF z])
|
||||
done
|
||||
|
||||
lemma vspace_obj_imp: "non_arch_obj ko \<Longrightarrow> non_vspace_obj ko"
|
||||
unfolding non_vspace_obj_def by assumption
|
||||
|
||||
lemma non_vspace_objs[intro]:
|
||||
"non_vspace_obj (Endpoint ep)"
|
||||
"non_vspace_obj (CNode sz cnode_contents)"
|
||||
"non_vspace_obj (TCB tcb)"
|
||||
"non_vspace_obj (Notification notification)"
|
||||
by (auto simp: non_vspace_obj_def)
|
||||
|
||||
lemma vspace_obj_predE:
|
||||
"\<lbrakk>vspace_obj_pred P; non_vspace_obj ko; non_vspace_obj ko'\<rbrakk> \<Longrightarrow> P ko = P ko'"
|
||||
unfolding vspace_obj_pred_def non_vspace_obj_def by (rule arch_obj_predE)
|
||||
|
||||
lemmas vspace_obj_pred_defs = non_vspace_objs vspace_obj_pred_def
|
||||
|
||||
lemma vspace_pred_imp: "vspace_obj_pred P \<Longrightarrow> arch_obj_pred P"
|
||||
using vspace_obj_pred_def by simp
|
||||
|
||||
lemma vspace_obj_pred_a_type[intro, simp]: "vspace_obj_pred (\<lambda>ko. a_type ko = AArch T)"
|
||||
by (auto simp: vspace_obj_pred_def)
|
||||
|
||||
lemma
|
||||
vspace_obj_pred_arch_obj_l[intro, simp]: "vspace_obj_pred (\<lambda>ko. ArchObj ako = ko)" and
|
||||
vspace_obj_pred_arch_obj_r[intro, simp]: "vspace_obj_pred (\<lambda>ko. ko = ArchObj ako)"
|
||||
by (auto simp: vspace_obj_pred_def)
|
||||
|
||||
lemma vspace_obj_pred_fun_lift: "vspace_obj_pred (\<lambda>ko. F (vspace_obj_fun_lift P N ko))"
|
||||
by (auto simp: vspace_obj_pred_def vspace_obj_fun_lift_def arch_obj_pred_fun_lift)
|
||||
|
||||
lemmas vspace_obj_pred_fun_lift_id[simp]
|
||||
= vspace_obj_pred_fun_lift[where F=id, simplified]
|
||||
|
||||
lemmas vspace_obj_pred_fun_lift_k[intro]
|
||||
= vspace_obj_pred_fun_lift[where F="K R" for R, simplified]
|
||||
|
||||
lemmas vspace_obj_pred_fun_lift_el[simp]
|
||||
= vspace_obj_pred_fun_lift[where F="\<lambda> S. x \<in> S" for x, simplified]
|
||||
|
||||
lemma vspace_obj_pred_const_conjI[intro]:
|
||||
"vspace_obj_pred P \<Longrightarrow>
|
||||
vspace_obj_pred P' \<Longrightarrow>
|
||||
vspace_obj_pred (\<lambda>ko. P ko \<and> P' ko)"
|
||||
apply (simp only: vspace_obj_pred_def)
|
||||
apply blast
|
||||
done
|
||||
|
||||
lemma vspace_obj_pred_fI:
|
||||
"(\<And>x. vspace_obj_pred (P x)) \<Longrightarrow> vspace_obj_pred (\<lambda>ko. f (\<lambda>x :: 'a :: type. P x ko))"
|
||||
by (simp only: vspace_obj_pred_def arch_obj_pred_fI)
|
||||
|
||||
declare
|
||||
vspace_obj_pred_fI[where f=All, intro]
|
||||
vspace_obj_pred_fI[where f=Ex, intro]
|
||||
|
||||
lemma pspace_in_kernel_window_atyp_lift_strong:
|
||||
assumes atyp_inv: "\<And>P p T. \<lbrace> \<lambda>s. P (typ_at T p s) \<rbrace> f \<lbrace> \<lambda>rv s. P (typ_at T p s) \<rbrace>"
|
||||
|
|
@ -65,8 +142,18 @@ lemma
|
|||
"(\<exists>ko. ko_at ko p s \<and> P ko) = (obj_at P p s)"
|
||||
by (simp add: obj_at_def)
|
||||
|
||||
lemma vs_lookup_arch_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
lemma in_user_frame_obj_pred_lift:
|
||||
assumes obj_at:
|
||||
"\<And>P P' p. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
shows "\<lbrace>in_user_frame p\<rbrace> f \<lbrace>\<lambda>_. in_user_frame p\<rbrace>"
|
||||
unfolding in_user_frame_def
|
||||
apply (wp hoare_vcg_ex_lift obj_at)
|
||||
apply (clarsimp simp: vspace_obj_pred_def)
|
||||
apply (auto simp: a_type_def aa_type_def split: kernel_object.splits arch_kernel_obj.splits)
|
||||
done
|
||||
|
||||
lemma vs_lookup_vspace_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> f \<lbrace>\<lambda>rv s. P (vs_lookup s)\<rbrace>"
|
||||
|
|
@ -78,12 +165,20 @@ lemma vs_lookup_arch_obj_at_lift:
|
|||
apply (clarsimp simp add: valid_def)
|
||||
apply (erule_tac P=P in rsubst)
|
||||
apply (rule ext)+
|
||||
apply (erule use_valid, rule obj_at, simp)
|
||||
by (auto simp: vs_refs.arch_only
|
||||
intro!: arch_obj_pred_fI[where f=Ex])
|
||||
apply (erule use_valid, rule obj_at, simp_all)
|
||||
apply (rule vspace_obj_pred_fI[where f=Ex])
|
||||
by (auto simp: vs_refs.vspace_only
|
||||
intro!: vspace_obj_pred_fI[where f=Ex])
|
||||
|
||||
lemma vs_lookup_pages_arch_obj_at_lift:
|
||||
lemma vs_lookup_arch_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> f \<lbrace>\<lambda>rv s. P (vs_lookup s)\<rbrace>"
|
||||
by (intro vs_lookup_vspace_obj_at_lift obj_at arch_state vspace_pred_imp)
|
||||
|
||||
lemma vs_lookup_pages_vspace_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. P (vs_lookup_pages s)\<rbrace> f \<lbrace>\<lambda>rv s. P (vs_lookup_pages s)\<rbrace>"
|
||||
|
|
@ -95,9 +190,26 @@ lemma vs_lookup_pages_arch_obj_at_lift:
|
|||
apply (clarsimp simp add: valid_def)
|
||||
apply (erule_tac P=P in rsubst)
|
||||
apply (rule ext)+
|
||||
apply (erule use_valid, rule obj_at, simp)
|
||||
by (auto simp: vs_refs_pages.arch_only
|
||||
intro!: arch_obj_pred_fI[where f=Ex])
|
||||
apply (erule use_valid, rule obj_at, simp_all)
|
||||
by (auto simp: vs_refs_pages.vspace_only
|
||||
intro!: vspace_obj_pred_fI[where f=Ex])
|
||||
|
||||
lemma vs_lookup_pages_arch_obj_at_lift:
|
||||
assumes obj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. P (vs_lookup_pages s)\<rbrace> f \<lbrace>\<lambda>rv s. P (vs_lookup_pages s)\<rbrace>"
|
||||
by (intro vs_lookup_pages_vspace_obj_at_lift obj_at arch_state vspace_pred_imp)
|
||||
|
||||
lemma valid_vspace_objs_lift_weak:
|
||||
assumes obj_at: "\<And>P P' p. vspace_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' p s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' p s)\<rbrace>"
|
||||
assumes arch_state: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>r s. P (arch_state s)\<rbrace>"
|
||||
shows "\<lbrace>valid_vspace_objs\<rbrace> f \<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
apply (rule valid_vspace_objs_lift)
|
||||
apply (rule vs_lookup_vspace_obj_at_lift)
|
||||
apply (rule obj_at arch_state vspace_pred_imp; simp)+
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_lift_weak:
|
||||
assumes obj_at: "\<And>P P' p. arch_obj_pred P' \<Longrightarrow>
|
||||
|
|
@ -123,7 +235,6 @@ lemma set_object_neg_lookup:
|
|||
apply simp
|
||||
done
|
||||
|
||||
|
||||
lemma set_object_vs_lookup:
|
||||
"\<lbrace>\<lambda>s. obj_at (\<lambda>ko'. vs_refs ko = vs_refs ko') p s \<and> P (vs_lookup s) \<rbrace>
|
||||
set_object p ko
|
||||
|
|
@ -141,7 +252,6 @@ lemma set_object_vs_lookup:
|
|||
apply simp
|
||||
done
|
||||
|
||||
|
||||
lemma set_object_pt_not_vs_lookup_pages:
|
||||
"\<lbrace>\<lambda>s. \<not>(ref \<unrhd> p') s
|
||||
\<and> ((\<exists>\<unrhd>p) s \<longrightarrow> (\<forall>x. case pte_ref_pages (pt x) of
|
||||
|
|
@ -242,22 +352,38 @@ lemma set_object_arch_objs:
|
|||
apply fastforce
|
||||
done
|
||||
|
||||
(* FIXME x64: is this correct? *)
|
||||
lemma set_object_vspace_objs:
|
||||
"\<lbrace>valid_vspace_objs and typ_at (a_type ko) p and
|
||||
obj_at (\<lambda>ko'. vs_refs ko \<subseteq> vs_refs ko') p and
|
||||
(\<lambda>s. case ko of ArchObj ao \<Rightarrow>
|
||||
(\<exists>\<rhd>p)s \<longrightarrow> valid_vspace_obj ao s
|
||||
| _ \<Rightarrow> True)\<rbrace>
|
||||
set_object p ko
|
||||
\<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
apply (simp add: valid_vspace_objs_def)
|
||||
apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift)
|
||||
apply (subst imp_conv_disj)
|
||||
apply (subst imp_conv_disj)
|
||||
apply (wp hoare_vcg_all_lift hoare_vcg_disj_lift set_object_neg_lookup set_object_neg_ko)
|
||||
apply (wp valid_vspace_obj_typ2 [where Q="typ_at (a_type ko) p"] set_object_typ_at | simp)+
|
||||
apply (clarsimp simp: pred_neg_def obj_at_def)
|
||||
apply (case_tac ko; auto)
|
||||
done
|
||||
|
||||
lemma set_object_valid_kernel_mappings:
|
||||
"\<lbrace>\<lambda>s. valid_kernel_mappings s
|
||||
\<and> valid_kernel_mappings_if_pm
|
||||
(set (x64_global_pdpts (arch_state s)))
|
||||
(set (second_level_tables (arch_state s)))
|
||||
ko\<rbrace>
|
||||
set_object ptr ko
|
||||
\<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>"
|
||||
apply (simp add: set_object_def)
|
||||
apply wp
|
||||
apply (clarsimp simp: valid_kernel_mappings_def
|
||||
apply_trace (clarsimp simp: valid_kernel_mappings_def second_level_tables_def
|
||||
elim!: ranE split: if_split_asm)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
(* FIXME x64: does this need more global table levels? *)
|
||||
lemma valid_vs_lookup_lift:
|
||||
assumes lookup: "\<And>P. \<lbrace>\<lambda>s. P (vs_lookup_pages s)\<rbrace> f \<lbrace>\<lambda>_ s. P (vs_lookup_pages s)\<rbrace>"
|
||||
assumes cap: "\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
|
||||
|
|
@ -270,19 +396,19 @@ lemma valid_vs_lookup_lift:
|
|||
|
||||
lemma valid_table_caps_lift:
|
||||
assumes cap: "\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
|
||||
assumes pts: "\<And>P. \<lbrace>\<lambda>s. P (x64_global_pdpts (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (x64_global_pdpts (arch_state s))\<rbrace>"
|
||||
assumes pts: "\<And>P. \<lbrace>\<lambda>s. P (second_level_tables (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (second_level_tables (arch_state s))\<rbrace>"
|
||||
assumes obj: "\<And>S p. \<lbrace>obj_at (empty_table S) p\<rbrace> f \<lbrace>\<lambda>rv. obj_at (empty_table S) p\<rbrace>"
|
||||
shows "\<lbrace>valid_table_caps\<rbrace> f \<lbrace>\<lambda>_. valid_table_caps\<rbrace>"
|
||||
unfolding valid_table_caps_def
|
||||
apply (rule hoare_lift_Pf [where f="\<lambda>s. (caps_of_state s)"])
|
||||
apply (rule hoare_lift_Pf [where f="\<lambda>s. x64_global_pdpts (arch_state s)"])
|
||||
apply (rule hoare_lift_Pf [where f="\<lambda>s. second_level_tables (arch_state s)"])
|
||||
apply (wp cap pts hoare_vcg_all_lift hoare_vcg_const_imp_lift obj)+
|
||||
done
|
||||
|
||||
lemma valid_arch_caps_lift:
|
||||
assumes lookup: "\<And>P. \<lbrace>\<lambda>s. P (vs_lookup_pages s)\<rbrace> f \<lbrace>\<lambda>_ s. P (vs_lookup_pages s)\<rbrace>"
|
||||
assumes cap: "\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
|
||||
assumes pts: "\<And>P. \<lbrace>\<lambda>s. P (x64_global_pdpts (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (x64_global_pdpts (arch_state s))\<rbrace>"
|
||||
assumes pts: "\<And>P. \<lbrace>\<lambda>s. P (second_level_tables (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (second_level_tables (arch_state s))\<rbrace>"
|
||||
assumes obj: "\<And>S p. \<lbrace>obj_at (empty_table S) p\<rbrace> f \<lbrace>\<lambda>rv. obj_at (empty_table S) p\<rbrace>"
|
||||
shows "\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>"
|
||||
unfolding valid_arch_caps_def
|
||||
|
|
@ -291,67 +417,51 @@ lemma valid_arch_caps_lift:
|
|||
apply simp
|
||||
done
|
||||
|
||||
|
||||
lemma valid_global_objs_lift':
|
||||
assumes pml4: "\<And>P. \<lbrace>\<lambda>s. P (x64_global_pml4 (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (x64_global_pml4 (arch_state s))\<rbrace>"
|
||||
assumes pdpts: "\<And>P. \<lbrace>\<lambda>s. P (x64_global_pdpts (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (x64_global_pdpts (arch_state s))\<rbrace>"
|
||||
assumes pds: "\<And>P. \<lbrace>\<lambda>s. P (x64_global_pds (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (x64_global_pds (arch_state s))\<rbrace>"
|
||||
assumes pts: "\<And>P. \<lbrace>\<lambda>s. P (x64_global_pts (arch_state s))\<rbrace> f \<lbrace>\<lambda>_ s. P (x64_global_pts (arch_state s))\<rbrace>"
|
||||
assumes obj: "\<And>p. \<lbrace>valid_ao_at p\<rbrace> f \<lbrace>\<lambda>rv. valid_ao_at p\<rbrace>"
|
||||
assumes obj: "\<And>p. \<lbrace>valid_vso_at p\<rbrace> f \<lbrace>\<lambda>rv. valid_vso_at p\<rbrace>"
|
||||
assumes ko: "\<And>ako p. \<lbrace>ko_at (ArchObj ako) p\<rbrace> f \<lbrace>\<lambda>_. ko_at (ArchObj ako) p\<rbrace>"
|
||||
assumes emp: "\<And>pd S.
|
||||
\<lbrace>\<lambda>s. (v \<longrightarrow> pd = x64_global_pml4 (arch_state s) \<and> S = set (x64_global_pdpts (arch_state s)) \<and> P s)
|
||||
\<lbrace>\<lambda>s. (v \<longrightarrow> pd = x64_global_pml4 (arch_state s) \<and> S = set (second_level_tables (arch_state s)) \<and> P s)
|
||||
\<and> obj_at (empty_table S) pd s\<rbrace>
|
||||
f \<lbrace>\<lambda>rv. obj_at (empty_table S) pd\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>s. valid_global_objs s \<and> (v \<longrightarrow> P s)\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
unfolding valid_global_objs_def
|
||||
unfolding valid_global_objs_def second_level_tables_def
|
||||
apply (rule hoare_pre)
|
||||
apply (rule hoare_use_eq [where f="\<lambda>s. x64_global_pts (arch_state s)", OF pts])
|
||||
apply (rule hoare_use_eq [where f="\<lambda>s. x64_global_pds (arch_state s)", OF pds])
|
||||
apply (rule hoare_use_eq [where f="\<lambda>s. x64_global_pdpts (arch_state s)", OF pdpts])
|
||||
apply (rule hoare_use_eq [where f="\<lambda>s. x64_global_pml4 (arch_state s)", OF pml4])
|
||||
apply (wp obj ko emp hoare_vcg_const_Ball_lift hoare_ex_wp)
|
||||
apply clarsimp
|
||||
apply (clarsimp simp: second_level_tables_def)
|
||||
done
|
||||
|
||||
lemmas valid_global_objs_lift
|
||||
= valid_global_objs_lift' [where v=False, simplified]
|
||||
|
||||
lemma arch_lifts:
|
||||
context
|
||||
fixes f :: "'a::state_ext state \<Rightarrow> ('b \<times> 'a state) set \<times> bool"
|
||||
assumes arch: "\<And>P. \<lbrace>\<lambda>s. P (arch_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (arch_state s)\<rbrace>"
|
||||
assumes aobj_at: "\<And>P P' pd. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
shows
|
||||
valid_global_vspace_mappings_lift:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_global_vspace_mappings\<rbrace>" and
|
||||
valid_arch_caps_lift_weak:
|
||||
"(\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>) \<Longrightarrow>
|
||||
\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>" and
|
||||
valid_global_objs_lift_weak:
|
||||
"\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>" and
|
||||
valid_asid_map_lift:
|
||||
"\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>" and
|
||||
valid_kernel_mappings_lift:
|
||||
"\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>" and
|
||||
valid_global_pts_lift:
|
||||
"\<lbrace>valid_global_pts\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pts\<rbrace>" and
|
||||
valid_global_pds_lift:
|
||||
"\<lbrace>valid_global_pds\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pds\<rbrace>" and
|
||||
valid_global_pdpts_lift:
|
||||
"\<lbrace>valid_global_pdpts\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pdpts\<rbrace>" and
|
||||
valid_arch_state_lift_aobj_at:
|
||||
"\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
apply -
|
||||
begin
|
||||
|
||||
subgoal
|
||||
context
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
begin
|
||||
|
||||
lemma valid_global_vspace_mappings_lift:
|
||||
"\<lbrace>valid_global_vspace_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_global_vspace_mappings\<rbrace>"
|
||||
proof -
|
||||
have arch_obj_at_pres:
|
||||
"\<And>r s t N P Q p. \<lbrakk> (r,t) \<in> fst (f s); P = Q \<rbrakk>
|
||||
\<Longrightarrow> obj_at (arch_obj_fun_lift P N) p s = obj_at (arch_obj_fun_lift Q N) p t"
|
||||
\<Longrightarrow> obj_at (vspace_obj_fun_lift P N) p s = obj_at (vspace_obj_fun_lift Q N) p t"
|
||||
apply safe
|
||||
apply (erule use_valid[OF _ aobj_at[where P="\<lambda>x. x"]]; simp)
|
||||
apply (rule classical;
|
||||
drule use_valid[OF _ aobj_at[where P="\<lambda>x. \<not>x", OF arch_obj_pred_fun_lift_id]])
|
||||
drule use_valid[OF _ aobj_at[where P="\<lambda>x. \<not>x", OF vspace_obj_pred_fun_lift_id]])
|
||||
by auto
|
||||
show ?thesis
|
||||
apply (simp only: valid_global_vspace_mappings_def valid_pml4_kernel_mappings_def)
|
||||
|
|
@ -383,28 +493,33 @@ lemma arch_lifts:
|
|||
done
|
||||
qed
|
||||
|
||||
subgoal
|
||||
lemma valid_arch_caps_lift_weak:
|
||||
"(\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>) \<Longrightarrow>
|
||||
\<lbrace>valid_arch_caps\<rbrace> f \<lbrace>\<lambda>_. valid_arch_caps\<rbrace>"
|
||||
apply (rule valid_arch_caps_lift[OF _ _ arch aobj_at])
|
||||
apply (rule vs_lookup_pages_arch_obj_at_lift[OF aobj_at arch], assumption+)
|
||||
apply (rule empty_table.arch_only)
|
||||
apply (rule vs_lookup_pages_vspace_obj_at_lift[OF aobj_at arch], assumption+)
|
||||
apply (rule empty_table.vspace_only)
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_global_objs_lift_weak:
|
||||
"\<lbrace>valid_global_objs\<rbrace> f \<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
apply (rule valid_global_objs_lift)
|
||||
apply (wp arch)+
|
||||
apply (simp add: valid_ao_at_def)
|
||||
apply (simp add: valid_vso_at_def)
|
||||
apply (rule hoare_vcg_ex_lift)
|
||||
apply (rule hoare_vcg_conj_lift)
|
||||
apply (wp aobj_at valid_arch_obj_typ | simp | rule empty_table.arch_only)+
|
||||
apply (wp aobj_at valid_vspace_obj_typ | simp | rule empty_table.vspace_only)+
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_asid_map_lift:
|
||||
"\<lbrace>valid_asid_map\<rbrace> f \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>"
|
||||
apply (simp add: valid_asid_map_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (simp add: vspace_at_asid_def)
|
||||
by (rule vs_lookup_arch_obj_at_lift[OF aobj_at arch])
|
||||
by (rule vs_lookup_vspace_obj_at_lift[OF aobj_at arch])
|
||||
|
||||
subgoal
|
||||
lemma valid_kernel_mappings_lift:
|
||||
"\<lbrace>valid_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. valid_kernel_mappings\<rbrace>"
|
||||
apply (simp add: valid_kernel_mappings_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (simp add: valid_kernel_mappings_if_pm_def ran_def
|
||||
|
|
@ -422,7 +537,15 @@ lemma arch_lifts:
|
|||
apply (case_tac xa; simp add: hoare_vcg_prop)
|
||||
done
|
||||
|
||||
subgoal valid_global_pts
|
||||
end
|
||||
|
||||
context
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. arch_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
begin
|
||||
|
||||
lemma valid_global_pts_lift:
|
||||
"\<lbrace>valid_global_pts\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pts\<rbrace>"
|
||||
apply (simp add: valid_global_pts_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (rule hoare_vcg_ball_lift)
|
||||
|
|
@ -430,7 +553,8 @@ lemma arch_lifts:
|
|||
apply clarsimp
|
||||
done
|
||||
|
||||
subgoal valid_global_pds
|
||||
lemma valid_global_pds_lift:
|
||||
"\<lbrace>valid_global_pds\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pds\<rbrace>"
|
||||
apply (simp add: valid_global_pds_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (rule hoare_vcg_ball_lift)
|
||||
|
|
@ -438,7 +562,8 @@ lemma arch_lifts:
|
|||
apply clarsimp
|
||||
done
|
||||
|
||||
subgoal valid_global_pdpts
|
||||
lemma valid_global_pdpts_lift:
|
||||
"\<lbrace>valid_global_pdpts\<rbrace> f \<lbrace>\<lambda>rv. valid_global_pdpts\<rbrace>"
|
||||
apply (simp add: valid_global_pdpts_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (rule hoare_vcg_ball_lift)
|
||||
|
|
@ -446,26 +571,29 @@ lemma arch_lifts:
|
|||
apply clarsimp
|
||||
done
|
||||
|
||||
subgoal
|
||||
lemma valid_arch_state_lift_aobj_at:
|
||||
"\<lbrace>valid_arch_state\<rbrace> f \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
apply (simp add: valid_arch_state_def valid_asid_table_def)
|
||||
apply (rule hoare_lift_Pf[where f="arch_state", OF _ arch])
|
||||
apply (wp hoare_vcg_conj_lift hoare_vcg_ball_lift
|
||||
valid_global_pts valid_global_pds valid_global_pdpts
|
||||
valid_global_pts_lift valid_global_pds_lift valid_global_pdpts_lift
|
||||
| (rule aobj_at, clarsimp))+
|
||||
apply simp
|
||||
done
|
||||
done
|
||||
|
||||
end
|
||||
end
|
||||
|
||||
lemma equal_kernel_mappings_lift:
|
||||
assumes aobj_at: "\<And>P P' pd. arch_obj_pred P' \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
assumes aobj_at:
|
||||
"\<And>P P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>\<lambda>s. P (obj_at P' pd s)\<rbrace> f \<lbrace>\<lambda>r s. P (obj_at P' pd s)\<rbrace>"
|
||||
shows "\<lbrace>equal_kernel_mappings\<rbrace> f \<lbrace>\<lambda>rv. equal_kernel_mappings\<rbrace>"
|
||||
apply (simp add: equal_kernel_mappings_def)
|
||||
apply (rule hoare_vcg_all_lift)+
|
||||
apply (rule hoare_convert_imp)
|
||||
apply simp
|
||||
apply (rule hoare_convert_imp)
|
||||
apply (wp aobj_at[OF arch_obj_pred_arch_obj_l])+
|
||||
apply (wp aobj_at[OF vspace_obj_pred_arch_obj_l])+
|
||||
done
|
||||
|
||||
lemma valid_machine_state_lift:
|
||||
|
|
@ -480,21 +608,6 @@ lemma valid_machine_state_lift:
|
|||
apply (wp aobj_at; simp)
|
||||
done
|
||||
|
||||
(*
|
||||
lemma bool_pred_exhaust:
|
||||
"(P = (\<lambda>x. x)) \<or> (P = (\<lambda>x. \<not>x)) \<or> (P = (\<lambda>_. True)) \<or> (P = (\<lambda>_. False))"
|
||||
apply (cases "P True"; cases "P False")
|
||||
apply (rule disjI2, rule disjI2, rule disjI1, rule ext)
|
||||
defer
|
||||
apply (rule disjI1, rule ext)
|
||||
defer
|
||||
apply (rule disjI2, rule disjI1, rule ext)
|
||||
defer
|
||||
apply (rule disjI2, rule disjI2, rule disjI2, rule ext)
|
||||
apply (match conclusion in "P x = _" for x \<Rightarrow> \<open>cases x; fastforce\<close>)+
|
||||
done
|
||||
*)
|
||||
|
||||
lemma valid_ao_at_lift:
|
||||
assumes z: "\<And>P p T. \<lbrace>\<lambda>s. P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
and y: "\<And>ao. \<lbrace>\<lambda>s. ko_at (ArchObj ao) p s\<rbrace> f \<lbrace>\<lambda>rv s. ko_at (ArchObj ao) p s\<rbrace>"
|
||||
|
|
@ -508,11 +621,29 @@ lemma valid_ao_at_lift_aobj_at:
|
|||
unfolding valid_ao_at_def
|
||||
by (wp hoare_vcg_ex_lift valid_arch_obj_typ aobj_at | clarsimp)+
|
||||
|
||||
lemma valid_vso_at_lift:
|
||||
assumes z: "\<And>P p T. \<lbrace>\<lambda>s. P (typ_at (AArch T) p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at (AArch T) p s)\<rbrace>"
|
||||
and y: "\<And>ao. \<lbrace>\<lambda>s. ko_at (ArchObj ao) p s\<rbrace> f \<lbrace>\<lambda>rv s. ko_at (ArchObj ao) p s\<rbrace>"
|
||||
shows "\<lbrace>valid_vso_at p\<rbrace> f \<lbrace>\<lambda>rv. valid_vso_at p\<rbrace>"
|
||||
unfolding valid_vso_at_def
|
||||
by (wpsimp wp: hoare_vcg_ex_lift y valid_vspace_obj_typ z)+
|
||||
|
||||
lemma valid_vso_at_lift_aobj_at:
|
||||
assumes aobj_at: "\<And>P' pd. vspace_obj_pred P' \<Longrightarrow> \<lbrace>obj_at P' pd\<rbrace> f \<lbrace>\<lambda>r s. obj_at P' pd s\<rbrace>"
|
||||
shows "\<lbrace>valid_vso_at p\<rbrace> f \<lbrace>\<lambda>rv. valid_vso_at p\<rbrace>"
|
||||
unfolding valid_vso_at_def
|
||||
apply (rule hoare_vcg_ex_lift)
|
||||
apply (rule hoare_vcg_conj_lift aobj_at)+
|
||||
apply (clarsimp simp: vspace_obj_pred_def)
|
||||
apply (wpsimp wp: valid_vspace_obj_typ)
|
||||
apply (wpsimp wp: aobj_at)
|
||||
apply assumption
|
||||
done
|
||||
|
||||
lemmas set_object_v_ker_map
|
||||
= set_object_valid_kernel_mappings
|
||||
[unfolded valid_kernel_mappings_if_pm_def]
|
||||
|
||||
|
||||
crunch v_ker_map[wp]: set_notification "valid_kernel_mappings"
|
||||
(ignore: set_object wp: set_object_v_ker_map crunch_wps)
|
||||
|
||||
|
|
@ -578,10 +709,17 @@ private method valid_global_obs_try_specialise_entries =
|
|||
lemma ko_at_def2: "ko_at ko p s \<equiv> (kheap s p = Some ko)"
|
||||
by (simp add: obj_at_def)
|
||||
|
||||
private method valid_global_vspace_mappings uses maps pres =
|
||||
(simp only: maps[simplified] split: kernel_object.split_asm arch_kernel_obj.split_asm;
|
||||
private lemmas mappings_defs' =
|
||||
valid_pml4_kernel_mappings_def valid_pdpt_kernel_mappings_def
|
||||
valid_pd_kernel_mappings_def valid_pt_kernel_mappings_def
|
||||
|
||||
private lemmas mappings_defs = mappings_defs'[simplified vspace_obj_fun_lift_def, simplified]
|
||||
|
||||
private method valid_global_vspace_mappings uses pres =
|
||||
(simp only: mappings_defs split: kernel_object.split_asm arch_kernel_obj.split_asm;
|
||||
rule conjI[OF pres[simplified ko_at_def2]];
|
||||
clarsimp simp: valid_global_objs_def obj_at_def empty_table_def pdpte_ref_def pde_ref_def;
|
||||
clarsimp simp: valid_global_objs_def obj_at_def empty_table_def pdpte_ref_def pde_ref_def
|
||||
second_level_tables_def;
|
||||
valid_global_obs_try_specialise_entries)
|
||||
|
||||
lemma valid_global_vspace_mappings_pres:
|
||||
|
|
@ -612,25 +750,25 @@ lemma valid_global_vspace_mappings_pres:
|
|||
apply (clarsimp simp: valid_global_vspace_mappings_def obj_at_def)
|
||||
apply (rename_tac pm_ko)
|
||||
apply (rule_tac x=pm_ko in exI)
|
||||
apply (valid_global_vspace_mappings maps: valid_pml4_kernel_mappings_def pres: global_pml4_pres)
|
||||
apply (valid_global_vspace_mappings pres: global_pml4_pres)
|
||||
apply (rename_tac pm i)
|
||||
apply (drule_tac x=i in spec)
|
||||
apply (clarsimp simp: valid_pml4e_kernel_mappings_def obj_at_def split: pml4e.splits)
|
||||
apply (rename_tac pdpt_ref pdpt_attr pdpt_perms pdpt_ko)
|
||||
apply (rule_tac x=pdpt_ko in exI)
|
||||
apply (valid_global_vspace_mappings maps: valid_pdpt_kernel_mappings_def pres: global_pdpts_pres)
|
||||
apply (valid_global_vspace_mappings pres: global_pdpts_pres)
|
||||
apply (rename_tac pdpt j)
|
||||
apply (drule_tac x=j in spec)
|
||||
apply (clarsimp simp: valid_pdpte_kernel_mappings_def obj_at_def split: pdpte.splits)
|
||||
apply (rename_tac pd_ref pd_attr pd_perms pd_ko)
|
||||
apply (rule_tac x=pd_ko in exI)
|
||||
apply (valid_global_vspace_mappings maps: valid_pd_kernel_mappings_def pres: global_pds_pres)
|
||||
apply (valid_global_vspace_mappings pres: global_pds_pres)
|
||||
apply (rename_tac pd k)
|
||||
apply (drule_tac x=k in spec)
|
||||
apply (clarsimp simp: valid_pde_kernel_mappings_def obj_at_def split: pde.splits)
|
||||
apply (rename_tac pt_ref pt_attr pt_perms pt_ko)
|
||||
apply (rule_tac x=pt_ko in exI)
|
||||
apply (valid_global_vspace_mappings maps: valid_pt_kernel_mappings_def pres: global_pts_pres)
|
||||
apply (valid_global_vspace_mappings pres: global_pts_pres)
|
||||
done
|
||||
|
||||
end
|
||||
|
|
@ -660,7 +798,7 @@ lemma valid_table_caps_ptD:
|
|||
apply (clarsimp simp: valid_table_caps_def simp del: split_paired_All)
|
||||
apply (erule allE)+
|
||||
apply (erule (1) impE)
|
||||
apply (clarsimp simp add: is_pt_cap_def cap_asid_def)
|
||||
apply (clarsimp simp add: valid_arch_obj_def is_pt_cap_def cap_asid_def)
|
||||
apply (erule impE, rule refl)
|
||||
apply (clarsimp simp: obj_at_def empty_table_def)
|
||||
done
|
||||
|
|
@ -754,5 +892,66 @@ lemma cap_is_device_obj_is_device[simp]:
|
|||
|
||||
crunch device_state_inv: storeWord "\<lambda>ms. P (device_state ms)"
|
||||
|
||||
(* some hyp_ref invariants *)
|
||||
|
||||
lemma state_hyp_refs_of_ep_update: "\<And>s ep val. typ_at AEndpoint ep s \<Longrightarrow>
|
||||
state_hyp_refs_of (s\<lparr>kheap := kheap s(ep \<mapsto> Endpoint val)\<rparr>) = state_hyp_refs_of s"
|
||||
apply (rule all_ext)
|
||||
apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def hyp_refs_of_def)
|
||||
done
|
||||
|
||||
lemma state_hyp_refs_of_ntfn_update: "\<And>s ep val. typ_at ANTFN ep s \<Longrightarrow>
|
||||
state_hyp_refs_of (s\<lparr>kheap := kheap s(ep \<mapsto> Notification val)\<rparr>) = state_hyp_refs_of s"
|
||||
apply (rule all_ext)
|
||||
apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def hyp_refs_of_def)
|
||||
done
|
||||
|
||||
lemma state_hyp_refs_of_tcb_bound_ntfn_update:
|
||||
"kheap s t = Some (TCB tcb) \<Longrightarrow>
|
||||
state_hyp_refs_of (s\<lparr>kheap := kheap s(t \<mapsto> TCB (tcb\<lparr>tcb_bound_notification := ntfn\<rparr>))\<rparr>)
|
||||
= state_hyp_refs_of s"
|
||||
apply (rule all_ext)
|
||||
apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def split: option.splits)
|
||||
done
|
||||
|
||||
lemma state_hyp_refs_of_tcb_state_update:
|
||||
"kheap s t = Some (TCB tcb) \<Longrightarrow>
|
||||
state_hyp_refs_of (s\<lparr>kheap := kheap s(t \<mapsto> TCB (tcb\<lparr>tcb_state := ts\<rparr>))\<rparr>)
|
||||
= state_hyp_refs_of s"
|
||||
apply (rule all_ext)
|
||||
apply (clarsimp simp add: state_hyp_refs_of_def obj_at_def split: option.splits)
|
||||
done
|
||||
|
||||
lemma valid_arch_obj_same_type:
|
||||
assumes valid_ao: "valid_arch_obj ao s"
|
||||
assumes ko_at: "kheap s p = Some ko"
|
||||
assumes a_type: "a_type ko' = a_type ko"
|
||||
shows "valid_arch_obj ao (s\<lparr>kheap := kheap s(p \<mapsto> ko')\<rparr>)"
|
||||
using valid_ao
|
||||
apply (induction ao rule: arch_kernel_obj.induct;
|
||||
clarsimp simp: valid_arch_obj_def typ_at_same_type ko_at a_type)
|
||||
apply (rule valid_table_entry_lifts[THEN hoare_to_pure_kheap_upd[OF _ a_type]];
|
||||
assumption?; simp add: obj_at_def ko_at)+
|
||||
done
|
||||
|
||||
lemma wellformed_arch_obj_same_type:
|
||||
"\<lbrakk> wellformed_arch_obj ao s; kheap s p = Some ko; a_type k = a_type ko \<rbrakk>
|
||||
\<Longrightarrow> wellformed_arch_obj ao (s\<lparr>kheap := kheap s(p \<mapsto> k)\<rparr>)"
|
||||
by (induction ao rule: arch_kernel_obj.induct;
|
||||
clarsimp simp: valid_arch_obj_def typ_at_same_type)
|
||||
|
||||
|
||||
lemma default_arch_object_not_live: "\<not> live (ArchObj (default_arch_object aty dev us))"
|
||||
by (clarsimp simp: default_arch_object_def live_def hyp_live_def arch_live_def
|
||||
split: aobject_type.splits)
|
||||
|
||||
lemma default_tcb_not_live: "\<not> live (TCB default_tcb)"
|
||||
by (clarsimp simp: default_tcb_def default_arch_tcb_def live_def hyp_live_def)
|
||||
|
||||
lemma valid_arch_tcb_same_type:
|
||||
"\<lbrakk> valid_arch_tcb t s; valid_obj p k s; kheap s p = Some ko; a_type k = a_type ko \<rbrakk>
|
||||
\<Longrightarrow> valid_arch_tcb t (s\<lparr>kheap := kheap s(p \<mapsto> k)\<rparr>)"
|
||||
by (auto simp: valid_arch_tcb_def obj_at_def)
|
||||
|
||||
end
|
||||
end
|
||||
|
|
|
|||
|
|
@ -249,18 +249,18 @@ lemma invs_A:
|
|||
dom_if_Some cte_level_bits_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: valid_tcb_def tcb_cap_cases_def is_master_reply_cap_def
|
||||
valid_cap_def obj_at_def valid_tcb_state_def
|
||||
valid_cap_def obj_at_def valid_tcb_state_def valid_arch_tcb_def
|
||||
cap_aligned_def word_bits_def valid_ipc_buffer_cap_simps)+
|
||||
apply (clarsimp simp: valid_cs_def word_bits_def cte_level_bits_def
|
||||
init_irq_ptrs_all_ineqs valid_tcb_def
|
||||
split: if_split_asm)
|
||||
apply (simp add: pspace_aligned_init_A pspace_distinct_init_A)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: if_live_then_nonz_cap_def obj_at_def state_defs)
|
||||
apply (clarsimp simp: if_live_then_nonz_cap_def obj_at_def state_defs live_def hyp_live_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: zombies_final_def cte_wp_at_cases state_defs
|
||||
tcb_cap_cases_def is_zombie_def)
|
||||
apply (clarsimp simp: sym_refs_def state_refs_of_def state_defs)
|
||||
apply (clarsimp simp: sym_refs_def state_refs_of_def state_defs state_hyp_refs_of_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: valid_mdb_def init_cdt_def no_mloop_def
|
||||
mdb_cte_at_def)
|
||||
|
|
@ -311,7 +311,7 @@ lemma invs_A:
|
|||
apply (clarsimp simp: valid_machine_state_def state_defs
|
||||
init_machine_state_def init_underlying_memory_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: valid_arch_objs_def obj_at_def state_defs)
|
||||
apply (clarsimp simp: valid_arch_objs_def obj_at_def state_defs valid_vspace_objs_def)
|
||||
apply (clarsimp simp: vs_lookup_def vs_asid_refs_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: valid_arch_caps_def)
|
||||
|
|
@ -321,13 +321,14 @@ lemma invs_A:
|
|||
apply (clarsimp simp: valid_table_caps_def caps_of_state_init_A_st_Null
|
||||
unique_table_caps_def unique_table_refs_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: valid_global_objs_def state_defs valid_ao_at_def obj_at_def
|
||||
apply (clarsimp simp: valid_global_objs_def state_defs valid_vso_at_def obj_at_def
|
||||
a_type_simps empty_table_def vmsz_aligned_def kernel_mapping_slot
|
||||
is_aligned_shift bit_simps pdpte_ref_def valid_global_pdpt_def)
|
||||
is_aligned_shift bit_simps pdpte_ref_def valid_global_pdpt_def
|
||||
second_level_tables_def)
|
||||
apply (rule conjI)
|
||||
apply (simp add: valid_kernel_mappings_def state_defs
|
||||
valid_kernel_mappings_if_pm_def pml4e_ref_def
|
||||
ran_def)
|
||||
ran_def second_level_tables_def)
|
||||
apply (auto simp: kernel_mapping_slot split: if_split_asm)[1]
|
||||
apply (rule conjI)
|
||||
apply (clarsimp simp: equal_kernel_mappings_def state_defs obj_at_def)
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ lemma mdb_cte_at_store_pml4e[wp]:
|
|||
done
|
||||
|
||||
lemma get_pml4e_valid[wp]:
|
||||
"\<lbrace>valid_arch_objs
|
||||
"\<lbrace>valid_vspace_objs
|
||||
and \<exists>\<rhd> (x && ~~mask pml4_bits)
|
||||
and K (ucast (x && mask pml4_bits >> word_size_bits) \<notin> kernel_mapping_slots)\<rbrace>
|
||||
get_pml4e x
|
||||
|
|
@ -91,7 +91,7 @@ lemma get_pml4e_valid[wp]:
|
|||
apply (simp add: get_pml4e_def)
|
||||
apply wp
|
||||
apply clarsimp
|
||||
apply (drule (2) valid_arch_objsD)
|
||||
apply (drule (2) valid_vspace_objsD)
|
||||
apply simp
|
||||
done
|
||||
|
||||
|
|
@ -338,7 +338,7 @@ lemma valid_arch_caps_table_caps:
|
|||
lemma valid_table_caps_aobj_upd_invalid_pml4e2:
|
||||
"\<lbrakk>valid_table_caps s; kheap s p = Some (ArchObj (PageMapL4 pml4)); valid_objs s;
|
||||
pml4e_ref_pages pml4e = None \<or> (\<forall>slot cap. caps_of_state s slot = Some cap \<longrightarrow> is_pml4_cap cap \<longrightarrow> p \<in> obj_refs cap \<longrightarrow>
|
||||
(entry \<in> kernel_mapping_slots \<and> the (pml4e_ref_pages pml4e) \<in> set (x64_global_pdpts (arch_state s))))\<rbrakk>
|
||||
(entry \<in> kernel_mapping_slots \<and> the (pml4e_ref_pages pml4e) \<in> set (second_level_tables (arch_state s))))\<rbrakk>
|
||||
\<Longrightarrow> valid_table_caps_aobj (caps_of_state s) (arch_state s) (ArchObj (PageMapL4 (pml4(entry := pml4e)))) p"
|
||||
apply (clarsimp simp: valid_table_caps_def valid_table_caps_aobj_def all_comm
|
||||
empty_table_def
|
||||
|
|
@ -389,9 +389,7 @@ lemma copy_global_invs_mappings_restricted:
|
|||
apply (rule mapM_x_wp[where S="{x. get_pml4_index pptr_base \<le> x
|
||||
\<and> x < 2 ^ (pml4_bits - word_size_bits)}"])
|
||||
apply simp_all
|
||||
apply (rule hoare_pre)
|
||||
apply (wp valid_irq_node_typ valid_irq_handlers_lift
|
||||
get_pml4e_wp | simp add: store_pml4e_def )+
|
||||
apply (wpsimp wp: valid_irq_node_typ valid_irq_handlers_lift get_pml4e_wp simp: store_pml4e_def)
|
||||
apply (clarsimp simp: valid_global_objs_def)
|
||||
apply (frule(1) invs_aligned_pml4D)
|
||||
apply (frule shiftl_less_t2n)
|
||||
|
|
@ -404,20 +402,21 @@ lemma copy_global_invs_mappings_restricted:
|
|||
apply (rule conjI)
|
||||
apply (auto simp: valid_objs_def valid_obj_def dom_def obj_at_def)[1]
|
||||
apply (clarsimp simp: obj_at_def empty_table_def kernel_vsrefs_def get_pml4_index_def aa_type_simps)
|
||||
apply (intro conjI)
|
||||
apply (clarsimp split: option.split_asm if_split_asm)+
|
||||
apply (drule valid_arch_objsD, (fastforce simp: obj_at_def)+)[1]
|
||||
apply (clarsimp split: option.split_asm if_split_asm)+
|
||||
apply (erule(2) valid_table_caps_aobj_upd_invalid_pml4e2[OF valid_arch_caps_table_caps])
|
||||
apply (clarsimp simp: pml4e_ref_pages_eq_refs in_kernel_mapping_slotsI[unfolded get_pml4_index_def])
|
||||
apply (clarsimp simp: valid_arch_state_asid_table_strg)
|
||||
apply (clarsimp split: option.split_asm if_split_asm)+
|
||||
apply (clarsimp simp: valid_global_objs_upd_def global_refs_def)
|
||||
apply (intro conjI)
|
||||
apply (clarsimp split: option.split_asm if_split_asm)+
|
||||
apply (drule valid_vspace_objsD, (fastforce simp: obj_at_def)+)[1]
|
||||
apply (clarsimp split: option.split_asm if_split_asm)
|
||||
apply (clarsimp simp: valid_global_objs_upd_def empty_table_def)
|
||||
apply (erule(2) valid_table_caps_aobj_upd_invalid_pml4e2[OF valid_arch_caps_table_caps])
|
||||
apply (clarsimp simp: pml4e_ref_pages_eq_refs in_kernel_mapping_slotsI[unfolded get_pml4_index_def])
|
||||
apply (clarsimp simp: valid_arch_state_asid_table_strg)
|
||||
apply (clarsimp split: option.split_asm if_split_asm)+
|
||||
apply (clarsimp simp: valid_global_objs_upd_def global_refs_def)
|
||||
apply (erule(1) valid_kernel_mappings_if_pm_pml4e)
|
||||
apply clarsimp
|
||||
apply (rule ccontr)
|
||||
apply (drule_tac x = "(ucast x)" in spec)
|
||||
apply (clarsimp split: option.split_asm if_split_asm simp: pml4e_ref_def[split_simps pml4e.split])+
|
||||
apply (clarsimp split: option.split_asm if_split_asm)+
|
||||
apply (drule minus_one_helper5[rotated])
|
||||
apply (auto simp: pml4_bits_def simple_bit_simps)
|
||||
done
|
||||
|
|
@ -635,6 +634,10 @@ lemma valid_untyped_helper [Retype_AI_assms]:
|
|||
done
|
||||
qed
|
||||
|
||||
lemma valid_default_arch_tcb:
|
||||
"\<And>s. valid_arch_tcb default_arch_tcb s"
|
||||
by (simp add: default_arch_tcb_def valid_arch_tcb_def)
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
|
@ -735,17 +738,22 @@ lemma vs_lookup_pages':
|
|||
apply simp
|
||||
done
|
||||
|
||||
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_arch_obj_pres:
|
||||
"valid_arch_obj ao s \<Longrightarrow> valid_arch_obj ao s'"
|
||||
lemma valid_vspace_obj_pres: "valid_vspace_obj ao s \<Longrightarrow> 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)+
|
||||
done
|
||||
|
||||
lemma valid_arch_obj_pres: "valid_arch_obj ao s \<Longrightarrow> valid_arch_obj ao s'"
|
||||
unfolding valid_arch_obj_def by (rule valid_vspace_obj_pres)
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
|
@ -753,9 +761,9 @@ context retype_region_proofs begin
|
|||
|
||||
interpretation retype_region_proofs_arch ..
|
||||
|
||||
lemma valid_arch_objs':
|
||||
assumes va: "valid_arch_objs s"
|
||||
shows "valid_arch_objs s'"
|
||||
lemma valid_vspace_objs':
|
||||
assumes vv: "valid_vspace_objs s"
|
||||
shows "valid_vspace_objs s'"
|
||||
proof
|
||||
fix p ao
|
||||
assume p: "(\<exists>\<rhd> p) s'"
|
||||
|
|
@ -764,22 +772,31 @@ proof
|
|||
by (simp add: ps_def obj_at_def s'_def split: if_split_asm)
|
||||
moreover
|
||||
{ assume "ArchObj ao = default_object ty dev us" with tyunt
|
||||
have "valid_arch_obj ao s'" by (rule valid_arch_obj_default)
|
||||
have "valid_vspace_obj ao s'" by (rule valid_vspace_obj_default)
|
||||
}
|
||||
moreover
|
||||
{ assume "ko_at (ArchObj ao) p s"
|
||||
with va p
|
||||
have "valid_arch_obj ao s"
|
||||
by (auto simp: vs_lookup' elim: valid_arch_objsD)
|
||||
hence "valid_arch_obj ao s'"
|
||||
by (rule valid_arch_obj_pres)
|
||||
with vv p
|
||||
have "valid_vspace_obj ao s"
|
||||
by (auto simp: vs_lookup' elim: valid_vspace_objsD)
|
||||
hence "valid_vspace_obj ao s'"
|
||||
by (rule valid_vspace_obj_pres)
|
||||
}
|
||||
ultimately
|
||||
show "valid_arch_obj ao s'" by blast
|
||||
show "valid_vspace_obj ao s'" by blast
|
||||
qed
|
||||
|
||||
lemma valid_arch_objs': "valid_arch_objs s \<Longrightarrow> valid_arch_objs s'"
|
||||
using valid_vspace_objs'
|
||||
unfolding valid_arch_objs_def valid_vspace_objs_def valid_arch_obj_def
|
||||
by auto
|
||||
|
||||
(* ML \<open>val pre_ctxt_0 = @{context}\<close> *)
|
||||
sublocale retype_region_proofs_gen?: retype_region_proofs_gen ..
|
||||
sublocale retype_region_proofs_gen?: retype_region_proofs_gen
|
||||
by (unfold_locales,
|
||||
auto simp: hyp_refs_eq[simplified s'_def ps_def]
|
||||
valid_default_arch_tcb)
|
||||
|
||||
(* local_setup \<open>note_new_facts pre_ctxt_0\<close> *)
|
||||
|
||||
end
|
||||
|
|
@ -943,10 +960,10 @@ lemma valid_arch_caps:
|
|||
|
||||
lemma valid_global_objs:
|
||||
"valid_global_objs s \<Longrightarrow> valid_global_objs s'"
|
||||
apply (simp add: valid_global_objs_def valid_ao_at_def)
|
||||
apply (simp add: valid_global_objs_def valid_vso_at_def)
|
||||
apply (elim conjE, intro conjI ballI)
|
||||
apply (erule exEI)
|
||||
apply (simp add: obj_at_pres valid_arch_obj_pres)
|
||||
apply (simp add: obj_at_pres valid_vspace_obj_pres)
|
||||
apply (simp add: obj_at_pres)
|
||||
apply (rule exEI, erule(1) bspec, simp add: obj_at_pres valid_arch_obj_pres)+
|
||||
done
|
||||
|
|
@ -1095,7 +1112,7 @@ lemma post_retype_invs:
|
|||
valid_global_refs valid_arch_state
|
||||
valid_irq_node_def obj_at_pres
|
||||
valid_arch_caps valid_global_objs
|
||||
valid_arch_objs' valid_irq_handlers
|
||||
valid_vspace_objs' valid_irq_handlers
|
||||
valid_mdb_rep2 mdb_and_revokable
|
||||
valid_pspace cur_tcb only_idle
|
||||
valid_kernel_mappings valid_asid_map
|
||||
|
|
@ -1111,7 +1128,7 @@ sublocale retype_region_proofs_invs?: retype_region_proofs_invs
|
|||
where region_in_kernel_window = region_in_kernel_window
|
||||
and post_retype_invs_check = post_retype_invs_check
|
||||
and post_retype_invs = post_retype_invs
|
||||
using post_retype_invs valid_cap valid_global_refs valid_arch_state valid_arch_objs'
|
||||
using post_retype_invs valid_cap valid_global_refs valid_arch_state valid_vspace_objs'
|
||||
by unfold_locales (auto simp: s'_def ps_def)
|
||||
|
||||
(* local_setup \<open>note_new_facts pre_ctxt_1\<close> *)
|
||||
|
|
@ -1241,7 +1258,6 @@ lemma init_arch_objects_excap[wp]:
|
|||
crunch st_tcb_at[wp]: init_arch_objects "st_tcb_at P t"
|
||||
(wp: crunch_wps ignore: update_object set_pml4)
|
||||
|
||||
|
||||
end
|
||||
|
||||
lemmas clearMemory_invs[wp] = X64.clearMemory_invs
|
||||
|
|
@ -1256,12 +1272,11 @@ lemmas caps_region_kernel_window_imp
|
|||
lemmas init_arch_objects_invs_from_restricted
|
||||
= X64.init_arch_objects_invs_from_restricted
|
||||
|
||||
|
||||
|
||||
lemmas init_arch_objects_wps
|
||||
= X64.init_arch_objects_cte_wp_at
|
||||
X64.init_arch_objects_valid_cap
|
||||
X64.init_arch_objects_cap_table
|
||||
X64.init_arch_objects_excap
|
||||
X64.init_arch_objects_st_tcb_at
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -21,6 +21,16 @@ context Arch begin global_naming X64
|
|||
|
||||
named_theorems Syscall_AI_assms
|
||||
|
||||
declare arch_get_sanitise_register_info_invs[Syscall_AI_assms]
|
||||
crunch pred_tcb_at[wp,Syscall_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "pred_tcb_at proj P t"
|
||||
crunch invs[wp,Syscall_AI_assms]: handle_arch_fault_reply "invs"
|
||||
crunch cap_to[wp,Syscall_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "ex_nonz_cap_to c"
|
||||
crunch it[wp,Syscall_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "\<lambda>s. P (idle_thread s)"
|
||||
crunch caps[wp,Syscall_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "\<lambda>s. P (caps_of_state s)"
|
||||
crunch cur_thread[wp,Syscall_AI_assms]: handle_arch_fault_reply, make_fault_msg, arch_get_sanitise_register_info "\<lambda>s. P (cur_thread s)"
|
||||
crunch valid_objs[wp,Syscall_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "valid_objs"
|
||||
crunch cte_wp_at[wp,Syscall_AI_assms]: handle_arch_fault_reply, arch_get_sanitise_register_info "\<lambda>s. P (cte_wp_at P' p s)"
|
||||
|
||||
crunch typ_at[wp, Syscall_AI_assms]: invoke_irq_control "\<lambda>s. P (typ_at T p s)"
|
||||
|
||||
lemma obj_refs_cap_rights_update[simp, Syscall_AI_assms]:
|
||||
|
|
|
|||
|
|
@ -93,6 +93,17 @@ lemma valid_ipc_buffer_cap_0[simp, TcbAcc_AI_assms]:
|
|||
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]:
|
||||
assumes x: "\<And>tcb. tcb_state (f tcb) = tcb_state tcb"
|
||||
assumes y: "\<And>tcb. tcb_arch_ref (f tcb) = tcb_arch_ref tcb"
|
||||
shows "\<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace> thread_set f t \<lbrace>\<lambda>rv s. P (state_hyp_refs_of s)\<rbrace>"
|
||||
apply (simp add: thread_set_def set_object_def)
|
||||
apply wp
|
||||
apply (clarsimp dest!: get_tcb_SomeD)
|
||||
apply (clarsimp elim!: rsubst[where P=P])
|
||||
apply (rule all_ext;
|
||||
clarsimp simp: state_hyp_refs_of_def hyp_refs_of_def tcb_hyp_refs_def get_tcb_def x y[simplified tcb_arch_ref_def])
|
||||
done
|
||||
|
||||
lemma mab_pb [simp]:
|
||||
"msg_align_bits \<le> pageBits"
|
||||
|
|
@ -132,6 +143,13 @@ lemma pred_tcb_cap_wp_at [TcbAcc_AI_assms]:
|
|||
apply fastforce+
|
||||
done
|
||||
|
||||
lemma as_user_hyp_refs_of[wp]:
|
||||
"\<lbrace>\<lambda>s. P (state_hyp_refs_of s)\<rbrace>
|
||||
as_user t m
|
||||
\<lbrace>\<lambda>rv s. P (state_hyp_refs_of s)\<rbrace>"
|
||||
apply (wp as_user_wp_thread_set_helper
|
||||
thread_set_hyp_refs_trivial | simp)+
|
||||
done
|
||||
|
||||
lemmas sts_typ_ats = sts_typ_ats abs_atyp_at_lifts [OF set_thread_state_typ_at]
|
||||
|
||||
|
|
|
|||
|
|
@ -143,6 +143,9 @@ lemma checked_insert_tcb_invs[wp]: (* arch specific *)
|
|||
apply (auto simp: is_cnode_or_valid_arch_def is_cap_simps)
|
||||
done
|
||||
|
||||
crunch tcb_at[wp, Tcb_AI_asms]: arch_get_sanitise_register_info "tcb_at a"
|
||||
crunch invs[wp, Tcb_AI_asms]: arch_get_sanitise_register_info "invs"
|
||||
crunch ex_nonz_cap_to[wp, Tcb_AI_asms]: arch_get_sanitise_register_info "ex_nonz_cap_to a"
|
||||
|
||||
lemma finalise_cap_not_cte_wp_at[Tcb_AI_asms]:
|
||||
assumes x: "P cap.NullCap"
|
||||
|
|
@ -165,12 +168,17 @@ lemma table_cap_ref_max_free_index_upd[simp,Tcb_AI_asms]:
|
|||
"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)
|
||||
|
||||
end
|
||||
|
||||
interpretation Tcb_AI_1? : Tcb_AI_1
|
||||
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
|
||||
by (unfold_locales; fact Tcb_AI_asms)
|
||||
proof goal_cases
|
||||
interpret Arch .
|
||||
case 1 show ?case by (unfold_locales; (fact Tcb_AI_asms)?)
|
||||
qed
|
||||
|
||||
context Arch begin global_naming X64
|
||||
|
||||
lemma use_no_cap_to_obj_asid_strg: (* arch specific *)
|
||||
"(cte_at p s \<and> no_cap_to_obj_dr_emp cap s \<and> valid_cap cap s \<and> invs s)
|
||||
|
|
@ -374,10 +382,9 @@ 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_asms)
|
||||
qed
|
||||
proof goal_cases
|
||||
interpret Arch .
|
||||
case 1 show ?case by (unfold_locales; (fact Tcb_AI_asms)?)
|
||||
qed
|
||||
|
||||
end
|
||||
|
|
@ -267,7 +267,7 @@ lemma set_untyped_cap_invs_simple[Untyped_AI_assms]:
|
|||
set_cap_idle update_cap_ifunsafe)
|
||||
apply (simp add:valid_irq_node_def)
|
||||
apply wps
|
||||
apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap_arch_objs set_cap_valid_arch_caps
|
||||
apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap_vspace_objs set_cap_valid_arch_caps
|
||||
set_cap_valid_global_objs set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at
|
||||
set_untyped_cap_refs_respects_device_simple)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state is_cap_simps)
|
||||
|
|
@ -438,12 +438,12 @@ lemma store_pml4e_weaken:
|
|||
done
|
||||
|
||||
lemma store_pml4e_nonempty_table:
|
||||
"\<lbrace>\<lambda>s. \<not> (obj_at (nonempty_table (set (x64_global_pdpts (arch_state s)))) r s)
|
||||
"\<lbrace>\<lambda>s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)
|
||||
\<and> (\<forall>rf. pml4e_ref pml4e = Some rf \<longrightarrow>
|
||||
rf \<in> set (x64_global_pdpts (arch_state s)))
|
||||
rf \<in> set (second_level_tables (arch_state s)))
|
||||
\<and> ucast (pml4e_ptr && mask pml4_bits >> 3) \<in> kernel_mapping_slots\<rbrace>
|
||||
store_pml4e pml4e_ptr pml4e
|
||||
\<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table (set (x64_global_pdpts (arch_state s)))) r s)\<rbrace>"
|
||||
\<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)\<rbrace>"
|
||||
apply (simp add: store_pml4e_def update_object_def set_object_def)
|
||||
apply (wp get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def nonempty_table_def a_type_def word_size_bits_def empty_table_def)
|
||||
|
|
@ -452,7 +452,7 @@ lemma store_pml4e_nonempty_table:
|
|||
lemma store_pml4e_global_global_objs:
|
||||
"\<lbrace>\<lambda>s. valid_global_objs s \<and> valid_arch_state s
|
||||
\<and> (\<forall>rf. pml4e_ref pml4e = Some rf \<longrightarrow>
|
||||
rf \<in> set (x64_global_pdpts (arch_state s)))
|
||||
rf \<in> set (second_level_tables (arch_state s)))
|
||||
\<and> ucast (pml4e_ptr && mask pml4_bits >> 3) \<in> kernel_mapping_slots
|
||||
\<rbrace>
|
||||
store_pml4e pml4e_ptr pml4e
|
||||
|
|
@ -481,11 +481,11 @@ lemma pml4_bits_ptTranslationBits_diff:
|
|||
|
||||
lemma copy_global_mappings_nonempty_table:
|
||||
"is_aligned pm pml4_bits \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. \<not> (obj_at (nonempty_table (set (x64_global_pdpts (arch_state s)))) r s) \<and>
|
||||
\<lbrace>\<lambda>s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \<and>
|
||||
valid_global_objs s \<and> valid_arch_state s \<and> pspace_aligned s\<rbrace>
|
||||
copy_global_mappings pm
|
||||
\<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table
|
||||
(set (x64_global_pdpts (arch_state s)))) r s) \<and>
|
||||
(set (second_level_tables (arch_state s)))) r s) \<and>
|
||||
valid_global_objs s \<and> valid_arch_state s \<and> pspace_aligned s\<rbrace>"
|
||||
apply (simp add: copy_global_mappings_def)
|
||||
apply (rule hoare_seq_ext [OF _ gets_sp])
|
||||
|
|
@ -530,11 +530,11 @@ lemma copy_global_mappings_nonempty_table:
|
|||
|
||||
|
||||
lemma mapM_copy_global_mappings_nonempty_table[wp]:
|
||||
"\<lbrace>(\<lambda>s. \<not> (obj_at (nonempty_table (set (x64_global_pdpts (arch_state s)))) r s)
|
||||
"\<lbrace>(\<lambda>s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)
|
||||
\<and> valid_global_objs s \<and> valid_arch_state s \<and> pspace_aligned s) and
|
||||
K (\<forall>pd\<in>set pds. is_aligned pd pml4_bits)\<rbrace>
|
||||
mapM_x copy_global_mappings pds
|
||||
\<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table (set (x64_global_pdpts (arch_state s)))) r s)\<rbrace>"
|
||||
\<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)\<rbrace>"
|
||||
apply (rule hoare_gen_asm)
|
||||
apply (rule hoare_strengthen_post)
|
||||
apply (rule mapM_x_wp', rule copy_global_mappings_nonempty_table)
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ where
|
|||
| "pte_range (SmallPagePTE ptr x y) p = {p}"
|
||||
|
||||
abbreviation "valid_pt_entries \<equiv> \<lambda>pt. valid_entries pte_range pt"
|
||||
|
||||
thm valid_entries_def
|
||||
abbreviation "valid_pd_entries \<equiv> \<lambda>pd. valid_entries pde_range pd"
|
||||
|
||||
abbreviation "valid_pdpt_entries \<equiv> \<lambda>pdpt. valid_entries pdpte_range pdpt"
|
||||
|
|
@ -68,13 +68,13 @@ lemmas obj_valid_vspace_simps[simp]
|
|||
arch_kernel_obj.split]
|
||||
|
||||
abbreviation
|
||||
valid_vspace_objs :: "'z state \<Rightarrow> bool"
|
||||
valid_vspace_objs' :: "'z state \<Rightarrow> bool"
|
||||
where
|
||||
"valid_vspace_objs s \<equiv> \<forall>x \<in> ran (kheap s). obj_valid_vspace x"
|
||||
"valid_vspace_objs' s \<equiv> \<forall>x \<in> ran (kheap s). obj_valid_vspace x"
|
||||
|
||||
(* FIXME x64: initial state
|
||||
lemma valid_vspace_init[iff]:
|
||||
"valid_vspace_objs init_A_st"
|
||||
"valid_vspace_objs' init_A_st"
|
||||
proof -
|
||||
have P: "valid_pml4_entries (global_pm :: 9 word \<Rightarrow> _)"
|
||||
apply (clarsimp simp: valid_entries_def)
|
||||
|
|
@ -86,15 +86,15 @@ proof -
|
|||
qed
|
||||
*)
|
||||
|
||||
lemma set_object_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and K (obj_valid_vspace obj)\<rbrace>
|
||||
lemma set_object_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and K (obj_valid_vspace obj)\<rbrace>
|
||||
set_object ptr obj
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: set_object_def, wp)
|
||||
apply (auto simp: fun_upd_def[symmetric] del: ballI elim: ball_ran_updI)
|
||||
done
|
||||
|
||||
crunch valid_vspace_objs[wp]: cap_insert, cap_swap_for_delete,empty_slot "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: cap_insert, cap_swap_for_delete,empty_slot "valid_vspace_objs'"
|
||||
(wp: crunch_wps simp: crunch_simps ignore:set_object)
|
||||
|
||||
(*
|
||||
|
|
@ -175,26 +175,26 @@ lemma valid_pml4_entries_invalid[simp]:
|
|||
"valid_pml4_entries (\<lambda>x. InvalidPML4E)"
|
||||
by (simp add:valid_entries_def)
|
||||
|
||||
lemma valid_vspace_objs_pml4D:
|
||||
"\<lbrakk>valid_vspace_objs s;
|
||||
lemma valid_vspace_objs'_pml4D:
|
||||
"\<lbrakk>valid_vspace_objs' s;
|
||||
kheap s ptr = Some (ArchObj (arch_kernel_obj.PageMapL4 pml4))\<rbrakk>
|
||||
\<Longrightarrow> valid_pml4_entries pml4"
|
||||
by (fastforce simp:ran_def)
|
||||
|
||||
lemma valid_vspace_objs_pdptD:
|
||||
"\<lbrakk>valid_vspace_objs s;
|
||||
lemma valid_vspace_objs'_pdptD:
|
||||
"\<lbrakk>valid_vspace_objs' s;
|
||||
kheap s ptr = Some (ArchObj (arch_kernel_obj.PDPointerTable pdpt))\<rbrakk>
|
||||
\<Longrightarrow> valid_pdpt_entries pdpt"
|
||||
by (fastforce simp:ran_def)
|
||||
|
||||
lemma valid_vspace_objs_pdD:
|
||||
"\<lbrakk>valid_vspace_objs s;
|
||||
lemma valid_vspace_objs'_pdD:
|
||||
"\<lbrakk>valid_vspace_objs' s;
|
||||
kheap s ptr = Some (ArchObj (arch_kernel_obj.PageDirectory pd))\<rbrakk>
|
||||
\<Longrightarrow> valid_pd_entries pd"
|
||||
by (fastforce simp:ran_def)
|
||||
|
||||
lemma valid_vspace_objs_ptD:
|
||||
"\<lbrakk>valid_vspace_objs s;
|
||||
lemma valid_vspace_objs'_ptD:
|
||||
"\<lbrakk>valid_vspace_objs' s;
|
||||
kheap s ptr = Some (ArchObj (arch_kernel_obj.PageTable pt))\<rbrakk>
|
||||
\<Longrightarrow> valid_pt_entries pt"
|
||||
by (fastforce simp:ran_def)
|
||||
|
|
@ -226,9 +226,9 @@ lemma mapM_x_store_pde_updates:
|
|||
apply (rule ext, clarsimp)
|
||||
done
|
||||
|
||||
lemma store_pde_valid_vspace_objs:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace>
|
||||
store_pde p pde \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma store_pde_valid_vspace_objs':
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace>
|
||||
store_pde p pde \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: store_pde_def set_pd_def update_object_def, wp get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (rule valid_entries_overwrite_0)
|
||||
|
|
@ -241,9 +241,9 @@ lemma store_pde_valid_vspace_objs:
|
|||
apply (case_tac pde,simp_all)
|
||||
done
|
||||
|
||||
lemma store_pte_valid_vspace_objs:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace>
|
||||
store_pte p pte \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma store_pte_valid_vspace_objs':
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace>
|
||||
store_pte p pte \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: store_pte_def set_pt_def update_object_def, wp get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (rule valid_entries_overwrite_0)
|
||||
|
|
@ -255,9 +255,9 @@ lemma store_pte_valid_vspace_objs:
|
|||
apply (case_tac pte,simp_all)
|
||||
done
|
||||
|
||||
lemma store_pdpte_valid_vspace_objs:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace>
|
||||
store_pdpte p pdpte \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma store_pdpte_valid_vspace_objs':
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace>
|
||||
store_pdpte p pdpte \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: store_pdpte_def set_pdpt_def update_object_def, wp get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (rule valid_entries_overwrite_0)
|
||||
|
|
@ -270,9 +270,9 @@ lemma store_pdpte_valid_vspace_objs:
|
|||
apply (case_tac pdpte,simp_all)
|
||||
done
|
||||
|
||||
lemma store_pml4e_valid_vspace_objs:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace>
|
||||
store_pml4e p pml4e \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma store_pml4e_valid_vspace_objs':
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace>
|
||||
store_pml4e p pml4e \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: store_pml4e_def set_pml4_def update_object_def, wp get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (rule valid_entries_overwrite_0)
|
||||
|
|
@ -284,8 +284,8 @@ lemma store_pml4e_valid_vspace_objs:
|
|||
apply (case_tac pml4e,simp_all)
|
||||
done
|
||||
|
||||
lemma unmap_page_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> unmap_page sz asid vptr pptr \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma unmap_page_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> unmap_page sz asid vptr pptr \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: unmap_page_def mapM_discarded
|
||||
cong: vmpage_size.case_cong)
|
||||
apply (wp)
|
||||
|
|
@ -294,17 +294,17 @@ lemma unmap_page_valid_vspace_objs[wp]:
|
|||
apply (rule hoare_pre)
|
||||
apply (wp get_object_wp get_pte_wp get_pde_wp lookup_pt_slot_inv_any lookup_pd_slot_inv_any
|
||||
get_pdpte_wp lookup_pdpt_slot_inv_any
|
||||
store_pte_valid_vspace_objs store_pde_valid_vspace_objs store_pdpte_valid_vspace_objs
|
||||
store_pte_valid_vspace_objs' store_pde_valid_vspace_objs' store_pdpte_valid_vspace_objs'
|
||||
|
||||
| simp add: mapM_x_map
|
||||
| wpc | simp add: check_mapping_pptr_def)+
|
||||
done
|
||||
|
||||
lemma flush_table_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> flush_table a b c d \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma flush_table_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> flush_table a b c d \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
by (wp mapM_x_wp' | wpc | simp add: flush_table_def | rule hoare_pre)+
|
||||
|
||||
crunch valid_vspace_objs[wp]: invalidate_local_page_structure_cache_asid valid_vspace_objs
|
||||
crunch valid_vspace_objs'[wp]: invalidate_local_page_structure_cache_asid valid_vspace_objs'
|
||||
|
||||
crunch kheap[wp]: get_cap "\<lambda>s. P (kheap s)"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
|
|
@ -313,28 +313,28 @@ lemma flush_table_kheap[wp]:
|
|||
"\<lbrace>\<lambda>s. P (kheap s)\<rbrace> flush_table a b c d \<lbrace>\<lambda>rv s. P (kheap s)\<rbrace>"
|
||||
by (wp mapM_x_wp' | wpc | simp add: flush_table_def | rule hoare_pre)+
|
||||
|
||||
lemma unmap_page_table_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> unmap_page_table asid vptr pt \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma unmap_page_table_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> unmap_page_table asid vptr pt \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: unmap_page_table_def)
|
||||
apply (wp get_object_wp store_pde_valid_vspace_objs get_pde_wp lookup_pd_slot_inv_any | wpc)+
|
||||
apply (wp get_object_wp store_pde_valid_vspace_objs' get_pde_wp lookup_pd_slot_inv_any | wpc)+
|
||||
apply (simp add: obj_at_def)
|
||||
done
|
||||
|
||||
crunch valid_vspace_objs[wp]: finalise_cap, cap_swap_for_delete, empty_slot "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: finalise_cap, cap_swap_for_delete, empty_slot "valid_vspace_objs'"
|
||||
(wp: crunch_wps select_wp preemption_point_inv simp: crunch_simps unless_def ignore:set_object)
|
||||
|
||||
lemma preemption_point_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> preemption_point \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma preemption_point_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> preemption_point \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
by (wp preemption_point_inv | simp)+
|
||||
|
||||
lemmas cap_revoke_preservation_valid_vspace_objs = cap_revoke_preservation[OF _,
|
||||
where E=valid_vspace_objs,
|
||||
where E=valid_vspace_objs',
|
||||
simplified, THEN validE_valid]
|
||||
|
||||
lemmas rec_del_preservation_valid_vspace_objs = rec_del_preservation[OF _ _ _ _,
|
||||
where P=valid_vspace_objs, simplified]
|
||||
where P=valid_vspace_objs', simplified]
|
||||
|
||||
crunch valid_vspace_objs[wp]: cap_delete, cap_revoke "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: cap_delete, cap_revoke "valid_vspace_objs'"
|
||||
(wp: rec_del_preservation_valid_vspace_objs cap_revoke_preservation_valid_vspace_objs)
|
||||
|
||||
lemma mapM_x_copy_pml4e_updates:
|
||||
|
|
@ -370,10 +370,10 @@ lemma mapM_x_copy_pml4e_updates:
|
|||
apply (rule ext, simp add: mask_add_aligned)
|
||||
done
|
||||
|
||||
lemma copy_global_mappings_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and valid_arch_state and pspace_aligned
|
||||
lemma copy_global_mappings_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and valid_arch_state and pspace_aligned
|
||||
and K (is_aligned p pml4_bits)\<rbrace>
|
||||
copy_global_mappings p \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
copy_global_mappings p \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (rule hoare_gen_asm)
|
||||
apply (simp add: copy_global_mappings_def)
|
||||
apply wp
|
||||
|
|
@ -465,49 +465,49 @@ lemma non_invalid_in_pdpte_range:
|
|||
\<Longrightarrow> x \<in> pdpte_range pdpte x"
|
||||
by (case_tac pdpte,simp_all)
|
||||
|
||||
crunch valid_vspace_objs[wp]: cancel_badged_sends "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: cancel_badged_sends "valid_vspace_objs'"
|
||||
(simp: crunch_simps filterM_mapM wp: crunch_wps ignore: filterM)
|
||||
|
||||
crunch valid_vspace_objs[wp]: cap_move, cap_insert "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: cap_move, cap_insert "valid_vspace_objs'"
|
||||
|
||||
lemma invoke_cnode_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and invs and valid_cnode_inv i\<rbrace> invoke_cnode i \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma invoke_cnode_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and invs and valid_cnode_inv i\<rbrace> invoke_cnode i \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: invoke_cnode_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp get_cap_wp | wpc | simp split del: if_split)+
|
||||
done
|
||||
|
||||
lemma as_user_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> as_user t m \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma as_user_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> as_user t m \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: as_user_def split_def)
|
||||
apply wp
|
||||
apply simp
|
||||
done
|
||||
|
||||
crunch valid_vspace_objs[wp]: invoke_tcb "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: invoke_tcb "valid_vspace_objs'"
|
||||
(wp: check_cap_inv crunch_wps simp: crunch_simps
|
||||
ignore: check_cap_at)
|
||||
|
||||
lemma invoke_domain_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> invoke_domain t d \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma invoke_domain_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> invoke_domain t d \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
by (simp add: invoke_domain_def | wp)+
|
||||
|
||||
crunch valid_vspace_objs[wp]: set_extra_badge, transfer_caps_loop "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: set_extra_badge, transfer_caps_loop "valid_vspace_objs'"
|
||||
(wp: transfer_caps_loop_pres)
|
||||
|
||||
crunch valid_vspace_objs[wp]: send_ipc, send_signal,
|
||||
do_reply_transfer, invoke_irq_control, invoke_irq_handler "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: send_ipc, send_signal,
|
||||
do_reply_transfer, invoke_irq_control, invoke_irq_handler "valid_vspace_objs'"
|
||||
(wp: crunch_wps simp: crunch_simps
|
||||
ignore: clearMemory const_on_failure set_object)
|
||||
|
||||
lemma valid_vspace_objs_trans_state[simp]: "valid_vspace_objs (trans_state f s) = valid_vspace_objs s"
|
||||
lemma valid_vspace_objs'_trans_state[simp]: "valid_vspace_objs' (trans_state f s) = valid_vspace_objs' s"
|
||||
apply (simp add: obj_valid_vspace_def)
|
||||
done
|
||||
|
||||
lemma retype_region_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> retype_region ptr bits o_bits type dev \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma retype_region_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> retype_region ptr bits o_bits type dev \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: retype_region_def split del: if_split)
|
||||
apply (wp | simp only: valid_vspace_objs_trans_state trans_state_update[symmetric])+
|
||||
apply (wp | simp only: valid_vspace_objs'_trans_state trans_state_update[symmetric])+
|
||||
apply (clarsimp simp: retype_addrs_fold foldr_upd_app_if ranI
|
||||
elim!: ranE split: if_split_asm simp del:fun_upd_apply)
|
||||
apply (simp add: default_object_def default_arch_object_def
|
||||
|
|
@ -516,26 +516,26 @@ lemma retype_region_valid_vspace_objs[wp]:
|
|||
done
|
||||
|
||||
lemma detype_valid_vspace[elim!]:
|
||||
"valid_vspace_objs s \<Longrightarrow> valid_vspace_objs (detype S s)"
|
||||
"valid_vspace_objs' s \<Longrightarrow> valid_vspace_objs' (detype S s)"
|
||||
by (auto simp add: detype_def ran_def)
|
||||
|
||||
crunch valid_vspace_objs[wp]: create_cap "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: create_cap "valid_vspace_objs'"
|
||||
(ignore: clearMemory simp: crunch_simps)
|
||||
|
||||
lemma init_arch_objects_valid_vspace:
|
||||
"\<lbrace>valid_vspace_objs and pspace_aligned and valid_arch_state
|
||||
"\<lbrace>valid_vspace_objs' and pspace_aligned and valid_arch_state
|
||||
and K (orefs = retype_addrs ptr type n us)
|
||||
and K (range_cover ptr sz (obj_bits_api type us) n)\<rbrace>
|
||||
init_arch_objects type ptr n obj_sz orefs
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (rule hoare_gen_asm)+
|
||||
apply (simp add: init_arch_objects_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp | wpc)+
|
||||
apply (rule_tac Q="\<lambda>rv. valid_vspace_objs and pspace_aligned and valid_arch_state"
|
||||
apply (rule_tac Q="\<lambda>rv. valid_vspace_objs' and pspace_aligned and valid_arch_state"
|
||||
in hoare_post_imp, simp)
|
||||
apply (rule mapM_x_wp')
|
||||
apply (rule hoare_pre, wp copy_global_mappings_valid_vspace_objs)
|
||||
apply (rule hoare_pre, wp copy_global_mappings_valid_vspace_objs')
|
||||
apply clarsimp
|
||||
apply (drule retype_addrs_aligned[where sz = sz])
|
||||
apply (simp add:range_cover_def)
|
||||
|
|
@ -545,34 +545,34 @@ lemma init_arch_objects_valid_vspace:
|
|||
arch_kobj_size_def default_arch_object_def range_cover_def)+
|
||||
done
|
||||
|
||||
lemma delete_objects_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs\<rbrace> delete_objects ptr bits \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma delete_objects_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs'\<rbrace> delete_objects ptr bits \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
by (rule delete_objects_reduct) (wp detype_valid_vspace)
|
||||
|
||||
crunch valid_vspace_objs[wp]: reset_untyped_cap "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: reset_untyped_cap "valid_vspace_objs'"
|
||||
(wp: mapME_x_inv_wp crunch_wps simp: crunch_simps unless_def)
|
||||
|
||||
lemma invoke_untyped_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and invs and ct_active
|
||||
lemma invoke_untyped_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and invs and ct_active
|
||||
and valid_untyped_inv ui\<rbrace>
|
||||
invoke_untyped ui
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (rule hoare_pre, rule invoke_untyped_Q)
|
||||
apply (wp init_arch_objects_valid_vspace | simp)+
|
||||
apply (auto simp: post_retype_invs_def split: if_split_asm)[1]
|
||||
apply (wp | simp)+
|
||||
done
|
||||
|
||||
lemma update_object_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and K (obj_valid_vspace obj)\<rbrace>
|
||||
lemma update_object_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and K (obj_valid_vspace obj)\<rbrace>
|
||||
update_object ptr obj
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: update_object_def, wp get_object_wp)
|
||||
apply (auto simp: fun_upd_def[symmetric] del: ballI elim: ball_ran_updI)
|
||||
done
|
||||
|
||||
crunch valid_vspace_objs[wp]: perform_asid_pool_invocation,
|
||||
perform_asid_control_invocation "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: perform_asid_pool_invocation,
|
||||
perform_asid_control_invocation "valid_vspace_objs'"
|
||||
(ignore: delete_objects update_object
|
||||
wp: static_imp_wp select_wp crunch_wps
|
||||
simp: crunch_simps unless_def)
|
||||
|
|
@ -621,19 +621,19 @@ lemma mask_pd_bits_shift_ucast_align[simp]:
|
|||
by (clarsimp simp: is_aligned_mask mask_def bit_simps) word_bitwise
|
||||
|
||||
|
||||
crunch valid_vspace_objs[wp]: pte_check_if_mapped, pde_check_if_mapped "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: pte_check_if_mapped, pde_check_if_mapped "valid_vspace_objs'"
|
||||
|
||||
lemma perform_page_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and valid_page_inv pinv\<rbrace>
|
||||
perform_page_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma perform_page_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and valid_page_inv pinv\<rbrace>
|
||||
perform_page_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: perform_page_invocation_def )
|
||||
apply (cases pinv,
|
||||
simp_all add: mapM_discarded
|
||||
split: sum.split arch_cap.split option.split,
|
||||
safe intro!: hoare_gen_asm hoare_gen_asm[unfolded K_def],
|
||||
simp_all add: mapM_x_Nil mapM_x_Cons mapM_x_map)
|
||||
apply (wp store_pte_valid_vspace_objs store_pde_valid_vspace_objs
|
||||
store_pdpte_valid_vspace_objs
|
||||
apply (wp store_pte_valid_vspace_objs' store_pde_valid_vspace_objs'
|
||||
store_pdpte_valid_vspace_objs'
|
||||
hoare_vcg_imp_lift[OF set_cap_arch_obj_neg] hoare_vcg_all_lift
|
||||
| clarsimp simp: cte_wp_at_weakenE[OF _ TrueI] obj_at_def
|
||||
swp_def valid_page_inv_def
|
||||
|
|
@ -644,14 +644,14 @@ lemma perform_page_valid_vspace_objs[wp]:
|
|||
| wp_once hoare_drop_imps)+
|
||||
done
|
||||
|
||||
lemma perform_page_table_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and valid_pti pinv\<rbrace>
|
||||
perform_page_table_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma perform_page_table_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and valid_pti pinv\<rbrace>
|
||||
perform_page_table_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: perform_page_table_invocation_def split_def
|
||||
cong: page_table_invocation.case_cong
|
||||
option.case_cong cap.case_cong arch_cap.case_cong)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp hoare_vcg_ex_lift store_pde_valid_vspace_objs store_pte_valid_vspace_objs
|
||||
apply (wp hoare_vcg_ex_lift store_pde_valid_vspace_objs' store_pte_valid_vspace_objs'
|
||||
set_cap_arch_obj hoare_vcg_all_lift mapM_x_wp'
|
||||
| wpc
|
||||
| simp add: swp_def
|
||||
|
|
@ -659,15 +659,15 @@ lemma perform_page_table_valid_vspace_objs[wp]:
|
|||
| wp_once hoare_drop_imps)+
|
||||
done
|
||||
|
||||
lemma perform_page_directory_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and valid_pdi pinv\<rbrace>
|
||||
perform_page_directory_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma perform_page_directory_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and valid_pdi pinv\<rbrace>
|
||||
perform_page_directory_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: perform_page_directory_invocation_def split_def
|
||||
cong: page_directory_invocation.case_cong
|
||||
option.case_cong cap.case_cong arch_cap.case_cong)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp hoare_vcg_ex_lift store_pde_valid_vspace_objs store_pte_valid_vspace_objs
|
||||
store_pdpte_valid_vspace_objs
|
||||
apply (wp hoare_vcg_ex_lift store_pde_valid_vspace_objs' store_pte_valid_vspace_objs'
|
||||
store_pdpte_valid_vspace_objs'
|
||||
set_cap_arch_obj hoare_vcg_all_lift mapM_x_wp'
|
||||
| wpc
|
||||
| simp add: swp_def
|
||||
|
|
@ -675,15 +675,15 @@ lemma perform_page_directory_valid_vspace_objs[wp]:
|
|||
| wp_once hoare_drop_imps)+
|
||||
done
|
||||
|
||||
lemma perform_pdpt_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and valid_pdpti pinv\<rbrace>
|
||||
perform_pdpt_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma perform_pdpt_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and valid_pdpti pinv\<rbrace>
|
||||
perform_pdpt_invocation pinv \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: perform_pdpt_invocation_def split_def
|
||||
cong: pdpt_invocation.case_cong
|
||||
option.case_cong cap.case_cong arch_cap.case_cong)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp hoare_vcg_ex_lift store_pde_valid_vspace_objs store_pte_valid_vspace_objs
|
||||
store_pdpte_valid_vspace_objs store_pml4e_valid_vspace_objs
|
||||
apply (wp hoare_vcg_ex_lift store_pde_valid_vspace_objs' store_pte_valid_vspace_objs'
|
||||
store_pdpte_valid_vspace_objs' store_pml4e_valid_vspace_objs'
|
||||
set_cap_arch_obj hoare_vcg_all_lift mapM_x_wp'
|
||||
| wpc
|
||||
| simp add: swp_def
|
||||
|
|
@ -691,12 +691,12 @@ lemma perform_pdpt_valid_vspace_objs[wp]:
|
|||
| wp_once hoare_drop_imps)+
|
||||
done
|
||||
|
||||
crunch valid_vspace_objs[wp]: perform_io_port_invocation valid_vspace_objs
|
||||
crunch valid_vspace_objs'[wp]: perform_io_port_invocation valid_vspace_objs'
|
||||
|
||||
lemma perform_invocation_valid_vspace_objs[wp]:
|
||||
"\<lbrace>invs and ct_active and valid_invocation i and valid_vspace_objs\<rbrace>
|
||||
lemma perform_invocation_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>invs and ct_active and valid_invocation i and valid_vspace_objs'\<rbrace>
|
||||
perform_invocation blocking call i
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
\<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (cases i, simp_all)
|
||||
apply (wp send_signal_interrupt_states | simp)+
|
||||
apply (clarsimp simp:)
|
||||
|
|
@ -706,12 +706,12 @@ lemma perform_invocation_valid_vspace_objs[wp]:
|
|||
apply (auto simp: valid_arch_inv_def )
|
||||
done
|
||||
|
||||
crunch valid_vspace_objs[wp]: handle_fault, reply_from_kernel "valid_vspace_objs"
|
||||
crunch valid_vspace_objs'[wp]: handle_fault, reply_from_kernel "valid_vspace_objs'"
|
||||
(simp: crunch_simps wp: crunch_wps)
|
||||
|
||||
lemma handle_invocation_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and invs and ct_active\<rbrace>
|
||||
handle_invocation calling blocking \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma handle_invocation_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and invs and ct_active\<rbrace>
|
||||
handle_invocation calling blocking \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: handle_invocation_def)
|
||||
apply (wp syscall_valid set_thread_state_ct_st
|
||||
| simp add: split_def | wpc
|
||||
|
|
@ -720,28 +720,28 @@ lemma handle_invocation_valid_vspace_objs[wp]:
|
|||
done
|
||||
|
||||
|
||||
crunch valid_vspace_objs[wp]: activate_thread,switch_to_thread, handle_hypervisor_fault,
|
||||
crunch valid_vspace_objs'[wp]: activate_thread,switch_to_thread, handle_hypervisor_fault,
|
||||
switch_to_idle_thread, handle_call, handle_recv, handle_reply,
|
||||
handle_send, handle_yield, handle_interrupt "valid_vspace_objs"
|
||||
handle_send, handle_yield, handle_interrupt "valid_vspace_objs'"
|
||||
(simp: crunch_simps wp: crunch_wps alternative_valid select_wp OR_choice_weak_wp select_ext_weak_wp
|
||||
ignore: without_preemption getActiveIRQ resetTimer ackInterrupt
|
||||
getFaultAddress OR_choice set_scheduler_action)
|
||||
|
||||
lemma handle_event_valid_vspace_objs[wp]:
|
||||
"\<lbrace>valid_vspace_objs and invs and ct_active\<rbrace> handle_event e \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
|
||||
lemma handle_event_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>valid_vspace_objs' and invs and ct_active\<rbrace> handle_event e \<lbrace>\<lambda>rv. valid_vspace_objs'\<rbrace>"
|
||||
apply (case_tac e; simp)
|
||||
by (wp | wpc | simp | wp_once hoare_drop_imps)+
|
||||
|
||||
lemma schedule_valid_vspace_objs[wp]: "\<lbrace>valid_vspace_objs\<rbrace> schedule :: (unit,unit) s_monad \<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
lemma schedule_valid_vspace_objs'[wp]: "\<lbrace>valid_vspace_objs'\<rbrace> schedule :: (unit,unit) s_monad \<lbrace>\<lambda>_. valid_vspace_objs'\<rbrace>"
|
||||
apply (simp add: schedule_def allActiveTCBs_def)
|
||||
apply (wp alternative_wp select_wp)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma call_kernel_valid_vspace_objs[wp]:
|
||||
"\<lbrace>invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s) and valid_vspace_objs\<rbrace>
|
||||
lemma call_kernel_valid_vspace_objs'[wp]:
|
||||
"\<lbrace>invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s) and valid_vspace_objs'\<rbrace>
|
||||
(call_kernel e) :: (unit,unit) s_monad
|
||||
\<lbrace>\<lambda>_. valid_vspace_objs\<rbrace>"
|
||||
\<lbrace>\<lambda>_. valid_vspace_objs'\<rbrace>"
|
||||
apply (cases e, simp_all add: call_kernel_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp | simp | wpc
|
||||
|
|
|
|||
|
|
@ -1049,7 +1049,7 @@ lemmas vs_lookup_pages1_is_wellformed_lookup
|
|||
= vs_lookup_pages1_wellformed.wellformed_lookup_axioms
|
||||
|
||||
lemma vs_refs_pages_vs_ref_lvl:
|
||||
"\<lbrakk> ko_at (ArchObj aobj) p s; (r, q) \<in> vs_refs_pages (ArchObj aobj); valid_arch_obj aobj s \<rbrakk>
|
||||
"\<lbrakk> ko_at (ArchObj aobj) p s; (r, q) \<in> vs_refs_pages (ArchObj aobj); valid_vspace_obj aobj s \<rbrakk>
|
||||
\<Longrightarrow> vs_ref_lvl (kheap s p) < vs_ref_lvl (kheap s q)"
|
||||
apply (cases aobj;
|
||||
clarsimp simp: vs_refs_pages_def graph_of_def ball_ran_eq obj_at_def
|
||||
|
|
@ -1064,7 +1064,7 @@ lemma vs_refs_pages_vs_ref_lvl:
|
|||
lemmas vs_refs_vs_ref_lvl = vs_refs_pages_vs_ref_lvl[OF _ vs_refs_vs_refs_pages]
|
||||
|
||||
lemma vs_lookup1_wellformed_order:
|
||||
"valid_arch_objs s
|
||||
"valid_vspace_objs s
|
||||
\<Longrightarrow> wellformed_order_lookup (vs_lookup1 s) (kheap s) vs_lookup1_on_heap_obj
|
||||
vs_ref_lvl (vs_asid_refs (x64_asid_table (arch_state s)))"
|
||||
apply (intro wellformed_order_lookup.intro vs_lookup1_wellformed.wellformed_lookup_axioms
|
||||
|
|
@ -1072,7 +1072,7 @@ lemma vs_lookup1_wellformed_order:
|
|||
apply (simp only: vs_lookup_def2[symmetric])
|
||||
apply (clarsimp simp add: vs_lookup1_def)
|
||||
apply (case_tac ko; (clarsimp simp: vs_refs_def; fail)?; rename_tac ako; clarsimp)
|
||||
apply (frule (2) valid_arch_objsD)
|
||||
apply (frule (2) valid_vspace_objsD)
|
||||
apply (case_tac ako; clarsimp simp: vs_refs_def)
|
||||
apply (drule (1) graph_of_in_ranD; clarsimp simp: obj_at_def)
|
||||
apply (match premises in "(i,_) \<in> graph_of _" for i \<Rightarrow>
|
||||
|
|
@ -1084,7 +1084,7 @@ lemma vs_lookup1_wellformed_order:
|
|||
done
|
||||
|
||||
lemma vs_lookup_pages1_wellformed_order:
|
||||
"\<lbrakk> valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s \<rbrakk>
|
||||
"\<lbrakk> valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s \<rbrakk>
|
||||
\<Longrightarrow> wellformed_order_lookup (vs_lookup_pages1 s) (kheap s) vs_lookup_pages1_on_heap_obj
|
||||
vs_ref_lvl (vs_asid_refs (x64_asid_table (arch_state s)))"
|
||||
apply (intro wellformed_order_lookup.intro vs_lookup_pages1_wellformed.wellformed_lookup_axioms
|
||||
|
|
|
|||
|
|
@ -125,7 +125,7 @@ lemma table_cap_ref_ap_eq:
|
|||
lemma vspace_at_asid_unique:
|
||||
"\<lbrakk> vspace_at_asid asid pm s; vspace_at_asid asid' pm s;
|
||||
unique_table_refs (caps_of_state s);
|
||||
valid_vs_lookup s; valid_arch_objs s; valid_global_objs s;
|
||||
valid_vs_lookup s; valid_vspace_objs s; valid_global_objs s;
|
||||
valid_arch_state s; asid < 2 ^ asid_bits; asid' < 2 ^ asid_bits \<rbrakk>
|
||||
\<Longrightarrow> asid = asid'"
|
||||
apply (clarsimp simp: vspace_at_asid_def)
|
||||
|
|
@ -155,7 +155,7 @@ lemma vspace_at_asid_unique2:
|
|||
lemma vspace_at_asid_uniq:
|
||||
"\<lbrakk> vspace_at_asid asid pml4 s; asid \<le> mask asid_bits; valid_asid_map s;
|
||||
unique_table_refs (caps_of_state s); valid_vs_lookup s;
|
||||
valid_arch_objs s; valid_global_objs s; valid_arch_state s \<rbrakk>
|
||||
valid_vspace_objs s; valid_global_objs s; valid_arch_state s \<rbrakk>
|
||||
\<Longrightarrow> vspace_at_uniq asid pml4 s"
|
||||
apply (clarsimp simp: vspace_at_uniq_def ran_option_map
|
||||
dest!: ran_restrictD)
|
||||
|
|
@ -321,6 +321,14 @@ lemma valid_arch_objs_unmap_strg:
|
|||
apply blast
|
||||
done
|
||||
|
||||
lemma valid_vspace_objs_unmap_strg:
|
||||
"valid_vspace_objs s \<longrightarrow>
|
||||
valid_vspace_objs(s\<lparr>arch_state := arch_state s\<lparr>x64_asid_table := (x64_asid_table (arch_state s))(ptr := None)\<rparr>\<rparr>)"
|
||||
apply (clarsimp simp: valid_vspace_objs_def)
|
||||
apply (drule vs_lookup_clear_asid_table [rule_format])
|
||||
apply blast
|
||||
done
|
||||
|
||||
|
||||
lemma valid_vs_lookup_unmap_strg:
|
||||
"valid_vs_lookup s \<longrightarrow>
|
||||
|
|
@ -439,6 +447,9 @@ crunch caps_of_state[wp]: invalidate_asid_entry "\<lambda>s. P (caps_of_state s)
|
|||
crunch arch_objs [wp]: invalidate_asid_entry valid_arch_objs
|
||||
(simp: valid_arch_objs_arch_update)
|
||||
|
||||
crunch vspace_objs [wp]: invalidate_asid_entry valid_vspace_objs
|
||||
(simp: valid_vspace_objs_arch_update)
|
||||
|
||||
lemma invalidate_asid_invalidates:
|
||||
"\<lbrace>valid_asid_map and valid_arch_state and K (asid \<le> mask asid_bits) and
|
||||
(\<lambda>s. x64_asid_table (arch_state s) (asid_high_bits_of asid) = Some ap)\<rbrace>
|
||||
|
|
@ -449,7 +460,7 @@ lemma invalidate_asid_invalidates:
|
|||
Some ap \<longrightarrow>
|
||||
x64_asid_map (arch_state s) asida = None\<rbrace>"
|
||||
apply (simp add: invalidate_asid_def)
|
||||
apply (wp )
|
||||
apply wp
|
||||
apply clarsimp
|
||||
apply (clarsimp simp: valid_arch_state_def valid_asid_table_def)
|
||||
apply (drule_tac x="asid_high_bits_of asid" and y="asid_high_bits_of asida" in inj_onD)
|
||||
|
|
@ -495,8 +506,9 @@ lemma invalidate_asid_invs [wp]:
|
|||
valid_global_refs_def global_refs_def
|
||||
valid_vs_lookup_def
|
||||
vs_lookup_arch_update vs_lookup_pages_arch_update
|
||||
valid_arch_objs_def valid_arch_state_def
|
||||
simp del: fun_upd_apply)
|
||||
valid_vspace_objs_def valid_arch_state_def
|
||||
second_level_tables_def
|
||||
simp del: fun_upd_apply)
|
||||
apply (clarsimp simp: valid_asid_map_def valid_machine_state_def)
|
||||
apply (rule conjI)
|
||||
apply (erule order_trans[rotated], clarsimp)
|
||||
|
|
@ -590,7 +602,7 @@ lemma valid_global_objs_arch_update:
|
|||
\<and> x64_global_pds (f (arch_state s)) = x64_global_pds (arch_state s)
|
||||
\<and> x64_global_pts (f (arch_state s)) = x64_global_pts (arch_state s)
|
||||
\<Longrightarrow> valid_global_objs (arch_state_update f s) = valid_global_objs s"
|
||||
by (simp add: valid_global_objs_def)
|
||||
by (simp add: valid_global_objs_def second_level_tables_def)
|
||||
|
||||
|
||||
crunch pred_tcb_at [wp]: find_vspace_for_asid "\<lambda>s. P (pred_tcb_at proj Q p s)"
|
||||
|
|
@ -636,13 +648,13 @@ crunch typ_at [wp]: find_vspace_for_asid "\<lambda>s. P (typ_at T p s)"
|
|||
lemmas find_vspace_for_asid_typ_ats [wp] = abs_typ_at_lifts [OF find_vspace_for_asid_typ_at]
|
||||
|
||||
lemma find_vspace_for_asid_page_map_l4 [wp]:
|
||||
"\<lbrace>valid_arch_objs\<rbrace>
|
||||
"\<lbrace>valid_vspace_objs\<rbrace>
|
||||
find_vspace_for_asid asid
|
||||
\<lbrace>\<lambda>pd. page_map_l4_at pd\<rbrace>, -"
|
||||
apply (simp add: find_vspace_for_asid_def assertE_def whenE_def split del: if_split)
|
||||
apply (wp|wpc|clarsimp|rule conjI)+
|
||||
apply (drule vs_lookup_atI)
|
||||
apply (drule (2) valid_arch_objsD)
|
||||
apply (drule (2) valid_vspace_objsD)
|
||||
apply clarsimp
|
||||
apply (drule bspec, blast)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
|
|
@ -671,14 +683,14 @@ lemma find_vspace_for_asid_lookup[wp]:
|
|||
|
||||
|
||||
lemma find_vspace_for_asid_pde [wp]:
|
||||
"\<lbrace>valid_arch_objs and pspace_aligned\<rbrace>
|
||||
"\<lbrace>valid_vspace_objs and pspace_aligned\<rbrace>
|
||||
find_vspace_for_asid asid
|
||||
\<lbrace>\<lambda>pd. pml4e_at (pd + (get_pml4_index vptr << word_size_bits))\<rbrace>, -"
|
||||
proof -
|
||||
have x:
|
||||
"\<lbrace>valid_arch_objs and pspace_aligned\<rbrace> find_vspace_for_asid asid
|
||||
"\<lbrace>valid_vspace_objs and pspace_aligned\<rbrace> find_vspace_for_asid asid
|
||||
\<lbrace>\<lambda>pd. pspace_aligned and page_map_l4_at pd\<rbrace>, -"
|
||||
by (rule hoare_pre) (wp, simp)
|
||||
by wpsimp
|
||||
show ?thesis
|
||||
apply (rule hoare_post_imp_R, rule x)
|
||||
apply clarsimp
|
||||
|
|
@ -728,13 +740,13 @@ lemma find_vspace_for_asid_lookup_none:
|
|||
|
||||
|
||||
lemma find_vspace_for_asid_aligned_pm [wp]:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs\<rbrace> find_vspace_for_asid asid \<lbrace>\<lambda>rv s. is_aligned rv table_size\<rbrace>,-"
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs\<rbrace> find_vspace_for_asid asid \<lbrace>\<lambda>rv s. is_aligned rv table_size\<rbrace>,-"
|
||||
apply (simp add: find_vspace_for_asid_def assertE_def split del: if_split)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp|wpc)+
|
||||
apply clarsimp
|
||||
apply (drule vs_lookup_atI)
|
||||
apply (drule (2) valid_arch_objsD)
|
||||
apply (drule (2) valid_vspace_objsD)
|
||||
apply clarsimp
|
||||
apply (drule bspec, blast)
|
||||
apply (thin_tac "ko_at ko p s" for ko p)
|
||||
|
|
@ -745,7 +757,7 @@ lemma find_vspace_for_asid_aligned_pm [wp]:
|
|||
done
|
||||
|
||||
lemma find_vspace_for_asid_aligned_pm_bits[wp]:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs\<rbrace>
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs\<rbrace>
|
||||
find_vspace_for_asid asid
|
||||
\<lbrace>\<lambda>rv s. is_aligned rv pml4_bits\<rbrace>, -"
|
||||
by (simp add: pml4_bits_def pageBits_def, rule find_vspace_for_asid_aligned_pm)
|
||||
|
|
@ -753,7 +765,7 @@ lemma find_vspace_for_asid_aligned_pm_bits[wp]:
|
|||
lemma find_vspace_for_asid_lots:
|
||||
"\<lbrace>\<lambda>s. (\<forall>rv. ([VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
VSRef (ucast (asid_high_bits_of asid)) None] \<rhd> rv) s
|
||||
\<longrightarrow> (valid_arch_objs s \<longrightarrow> page_map_l4_at rv s)
|
||||
\<longrightarrow> (valid_vspace_objs s \<longrightarrow> page_map_l4_at rv s)
|
||||
\<longrightarrow> Q rv s)
|
||||
\<and> ((\<forall>rv. \<not> ([VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
VSRef (ucast (asid_high_bits_of asid)) None] \<rhd> rv) s) \<longrightarrow> (\<forall>e. E e s))\<rbrace>
|
||||
|
|
@ -811,24 +823,24 @@ where
|
|||
|
||||
lemma lookup_pdpt_slot_is_aligned:
|
||||
"\<lbrace>(\<exists>\<rhd> pm) and K (vmsz_aligned vptr sz) and K (is_aligned pm pml4_bits)
|
||||
and valid_arch_state and valid_arch_objs and equal_kernel_mappings
|
||||
and valid_arch_state and valid_vspace_objs and equal_kernel_mappings
|
||||
and pspace_aligned and valid_global_objs\<rbrace>
|
||||
lookup_pdpt_slot pm vptr
|
||||
\<lbrace>\<lambda>rv s. is_aligned rv word_size_bits\<rbrace>,-"
|
||||
apply (simp add: lookup_pdpt_slot_def)
|
||||
apply (wp get_pml4e_wp | wpc)+
|
||||
apply (clarsimp simp: lookup_pml4_slot_eq)
|
||||
apply (frule(2) valid_arch_objsD[rotated])
|
||||
apply (frule(2) valid_vspace_objsD[rotated])
|
||||
apply simp
|
||||
apply (rule is_aligned_add)
|
||||
apply (case_tac "ucast (lookup_pml4_slot pm vptr && mask pml4_bits >> word_size_bits) \<in> kernel_mapping_slots")
|
||||
apply (frule kernel_mapping_slots_empty_pml4eI)
|
||||
apply (simp add: obj_at_def)+
|
||||
apply (erule_tac x="ptrFromPAddr x" in allE)
|
||||
apply (simp add: pml4e_ref_def)
|
||||
apply (simp add: pml4e_ref_def second_level_tables_def)
|
||||
apply (erule is_aligned_weaken[OF is_aligned_global_pdpt])
|
||||
apply ((simp add: invs_psp_aligned invs_arch_objs invs_arch_state
|
||||
pdpt_bits_def pageBits_def bit_simps
|
||||
apply ((simp add: invs_psp_aligned invs_vspace_objs invs_arch_state
|
||||
pdpt_bits_def bit_simps
|
||||
split: vmpage_size.split)+)[3]
|
||||
apply (drule_tac x="ucast (lookup_pml4_slot pm vptr && mask pml4_bits >> word_size_bits)" in bspec, simp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def)
|
||||
|
|
@ -843,7 +855,7 @@ lemma lookup_pdpt_slot_is_aligned:
|
|||
(* FIXME x64: need pd, pt versions of this *)
|
||||
lemma lookup_pd_slot_is_aligned:
|
||||
"\<lbrace>(\<exists>\<rhd> pm) and K (vmsz_aligned vptr sz) and K (is_aligned pm pml4_bits)
|
||||
and valid_arch_state and valid_arch_objs and equal_kernel_mappings
|
||||
and valid_arch_state and valid_vspace_objs and equal_kernel_mappings
|
||||
and pspace_aligned and valid_global_objs\<rbrace>
|
||||
lookup_pd_slot pm vptr
|
||||
\<lbrace>\<lambda>rv s. is_aligned rv word_size_bits\<rbrace>,-"
|
||||
|
|
@ -994,7 +1006,7 @@ definition
|
|||
and cte_wp_at (\<lambda>c. is_arch_update cap c \<and> cap_asid c = None) cptr
|
||||
and (\<lambda>s. \<exists>x ref. (pde_ref_pages pde = Some x)
|
||||
\<and> x \<in> obj_refs cap
|
||||
\<and> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) x s
|
||||
\<and> obj_at (empty_table (set (second_level_tables (arch_state s)))) x s
|
||||
\<and> (ref \<rhd> (p && ~~ mask pd_bits)) s
|
||||
\<and> vs_cap_ref cap = Some (VSRef ((p && mask pd_bits >> word_size_bits) && mask ptTranslationBits) (Some APageDirectory) # ref))
|
||||
and K (is_pt_cap cap)
|
||||
|
|
@ -1014,7 +1026,7 @@ definition
|
|||
and cte_wp_at (\<lambda>c. is_arch_update cap c \<and> cap_asid c = None) cptr
|
||||
and (\<lambda>s. \<exists>x ref. (pdpte_ref_pages pdpte = Some x)
|
||||
\<and> x \<in> obj_refs cap
|
||||
\<and> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) x s
|
||||
\<and> obj_at (empty_table (set (second_level_tables (arch_state s)))) x s
|
||||
\<and> (ref \<rhd> (p && ~~ mask pdpt_bits)) s
|
||||
\<and> vs_cap_ref cap =
|
||||
Some (VSRef ((p && mask pdpt_bits >> word_size_bits) && mask ptTranslationBits)
|
||||
|
|
@ -1033,7 +1045,7 @@ definition
|
|||
and cte_wp_at (\<lambda>c. is_arch_update cap c \<and> cap_asid c = None) cptr
|
||||
and (\<lambda>s. \<exists>x ref. (pml4e_ref_pages pml4e = Some x)
|
||||
\<and> x \<in> obj_refs cap
|
||||
\<and> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) x s
|
||||
\<and> obj_at (empty_table (set (second_level_tables (arch_state s)))) x s
|
||||
\<and> (ref \<rhd> (p && ~~ mask pml4_bits)) s
|
||||
\<and> vs_cap_ref cap =
|
||||
Some (VSRef ((p && mask pml4_bits >> word_size_bits) && mask ptTranslationBits)
|
||||
|
|
@ -1123,14 +1135,14 @@ lemma arch_state_update_invs:
|
|||
shows "invs (arch_state_update f s)"
|
||||
using assms by (simp add: invs_def valid_state_def valid_irq_node_def valid_irq_states_def
|
||||
valid_machine_state_def valid_arch_caps_def
|
||||
valid_arch_objs_arch_update valid_vs_lookup_arch_update
|
||||
valid_vspace_objs_arch_update valid_vs_lookup_arch_update
|
||||
valid_asid_map_arch_update)
|
||||
|
||||
lemma set_current_cr3_invs[wp]:
|
||||
"\<lbrace>invs\<rbrace> set_current_cr3 c \<lbrace>\<lambda>rv. invs\<rbrace>"
|
||||
apply (wpsimp simp: set_current_cr3_def; erule arch_state_update_invs)
|
||||
by (auto simp: valid_global_refs_def global_refs_def valid_arch_state_def valid_table_caps_def
|
||||
valid_global_objs_def valid_kernel_mappings_def)
|
||||
valid_global_objs_def valid_kernel_mappings_def second_level_tables_def)
|
||||
|
||||
lemma set_current_vspace_root_invs[wp]:
|
||||
"\<lbrace>invs\<rbrace> set_current_vspace_root vspace asid \<lbrace>\<lambda>rv. invs\<rbrace>"
|
||||
|
|
@ -1157,10 +1169,11 @@ lemma update_asid_map_invs:
|
|||
apply (wp find_vspace_for_asid_assert_wp)
|
||||
apply (clarsimp simp: invs_def valid_state_def)
|
||||
apply (simp add: valid_global_refs_def global_refs_def
|
||||
valid_irq_node_def valid_arch_objs_arch_update
|
||||
valid_irq_node_def valid_vspace_objs_arch_update
|
||||
valid_global_objs_def valid_arch_caps_def
|
||||
valid_table_caps_def valid_kernel_mappings_def
|
||||
valid_machine_state_def valid_vs_lookup_arch_update)
|
||||
valid_machine_state_def valid_vs_lookup_arch_update
|
||||
second_level_tables_def)
|
||||
apply (simp add: valid_asid_map_def fun_upd_def[symmetric] vspace_at_asid_arch_up)
|
||||
done
|
||||
|
||||
|
|
@ -1280,9 +1293,9 @@ end
|
|||
|
||||
|
||||
lemma ref_is_unique:
|
||||
"\<lbrakk>(ref \<rhd> p) s; (ref' \<rhd> p) s; p \<notin> set (x64_global_pdpts (arch_state s));
|
||||
"\<lbrakk>(ref \<rhd> p) s; (ref' \<rhd> p) s; p \<notin> set (second_level_tables (arch_state s));
|
||||
valid_vs_lookup s; unique_table_refs (caps_of_state s);
|
||||
valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s;
|
||||
valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s;
|
||||
valid_caps (caps_of_state s) s\<rbrakk>
|
||||
\<Longrightarrow> ref = ref'"
|
||||
apply (erule (1) vs_lookupE_alt[OF _ _ valid_asid_table_ran], clarsimp)
|
||||
|
|
@ -1357,7 +1370,7 @@ lemma kernel_vsrefs_kernel_mapping_slots:
|
|||
done
|
||||
|
||||
lemma vs_lookup_typI:
|
||||
"\<lbrakk>(r \<rhd> p) s; valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
"\<lbrakk>(r \<rhd> p) s; valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
\<Longrightarrow> asid_pool_at p s \<or> vspace_table_at p s"
|
||||
apply (erule (1) vs_lookupE_alt)
|
||||
apply (clarsimp simp: ran_def)
|
||||
|
|
@ -1366,7 +1379,7 @@ lemma vs_lookup_typI:
|
|||
done
|
||||
|
||||
lemma vs_lookup_vs_lookup_pagesI:
|
||||
"\<lbrakk>(r \<rhd> p) s; (r' \<unrhd> p) s; valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
"\<lbrakk>(r \<rhd> p) s; (r' \<unrhd> p) s; valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
\<Longrightarrow> (r' \<rhd> p) s"
|
||||
by (erule (5) vs_lookup_vs_lookup_pagesI'[OF _ vs_lookup_typI])
|
||||
|
||||
|
|
@ -2132,8 +2145,8 @@ method rewrite_lookup_when_aligned
|
|||
and TP : "typ_at (AArch APageMapL4) p s" for s p P \<Rightarrow> \<open>rule revcut_rl[OF is_aligned_pml4[OF TP L]]\<close>
|
||||
, clarsimp simp: pml4_bits_def pml4_shifting[folded lookup_pml4_slot_def[unfolded Let_def], unfolded pml4_bits_def])
|
||||
|
||||
lemma valid_arch_objs_asidpoolD:
|
||||
"\<lbrakk>valid_arch_obj (ASIDPool pool) s; pool (ucast asid) = Some x\<rbrakk> \<Longrightarrow> typ_at (AArch APageMapL4) x s"
|
||||
lemma valid_vspace_objs_asidpoolD:
|
||||
"\<lbrakk>valid_vspace_obj (ASIDPool pool) s; pool (ucast asid) = Some x\<rbrakk> \<Longrightarrow> typ_at (AArch APageMapL4) x s"
|
||||
by fastforce
|
||||
|
||||
lemma vs_refs_get_pml4_index:
|
||||
|
|
@ -2174,32 +2187,32 @@ lemma vs_refs_get_pd_index:
|
|||
apply (clarsimp simp: mask_def)
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_pml4D:
|
||||
"\<lbrakk>valid_arch_obj (PageMapL4 pm) s; pm (ucast (get_pml4_index vaddr)) = PDPointerTablePML4E a b c;
|
||||
lemma valid_vspace_objs_pml4D:
|
||||
"\<lbrakk>valid_vspace_obj (PageMapL4 pm) s; pm (ucast (get_pml4_index vaddr)) = PDPointerTablePML4E a b c;
|
||||
vaddr < pptr_base; canonical_address vaddr\<rbrakk> \<Longrightarrow> typ_at (AArch APDPointerTable) (ptrFromPAddr a) s"
|
||||
apply (clarsimp)
|
||||
apply (drule bspec)
|
||||
apply (drule kernel_base_kernel_mapping_slots, simp+)
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_pdptD:
|
||||
"\<lbrakk>valid_arch_obj (PDPointerTable pdpt) s; pdpt x = PageDirectoryPDPTE a b c\<rbrakk>
|
||||
lemma valid_vspace_objs_pdptD:
|
||||
"\<lbrakk>valid_vspace_obj (PDPointerTable pdpt) s; pdpt x = PageDirectoryPDPTE a b c\<rbrakk>
|
||||
\<Longrightarrow> typ_at (AArch APageDirectory) (ptrFromPAddr a) s"
|
||||
apply (clarsimp)
|
||||
apply (drule_tac x = x in spec)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_pdD:
|
||||
"\<lbrakk>valid_arch_obj (PageDirectory pd) s; pd x = PageTablePDE a b c\<rbrakk>
|
||||
lemma valid_vspace_objs_pdD:
|
||||
"\<lbrakk>valid_vspace_obj (PageDirectory pd) s; pd x = PageTablePDE a b c\<rbrakk>
|
||||
\<Longrightarrow> typ_at (AArch APageTable) (ptrFromPAddr a) s"
|
||||
apply (clarsimp)
|
||||
apply (drule_tac x = x in spec)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_largePage:
|
||||
"\<lbrakk>valid_arch_obj (PageDirectory pd) s; pd x = LargePagePDE a b c; ko_at ko (ptrFromPAddr a) s\<rbrakk>
|
||||
lemma valid_vspace_objs_largePage:
|
||||
"\<lbrakk>valid_vspace_obj (PageDirectory pd) s; pd x = LargePagePDE a b c; ko_at ko (ptrFromPAddr a) s\<rbrakk>
|
||||
\<Longrightarrow> vs_refs_pages ko = {}"
|
||||
apply (clarsimp)
|
||||
apply (drule_tac x = x in spec)
|
||||
|
|
@ -2207,8 +2220,8 @@ lemma valid_arch_objs_largePage:
|
|||
apply (auto simp: data_at_def obj_at_def vs_refs_pages_def)
|
||||
done
|
||||
|
||||
lemma valid_arch_objs_hugePage:
|
||||
"\<lbrakk>valid_arch_obj (PDPointerTable pdpt) s; pdpt x = HugePagePDPTE a b c; ko_at ko (ptrFromPAddr a) s\<rbrakk>
|
||||
lemma valid_vspace_objs_hugePage:
|
||||
"\<lbrakk>valid_vspace_obj (PDPointerTable pdpt) s; pdpt x = HugePagePDPTE a b c; ko_at ko (ptrFromPAddr a) s\<rbrakk>
|
||||
\<Longrightarrow> vs_refs_pages ko = {}"
|
||||
apply (clarsimp)
|
||||
apply (drule_tac x = x in spec)
|
||||
|
|
@ -2229,29 +2242,29 @@ method extract_vs_lookup =
|
|||
| (match premises in path[thin]: "(_ \<rhd> p) s"
|
||||
and ko_at: "ko_at (ArchObj (ASIDPool pool)) p s"
|
||||
and pool: "pool (ucast (_ :: word64)) = Some _"
|
||||
and vs : "valid_arch_objs s" for pool p s
|
||||
and vs : "valid_vspace_objs s" for pool p s
|
||||
\<Rightarrow> \<open>cut_tac vs_lookup_step[OF path vs_lookup1I[OF ko_at asid_pool_refsD refl], OF pool]
|
||||
, cut_tac valid_arch_objs_asidpoolD[OF valid_arch_objsD,OF path ko_at vs pool]\<close>)
|
||||
, cut_tac valid_vspace_objs_asidpoolD[OF valid_vspace_objsD,OF path ko_at vs pool]\<close>)
|
||||
| (match premises in path[thin]: "(_ \<rhd> p) s"
|
||||
and ko_at: "ko_at (ArchObj (PageMapL4 pm)) p s"
|
||||
and pm: "pm _ = _"
|
||||
and vaddr: "vaddr < pptr_base"
|
||||
and cano: "canonical_address vaddr"
|
||||
and vs : "valid_arch_objs s" for pm p s vaddr
|
||||
and vs : "valid_vspace_objs s" for pm p s vaddr
|
||||
\<Rightarrow> \<open>cut_tac vs_lookup_step[OF path vs_lookup1I[OF ko_at vs_refs_get_pml4_index refl],OF pm vaddr cano]
|
||||
, cut_tac valid_arch_objs_pml4D[OF valid_arch_objsD,OF path ko_at vs pm vaddr cano]\<close>)
|
||||
, cut_tac valid_vspace_objs_pml4D[OF valid_vspace_objsD,OF path ko_at vs pm vaddr cano]\<close>)
|
||||
| (match premises in path[thin]: "(_ \<rhd> p) s"
|
||||
and ko_at: "ko_at (ArchObj (PDPointerTable pdpt)) p s"
|
||||
and pdpt: "pdpt (ucast (_::word64)) = PageDirectoryPDPTE _ _ _"
|
||||
and vs : "valid_arch_objs s" for pdpt p s
|
||||
and vs : "valid_vspace_objs s" for pdpt p s
|
||||
\<Rightarrow> \<open>cut_tac vs_lookup_step[OF path vs_lookup1I[OF ko_at vs_refs_get_pdpt_index refl],OF pdpt]
|
||||
, cut_tac valid_arch_objs_pdptD[OF valid_arch_objsD,OF path ko_at vs pdpt]\<close>)
|
||||
, cut_tac valid_vspace_objs_pdptD[OF valid_vspace_objsD,OF path ko_at vs pdpt]\<close>)
|
||||
| (match premises in path[thin]: "(_ \<rhd> p) s"
|
||||
and ko_at: "ko_at (ArchObj (PageDirectory pd)) p s"
|
||||
and pd: "pd (ucast (_::word64)) = PageTablePDE _ _ _"
|
||||
and vs : "valid_arch_objs s" for pd p s
|
||||
and vs : "valid_vspace_objs s" for pd p s
|
||||
\<Rightarrow> \<open>cut_tac vs_lookup_step[OF path vs_lookup1I[OF ko_at vs_refs_get_pd_index refl],OF pd]
|
||||
, cut_tac valid_arch_objs_pdD[OF valid_arch_objsD,OF path ko_at vs pd]\<close>)
|
||||
, cut_tac valid_vspace_objs_pdD[OF valid_vspace_objsD,OF path ko_at vs pd]\<close>)
|
||||
|
||||
lemma in_vs_asid_refsD:
|
||||
"(a,b)\<in> vs_asid_refs table \<Longrightarrow> \<exists>p. table p = Some b \<and> a = [VSRef (ucast p) None]"
|
||||
|
|
@ -2278,7 +2291,7 @@ lemma lookup_pml4_slot_mask:
|
|||
done
|
||||
|
||||
lemma unmap_pdpt_vs_lookup_pages_pre:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and typ_at (AArch APDPointerTable) pdpt
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and typ_at (AArch APDPointerTable) pdpt
|
||||
and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_pdpt asid vaddr pdpt
|
||||
\<lbrace>\<lambda>r s. (the (vs_cap_ref (ArchObjectCap (PDPointerTableCap pdpt (Some (asid,vaddr))))),pdpt) \<notin> vs_lookup_pages s\<rbrace>"
|
||||
|
|
@ -2292,7 +2305,7 @@ lemma unmap_pdpt_vs_lookup_pages_pre:
|
|||
apply (strengthen lookup_refs_pml4_shrink_strg valid_arch_state_asid_table_strg not_in_vs_refs_pages_strg
|
||||
| clarsimp )+
|
||||
apply (strengthen | wp hoare_vcg_imp_lift hoare_vcg_all_lift | clarsimp simp: conj_ac)+
|
||||
apply_trace (wpc | wp)+
|
||||
apply (wpc | wp)+
|
||||
apply (wp get_pml4e_wp)
|
||||
apply (simp add: find_vspace_for_asid_def | wp | wpc)+
|
||||
apply (wpc | wp get_pdpte_wp get_pml4e_wp assertE_wp | clarsimp simp: lookup_pml4_slot_def find_vspace_for_asid_def)
|
||||
|
|
@ -2334,7 +2347,7 @@ lemma unmap_pdpt_vs_lookup_pages_pre:
|
|||
qed
|
||||
|
||||
lemma unmap_pdpt_vs_lookup_pages:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and typ_at (AArch APDPointerTable) pd and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and typ_at (AArch APDPointerTable) pd and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_pdpt asid vaddr pd
|
||||
\<lbrace>\<lambda>r s. ([VSRef ((vaddr >> 39) && mask 9) (Some APageMapL4),
|
||||
VSRef (asid && mask asid_low_bits) (Some AASIDPool), VSRef (ucast (asid_high_bits_of asid)) None],
|
||||
|
|
@ -2348,7 +2361,7 @@ lemma unmap_pdpt_vs_lookup_pages:
|
|||
|
||||
|
||||
lemma unmap_pt_vs_lookup_pages_pre:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and typ_at (AArch APageTable) pt and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>unmap_page_table asid vaddr pt
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and typ_at (AArch APageTable) pt and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>unmap_page_table asid vaddr pt
|
||||
\<lbrace>\<lambda>r s. (the (vs_cap_ref (ArchObjectCap (PageTableCap pt (Some (asid,vaddr))))),pt) \<notin> vs_lookup_pages s\<rbrace>"
|
||||
proof -
|
||||
note ref_simps[simp] = vs_cap_ref_simps vs_ref_pages_simps
|
||||
|
|
@ -2410,14 +2423,14 @@ lemma unmap_pt_vs_lookup_pages_pre:
|
|||
apply (clarsimp simp: obj_at_def pdpte_ref_pages_def image_def vs_lookup_pages_def
|
||||
dest!: graph_ofD split: if_splits pdpte.split_asm)
|
||||
apply (clarsimp dest!: in_vs_asid_refsD wellformed_lookup.lookup_ref_step[OF vs_lookup_pages1_is_wellformed_lookup])
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: ko_at_def2)
|
||||
apply simp
|
||||
apply clarsimp
|
||||
apply (drule_tac x = a in spec)
|
||||
apply (clarsimp simp: data_at_def obj_at_def a_type_simps)
|
||||
apply (clarsimp dest!: in_vs_asid_refsD wellformed_lookup.lookup_ref_step[OF vs_lookup_pages1_is_wellformed_lookup])
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: ko_at_def2)
|
||||
apply simp
|
||||
apply clarsimp
|
||||
|
|
@ -2433,7 +2446,7 @@ lemma get_index_neq:
|
|||
by (auto simp: get_pt_index_def bit_simps up_ucast_inj_eq ucast_up_ucast ucast_ucast_id)
|
||||
|
||||
lemma unmap_page_vs_lookup_pages_pre:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state
|
||||
and data_at sz pg and K (vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_page sz asid vaddr pg
|
||||
\<lbrace>\<lambda>r s. (the (vs_cap_ref (ArchObjectCap (PageCap dev pg R typ sz (Some (asid,vaddr))))),pg) \<notin> vs_lookup_pages s\<rbrace>"
|
||||
|
|
@ -2551,7 +2564,7 @@ lemma unmap_page_vs_lookup_pages_pre:
|
|||
ucast_ucast_mask bit_simps obj_at_def
|
||||
dest!: vs_lookup_pages1D graph_ofD wellformed_lookup.lookup_rtrancl_stepD[OF vs_lookup_pages1_is_wellformed_lookup]
|
||||
split: pte.split_asm)
|
||||
apply (drule valid_arch_objs_largePage[OF valid_arch_objsD])
|
||||
apply (drule valid_vspace_objs_largePage[OF valid_vspace_objsD])
|
||||
apply (simp add: ko_at_def2)+
|
||||
apply (drule eq_ucast_ucast_eq[rotated,THEN sym], simp)
|
||||
apply (clarsimp simp: check_mapping_pptr_def get_pd_index_def get_pml4_index_def get_pdpt_index_def
|
||||
|
|
@ -2559,7 +2572,7 @@ lemma unmap_page_vs_lookup_pages_pre:
|
|||
dest!: vs_lookup_pages1D graph_ofD wellformed_lookup.lookup_rtrancl_stepD[OF vs_lookup_pages1_is_wellformed_lookup]
|
||||
wellformed_lookup.lookup_rtrancl_stepsD[where r = "[a]" for a, simplified,OF vs_lookup_pages1_is_wellformed_lookup]
|
||||
split: pte.split_asm)
|
||||
apply (drule valid_arch_objs_hugePage[OF valid_arch_objsD])
|
||||
apply (drule valid_vspace_objs_hugePage[OF valid_vspace_objsD])
|
||||
apply (simp add: ko_at_def2)+
|
||||
apply (erule wellformed_lookup.lookup_forwardE[OF vs_lookup_pages1_is_wellformed_lookup], (simp+)[2])
|
||||
apply (clarsimp dest!: vs_lookup_pages1D graph_ofD
|
||||
|
|
@ -2599,7 +2612,7 @@ lemma unmap_page_vs_lookup_pages_pre:
|
|||
apply (clarsimp dest!: vs_lookup_pages1D graph_ofD
|
||||
wellformed_lookup.lookup_rtrancl_stepD[OF vs_lookup_pages1_is_wellformed_lookup]
|
||||
simp: obj_at_def)
|
||||
apply (drule valid_arch_objs_hugePage[OF valid_arch_objsD])
|
||||
apply (drule valid_vspace_objs_hugePage[OF valid_vspace_objsD])
|
||||
apply (simp add: ko_at_def2)+
|
||||
apply (erule wellformed_lookup.lookup_forwardE[OF vs_lookup_pages1_is_wellformed_lookup], (simp+)[2])
|
||||
apply (clarsimp dest!: vs_lookup_pages1D graph_ofD
|
||||
|
|
@ -2628,7 +2641,7 @@ lemma unmap_page_vs_lookup_pages_pre:
|
|||
apply (clarsimp dest!: vs_lookup_pages1D graph_ofD
|
||||
wellformed_lookup.lookup_rtrancl_stepD[OF vs_lookup_pages1_is_wellformed_lookup]
|
||||
simp: obj_at_def pdpte_ref_pages_def[split_simps pdpte.split])
|
||||
apply (drule valid_arch_objs_pdptD[OF valid_arch_objsD])
|
||||
apply (drule valid_vspace_objs_pdptD[OF valid_vspace_objsD])
|
||||
apply (simp add: ko_at_def2)+
|
||||
apply (clarsimp simp: obj_at_def data_at_def a_type_simps)
|
||||
apply (clarsimp dest!: vs_lookup_pages1D graph_ofD
|
||||
|
|
@ -2639,7 +2652,7 @@ qed
|
|||
|
||||
(* FIXME x64: unmap_pdpt_vs_lookup_pages_pre might also needed here*)
|
||||
lemma unmap_pd_vs_lookup_pages_pre:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and typ_at (AArch APageDirectory) pd and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and typ_at (AArch APageDirectory) pd and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_pd asid vaddr pd
|
||||
\<lbrace>\<lambda>r s. (the (vs_cap_ref (ArchObjectCap (PageDirectoryCap pd (Some (asid,vaddr))))),pd) \<notin> vs_lookup_pages s\<rbrace>"
|
||||
proof -
|
||||
|
|
@ -2693,7 +2706,7 @@ lemma unmap_pd_vs_lookup_pages_pre:
|
|||
apply (clarsimp simp: obj_at_def pdpte_ref_pages_def image_def vs_lookup_pages_def
|
||||
dest!: graph_ofD split: if_splits pdpte.split_asm)
|
||||
apply (clarsimp dest!: in_vs_asid_refsD wellformed_lookup.lookup_ref_step[OF vs_lookup_pages1_is_wellformed_lookup])
|
||||
apply (drule valid_arch_objsD)
|
||||
apply (drule valid_vspace_objsD)
|
||||
apply (simp add: ko_at_def2)
|
||||
apply simp
|
||||
apply clarsimp
|
||||
|
|
@ -2703,7 +2716,7 @@ lemma unmap_pd_vs_lookup_pages_pre:
|
|||
qed
|
||||
|
||||
lemma unmap_pd_vs_lookup_pages:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and typ_at (AArch APageDirectory) pd and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace> unmap_pd asid vaddr pd
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and typ_at (AArch APageDirectory) pd and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace> unmap_pd asid vaddr pd
|
||||
\<lbrace>\<lambda>r s. ([VSRef ((vaddr >> 30) && mask 9) (Some APDPointerTable), VSRef ((vaddr >> 39) && mask 9) (Some APageMapL4),
|
||||
VSRef (asid && mask asid_low_bits) (Some AASIDPool), VSRef (ucast (asid_high_bits_of asid)) None],
|
||||
pd)
|
||||
|
|
@ -2715,7 +2728,7 @@ lemma unmap_pd_vs_lookup_pages:
|
|||
done
|
||||
|
||||
lemma unmap_pt_vs_lookup_pages:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and typ_at (AArch APageTable) pt and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace> unmap_page_table asid vaddr pt
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and typ_at (AArch APageTable) pt and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace> unmap_page_table asid vaddr pt
|
||||
\<lbrace>\<lambda>rv s. ([VSRef ((vaddr >> 21) && mask 9) (Some APageDirectory), VSRef ((vaddr >> 30) && mask 9) (Some APDPointerTable),
|
||||
VSRef ((vaddr >> 39) && mask 9) (Some APageMapL4), VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
VSRef (ucast (asid_high_bits_of asid)) None],
|
||||
|
|
@ -2727,7 +2740,7 @@ lemma unmap_pt_vs_lookup_pages:
|
|||
done
|
||||
|
||||
lemma unmap_page_vs_lookup_pages_small:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and data_at X64SmallPage pg and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and data_at X64SmallPage pg and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_page X64SmallPage asid vaddr pg
|
||||
\<lbrace>\<lambda>rv s. ([VSRef ((vaddr >> 12) && mask 9) (Some APageTable), VSRef ((vaddr >> 21) && mask 9) (Some APageDirectory), VSRef ((vaddr >> 30) && mask 9) (Some APDPointerTable),
|
||||
VSRef ((vaddr >> 39) && mask 9) (Some APageMapL4), VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
|
|
@ -2740,7 +2753,7 @@ lemma unmap_page_vs_lookup_pages_small:
|
|||
done
|
||||
|
||||
lemma unmap_page_vs_lookup_pages_large:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and data_at X64LargePage pg and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and data_at X64LargePage pg and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_page X64LargePage asid vaddr pg
|
||||
\<lbrace>\<lambda>rv s. ([VSRef ((vaddr >> 21) && mask 9) (Some APageDirectory), VSRef ((vaddr >> 30) && mask 9) (Some APDPointerTable),
|
||||
VSRef ((vaddr >> 39) && mask 9) (Some APageMapL4), VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
|
|
@ -2753,7 +2766,7 @@ lemma unmap_page_vs_lookup_pages_large:
|
|||
done
|
||||
|
||||
lemma unmap_page_vs_lookup_pages_huge:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and valid_arch_state and data_at X64HugePage pg and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and valid_arch_state and data_at X64HugePage pg and K(vaddr < pptr_base \<and> canonical_address vaddr)\<rbrace>
|
||||
unmap_page X64HugePage asid vaddr pg
|
||||
\<lbrace>\<lambda>rv s. ([VSRef ((vaddr >> 30) && mask 9) (Some APDPointerTable),
|
||||
VSRef ((vaddr >> 39) && mask 9) (Some APageMapL4), VSRef (asid && mask asid_low_bits) (Some AASIDPool),
|
||||
|
|
@ -2776,7 +2789,7 @@ lemma unmap_pdpt_invs[wp]:
|
|||
| wpc | simp add: flush_all_def pml4e_ref_pages_def)+
|
||||
apply (strengthen lookup_pml4_slot_kernel_mappings[THEN notE[where R=False], rotated -1, mk_strg D], simp)
|
||||
apply (strengthen not_in_global_refs_vs_lookup)+
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_arch_objs
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_vspace_objs
|
||||
invs_psp_aligned lookup_pml4_slot_eq pml4e_ref_def)
|
||||
done
|
||||
|
||||
|
|
@ -2809,7 +2822,7 @@ lemma unmap_pd_invs[wp]:
|
|||
| strengthen imp_consequent )+
|
||||
apply (strengthen not_in_global_refs_vs_lookup invs_valid_vs_lookup invs_valid_global_refs
|
||||
invs_arch_state invs_valid_global_objs | wp find_vspace_for_asid_aligned_pm_bits | simp)+
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_arch_objs
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_vspace_objs
|
||||
invs_psp_aligned lookup_pml4_slot_eq pml4e_ref_def)
|
||||
done
|
||||
|
||||
|
|
@ -2826,7 +2839,7 @@ lemma unmap_pt_invs[wp]:
|
|||
| strengthen imp_consequent )+
|
||||
apply (strengthen not_in_global_refs_vs_lookup invs_valid_vs_lookup invs_valid_global_refs
|
||||
invs_arch_state invs_valid_global_objs | wp find_vspace_for_asid_aligned_pm_bits | simp)+
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_arch_objs
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_vspace_objs
|
||||
invs_psp_aligned lookup_pml4_slot_eq pml4e_ref_def)
|
||||
done
|
||||
|
||||
|
|
@ -3037,26 +3050,21 @@ lemma empty_table_pt_capI:
|
|||
"\<lbrakk>caps_of_state s p =
|
||||
Some (cap.ArchObjectCap (arch_cap.PageTableCap pt None));
|
||||
valid_table_caps s\<rbrakk>
|
||||
\<Longrightarrow> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) pt s"
|
||||
\<Longrightarrow> obj_at (empty_table (set (second_level_tables (arch_state s)))) pt s"
|
||||
apply (case_tac p)
|
||||
apply (clarsimp simp: valid_table_caps_def simp del: imp_disjL)
|
||||
apply (drule spec)+
|
||||
apply (erule impE, simp add: is_cap_simps)+
|
||||
by assumption
|
||||
|
||||
lemma arch_obj_pred_empty_table:
|
||||
"arch_obj_pred (empty_table S)"
|
||||
by (fastforce simp: arch_obj_pred_def non_arch_obj_def empty_table_def
|
||||
sublocale vs_refs_empty: vspace_only_obj_pred "\<lambda>ko. vs_refs ko = {}"
|
||||
by unfold_locales
|
||||
(fastforce simp: vspace_obj_pred_def arch_obj_pred_def non_arch_obj_def vs_refs_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
|
||||
lemma arch_obj_pred_empty_refs_pages:
|
||||
"arch_obj_pred (\<lambda>ko. vs_refs_pages ko = {})"
|
||||
by (fastforce simp: arch_obj_pred_def non_arch_obj_def vs_refs_pages_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
|
||||
lemma arch_obj_pred_empty_refs:
|
||||
"arch_obj_pred (\<lambda>ko. vs_refs ko = {})"
|
||||
by (fastforce simp: arch_obj_pred_def non_arch_obj_def vs_refs_def
|
||||
sublocale vs_refs_pages_empty: vspace_only_obj_pred "\<lambda>ko. vs_refs_pages ko = {}"
|
||||
by unfold_locales
|
||||
(fastforce simp: vspace_obj_pred_def arch_obj_pred_def non_arch_obj_def vs_refs_pages_def
|
||||
split: kernel_object.splits arch_kernel_obj.splits)
|
||||
|
||||
lemma set_cap_cte_wp_at_ex:
|
||||
|
|
@ -3286,8 +3294,8 @@ lemma empty_refs_strg:
|
|||
by (simp add: empty_table_def split: kernel_object.splits arch_kernel_obj.splits)
|
||||
|
||||
lemma obj_at_empty_refs_strg:
|
||||
"obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) ptr s \<longrightarrow> obj_at (\<lambda>a. vs_refs_pages a = {}) ptr s"
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
"obj_at (empty_table (set (second_level_tables (arch_state s)))) ptr s \<longrightarrow> obj_at (\<lambda>a. vs_refs_pages a = {}) ptr s"
|
||||
apply (clarsimp simp: obj_at_def second_level_tables_def)
|
||||
done
|
||||
|
||||
lemma perform_page_directory_invocation_invs[wp]:
|
||||
|
|
@ -3301,7 +3309,7 @@ lemma perform_page_directory_invocation_invs[wp]:
|
|||
apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift
|
||||
store_pdpte_invs arch_update_cap_invs_map
|
||||
| strengthen obj_at_empty_refs_strg
|
||||
| simp add: arch_obj_pred_empty_table del: split_paired_all split_paired_All | wps
|
||||
| simp add: empty_table.arch_only del: split_paired_All | wps
|
||||
| rule set_cap.aobj_at |wpc)+
|
||||
apply (rule set_cap_cte_wp_at_ex[simplified])
|
||||
apply wp+
|
||||
|
|
@ -3327,7 +3335,7 @@ lemma perform_page_directory_invocation_invs[wp]:
|
|||
apply (erule(1) vs_lookup_vs_lookup_pagesI)
|
||||
apply fastforce+
|
||||
apply (simp add:global_refs_def)
|
||||
apply fastforce+
|
||||
apply (fastforce simp: second_level_tables_def)+
|
||||
apply (clarsimp dest!:invs_valid_objs valid_objs_caps)
|
||||
apply (rename_tac cap cslot)
|
||||
apply (clarsimp simp: perform_page_directory_invocation_def)
|
||||
|
|
@ -3372,19 +3380,11 @@ lemma perform_page_directory_invocation_invs[wp]:
|
|||
apply (strengthen range_neg_mask_strengthen[mk_strg] vtable_range_univ[THEN subset_refl_subst, mk_strg])
|
||||
apply (frule valid_global_refsD2, force)
|
||||
apply (clarsimp simp: valid_cap_def wellformed_mapdata_def image_def le_mask_iff_lt_2n cap_aligned_def
|
||||
cap_range_def invs_arch_objs pd_bits_def vtable_range_univ invs_arch_state)
|
||||
cap_range_def invs_vspace_objs pd_bits_def vtable_range_univ invs_arch_state)
|
||||
apply (simp add: mask_def)
|
||||
done
|
||||
|
||||
lemma valid_table_caps_empty_ptD:
|
||||
"\<lbrakk> caps_of_state s p = Some (ArchObjectCap (PageTableCap pt None));
|
||||
valid_table_caps s \<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) pt s"
|
||||
apply (clarsimp simp: valid_table_caps_def simp del: split_paired_All)
|
||||
apply (erule allE)+
|
||||
apply (erule (1) impE)
|
||||
apply (fastforce simp add: is_pt_cap_def cap_asid_def)
|
||||
done
|
||||
lemmas valid_table_caps_empty_ptD = empty_table_pt_capI
|
||||
|
||||
lemma perform_page_table_invocation_invs[wp]:
|
||||
"\<lbrace>invs and valid_pti pti\<rbrace>
|
||||
|
|
@ -3397,7 +3397,7 @@ lemma perform_page_table_invocation_invs[wp]:
|
|||
apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift
|
||||
store_pde_invs arch_update_cap_invs_map
|
||||
| strengthen obj_at_empty_refs_strg
|
||||
| simp add: arch_obj_pred_empty_table del: split_paired_all split_paired_All | wps
|
||||
| simp add: empty_table.arch_only del: split_paired_all split_paired_All | wps
|
||||
| wp set_cap.aobj_at | wpc)+
|
||||
apply (rule set_cap_cte_wp_at_ex[simplified])
|
||||
apply (wp)+
|
||||
|
|
@ -3423,7 +3423,7 @@ lemma perform_page_table_invocation_invs[wp]:
|
|||
apply (erule(1) vs_lookup_vs_lookup_pagesI)
|
||||
apply fastforce+
|
||||
apply (simp add:global_refs_def)
|
||||
apply fastforce+
|
||||
apply (fastforce simp: second_level_tables_def)+
|
||||
apply (clarsimp dest!:invs_valid_objs valid_objs_caps)
|
||||
apply (rename_tac cap cslot)
|
||||
apply (clarsimp simp: perform_page_table_invocation_def)
|
||||
|
|
@ -3468,7 +3468,7 @@ lemma perform_page_table_invocation_invs[wp]:
|
|||
apply (strengthen range_neg_mask_strengthen[mk_strg])
|
||||
apply (frule valid_global_refsD2, force)
|
||||
apply (clarsimp simp: valid_cap_def wellformed_mapdata_def image_def le_mask_iff_lt_2n cap_range_def
|
||||
invs_arch_objs vtable_range_univ invs_arch_state cap_aligned_def)
|
||||
invs_vspace_objs vtable_range_univ invs_arch_state cap_aligned_def)
|
||||
apply (simp add: mask_def)
|
||||
done
|
||||
|
||||
|
|
@ -3480,7 +3480,7 @@ lemma pml4_mask_shift_mask_irrelevant[simp]: "(((obj_ref::machine_word) && mask
|
|||
lemma valid_table_caps_pdptD:
|
||||
"\<lbrakk> caps_of_state s p = Some (ArchObjectCap (PDPointerTableCap pd None));
|
||||
valid_table_caps s \<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) pd s"
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) pd s"
|
||||
apply (clarsimp simp: valid_table_caps_def simp del: split_paired_All)
|
||||
apply (erule allE)+
|
||||
apply (erule (1) impE)
|
||||
|
|
@ -3489,13 +3489,13 @@ lemma valid_table_caps_pdptD:
|
|||
|
||||
lemma valid_global_refs_pdptD:
|
||||
"\<lbrakk>caps_of_state s (a,b) = Some (ArchObjectCap (PDPointerTableCap p asid)); valid_global_refs s\<rbrakk>
|
||||
\<Longrightarrow> p \<notin> set (x64_global_pdpts (arch_state s))"
|
||||
\<Longrightarrow> p \<notin> set (second_level_tables (arch_state s))"
|
||||
apply (clarsimp simp: valid_global_refs_def valid_refs_def
|
||||
cte_wp_at_caps_of_state is_cap_simps)
|
||||
apply (drule_tac x=a in spec)
|
||||
apply (drule_tac x=b in spec)
|
||||
apply (drule_tac x="ArchObjectCap (PDPointerTableCap p asid)" in spec)
|
||||
apply (clarsimp simp: cap_range_def global_refs_def)
|
||||
apply (clarsimp simp: cap_range_def global_refs_def second_level_tables_def)
|
||||
done
|
||||
|
||||
(* FIXME x64: indenting *)
|
||||
|
|
@ -3510,7 +3510,7 @@ lemma perform_pdpt_invocation_invs[wp]:
|
|||
apply (wp hoare_vcg_const_imp_lift hoare_vcg_all_lift hoare_vcg_conj_lift
|
||||
store_pml4e_invs arch_update_cap_invs_map
|
||||
| strengthen obj_at_empty_refs_strg
|
||||
| simp add: arch_obj_pred_empty_table del: split_paired_all split_paired_All | wps
|
||||
| simp add: empty_table.arch_only del: split_paired_all split_paired_All | wps
|
||||
| rule set_cap.aobj_at |wpc)+
|
||||
apply (rule set_cap_cte_wp_at_ex[simplified])
|
||||
apply (wp hoare_vcg_all_lift set_cap.aobj_at, simp)
|
||||
|
|
@ -3541,9 +3541,9 @@ lemma perform_pdpt_invocation_invs[wp]:
|
|||
apply (erule(1) vs_lookup_vs_lookup_pagesI)
|
||||
apply fastforce+
|
||||
apply (simp add:global_refs_def)
|
||||
apply fastforce+
|
||||
apply (clarsimp dest!:invs_valid_objs valid_objs_caps)
|
||||
apply (clarsimp simp: kernel_vsrefs_kernel_mapping_slots)
|
||||
apply (fastforce simp: second_level_tables_def)+
|
||||
apply (clarsimp dest!:invs_valid_objs valid_objs_caps)
|
||||
apply (clarsimp simp: kernel_vsrefs_kernel_mapping_slots)
|
||||
apply (rename_tac cap cslot)
|
||||
apply (clarsimp simp: perform_pdpt_invocation_def)
|
||||
apply (rule hoare_name_pre_state)
|
||||
|
|
@ -3588,7 +3588,7 @@ apply (clarsimp simp: kernel_vsrefs_kernel_mapping_slots)
|
|||
apply (strengthen range_neg_mask_strengthen[mk_strg] vtable_range_univ[THEN subset_refl_subst, mk_strg])
|
||||
apply (frule valid_global_refsD2, force)
|
||||
apply (clarsimp simp: valid_cap_def wellformed_mapdata_def image_def le_mask_iff_lt_2n cap_aligned_def
|
||||
cap_range_def invs_arch_objs pdpt_bits_def vtable_range_univ invs_arch_state)
|
||||
cap_range_def invs_vspace_objs pdpt_bits_def vtable_range_univ invs_arch_state)
|
||||
apply (simp add: mask_def)
|
||||
done
|
||||
|
||||
|
|
@ -3596,7 +3596,7 @@ lemma valid_kernel_mappingsD:
|
|||
"\<lbrakk> kheap s pml4ptr = Some (ArchObj (PageMapL4 pml4));
|
||||
valid_kernel_mappings s \<rbrakk>
|
||||
\<Longrightarrow> \<forall>x r. pml4e_ref (pml4 x) = Some r \<longrightarrow>
|
||||
(r \<in> set (x64_global_pdpts (arch_state s)))
|
||||
(r \<in> set (second_level_tables (arch_state s)))
|
||||
= (ucast (pptr_base >> pml4_shift_bits) \<le> x)"
|
||||
apply (simp add: valid_kernel_mappings_def)
|
||||
apply (drule bspec, erule ranI)
|
||||
|
|
@ -3610,34 +3610,26 @@ lemma set_mi_invs[wp]: "\<lbrace>invs\<rbrace> set_message_info t a \<lbrace>\<l
|
|||
|
||||
lemma reachable_page_table_not_global:
|
||||
"\<lbrakk>(ref \<rhd> p) s; valid_kernel_mappings s; valid_global_pdpts s;
|
||||
valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
\<Longrightarrow> p \<notin> set (x64_global_pdpts (arch_state s))"
|
||||
valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
\<Longrightarrow> p \<notin> set (second_level_tables (arch_state s))"
|
||||
apply clarsimp
|
||||
apply (erule (2) vs_lookupE_alt[OF _ _valid_asid_table_ran])
|
||||
apply (fastforce simp: valid_global_pdpts_def obj_at_def)+
|
||||
apply (clarsimp simp: valid_global_pdpts_def)
|
||||
apply (fastforce simp: second_level_tables_def valid_global_pdpts_def obj_at_def)+
|
||||
apply (clarsimp simp: second_level_tables_def valid_global_pdpts_def)
|
||||
apply (drule (1) bspec)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (clarsimp simp: valid_kernel_mappings_def valid_kernel_mappings_if_pm_def ran_def)
|
||||
apply (drule_tac x="ArchObj (PageMapL4 pm)" in spec)
|
||||
apply (drule mp, erule_tac x=p\<^sub>2 in exI)
|
||||
apply clarsimp
|
||||
apply (fastforce simp: valid_global_pdpts_def obj_at_def)+
|
||||
apply (clarsimp simp: second_level_tables_def)
|
||||
apply (fastforce simp: second_level_tables_def valid_global_pdpts_def obj_at_def)+
|
||||
done
|
||||
|
||||
lemma invs_valid_global_pdpts[elim]:
|
||||
"invs s \<Longrightarrow> valid_global_pdpts s"
|
||||
by (clarsimp simp: invs_def valid_arch_state_def valid_state_def)
|
||||
|
||||
lemma valid_table_caps_ptD:
|
||||
"\<lbrakk> caps_of_state s p = Some (ArchObjectCap (PageTableCap pt None));
|
||||
valid_table_caps s \<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) pt s"
|
||||
apply (clarsimp simp: valid_table_caps_def simp del: split_paired_All)
|
||||
apply (erule allE)+
|
||||
apply (erule (1) impE)
|
||||
apply (fastforce simp add: is_pt_cap_def cap_asid_def)
|
||||
done
|
||||
lemmas valid_table_caps_ptD = empty_table_pt_capI
|
||||
|
||||
lemma empty_ref_pageD[elim]:
|
||||
"\<lbrakk> data_at X64LargePage page s \<rbrakk> \<Longrightarrow>
|
||||
|
|
@ -3652,22 +3644,22 @@ lemma empty_refs_pageCapD[elim]:
|
|||
|
||||
lemma reachable_pd_not_global:
|
||||
"\<lbrakk>(ref \<rhd> p) s; valid_kernel_mappings s; valid_global_pdpts s;
|
||||
valid_arch_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
\<Longrightarrow> p \<notin> set (x64_global_pdpts (arch_state s))"
|
||||
valid_vspace_objs s; valid_asid_table (x64_asid_table (arch_state s)) s\<rbrakk>
|
||||
\<Longrightarrow> p \<notin> set (second_level_tables (arch_state s))"
|
||||
apply clarsimp
|
||||
apply (erule (2) vs_lookupE_alt[OF _ _valid_asid_table_ran])
|
||||
apply (fastforce simp: valid_global_pdpts_def obj_at_def)+
|
||||
apply (clarsimp simp: valid_global_pdpts_def)
|
||||
apply (fastforce simp: second_level_tables_def valid_global_pdpts_def obj_at_def)+
|
||||
apply (clarsimp simp: second_level_tables_def valid_global_pdpts_def)
|
||||
apply (drule (1) bspec)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (clarsimp simp: valid_kernel_mappings_def valid_kernel_mappings_if_pm_def ran_def)
|
||||
apply (drule_tac x="ArchObj (PageMapL4 pm)" in spec)
|
||||
apply (drule mp, erule_tac x=p\<^sub>2 in exI)
|
||||
apply clarsimp
|
||||
apply (fastforce simp: valid_global_pdpts_def obj_at_def)+
|
||||
apply (fastforce simp: second_level_tables_def valid_global_pdpts_def obj_at_def)+
|
||||
done
|
||||
|
||||
lemma vs_lookup_invs_ref_is_unique: "\<lbrakk> (ref \<rhd> p) s; (ref' \<rhd> p) s; invs s\<rbrakk> \<Longrightarrow> ref = ref'"
|
||||
lemma vs_lookup_invs_ref_is_unique: "\<lbrakk> (ref \<rhd> p) s; (ref' \<rhd> p) s; invs s \<rbrakk> \<Longrightarrow> ref = ref'"
|
||||
apply (erule (1) ref_is_unique)
|
||||
apply (erule reachable_pd_not_global)
|
||||
by (auto elim: invs_valid_kernel_mappings intro!: valid_objs_caps)
|
||||
|
|
@ -3703,12 +3695,12 @@ lemma unmap_page_invs[wp]:
|
|||
invs_valid_global_refs
|
||||
invs_arch_state invs_valid_global_objs | clarsimp simp: conj_ac)+
|
||||
apply wp
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_arch_objs
|
||||
apply (auto simp: vspace_at_asid_def is_aligned_pml4[simplified] invs_vspace_objs
|
||||
invs_psp_aligned lookup_pml4_slot_eq pml4e_ref_def)
|
||||
done
|
||||
|
||||
lemma unmap_page_unmapped:
|
||||
"\<lbrace>pspace_aligned and valid_arch_objs and data_at sz pptr and valid_arch_state and
|
||||
"\<lbrace>pspace_aligned and valid_vspace_objs and data_at sz pptr and valid_arch_state and
|
||||
valid_objs and (\<lambda>s. valid_asid_table (x64_asid_table (arch_state s)) s) and
|
||||
K ((sz = X64SmallPage \<longrightarrow> ref =
|
||||
[VSRef ((vaddr >> 12) && mask 9) (Some APageTable),
|
||||
|
|
@ -3750,7 +3742,7 @@ lemma perform_page_invs [wp]:
|
|||
| simp add: pte_check_if_mapped_def pde_check_if_mapped_def del: fun_upd_apply split_paired_Ex
|
||||
)+
|
||||
apply (wp_trace set_cap_cte_wp_at_ex hoare_vcg_imp_lift hoare_vcg_all_lift arch_update_cap_invs_map
|
||||
set_cap.aobj_at[OF arch_obj_pred_empty_refs_pages] | wps)+
|
||||
set_cap.aobj_at[OF vs_refs_pages_empty.arch_only] | wps)+
|
||||
apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state valid_slots_def is_cap_simps parent_for_refs_def
|
||||
empty_refs_def same_refs_def pt_bits_def is_arch_update_def cap_master_cap_def
|
||||
split: vm_page_entry.splits
|
||||
|
|
@ -3918,7 +3910,7 @@ lemma perform_page_invs [wp]:
|
|||
lemma not_kernel_slot_not_global_pml4:
|
||||
"\<lbrakk>pml4e_ref (pml4 x) = Some p; x \<notin> kernel_mapping_slots;
|
||||
kheap s p' = Some (ArchObj (PageMapL4 pml4)); valid_kernel_mappings s\<rbrakk>
|
||||
\<Longrightarrow> p \<notin> set (x64_global_pdpts (arch_state s))"
|
||||
\<Longrightarrow> p \<notin> set (second_level_tables (arch_state s))"
|
||||
apply (clarsimp simp: valid_kernel_mappings_def valid_kernel_mappings_if_pm_def)
|
||||
apply (drule_tac x="ArchObj (PageMapL4 pml4)" in bspec)
|
||||
apply ((fastforce simp: ran_def)+)[1]
|
||||
|
|
@ -3949,7 +3941,7 @@ lemma asid_lvl_lookup1D:
|
|||
|
||||
lemma valid_kernel_mappings_if_pm_asid:
|
||||
"\<lbrakk>valid_kernel_mappings s; kheap s p = Some (ArchObj (ASIDPool pool))\<rbrakk>
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (x64_global_pdpts (arch_state s))) (ArchObj (ASIDPool (pool(ucast asid := pml4base))))"
|
||||
\<Longrightarrow> valid_kernel_mappings_if_pm (set (second_level_tables (arch_state s))) (ArchObj (ASIDPool (pool(ucast asid := pml4base))))"
|
||||
by (fastforce simp: pml4e_ref_def valid_kernel_mappings_if_pm_def valid_kernel_mappings_def
|
||||
dest!: bspec split: option.split_asm pml4e.split_asm)
|
||||
|
||||
|
|
@ -3996,9 +3988,9 @@ lemma asid_is_zeroI:
|
|||
lemma store_asid_pool_entry_invs:
|
||||
"\<lbrace>invs and K (asid \<le> mask asid_bits \<and> 0 < asid) and
|
||||
(\<lambda>s. case pml4base of None \<Rightarrow> x64_asid_map (arch_state s) asid = None
|
||||
| Some ptr \<Rightarrow> obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) ptr s
|
||||
| Some ptr \<Rightarrow> obj_at (empty_table (set (second_level_tables (arch_state s)))) ptr s
|
||||
\<and> typ_at (AArch APageMapL4) ptr s \<and> (\<forall>pool. ko_at (ArchObj (ASIDPool pool)) p s \<longrightarrow> pool (ucast asid) = None)
|
||||
\<and> p \<notin> set (x64_global_pdpts (arch_state s))
|
||||
\<and> p \<notin> set (second_level_tables (arch_state s))
|
||||
\<and> (\<exists>slot. cte_wp_at (\<lambda>cap. is_pml4_cap cap \<and> ptr \<in> obj_refs cap \<and> cap_asid cap = Some asid) slot s))
|
||||
and [VSRef (ucast (asid_high_bits_of asid)) None] \<rhd> p
|
||||
\<rbrace>
|
||||
|
|
@ -4007,7 +3999,7 @@ lemma store_asid_pool_entry_invs:
|
|||
apply (wp)
|
||||
apply (intro impI allI conjI valid_table_caps_aobj_upd_invalid_pml4e invs_valid_table_caps , simp_all add: obj_at_def)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask a_type_simps
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_table_caps_asid_upd)+
|
||||
apply (drule subsetD[OF vs_refs_of_set_diff])
|
||||
apply (frule invs_valid_asid_map)
|
||||
|
|
@ -4028,18 +4020,19 @@ lemma store_asid_pool_entry_invs:
|
|||
dest!: vs_lookup1D graph_ofD)+
|
||||
apply (clarsimp simp: lookup_leaf_def vs_refs_def mask_asid_low_bits_ucast_ucast dest!: graph_ofD)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs
|
||||
| intro valid_kernel_mappings_if_pm_asid invs_valid_kernel_mappings valid_global_objs_upd_invalid_asid_slot
|
||||
| fastforce)+
|
||||
apply (fastforce dest!: valid_arch_obj_from_invs valid_arch_obj_from_invs ran_del_subset simp: obj_at_def)+
|
||||
apply (fastforce dest!: valid_vspace_obj_from_invs valid_vspace_obj_from_invs ran_del_subset
|
||||
simp: obj_at_def)+
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs)
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs)
|
||||
apply (rule ccontr)
|
||||
apply (erule(1) unmapped_cap_lookup_refs_empty[OF _ rtrancl_into_trancl1])
|
||||
apply (drule wellformed_lookup.lookup1_cut[OF vs_lookup1_is_wellformed_lookup],fastforce,fastforce)
|
||||
apply (clarsimp simp: aa_type_simps obj_at_def split: option.split_asm if_split_asm)
|
||||
apply (clarsimp simp: obj_at_def aa_type_simps aobj_upd_invalid_slots_simps ucast_ucast_mask
|
||||
split: if_split_asm option.split_asm dest:valid_arch_obj_from_invs valid_obj_from_invs)
|
||||
split: if_split_asm option.split_asm dest:valid_vspace_obj_from_invs valid_obj_from_invs)
|
||||
apply (rule ccontr)
|
||||
apply (erule unmapped_cap_lookup_refs_pages_empty[OF _ ])
|
||||
apply (erule rtrancl_into_trancl1)
|
||||
|
|
@ -4080,7 +4073,7 @@ lemma store_asid_pool_entry_invs:
|
|||
lemma valid_table_caps_pml4D:
|
||||
"\<lbrakk> caps_of_state s p = Some (ArchObjectCap (PML4Cap pool None));
|
||||
valid_table_caps s \<rbrakk> \<Longrightarrow>
|
||||
obj_at (empty_table (set (x64_global_pdpts (arch_state s)))) pool s"
|
||||
obj_at (empty_table (set (second_level_tables (arch_state s)))) pool s"
|
||||
apply (clarsimp simp: valid_table_caps_def simp del: split_paired_All)
|
||||
apply (erule allE)+
|
||||
apply (erule (1) impE)
|
||||
|
|
@ -4106,7 +4099,7 @@ lemma perform_asid_pool_invs [wp]:
|
|||
le_mask_iff_lt_2n[where 'a = "64",simplified, THEN iffD1,
|
||||
OF asid_word_bits[unfolded word_bits_def, simplified]])
|
||||
apply (drule caps_of_state_cteD)
|
||||
apply (clarsimp simp: obj_at_def cte_wp_at_cases a_type_def)
|
||||
apply (clarsimp simp: obj_at_def cte_wp_at_cases a_type_def second_level_tables_def)
|
||||
apply (clarsimp split: Structures_A.kernel_object.splits arch_kernel_obj.splits if_split_asm)
|
||||
apply (fastforce dest!: invs_valid_global_objs simp: valid_global_objs_def obj_at_def)
|
||||
done
|
||||
|
|
|
|||
|
|
@ -174,7 +174,7 @@ lemma no_fail_freeMemory[simp, wp]:
|
|||
|
||||
|
||||
lemma no_fail_getActiveIRQ[wp]:
|
||||
"no_fail \<top> getActiveIRQ"
|
||||
"no_fail \<top> (getActiveIRQ in_kernel)"
|
||||
apply (simp add: getActiveIRQ_def)
|
||||
apply (rule no_fail_pre)
|
||||
apply (wp non_fail_select)
|
||||
|
|
@ -184,7 +184,7 @@ lemma no_fail_getActiveIRQ[wp]:
|
|||
definition "irq_state_independent P \<equiv> \<forall>f s. P s \<longrightarrow> P (irq_state_update f s)"
|
||||
|
||||
lemma getActiveIRQ_inv [wp]:
|
||||
"\<lbrakk>irq_state_independent P\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> getActiveIRQ \<lbrace>\<lambda>rv. P\<rbrace>"
|
||||
"\<lbrakk>irq_state_independent P\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> getActiveIRQ in_kernel \<lbrace>\<lambda>rv. P\<rbrace>"
|
||||
apply (simp add: getActiveIRQ_def)
|
||||
apply (wp alternative_wp select_wp)
|
||||
apply (simp add: irq_state_independent_def)
|
||||
|
|
@ -251,7 +251,7 @@ lemma no_irq_loadWord: "no_irq (loadWord x)"
|
|||
done
|
||||
|
||||
|
||||
lemma no_irq_getActiveIRQ: "no_irq getActiveIRQ"
|
||||
lemma no_irq_getActiveIRQ: "no_irq (getActiveIRQ in_kernel)"
|
||||
apply (clarsimp simp: no_irq_def)
|
||||
apply (rule getActiveIRQ_inv)
|
||||
apply (simp add: irq_state_independent_def)
|
||||
|
|
@ -354,7 +354,9 @@ lemma no_irq_out32: "no_irq (out32 irq b)"
|
|||
by (wp | clarsimp simp: out32_def)+
|
||||
|
||||
lemma getActiveIRQ_le_maxIRQ':
|
||||
"\<lbrace>\<lambda>s. \<forall>irq > maxIRQ. irq_masks s irq\<rbrace> getActiveIRQ \<lbrace>\<lambda>rv s. \<forall>x. rv = Some x \<longrightarrow> x \<le> maxIRQ\<rbrace>"
|
||||
"\<lbrace>\<lambda>s. \<forall>irq > maxIRQ. irq_masks s irq\<rbrace>
|
||||
getActiveIRQ in_kernel
|
||||
\<lbrace>\<lambda>rv s. \<forall>x. rv = Some x \<longrightarrow> x \<le> maxIRQ\<rbrace>"
|
||||
apply (simp add: getActiveIRQ_def)
|
||||
apply (wp alternative_wp select_wp)
|
||||
apply clarsimp
|
||||
|
|
@ -364,12 +366,28 @@ lemma getActiveIRQ_le_maxIRQ':
|
|||
|
||||
(* FIXME: follows already from getActiveIRQ_le_maxIRQ *)
|
||||
lemma getActiveIRQ_neq_Some0xFF':
|
||||
"\<lbrace>\<top>\<rbrace> getActiveIRQ \<lbrace>\<lambda>rv s. rv \<noteq> Some 0x3FF\<rbrace>"
|
||||
"\<lbrace>\<top>\<rbrace> getActiveIRQ in_kernel \<lbrace>\<lambda>rv s. rv \<noteq> Some 0x3FF\<rbrace>"
|
||||
apply (simp add: getActiveIRQ_def)
|
||||
apply (wp alternative_wp select_wp)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma getActiveIRQ_neq_non_kernel:
|
||||
"\<lbrace>\<top>\<rbrace> getActiveIRQ True \<lbrace>\<lambda>rv s. rv \<notin> Some ` non_kernel_IRQs \<rbrace>"
|
||||
apply (simp add: getActiveIRQ_def)
|
||||
apply (wp alternative_wp select_wp)
|
||||
apply auto
|
||||
done
|
||||
|
||||
lemma dmo_getActiveIRQ_non_kernel[wp]:
|
||||
"\<lbrace>\<top>\<rbrace> do_machine_op (getActiveIRQ True)
|
||||
\<lbrace>\<lambda>rv s. \<forall>irq. rv = Some irq \<longrightarrow> irq \<in> non_kernel_IRQs \<longrightarrow> P irq s\<rbrace>"
|
||||
unfolding do_machine_op_def
|
||||
apply wpsimp
|
||||
apply (drule use_valid, rule getActiveIRQ_neq_non_kernel, rule TrueI)
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
lemma empty_fail_invalidateTLB: "empty_fail invalidateTLB"
|
||||
by (simp add: invalidateTLB_def)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue