236 lines
8.1 KiB
Plaintext
236 lines
8.1 KiB
Plaintext
(*
|
|
* Copyright 2014, General Dynamics C4 Systems
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the GNU General Public License version 2. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_GPLv2.txt" for details.
|
|
*
|
|
* @TAG(GD_GPL)
|
|
*)
|
|
|
|
(*
|
|
VSpace refinement
|
|
*)
|
|
|
|
theory VSpacePre_AI
|
|
imports "$L4V_ARCH/ArchTcbAcc_AI"
|
|
begin
|
|
|
|
context begin interpretation Arch .
|
|
|
|
requalify_facts
|
|
cap_master_cap_tcb_cap_valid_arch
|
|
|
|
end
|
|
|
|
lemma throw_on_false_wp[wp]:
|
|
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. (rv \<longrightarrow> Q () s) \<and> (\<not> rv \<longrightarrow> E x s)\<rbrace>
|
|
\<Longrightarrow> \<lbrace>P\<rbrace> throw_on_false x f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
|
|
apply (simp add: throw_on_false_def unlessE_def)
|
|
apply wp
|
|
apply simp
|
|
done
|
|
|
|
crunch_ignore (add: throw_on_false)
|
|
|
|
definition
|
|
"is_arch_update cap cap' \<equiv> is_arch_cap cap \<and> cap_master_cap cap = cap_master_cap cap'"
|
|
|
|
|
|
definition
|
|
"is_arch_diminished cap cap' \<equiv> is_arch_cap cap \<and> diminished cap cap'"
|
|
|
|
|
|
lemma dmo_asid_map [wp]:
|
|
"\<lbrace>valid_asid_map\<rbrace> do_machine_op f \<lbrace>\<lambda>_. valid_asid_map\<rbrace>"
|
|
apply (simp add: do_machine_op_def split_def)
|
|
apply wp
|
|
apply simp
|
|
done
|
|
|
|
crunch caps_of_state[wp]: do_machine_op "\<lambda>s. P (caps_of_state s)"
|
|
|
|
interpretation dmo: non_arch_non_cap_op "do_machine_op f"
|
|
apply (unfold_locales)
|
|
apply wp
|
|
done
|
|
|
|
declare not_Some_eq_tuple[simp]
|
|
|
|
lemma valid_irq_states_arch_state_update[simp]:
|
|
"valid_irq_states (s\<lparr>arch_state := x\<rparr>) = valid_irq_states s"
|
|
by(auto simp: valid_irq_states_def)
|
|
|
|
lemma pull_out_P:
|
|
"P s \<and> (\<forall>c. caps_of_state s p = Some c \<longrightarrow> Q s c) \<longrightarrow> (\<forall>c. caps_of_state s p = Some c \<longrightarrow> P s \<and> Q s c)"
|
|
by blast
|
|
|
|
lemma upto_enum_step_subtract:
|
|
"x \<le> z \<Longrightarrow> [x, y .e. z] = (map ((op +) x) [0, y - x .e. z - x])"
|
|
by (auto simp add: upto_enum_step_def)
|
|
|
|
(* FIXME: move *)
|
|
lemma returnOk_E': "\<lbrace>P\<rbrace> returnOk r -,\<lbrace>E\<rbrace>"
|
|
by (clarsimp simp: returnOk_def validE_E_def validE_def valid_def return_def)
|
|
lemma throwError_R': "\<lbrace>P\<rbrace> throwError e \<lbrace>Q\<rbrace>,-"
|
|
by (clarsimp simp:throwError_def validE_R_def validE_def valid_def return_def)
|
|
|
|
lemma invs_valid_irq_states[elim!]:
|
|
"invs s \<Longrightarrow> valid_irq_states s"
|
|
by(auto simp: invs_def valid_state_def)
|
|
|
|
lemma bool_function_four_cases:
|
|
"f = Not \<or> f = id \<or> f = (\<lambda>_. True) \<or> f = (\<lambda>_. False)"
|
|
by (auto simp add: fun_eq_iff all_bool_eq)
|
|
|
|
lemma uint_ucast:
|
|
"(x :: ('a :: len) word) < 2 ^ len_of TYPE ('b)
|
|
\<Longrightarrow> uint (ucast x :: ('b :: len) word) = uint x"
|
|
apply (simp add: ucast_def)
|
|
apply (subst word_uint.Abs_inverse)
|
|
apply (simp add: uints_num word_less_alt word_le_def)
|
|
apply (frule impI[where P="True"])
|
|
apply (subst(asm) uint_2p)
|
|
apply (clarsimp simp only: word_neq_0_conv[symmetric])
|
|
apply simp_all
|
|
done
|
|
|
|
(* FIXME: move *)
|
|
lemma inj_on_domD: "\<lbrakk>inj_on f (dom f); f x = Some z; f y = Some z\<rbrakk> \<Longrightarrow> x = y"
|
|
by (erule inj_onD) clarsimp+
|
|
|
|
lemma hoare_name_pre_state2:
|
|
"(\<And>s. \<lbrace>P and (op = s)\<rbrace> f \<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
|
|
by (auto simp: valid_def intro: hoare_name_pre_state)
|
|
|
|
lemma pd_casting_shifting:
|
|
"size x + 2 < len_of TYPE('a) \<Longrightarrow>
|
|
ucast (ucast x << 2 >> 2 :: ('a :: len) word) = x"
|
|
apply (rule word_eqI)
|
|
apply (simp add: nth_ucast nth_shiftr nth_shiftl word_size)
|
|
done
|
|
|
|
lemma aligned_already_mask:
|
|
"is_aligned x n \<Longrightarrow> is_aligned (x && msk) n"
|
|
apply (simp add: is_aligned_mask word_bw_assocs)
|
|
apply (subst word_bw_comms, subst word_bw_assocs[symmetric])
|
|
apply simp
|
|
done
|
|
|
|
lemma set_upto_enum_step_4:
|
|
"set [0, 4 .e. x :: word32]
|
|
= (\<lambda>x. x << 2) ` {.. x >> 2}"
|
|
by (auto simp: upto_enum_step_def shiftl_t2n shiftr_div_2n_w
|
|
word_size mult.commute)
|
|
|
|
lemma arch_update_cap_zombies:
|
|
"\<lbrace>\<lambda>s. cte_wp_at (is_arch_update cap) p s \<and> zombies_final s\<rbrace> set_cap cap p \<lbrace>\<lambda>rv s. zombies_final s\<rbrace>"
|
|
apply (simp add: zombies_final_def2 cte_wp_at_caps_of_state del: split_paired_All)
|
|
apply wp
|
|
apply (intro allI impI)
|
|
apply (elim conjE exE)
|
|
apply (simp del: split_paired_All add: is_arch_update_def split: split_if_asm)
|
|
apply (erule_tac x=p in allE)
|
|
apply (erule_tac x=p' in allE)
|
|
apply simp
|
|
apply (frule master_cap_obj_refs)
|
|
apply (drule cap_master_cap_zombie)
|
|
apply clarsimp
|
|
apply (erule_tac x=pa in allE)
|
|
apply (erule_tac x=p in allE)
|
|
apply simp
|
|
apply (frule master_cap_obj_refs)
|
|
apply (drule cap_master_cap_zombie)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma arch_update_cap_pspace:
|
|
"\<lbrace>cte_wp_at (is_arch_update cap) p and valid_pspace and valid_cap cap\<rbrace>
|
|
set_cap cap p
|
|
\<lbrace>\<lambda>rv. valid_pspace\<rbrace>"
|
|
apply (simp add: valid_pspace_def)
|
|
apply (rule hoare_pre)
|
|
apply (wp set_cap_valid_objs update_cap_iflive arch_update_cap_zombies)
|
|
apply clarsimp
|
|
apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_update_def)
|
|
apply (frule cap_master_cap_zobj_refs)
|
|
apply clarsimp
|
|
apply (drule caps_of_state_cteD)
|
|
apply (drule (1) cte_wp_tcb_cap_valid)
|
|
apply (simp add: cap_master_cap_tcb_cap_valid_arch)
|
|
done
|
|
|
|
lemma arch_update_cap_valid_mdb:
|
|
"\<lbrace>cte_wp_at (is_arch_update cap) p and valid_mdb\<rbrace> set_cap cap p \<lbrace>\<lambda>rv. valid_mdb\<rbrace>"
|
|
apply (simp add: valid_mdb_def2 pred_conj_def)
|
|
apply (rule hoare_lift_Pf2 [where f=cdt])
|
|
prefer 2
|
|
apply wp[1]
|
|
apply (rule hoare_lift_Pf2 [where f=is_original_cap])
|
|
prefer 2
|
|
apply wp[1]
|
|
apply (rule hoare_pre)
|
|
apply wp
|
|
apply (clarsimp simp: cte_wp_at_caps_of_state)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: mdb_cte_at_def is_arch_update_def)
|
|
apply (fastforce simp: is_cap_simps)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: untyped_mdb_def is_arch_update_def)
|
|
apply (rule conjI)
|
|
apply (fastforce simp: is_cap_simps)
|
|
apply clarsimp
|
|
apply (drule master_cap_obj_refs)
|
|
apply fastforce
|
|
apply (rule conjI)
|
|
apply (erule(1) descendants_inc_minor)
|
|
apply (clarsimp simp:is_arch_update_def)
|
|
apply (frule master_cap_class)
|
|
apply (clarsimp dest!:master_cap_cap_range)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: untyped_inc_def is_arch_update_def)
|
|
subgoal by (fastforce simp: is_cap_simps)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: ut_revocable_def)
|
|
apply (clarsimp simp: is_arch_update_def is_cap_simps)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: irq_revocable_def is_arch_update_def is_cap_simps simp del: split_paired_All)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: reply_master_revocable_def is_arch_update_def is_cap_simps)
|
|
apply (clarsimp simp: reply_mdb_def is_arch_update_def)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: reply_caps_mdb_def is_cap_simps cap_master_cap_def
|
|
simp del: split_paired_Ex split_paired_All)
|
|
apply (fastforce elim!: exEI)
|
|
by (clarsimp simp: is_cap_simps cap_master_cap_def reply_masters_mdb_def)
|
|
|
|
lemma set_cap_arch_obj:
|
|
"\<lbrace>ko_at (ArchObj ao) p and cte_at p'\<rbrace> set_cap cap p' \<lbrace>\<lambda>_. ko_at (ArchObj ao) p\<rbrace>"
|
|
apply (wp set_cap_obj_at_other)
|
|
apply (clarsimp simp: obj_at_def cte_wp_at_cases)
|
|
done
|
|
|
|
lemma set_mrs_typ_at[wp]:
|
|
"\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> set_mrs t buf mrs \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
|
apply (simp add: set_mrs_def zipWithM_x_mapM split_def
|
|
store_word_offs_def set_object_def
|
|
cong: option.case_cong
|
|
split del: split_if)
|
|
apply (wp hoare_vcg_split_case_option)
|
|
apply (rule mapM_wp [where S=UNIV, simplified])
|
|
apply (wp | simp)+
|
|
apply (clarsimp simp: obj_at_def a_type_def
|
|
dest!: get_tcb_SomeD)
|
|
done
|
|
|
|
lemma set_mrs_tcb[wp]:
|
|
"\<lbrace> tcb_at t \<rbrace> set_mrs receiver recv_buf mrs \<lbrace>\<lambda>rv. tcb_at t \<rbrace>"
|
|
by (simp add: tcb_at_typ, wp)
|
|
|
|
|
|
lemma set_mrs_ntfn_at[wp]:
|
|
"\<lbrace> ntfn_at p \<rbrace> set_mrs receiver recv_buf mrs \<lbrace>\<lambda>rv. ntfn_at p \<rbrace>"
|
|
by (simp add: ntfn_at_typ, wp)
|
|
|
|
end
|