adbrucker
/
lh-l4v
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

merge master into x64-split 

Primarily concerns wp improvements
This commit is contained in:
Matthew Brecknell 2017-01-18 07:49:48 +11:00
parent ed19e4a341 3fee2d83b4
commit 759a0387ab
176 changed files with 4811 additions and 6081 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
camkes/glue-proofs/RPCFrom.thy
View File

@ -384,7 +384,7 @@ lemma RPCFrom_echo_int_nf:
apply (simp add:RPCFrom_echo_int'_def)
apply (wp seL4_Call_wp)
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply wp+
apply (simp add:globals_frame_intact_def ipc_buffer_valid_def
setMRs_def setMR_def)
done
@ -402,7 +402,7 @@ lemma RPCFrom_echo_parameter_nf:
apply (simp add:RPCFrom_echo_parameter'_def)
apply (wp seL4_Call_wp)
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply wp+
apply (simp add:globals_frame_intact_def ipc_buffer_valid_def
setMRs_def setMR_def)
done
@ -420,7 +420,7 @@ lemma RPCFrom_echo_char_nf:
apply (simp add:RPCFrom_echo_char'_def)
apply (wp seL4_Call_wp)
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply wp+
apply (simp add:globals_frame_intact_def ipc_buffer_valid_def
setMRs_def setMR_def)
done
@ -438,7 +438,7 @@ lemma RPCFrom_increment_char_nf:
apply (simp add:RPCFrom_increment_char'_def)
apply (wp seL4_Call_wp)
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply wp+
apply (simp add:globals_frame_intact_def ipc_buffer_valid_def
setMRs_def setMR_def)
done
@ -458,7 +458,7 @@ lemma RPCFrom_increment_parameter_nf:
apply (simp add:RPCFrom_increment_parameter'_def)
apply (wp seL4_Call_wp)
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply wp+
apply (simp add:globals_frame_intact_def ipc_buffer_valid_def
setMRs_def setMR_def)
done
@ -476,7 +476,7 @@ lemma RPCFrom_increment_64_nf:
apply (simp add:RPCFrom_increment_64'_def)
apply (wp seL4_Call_wp)
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply wp+
apply (simp add:globals_frame_intact_def ipc_buffer_valid_def
setMRs_def setMR_def)
done

26
camkes/glue-proofs/RPCTo.thy
View File

@ -461,8 +461,8 @@ lemma echo_int_internal_wp[wp_unsafe]:
\<lbrace>P48'\<rbrace>!"
apply (simp add:echo_int_internal'_def)
apply wp
apply (wp RPCTo_echo_int_wp)
apply (wp get_echo_int_i_wp)
apply (wp RPCTo_echo_int_wp)+
apply (wp get_echo_int_i_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id
update_global_w32_def)
@ -492,9 +492,9 @@ lemma echo_parameter_internal_wp[wp_unsafe]:
\<lbrace>P51'\<rbrace>!"
apply (simp add:echo_parameter_internal'_def)
apply wp
apply (wp RPCTo_echo_parameter_wp)
apply (wp RPCTo_echo_parameter_wp)+
apply (wp get_echo_parameter_pout_wp)
apply (wp get_echo_parameter_pin_wp)
apply (wp get_echo_parameter_pin_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id
update_global_w32_def)
@ -519,8 +519,8 @@ lemma echo_char_internal_wp[wp_unsafe]:
\<lbrace>P54'\<rbrace>!"
apply (simp add:echo_char_internal'_def)
apply wp
apply (wp RPCTo_echo_char_wp)
apply (wp get_echo_char_i_wp)
apply (wp RPCTo_echo_char_wp)+
apply (wp get_echo_char_i_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id
update_global_w8_def)
@ -546,8 +546,8 @@ lemma increment_char_internal_wp[wp_unsafe]:
\<lbrace>P57'\<rbrace>!"
apply (simp add:increment_char_internal'_def)
apply wp
apply (wp RPCTo_increment_char_wp)
apply (wp get_increment_char_x_wp)
apply (wp RPCTo_increment_char_wp)+
apply (wp get_increment_char_x_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id
update_global_w8_def)
@ -573,8 +573,8 @@ lemma increment_parameter_internal_wp[wp_unsafe]:
\<lbrace>P60'\<rbrace>!"
apply (simp add:increment_parameter_internal'_def)
apply wp
apply (wp RPCTo_increment_parameter_wp)
apply (wp get_increment_parameter_x_wp)
apply (wp RPCTo_increment_parameter_wp)+
apply (wp get_increment_parameter_x_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id
update_global_w32_def)
@ -601,8 +601,8 @@ lemma increment_64_internal_wp[wp_unsafe]:
\<lbrace>P63'\<rbrace>!"
apply (simp add:increment_64_internal'_def)
apply wp
apply (wp RPCTo_increment_64_wp)
apply (wp get_increment_64_x_wp)
apply (wp RPCTo_increment_64_wp)+
apply (wp get_increment_64_x_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def thread_count_def setMR_def ucast_id
update_global_w64_def update_global_w64_high_def)
@ -682,7 +682,7 @@ lemma RPCTo_run_internal_wp[wp_unsafe]:
apply (simp add:seL4_MessageInfo_new'_def)
apply wp
apply (wp increment_64_internal_wp)
apply (wp seL4_Wait_wp)
apply (wp seL4_Wait_wp)+
apply (clarsimp simp:globals_frame_intact_def ipc_buffer_valid_def
tls_valid_def tls_def tls_ptr_def ucast_id seL4_GetIPCBuffer'_def
thread_count_def setMR_def setMRs_def update_global_w32_def

36
lib/BCorres_UL.thy
View File

@ -145,21 +145,18 @@ lemma fail_bcorres_underlying[wp]: "bcorres_underlying t fail fail"
lemma assertE_bcorres_underlying[wp]: "bcorres_underlying t (assertE P) (assertE P)"
apply (clarsimp simp add: assertE_def returnOk_def)
apply (intro impI conjI)
apply wp
apply (intro impI conjI; wp)
done
lemmas assertE_s_bcorres_underlying[wp] = drop_sbcorres_underlying[OF assertE_bcorres_underlying]
lemma when_s_bcorres_underlying[wp]: "(P \<Longrightarrow> s_bcorres_underlying t f f' s) \<Longrightarrow> s_bcorres_underlying t (when P f) (when P f') s"
apply (simp add: when_def)
apply (intro impI conjI)
apply wp
done
lemma when_s_bcorres_underlying[wp]:
"(P \<Longrightarrow> s_bcorres_underlying t f f' s) \<Longrightarrow> s_bcorres_underlying t (when P f) (when P f') s"
by (simp add: return_s_bcorres_underlying when_def)
lemma when_bcorres_underlying[wp]: "(P \<Longrightarrow> bcorres_underlying t f f') \<Longrightarrow> bcorres_underlying t (when P f) (when P f')"
apply (simp add: bcorres_underlying_def when_s_bcorres_underlying)
done
lemma when_bcorres_underlying[wp]:
"(P \<Longrightarrow> bcorres_underlying t f f') \<Longrightarrow> bcorres_underlying t (when P f) (when P f')"
by (simp add: bcorres_underlying_def when_s_bcorres_underlying)
lemma put_bcorres_underlying[wp]:
"t f = f' \<Longrightarrow> bcorres_underlying t (put f) (put f')"
@ -200,31 +197,26 @@ lemma mapM_x_bcorres_underlying[wp]:
lemma mapM_bcorres_underlying[wp]:
"(\<And>x. bcorres_underlying t (f x) (f' x)) \<Longrightarrow> bcorres_underlying t (mapM f xs) (mapM f' xs)"
apply (simp add: mapM_def | wp)+
done
by (simp add: mapM_def | wp)+
lemma gets_s_bcorres_underlyingE': "s_bcorres_underlying t (f (x s)) (f' (x' (t s))) s \<Longrightarrow> s_bcorres_underlying t (liftE (gets x) >>=E f) (liftE (gets x') >>=E f') s"
apply (simp add: gets_def liftE_def lift_def bindE_def)
apply wp
apply simp
done
by (simp add: gets_def liftE_def lift_def bindE_def) wp
lemma bcorres_underlying_filterM[wp]:
"(\<And>x. bcorres_underlying t (a x) (a' x)) \<Longrightarrow> bcorres_underlying t (filterM a b) (filterM a' b)"
apply (induct b)
apply (simp add: filterM_def)
apply (wp | simp)+
apply (simp add: filterM_def)
apply (wp | simp)+
done
lemma option_rec_bcorres_underlying[wp_split]:
"(\<And>x y. bcorres_underlying t (g x y) (g' x y)) \<Longrightarrow> (\<And>x. bcorres_underlying t (f x) (f' x))
\<Longrightarrow> bcorres_underlying t (rec_option f g a b) (rec_option f' g' a b)"
apply (cases a,simp+)
done
by (cases a,simp+)
lemma bcorres_underlying_mapME[wp]: "(\<And>x. bcorres_underlying t (f x) (f' x)) \<Longrightarrow> bcorres_underlying t (mapME f r) (mapME f' r)"
apply (induct r)
apply (simp add: mapME_def sequenceE_def | wp)+
apply (simp add: mapME_def sequenceE_def | wp)+
done
lemma handle2_bcorres_underlying[wp]: "bcorres_underlying t f f' \<Longrightarrow> (\<And>x. bcorres_underlying t (g x) (g' x)) \<Longrightarrow> bcorres_underlying t (f <handle2> g) (f' <handle2> g')"

6
lib/Bisim_UL.thy
View File

@ -366,7 +366,7 @@ lemma bisim_symb_exec_r_det_on:
apply fastforce
apply (rule nf)
apply (rule z)
apply (wp y)
apply (wp y)+
apply simp+
done
@ -472,8 +472,8 @@ lemma bisim_symb_exec_r:
apply fastforce
apply (rule ne)
apply (rule z)
apply (wp y)
apply simp+
apply (wp y)+
apply simp+
done
lemma bisim_not_empty:

2
lib/Corres_UL.thy
View File

@ -802,7 +802,7 @@ lemma corres_returnOk:
apply (rule corres_noopE)
apply wp
apply clarsimp
apply (rule no_fail_pre, wp)
apply wp
done
lemmas corres_returnOkTT = corres_trivial [OF corres_returnOk]

10
lib/EquivValid.thy
View File

@ -286,7 +286,7 @@ lemma get_bind_ev2:
apply(rule_tac R'="I And A" in equiv_valid_2_bind_general)
apply(rule assms, simp+)
apply(rule get_evrv)
apply(wp get_sp)
apply(wp get_sp)+
by(auto)
@ -900,8 +900,8 @@ lemma mapM_ev'':
assumes inv: "\<And> x. x \<in> set lst \<Longrightarrow> \<lbrace> \<lambda>s. \<forall>x\<in>set lst. P x s \<rbrace> m x \<lbrace> \<lambda>_ s. \<forall>x\<in>set lst. P x s \<rbrace>"
shows "equiv_valid_inv D A (\<lambda> s. \<forall>x\<in>set lst. P x s) (mapM m lst)"
apply(rule mapM_ev)
apply(rule equiv_valid_guard_imp[OF reads_res], simp+)
apply(wp inv, simp)
apply(rule equiv_valid_guard_imp[OF reads_res]; simp)
apply(wpsimp wp: inv)
done
lemma mapM_x_ev'':
@ -909,8 +909,8 @@ lemma mapM_x_ev'':
assumes inv: "\<And> x. x \<in> set lst \<Longrightarrow> \<lbrace> \<lambda>s. \<forall>x\<in>set lst. P x s \<rbrace> m x \<lbrace> \<lambda>_ s. \<forall>x\<in>set lst. P x s \<rbrace>"
shows "equiv_valid_inv D A (\<lambda> s. \<forall>x\<in>set lst. P x s) (mapM_x m lst)"
apply(rule mapM_x_ev)
apply(rule equiv_valid_guard_imp[OF reads_res], simp+)
apply(wp inv, simp)
apply(rule equiv_valid_guard_imp[OF reads_res]; simp)
apply(wpsimp wp: inv)
done
lemma catch_ev[wp]:

4
lib/HaskellLemmaBucket.thy
View File

@ -209,8 +209,8 @@ lemma findM_on_outcome':
apply (induct xs)
apply (simp, wp)
apply (simp, wp)
apply assumption
apply (rule x)
apply (rule x)
apply simp
done

200
lib/Monad_WP/NonDetMonadVCG.thy
View File

@ -16,6 +16,10 @@ imports
"Strengthen"
begin
(* Wrap up the standard usage pattern of wp/wpc/simp into its own command: *)
method wpsimp uses wp simp =
((determ \<open>wp add: wp|wpc|clarsimp simp: simp\<close>)+)[1]
declare K_def [simp]
section "Satisfiability"
@ -511,7 +515,7 @@ lemma exs_valid_get [wp]:
lemma exs_valid_gets [wp]:
"\<lbrace> \<lambda>s. Q (f s) s \<rbrace> gets f \<exists>\<lbrace> Q \<rbrace>"
by (clarsimp simp: gets_def, wp)
by (clarsimp simp: gets_def) wp
lemma exs_valid_put [wp]:
"\<lbrace> Q v \<rbrace> put v \<exists>\<lbrace> Q \<rbrace>"
@ -878,62 +882,51 @@ lemma hoare_vcg_prop:
lemma return_wp:
"\<lbrace>P x\<rbrace> return x \<lbrace>P\<rbrace>"
apply(simp add:valid_def return_def)
done
by(simp add:valid_def return_def)
lemma get_wp:
"\<lbrace>\<lambda>s. P s s\<rbrace> get \<lbrace>P\<rbrace>"
apply(simp add:valid_def split_def get_def)
done
by(simp add:valid_def split_def get_def)
lemma gets_wp:
"\<lbrace>\<lambda>s. P (f s) s\<rbrace> gets f \<lbrace>P\<rbrace>"
apply(simp add:valid_def split_def gets_def return_def get_def bind_def)
done
"\<lbrace>\<lambda>s. P (f s) s\<rbrace> gets f \<lbrace>P\<rbrace>"
by(simp add:valid_def split_def gets_def return_def get_def bind_def)
lemma modify_wp:
"\<lbrace>\<lambda>s. P () (f s)\<rbrace> modify f \<lbrace>P\<rbrace>"
apply(simp add:valid_def split_def modify_def get_def put_def bind_def)
done
"\<lbrace>\<lambda>s. P () (f s)\<rbrace> modify f \<lbrace>P\<rbrace>"
by(simp add:valid_def split_def modify_def get_def put_def bind_def)
lemma put_wp:
"\<lbrace>\<lambda>s. P () x\<rbrace> put x \<lbrace>P\<rbrace>"
apply(simp add:valid_def put_def)
done
by(simp add:valid_def put_def)
lemma returnOk_wp:
"\<lbrace>P x\<rbrace> returnOk x \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
apply(simp add:validE_def2 returnOk_def return_def)
done
by(simp add:validE_def2 returnOk_def return_def)
lemma throwError_wp:
"\<lbrace>E e\<rbrace> throwError e \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
apply(simp add:validE_def2 throwError_def return_def)
done
by(simp add:validE_def2 throwError_def return_def)
lemma returnOKE_R_wp : "\<lbrace>P x\<rbrace> returnOk x \<lbrace>P\<rbrace>, -"
by (simp add: validE_R_def validE_def valid_def
returnOk_def return_def)
by (simp add: validE_R_def validE_def valid_def returnOk_def return_def)
lemma liftE_wp:
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
apply(clarsimp simp:valid_def validE_def2 liftE_def split_def Let_def bind_def return_def)
done
by(clarsimp simp:valid_def validE_def2 liftE_def split_def Let_def bind_def return_def)
lemma catch_wp:
"\<lbrakk> \<And>x. \<lbrace>E x\<rbrace> handler x \<lbrace>Q\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<rbrakk> \<Longrightarrow>
\<lbrace>P\<rbrace> catch f handler \<lbrace>Q\<rbrace>"
apply (unfold catch_def valid_def validE_def return_def)
apply (clarsimp simp: bind_def)
apply (fastforce split: sum.splits)
apply (fastforce simp: bind_def split: sum.splits)
done
lemma handleE'_wp:
"\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace> \<rbrakk> \<Longrightarrow>
\<lbrace>P\<rbrace> f <handle2> handler \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
apply (unfold handleE'_def valid_def validE_def return_def)
apply (clarsimp simp: bind_def)
apply (fastforce split: sum.splits)
apply (fastforce simp: bind_def split: sum.splits)
done
lemma handleE_wp:
@ -1214,12 +1207,9 @@ lemma hoare_vcg_all_lift:
"\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>"
by (fastforce simp: valid_def)
(*
* hoare_vcg_all_lift_R
*
* \<And>x. \<lbrace>?P x\<rbrace> ?f \<lbrace>?Q x\<rbrace>, -) \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. ?P x s\<rbrace> ?f \<lbrace>\<lambda>rv s. \<forall>x. ?Q x rv s\<rbrace>, -
*)
lemmas hoare_vcg_all_lift_R = hoare_vcg_const_Ball_lift_R[where S=UNIV, simplified]
lemma hoare_vcg_all_lift_R:
"(\<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>, -) \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>, -"
by (rule hoare_vcg_const_Ball_lift_R[where S=UNIV, simplified])
lemma hoare_vcg_const_imp_lift:
"\<lbrakk> P \<Longrightarrow> \<lbrace>Q\<rbrace> m \<lbrace>R\<rbrace> \<rbrakk> \<Longrightarrow>
@ -1379,6 +1369,7 @@ lemmas hoare_wp_splits [wp_split] =
lemmas [wp_comb] = hoare_wp_state_combsE hoare_wp_combsE hoare_wp_combs
lemmas [wp] = hoare_vcg_prop
wp_post_taut
return_wp
put_wp
get_wp
@ -1393,6 +1384,7 @@ lemmas [wp] = hoare_vcg_prop
lemmas [wp_trip] = valid_is_triple validE_is_triple validE_E_is_triple validE_R_is_triple
text {* Simplifications on conjunction *}
lemma hoare_post_eq: "\<lbrakk> Q = Q'; \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
@ -1431,8 +1423,7 @@ lemmas hoare_wp_simps [wp_split] =
if_apply_reduct if_apply_reductE if_apply_reductE_R TrueI
schematic_goal if_apply_test: "\<lbrace>?Q\<rbrace> (if A then returnOk else K fail) x \<lbrace>P\<rbrace>,\<lbrace>E\<rbrace>"
apply (wp | unfold K_def)+
done
by wpsimp
lemma hoare_elim_pred_conj:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. Q r s \<and> Q' r s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. Q r and Q' r\<rbrace>"
@ -1456,12 +1447,16 @@ lemmas hoare_wp_pred_conj_elims =
lemmas hoare_weaken_preE = hoare_vcg_precond_impE
lemmas hoare_pre =
lemmas hoare_pre [wp_pre] =
hoare_weaken_pre
hoare_weaken_preE
hoare_vcg_precond_impE_R
hoare_weaken_preE_E
declare no_fail_pre [wp_pre]
bundle no_pre = hoare_pre [wp_pre del] no_fail_pre [wp_pre del]
text {* Miscellaneous lemmas on hoare triples *}
lemma hoare_vcg_mp:
@ -1491,10 +1486,7 @@ lemma hoare_add_post:
lemma hoare_whenE_wp:
"(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>"
unfolding whenE_def
apply clarsimp
apply wp
done
unfolding whenE_def by clarsimp wp
lemma hoare_gen_asmE:
"(P \<Longrightarrow> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>,-) \<Longrightarrow> \<lbrace>P' and K P\<rbrace> f \<lbrace>Q\<rbrace>, -"
@ -1506,10 +1498,8 @@ lemma hoare_list_case:
shows "\<lbrace>case xs of [] \<Rightarrow> P1 | y#ys \<Rightarrow> P2 y ys\<rbrace>
f (case xs of [] \<Rightarrow> f1 | y#ys \<Rightarrow> f2 y ys)
\<lbrace>Q\<rbrace>"
apply (cases xs)
apply simp
apply (cases xs; simp)
apply (rule P1)
apply simp
apply (rule P2)
apply simp
done
@ -1524,8 +1514,7 @@ lemma hoare_use_eq:
shows "\<lbrace>\<lambda>s. P (f s) s\<rbrace> m \<lbrace>\<lambda>rv s. Q (f s :: 'c :: type) s \<rbrace>"
apply (rule_tac Q="\<lambda>rv s. \<exists>f'. f' = f s \<and> Q f' s" in hoare_post_imp)
apply simp
apply (wp hoare_vcg_ex_lift x y)
apply simp
apply (wpsimp wp: hoare_vcg_ex_lift x y)
done
lemma hoare_return_sp:
@ -1590,11 +1579,7 @@ lemma in_liftM:
apply (simp add: Bex_def)
done
(*
* handy_liftM_lemma
*
* ((?r, ?s') \<in> fst (liftM ?t ?f ?s)) = (\<exists>r'. (r', ?s') \<in> fst (?f ?s) \<and> ?r = ?t r')
*)
(* FIXME: eliminate *)
lemmas handy_liftM_lemma = in_liftM
lemma hoare_fun_app_wp[wp]:
@ -1689,7 +1674,7 @@ lemma case_option_wp:
assumes y: "\<lbrace>P'\<rbrace> m' \<lbrace>Q\<rbrace>"
shows "\<lbrace>\<lambda>s. (x = None \<longrightarrow> P' s) \<and> (x \<noteq> None \<longrightarrow> P (the x) s)\<rbrace>
case_option m' m x \<lbrace>Q\<rbrace>"
apply (cases x, simp_all)
apply (cases x; simp)
apply (rule y)
apply (rule x)
done
@ -1699,7 +1684,7 @@ lemma case_option_wpE:
assumes y: "\<lbrace>P'\<rbrace> m' \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
shows "\<lbrace>\<lambda>s. (x = None \<longrightarrow> P' s) \<and> (x \<noteq> None \<longrightarrow> P (the x) s)\<rbrace>
case_option m' m x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
apply (cases x, simp_all)
apply (cases x; simp)
apply (rule y)
apply (rule x)
done
@ -1742,11 +1727,7 @@ lemma list_cases_wp:
(* FIXME: make wp *)
lemma whenE_throwError_wp:
"\<lbrace>\<lambda>s. \<not>Q \<longrightarrow> P s\<rbrace> whenE Q (throwError e) \<lbrace>\<lambda>rv. P\<rbrace>, -"
apply (simp add: whenE_def split del: if_split)
apply (rule hoare_pre)
apply wp
apply simp
done
unfolding whenE_def by wpsimp
lemma select_throwError_wp:
"\<lbrace>\<lambda>s. \<forall>x\<in>S. Q x s\<rbrace> select S >>= throwError -, \<lbrace>Q\<rbrace>"
@ -1760,16 +1741,13 @@ subsection "Basic validNF theorems"
lemma validNF [intro?]:
"\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>; no_fail P f \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!"
apply (clarsimp simp: validNF_def)
done
by (clarsimp simp: validNF_def)
lemma validNF_valid: "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>"
apply (clarsimp simp: validNF_def)
done
by (clarsimp simp: validNF_def)
lemma validNF_no_fail: "\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>! \<rbrakk> \<Longrightarrow> no_fail P f"
apply (clarsimp simp: validNF_def)
done
by (clarsimp simp: validNF_def)
lemma snd_validNF:
"\<lbrakk> \<lbrace> P \<rbrace> f \<lbrace> Q \<rbrace>!; P s \<rbrakk> \<Longrightarrow> \<not> snd (f s)"
@ -1783,57 +1761,42 @@ subsection "validNF weakest pre-condition rules"
lemma validNF_return [wp]:
"\<lbrace> P x \<rbrace> return x \<lbrace> P \<rbrace>!"
apply rule
apply wp
apply (clarsimp simp: no_fail_def return_def)
done
by (wp validNF)+
lemma validNF_get [wp]:
"\<lbrace> \<lambda>s. P s s \<rbrace> get \<lbrace> P \<rbrace>!"
apply rule
apply wp
apply (clarsimp simp: no_fail_def get_def)
done
by (wp validNF)+
lemma validNF_put [wp]:
"\<lbrace> \<lambda>s. P () x \<rbrace> put x \<lbrace> P \<rbrace>!"
apply rule
apply wp
apply (clarsimp simp: no_fail_def put_def)
done
by (wp validNF)+
lemma validNF_K_bind [wp]:
"\<lbrace> P \<rbrace> x \<lbrace> Q \<rbrace>! \<Longrightarrow> \<lbrace> P \<rbrace> K_bind x f \<lbrace> Q \<rbrace>!"
apply (clarsimp simp: validNF_def)
done
by simp
lemma validNF_fail [wp]:
"\<lbrace> \<lambda>s. False \<rbrace> fail \<lbrace> Q \<rbrace>!"
by (clarsimp simp: validNF_def fail_def no_fail_def)
lemma validNF_prop [wp_unsafe]:
"\<lbrakk> no_fail (\<lambda>s. P) f \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s. P \<rbrace> f \<lbrace> \<lambda>rv s. P \<rbrace>!"
apply rule
apply wp
apply simp
done
"\<lbrakk> no_fail (\<lambda>s. P) f \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s. P \<rbrace> f \<lbrace> \<lambda>rv s. P \<rbrace>!"
by (wp validNF)+
lemma validNF_post_conj [intro!]:
"\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> Q \<rbrace>!; \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> a \<lbrace> Q And R \<rbrace>!"
apply (clarsimp simp: validNF_def)
done
by (clarsimp simp: validNF_def)
lemma no_fail_or:
"\<lbrakk>no_fail P a; no_fail Q a\<rbrakk> \<Longrightarrow> no_fail (P or Q) a"
by (clarsimp simp: no_fail_def)
lemma validNF_pre_disj [intro!]:
"\<lbrakk> \<lbrace> P \<rbrace> a \<lbrace> R \<rbrace>!; \<lbrace> Q \<rbrace> a \<lbrace> R \<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace> P or Q \<rbrace> a \<lbrace> R \<rbrace>!"
apply rule
apply (drule validNF_valid)+
apply auto[1]
apply (drule validNF_no_fail)+
apply (clarsimp simp: no_fail_def)
done
by (rule validNF) (auto dest: validNF_valid validNF_no_fail intro: no_fail_or)
(*
* Setup combination rules for WP, which also requires
* Set up combination rules for WP, which also requires
* a "wp_trip" rule for validNF.
*)
@ -1842,8 +1805,7 @@ definition "validNF_property Q s b \<equiv> \<not> snd (b s) \<and> (\<forall>(r
lemma validNF_is_triple [wp_trip]:
"validNF P f Q = triple_judgement P f (validNF_property Q)"
apply (clarsimp simp: validNF_def triple_judgement_def validNF_property_def)
apply (clarsimp simp: no_fail_def valid_def)
apply auto
apply (auto simp: no_fail_def valid_def)
done
lemma validNF_weaken_pre [wp_comb]:
@ -1896,7 +1858,7 @@ lemma validNF_vcg_disj_lift:
lemma validNF_vcg_all_lift [wp]:
"\<lbrakk> \<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>! \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<forall>x. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x. Q x rv s\<rbrace>!"
apply atomize
apply rule
apply (rule validNF)
apply (clarsimp simp: validNF_def)
apply (rule hoare_vcg_all_lift)
apply force
@ -1906,7 +1868,7 @@ lemma validNF_vcg_all_lift [wp]:
lemma validNF_bind [wp_split]:
"\<lbrakk> \<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>! \<rbrakk> \<Longrightarrow>
\<lbrace>A\<rbrace> do x \<leftarrow> f; g x od \<lbrace>C\<rbrace>!"
apply rule
apply (rule validNF)
apply (metis validNF_valid hoare_seq_ext)
apply (clarsimp simp: no_fail_def validNF_def bind_def' valid_def)
apply blast
@ -1918,9 +1880,8 @@ subsection "validNF compound rules"
lemma validNF_state_assert [wp]:
"\<lbrace> \<lambda>s. P () s \<and> G s \<rbrace> state_assert G \<lbrace> P \<rbrace>!"
apply rule
apply wp
apply simp
apply (rule validNF)
apply wpsimp
apply (clarsimp simp: no_fail_def state_assert_def
bind_def' assert_def return_def get_def)
done
@ -1952,20 +1913,18 @@ lemma validNF_alt_def:
lemma validNF_assert [wp]:
"\<lbrace> (\<lambda>s. P) and (R ()) \<rbrace> assert P \<lbrace> R \<rbrace>!"
apply rule
apply (rule validNF)
apply (clarsimp simp: valid_def in_return)
apply (clarsimp simp: no_fail_def return_def)
done
lemma validNF_false_pre:
"\<lbrace> \<lambda>_. False \<rbrace> P \<lbrace> Q \<rbrace>!"
apply (clarsimp simp: validNF_def no_fail_def)
done
by (clarsimp simp: validNF_def no_fail_def)
lemma validNF_chain:
"\<lbrakk>\<lbrace>P'\<rbrace> a \<lbrace>R'\<rbrace>!; \<And>s. P s \<Longrightarrow> P' s; \<And>r s. R' r s \<Longrightarrow> R r s\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> a \<lbrace>R\<rbrace>!"
apply (fastforce simp: validNF_def valid_def no_fail_def Ball_def)
done
by (fastforce simp: validNF_def valid_def no_fail_def Ball_def)
lemma validNF_case_prod [wp]:
"\<lbrakk> \<And>x y. validNF (P x y) (B x y) Q \<rbrakk> \<Longrightarrow> validNF (case_prod P v) (case_prod (\<lambda>x y. B x y) v) Q"
@ -1979,8 +1938,7 @@ lemma validE_NF_case_prod [wp]:
done
lemma no_fail_is_validNF_True: "no_fail P s = (\<lbrace> P \<rbrace> s \<lbrace> \<lambda>_ _. True \<rbrace>!)"
apply (clarsimp simp: no_fail_def validNF_def valid_def)
done
by (clarsimp simp: no_fail_def validNF_def valid_def)
subsection "validNF reasoning in the exception monad"
@ -2033,8 +1991,7 @@ lemma validE_NF_chain:
\<And>r' s'. R' r' s' \<Longrightarrow> R r' s';
\<And>r'' s''. E' r'' s'' \<Longrightarrow> E r'' s''\<rbrakk> \<Longrightarrow>
\<lbrace>\<lambda>s. P s \<rbrace> a \<lbrace>\<lambda>r' s'. R r' s'\<rbrace>,\<lbrace>\<lambda>r'' s''. E r'' s''\<rbrace>!"
apply (fastforce simp: validE_NF_def validE_def2 no_fail_def Ball_def split: sum.splits)
done
by (fastforce simp: validE_NF_def validE_def2 no_fail_def Ball_def split: sum.splits)
lemma validE_NF_bind_wp [wp]:
"\<lbrakk>\<And>x. \<lbrace>B x\<rbrace> g x \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>!; \<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>, \<lbrace>E\<rbrace>!\<rbrakk> \<Longrightarrow> \<lbrace>A\<rbrace> f >>=E (\<lambda>x. g x) \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>!"
@ -2042,8 +1999,7 @@ lemma validE_NF_bind_wp [wp]:
apply (rule validNF_bind [rotated])
apply assumption
apply (clarsimp simp: lift_def throwError_def split: sum.splits)
apply wp
apply simp
apply wpsimp
done
lemma validNF_catch [wp]:
@ -2057,33 +2013,21 @@ lemma validNF_catch [wp]:
lemma validNF_throwError [wp]:
"\<lbrace>E e\<rbrace> throwError e \<lbrace>P\<rbrace>, \<lbrace>E\<rbrace>!"
apply (unfold validE_NF_alt_def throwError_def o_def)
apply wp
apply simp
done
by (unfold validE_NF_alt_def throwError_def o_def) wpsimp
lemma validNF_returnOk [wp]:
"\<lbrace>P e\<rbrace> returnOk e \<lbrace>P\<rbrace>, \<lbrace>E\<rbrace>!"
apply (clarsimp simp: validE_NF_alt_def returnOk_def)
apply wp
apply clarsimp
done
by (clarsimp simp: validE_NF_alt_def returnOk_def) wpsimp
lemma validNF_whenE [wp]:
"(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>!) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>!"
unfolding whenE_def
apply clarsimp
apply wp
done
unfolding whenE_def by clarsimp wp
lemma validNF_nobindE [wp]:
"\<lbrakk> \<lbrace>B\<rbrace> g \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>!;
\<lbrace>A\<rbrace> f \<lbrace>\<lambda>r s. B s\<rbrace>,\<lbrace>E\<rbrace>! \<rbrakk> \<Longrightarrow>
\<lbrace>A\<rbrace> doE f; g odE \<lbrace>C\<rbrace>,\<lbrace>E\<rbrace>!"
apply clarsimp
apply wp
apply auto
done
by clarsimp wp
(*
* Setup triple rules for validE_NF so that we can use the
@ -2110,10 +2054,7 @@ lemma validNF_cong:
lemma validE_NF_liftE [wp]:
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>! \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
apply (clarsimp simp: validE_NF_alt_def liftE_def)
apply wp
apply clarsimp
done
by (wpsimp simp: validE_NF_alt_def liftE_def)
lemma validE_NF_handleE' [wp]:
"\<lbrakk> \<And>x. \<lbrace>F x\<rbrace> handler x \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!; \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>F\<rbrace>! \<rbrakk> \<Longrightarrow>
@ -2122,8 +2063,7 @@ lemma validE_NF_handleE' [wp]:
apply (rule validNF_bind [rotated])
apply assumption
apply (clarsimp split: sum.splits)
apply wp
apply simp
apply wpsimp
done
lemma validE_NF_handleE [wp]:
@ -2138,7 +2078,7 @@ lemma validE_NF_condition [wp]:
\<Longrightarrow> \<lbrace>\<lambda>s. if C s then Q s else R s\<rbrace> condition C A B \<lbrace>P\<rbrace>,\<lbrace> E \<rbrace>!"
apply rule
apply (drule validE_NF_valid)+
apply (wp, simp, simp)
apply wp
apply (drule validE_NF_no_fail)+
apply (clarsimp simp: no_fail_def condition_def)
done

111
lib/Monad_WP/wp/WP-method.ML
View File

@ -12,7 +12,8 @@ signature WP =
sig
type wp_rules = {trips: thm list * (theory -> term -> term),
rules: (int * thm) Net.net * int * (int * thm) list,
splits: thm list, combs: thm list, unsafe_rules: thm list};
splits: thm list, combs: thm list, unsafe_rules: thm list,
wp_pre: thm list};
val debug_get: Proof.context -> wp_rules;
@ -43,6 +44,8 @@ sig
val combs_del: Thm.attribute;
val wp_unsafe_add: Thm.attribute;
val wp_unsafe_del: Thm.attribute;
val wp_pre_add: Thm.attribute;
val wp_pre_del: Thm.attribute;
end;
structure WeakestPre =
@ -50,7 +53,8 @@ struct
type wp_rules = {trips: thm list * (theory -> term -> term),
rules: (int * thm) Net.net * int * (int * thm) list,
splits: thm list, combs: thm list, unsafe_rules: thm list};
splits: thm list, combs: thm list, unsafe_rules: thm list,
wp_pre: thm list};
fun accum_last_occurence' [] _ = ([], Termtab.empty)
| accum_last_occurence' ((t, v) :: ts) tt1 = let
@ -107,13 +111,14 @@ fun rules_merge (wp_rules, wp_rules') = let
rules = mk_rules trip_conv rules,
splits = Thm.merge_thms (#splits wp_rules, #splits wp_rules'),
combs = Thm.merge_thms (#combs wp_rules, #combs wp_rules'),
unsafe_rules = Thm.merge_thms (#unsafe_rules wp_rules, #unsafe_rules wp_rules')} end
unsafe_rules = Thm.merge_thms (#unsafe_rules wp_rules, #unsafe_rules wp_rules'),
wp_pre = Thm.merge_thms (#wp_pre wp_rules, #wp_pre wp_rules')} end
structure WPData = Generic_Data
(struct
type T = wp_rules;
val empty = {trips = ([], K I), rules = no_rules,
splits = [], combs = [], unsafe_rules = []};
splits = [], combs = [], unsafe_rules = [], wp_pre = []};
val extend = I;
val merge = rules_merge;
@ -142,63 +147,91 @@ fun get_combined_rules rules' combs' =
fun add_rule rule rs =
{trips = #trips rs,
rules = add_rule_inner (snd (#trips rs)) rule (#rules rs),
splits = #splits rs, combs = #combs rs,
unsafe_rules = #unsafe_rules rs};
splits = #splits rs,
combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = #wp_pre rs
}
fun del_rule rule rs =
{trips = #trips rs,
rules = del_rule_inner (snd (#trips rs)) rule (#rules rs),
splits = #splits rs, combs = #combs rs,
unsafe_rules = #unsafe_rules rs};
splits = #splits rs,
combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = #wp_pre rs
}
fun add_trip rule (rs : wp_rules) = let
val trips = Thm.add_thm rule (fst (#trips rs));
val trip_conv = mk_trip_conv trips
in {trips = (trips, trip_conv),
rules = mk_rules trip_conv (dest_rules (#rules rs)),
splits = #splits rs, combs = #combs rs,
unsafe_rules = #unsafe_rules rs} end;
splits = #splits rs,
combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = #wp_pre rs}
end
fun del_trip rule (rs : wp_rules) = let
val trips = Thm.del_thm rule (fst (#trips rs));
val trip_conv = mk_trip_conv trips
in {trips = (trips, trip_conv),
rules = mk_rules trip_conv (dest_rules (#rules rs)),
splits = #splits rs, combs = #combs rs,
unsafe_rules = #unsafe_rules rs} end;
splits = #splits rs,
combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = #wp_pre rs}
end
fun add_split rule (rs : wp_rules) =
{trips = #trips rs, rules = #rules rs,
splits = Thm.add_thm rule (#splits rs), combs = #combs rs,
unsafe_rules = #unsafe_rules rs};
{trips = #trips rs,
rules = #rules rs,
splits = Thm.add_thm rule (#splits rs),
combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = #wp_pre rs}
fun add_comb rule (rs : wp_rules) =
{trips = #trips rs, rules = #rules rs,
splits = #splits rs, combs = Thm.add_thm rule (#combs rs),
unsafe_rules = #unsafe_rules rs};
unsafe_rules = #unsafe_rules rs, wp_pre = #wp_pre rs}
fun del_split rule rs =
{trips = #trips rs, rules = #rules rs,
splits = Thm.del_thm rule (#splits rs), combs = #combs rs,
unsafe_rules = #unsafe_rules rs};
unsafe_rules = #unsafe_rules rs, wp_pre = #wp_pre rs}
fun del_comb rule rs =
{trips = #trips rs, rules = #rules rs,
splits = #splits rs, combs = Thm.del_thm rule (#combs rs),
unsafe_rules = #unsafe_rules rs};
unsafe_rules = #unsafe_rules rs, wp_pre = #wp_pre rs}
fun add_unsafe_rule rule rs =
{trips = #trips rs, rules = #rules rs,
splits = #splits rs, combs = #combs rs,
unsafe_rules = Thm.add_thm rule (#unsafe_rules rs)};
unsafe_rules = Thm.add_thm rule (#unsafe_rules rs),
wp_pre = #wp_pre rs}
fun del_unsafe_rule rule rs =
{trips = #trips rs, rules = #rules rs,
splits = #splits rs, combs = #combs rs,
unsafe_rules = Thm.del_thm rule (#unsafe_rules rs)};
unsafe_rules = Thm.del_thm rule (#unsafe_rules rs),
wp_pre = #wp_pre rs}
fun gen_att m = Thm.declaration_attribute (fn thm => fn context =>
WPData.map (m thm) context);
fun add_wp_pre rule rs =
{trips = #trips rs, rules = #rules rs,
splits = #splits rs, combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = Thm.add_thm rule (#wp_pre rs)}
fun del_wp_pre rule rs =
{trips = #trips rs, rules = #rules rs,
splits = #splits rs, combs = #combs rs,
unsafe_rules = #unsafe_rules rs,
wp_pre = Thm.del_thm rule (#wp_pre rs)}
fun gen_att m = Thm.declaration_attribute (fn thm => fn context => WPData.map (m thm) context);
val wp_add = gen_att add_rule;
val wp_del = gen_att del_rule;
@ -210,6 +243,8 @@ val combs_add = gen_att add_comb;
val combs_del = gen_att del_comb;
val wp_unsafe_add = gen_att add_unsafe_rule;
val wp_unsafe_del = gen_att del_unsafe_rule;
val wp_pre_add = gen_att add_wp_pre;
val wp_pre_del = gen_att del_wp_pre;
val setup =
Attrib.setup @{binding "wp"}
@ -227,6 +262,9 @@ val setup =
#> Attrib.setup @{binding "wp_unsafe"}
(Attrib.add_del wp_unsafe_add wp_unsafe_del)
"unsafe monadic weakest precondition rules"
#> Attrib.setup @{binding "wp_pre"}
(Attrib.add_del wp_pre_add wp_pre_del)
"initial weakening rules for wp"
fun debug_get ctxt = WPData.get (Context.Proof ctxt);
@ -294,23 +332,34 @@ fun apply_rules_tac_n trace ctxt extras extras_ref n =
let
val rules = get_rules ctxt extras;
val used_rules = Unsynchronized.ref [] : thm list Unsynchronized.ref
fun has_vars st = Term.exists_subterm Term.is_Var (Thm.concl_of st)
val wp_pre_tac = COND has_vars all_tac (TRY (resolve_tac ctxt (#wp_pre rules) 1))
val cleanup_tac = TRY (REPEAT
(resolve_tac ctxt [@{thm TrueI}, @{thm conj_TrueI}, @{thm conj_TrueI2}] 1
ORELSE assume_tac ctxt 1))
val steps_tac = (CHANGED (REPEAT_DETERM (resolve_ruleset_tac ctxt rules used_rules 1)))
THEN cleanup_tac
in
SELECT_GOAL (
(fn t => Seq.map (fn thm => (warn_unused_thms ctxt extras extras_ref used_rules;
trace_used_thms trace used_rules ctxt; thm))
(CHANGED (REPEAT_DETERM (resolve_ruleset_tac ctxt rules used_rules n)) t)) THEN_ELSE
(fn t => (warn_unsafe_thms (#unsafe_rules rules) n ctxt t; all_tac t),
fn t => (warn_unsafe_thms (#unsafe_rules rules) n ctxt t; no_tac t))
end;
((wp_pre_tac THEN steps_tac) t)) THEN_ELSE
(fn t => (warn_unsafe_thms (#unsafe_rules rules) 1 ctxt t; all_tac t),
fn t => (warn_unsafe_thms (#unsafe_rules rules) 1 ctxt t; no_tac t))) n
end
fun apply_rules_tac trace ctxt extras extras_ref =
apply_rules_tac_n trace ctxt extras extras_ref 1;
fun apply_rules_tac trace ctxt extras extras_ref = apply_rules_tac_n trace ctxt extras extras_ref 1;
fun apply_once_tac trace ctxt extras extras_ref t =
let val used_rules = Unsynchronized.ref [] : thm list Unsynchronized.ref;
let
val used_rules = Unsynchronized.ref [] : thm list Unsynchronized.ref;
in Seq.map (fn thm => (warn_unused_thms ctxt extras extras_ref used_rules;
trace_used_thms trace used_rules ctxt; thm))
(resolve_ruleset_tac ctxt (get_rules ctxt extras) used_rules 1 t) end
(SELECT_GOAL (resolve_ruleset_tac ctxt (get_rules ctxt extras) used_rules 1) 1 t) end
fun clear_rules ({combs, rules, trips, splits, unsafe_rules}) =
{combs=combs, rules=no_rules, trips=trips, splits=splits, unsafe_rules=unsafe_rules}
fun clear_rules ({combs, rules, trips, splits, unsafe_rules, wp_pre}) =
{combs=combs, rules=no_rules, trips=trips, splits=splits, unsafe_rules=unsafe_rules, wp_pre=wp_pre}
fun wp_modifiers extras_ref =
[Args.add -- Args.colon >> K (I, fn att => (add_extra_rule (#2 att) extras_ref; wp_add att)),

8
lib/Monad_WP/wp/WP.thy
View File

@ -9,7 +9,9 @@
*)
theory WP
imports "~~/src/HOL/Main"
imports
"~~/src/HOL/Main"
"~~/src/HOL/Eisbach/Eisbach_Tools"
begin
definition
@ -28,6 +30,9 @@ definition
where
"postconditions P Q = (\<lambda>a b. P a b \<and> Q a b)"
lemma conj_TrueI: "P \<Longrightarrow> True \<and> P" by simp
lemma conj_TrueI2: "P \<Longrightarrow> P \<and> True" by simp
ML_file "WP-method.ML"
declare [[wp_warn_unused = false]]
@ -46,4 +51,5 @@ method_setup wp_trace = {* WeakestPre.apply_rules_args true *}
method_setup wp_once_trace = {* WeakestPre.apply_once_args true *}
"applies one weakest precondition rule with tracing"
end

1
lib/Monad_WP/wp/WPI.thy
View File

@ -430,7 +430,6 @@ notepad begin
f x
\<lbrace>\<lambda>r s. D'' x \<and> (R D r s \<longrightarrow> (Q s \<and> Q' s \<and> D \<and> (y x \<longrightarrow> D''' y) \<and> (D'''' \<longrightarrow> y x))) \<and>
(\<not> R D r s \<longrightarrow> (Q s \<and> Q'' s))\<rbrace>"
apply (rule hoare_pre)
apply wp
apply (wpi wpi: Q')
apply (wpi wpi: Q)

4
lib/MonadicRewrite.thy
View File

@ -363,11 +363,11 @@ lemma monadic_rewrite_gets_the_walk:
apply (rule monadic_rewrite_trans)
apply (erule(1) monadic_rewrite_bind_tail)
apply (simp add: gets_the_def bind_assoc)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rule monadic_rewrite_trans)
apply (rule monadic_rewrite_bind_tail)
apply (rule_tac rv=rv in monadic_rewrite_symb_exec_l_known,
wp empty_fail_gets)
(wp empty_fail_gets)+)
apply (rule monadic_rewrite_refl)
apply wp
apply assumption

88
lib/NonDetMonadLemmaBucket.thy
View File

@ -176,11 +176,7 @@ next
have IH: "\<lbrace>P\<rbrace> zipWithM_x m as bs \<lbrace>\<lambda>rv. P\<rbrace>"
by fact
show ?case
apply (simp add: zipWithM_x_Cons)
apply wp
apply (rule IH)
apply (rule x)
done
by (simp add: zipWithM_x_Cons) (wp IH x)
qed
lemma K_valid[wp]:
@ -193,10 +189,9 @@ lemma mapME_wp:
apply (induct xs)
apply (simp add: mapME_def sequenceE_def)
apply wp
apply (simp add: mapME_Cons)
apply wp
apply simp
apply (simp add: x)
apply (simp add: mapME_Cons)
apply (wp x|simp)+
done
lemmas mapME_wp' = mapME_wp [OF _ subset_refl]
@ -229,8 +224,8 @@ lemma mapM_wp:
apply (simp add: mapM_def sequence_def)
apply (simp add: mapM_Cons)
apply wp
apply assumption
apply (simp add: x)
apply (rule x, clarsimp)
apply simp
done
lemma mapM_x_mapM:
@ -242,12 +237,7 @@ lemma mapM_x_mapM:
lemma mapM_x_wp:
assumes x: "\<And>x. x \<in> S \<Longrightarrow> \<lbrace>P\<rbrace> f x \<lbrace>\<lambda>rv. P\<rbrace>"
shows "set xs \<subseteq> S \<Longrightarrow> \<lbrace>P\<rbrace> mapM_x f xs \<lbrace>\<lambda>rv. P\<rbrace>"
apply (subst mapM_x_mapM)
apply wp
apply (rule mapM_wp)
apply (rule x)
apply assumption+
done
by (subst mapM_x_mapM) (wp mapM_wp x)
lemma mapM_x_Nil:
"mapM_x f [] = return ()"
@ -282,8 +272,7 @@ next
thus ?case
apply (simp add: mapM_x_Cons)
apply wp
apply assumption
apply (wp hr)
apply (wp hr)
apply assumption
done
qed
@ -321,12 +310,12 @@ proof (induct xs rule: rev_induct)
next
case (snoc x xs)
show ?case
apply -
apply (simp add: mapM_append_single)
apply (wp snoc.prems)
apply simp
apply (rule snoc.hyps [OF snoc.prems])
apply simp
apply simp
apply (rule snoc.hyps [OF snoc.prems])
apply simp
apply assumption
done
qed
@ -351,8 +340,8 @@ lemma mapME_x_inv_wp:
apply (simp add: mapME_x_def sequenceE_x_def)
apply (fold mapME_x_def sequenceE_x_def)
apply wp
apply assumption
apply (rule x)
apply (rule x)
apply assumption
done
lemma liftM_return [simp]:
@ -632,10 +621,7 @@ lemma no_fail_throwError [wp]:
lemma no_fail_liftE [wp]:
"no_fail P f \<Longrightarrow> no_fail P (liftE f)"
apply (simp add: liftE_def)
apply (rule no_fail_pre, (wp | assumption)+)
apply simp
done
unfolding liftE_def by wpsimp
lemma bind_return_eq:
"(a >>= return) = (b >>= return) \<Longrightarrow> a = b"
@ -733,8 +719,7 @@ lemma in_returns [monad_eq]:
lemma assertE_sp:
"\<lbrace>P\<rbrace> assertE Q \<lbrace>\<lambda>rv s. Q \<and> P s\<rbrace>,\<lbrace>E\<rbrace>"
by (clarsimp simp: assertE_def, wp)
by (clarsimp simp: assertE_def) wp
lemma catch_liftE:
"catch (liftE g) h = g"
@ -957,8 +942,7 @@ next
case (Cons z zs)
show ?case
apply (clarsimp simp: mapM_Cons)
apply (rule no_fail_pre)
apply (wp Cons.prems Cons.hyps hoare_vcg_const_Ball_lift|simp)+
apply (wp Cons.prems Cons.hyps hoare_vcg_const_Ball_lift|simp)+
done
qed
@ -1103,13 +1087,7 @@ lemma no_fail_mapM:
apply (induct xs)
apply (simp add: mapM_def sequence_def)
apply (simp add: mapM_Cons)
apply (rule no_fail_pre)
apply (rule no_fail_bind)
apply fastforce
apply (erule no_fail_bind)
apply (rule no_fail_return)
apply wp
apply simp
apply (wp|fastforce)+
done
lemma gets_inv [simp]:
@ -1151,8 +1129,7 @@ lemma injection_wp:
"\<lbrakk> t = injection_handler f; \<lbrace>P\<rbrace> m \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>ft. E (f ft)\<rbrace> \<rbrakk>
\<Longrightarrow> \<lbrace>P\<rbrace> t m \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
apply (simp add: injection_handler_def)
apply wp
apply simp
apply (wp|simp)+
done
lemma injection_wp_E:
@ -1374,10 +1351,7 @@ lemma whenE_whenE_same:
apply simp
done
lemma gets_the_inv: "\<lbrace>P\<rbrace> gets_the V \<lbrace>\<lambda>rv. P\<rbrace>"
apply wp
apply simp
done
lemma gets_the_inv: "\<lbrace>P\<rbrace> gets_the V \<lbrace>\<lambda>rv. P\<rbrace>" by wpsimp
lemma select_f_inv:
"\<lbrace>P\<rbrace> select_f S \<lbrace>\<lambda>_. P\<rbrace>"
@ -1393,7 +1367,7 @@ lemma validI:
lemma opt_return_pres_lift:
assumes x: "\<And>v. \<lbrace>P\<rbrace> f v \<lbrace>\<lambda>rv. P\<rbrace>"
shows "\<lbrace>P\<rbrace> case x of None \<Rightarrow> return () | Some v \<Rightarrow> f v \<lbrace>\<lambda>rv. P\<rbrace>"
by (rule hoare_pre, wpcw, wp x, simp)
by (rule hoare_pre, (wpcw; wp x), simp)
lemma exec_select_f_singleton:
"(select_f ({v},False) >>= f) = f v"
@ -1431,8 +1405,9 @@ lemma filterM_preserved:
"\<lbrakk> \<And>x. x \<in> set xs \<Longrightarrow> \<lbrace>P\<rbrace> m x \<lbrace>\<lambda>rv. P\<rbrace> \<rbrakk>
\<Longrightarrow> \<lbrace>P\<rbrace> filterM m xs \<lbrace>\<lambda>rv. P\<rbrace>"
apply (induct xs)
apply (wp | simp | erule meta_mp)+
apply (wp | simp | erule meta_mp | drule meta_spec)+
done
lemma filterM_append:
"filterM f (xs @ ys) = (do
xs' \<leftarrow> filterM f xs;
@ -2057,14 +2032,12 @@ next
show ?case
apply (simp add: mapME_Cons)
apply (wp)
apply (rule_tac Q' = "\<lambda>xs s. (R s \<and> (\<forall>x \<in> set xs. P x s)) \<and> P x s" in
hoare_post_imp_R)
apply (rule_tac Q' = "\<lambda>xs s. (R s \<and> (\<forall>x \<in> set xs. P x s)) \<and> P x s" in hoare_post_imp_R)
apply (wp Cons.hyps minvp)
apply simp
apply (fold validE_R_def)
apply simp
apply (rule hoare_pre)
apply (wp invr est)
apply (wp invr est)
apply simp
done
qed clarsimp
@ -2126,7 +2099,7 @@ lemma list_case_throw_validE_R:
"\<lbrakk> \<And>y ys. xs = y # ys \<Longrightarrow> \<lbrace>P\<rbrace> f y ys \<lbrace>Q\<rbrace>,- \<rbrakk> \<Longrightarrow>
\<lbrace>P\<rbrace> case xs of [] \<Rightarrow> throwError e | x # xs \<Rightarrow> f x xs \<lbrace>Q\<rbrace>,-"
apply (case_tac xs, simp_all)
apply (rule hoare_pre, wp)
apply wp
done
lemma validE_R_sp:
@ -2145,8 +2118,7 @@ lemma valid_set_take_helper:
lemma whenE_throwError_sp:
"\<lbrace>P\<rbrace> whenE Q (throwError e) \<lbrace>\<lambda>rv s. \<not> Q \<and> P s\<rbrace>, -"
apply (simp add: whenE_def validE_R_def)
apply (intro conjI impI)
apply wp
apply (intro conjI impI; wp)
done
lemma no_fail_bindE [wp]:
@ -2164,10 +2136,6 @@ lemma no_fail_bindE [wp]:
apply clarsimp
done
lemma when_False:
"when False f = return ()"
by (simp add: when_def)
lemma empty_fail_mapM_x [simp]:
"(\<And>x. empty_fail (a x)) \<Longrightarrow> empty_fail (mapM_x a xs)"
apply (induct_tac xs)
@ -2631,7 +2599,9 @@ lemma no_throw_bindE_simple: "\<lbrakk> no_throw \<top> L; \<And>x. no_throw \<t
apply wp
done
lemma no_throw_handleE_simple: "\<lbrakk> \<And>x. no_throw \<top> L \<or> no_throw \<top> (R x) \<rbrakk> \<Longrightarrow> no_throw \<top> (L <handle> R)"
lemma no_throw_handleE_simple:
notes hoare_pre [wp_pre del]
shows "\<lbrakk> \<And>x. no_throw \<top> L \<or> no_throw \<top> (R x) \<rbrakk> \<Longrightarrow> no_throw \<top> (L <handle> R)"
apply (clarsimp simp: no_throw_def)
apply atomize
apply clarsimp

1
lib/sep_algebra/MonadSep.thy
View File

@ -28,6 +28,7 @@ lemma hoare_gen_lifted_asm:
by (auto intro: hoare_assume_pre)
lemma mapM_x_sep_inv':
includes no_pre
assumes f:
"\<And>R x. x \<in> S \<Longrightarrow>
\<lbrace>\<lambda>s.<P x \<and>* I \<and>* R> s \<and> I' s\<rbrace>

17
proof/access-control/ADT_AC.thy
View File

@ -304,6 +304,7 @@ lemma dmo_um_upd_machine_state:
"\<lbrace>\<lambda>s. P (device_state (machine_state s))\<rbrace>
do_machine_op (user_memory_update ms)
\<lbrace>\<lambda>_ s. P (device_state (machine_state s))\<rbrace>"
including no_pre
apply (wp dmo_wp)
by (simp add:user_memory_update_def simpler_modify_def valid_def)
@ -313,20 +314,20 @@ lemma do_user_op_respects:
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: do_user_op_def)
apply (wp | simp | wpc)+
apply (rule dmo_device_update_respects_Write)
apply (wp dmo_um_upd_machine_state
dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift
| wpc | clarsimp)+
apply (rule hoare_pre_cont)
apply (wp select_wp | wpc | clarsimp)+
apply (rule dmo_device_update_respects_Write)
apply (wp dmo_um_upd_machine_state
dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift
| wpc | clarsimp)+
apply (rule hoare_pre_cont)
apply (wp select_wp | wpc | clarsimp)+
apply (simp add: restrict_map_def split:if_splits)
apply (rule conjI)
apply (clarsimp split: if_splits)
apply (drule_tac auth=Write in user_op_access')
apply (simp add: vspace_cap_rights_to_auth_def)+
apply (simp add: vspace_cap_rights_to_auth_def)+
apply (rule conjI,simp)
apply (clarsimp split: if_splits)
apply (drule_tac auth=Write in user_op_access')
apply (drule_tac auth=Write in user_op_access')
apply (simp add: vspace_cap_rights_to_auth_def)+
done

9
proof/access-control/Arch_AC.thy
View File

@ -622,7 +622,7 @@ lemma set_mrs_integrity_autarch:
apply (fastforce simp add: le_eq_less_or_eq)
apply (simp add: msg_max_length_def msg_align_bits)
apply simp
apply (wp set_object_integrity_autarch hoare_drop_imps hoare_vcg_all_lift)
apply (wp set_object_integrity_autarch hoare_drop_imps hoare_vcg_all_lift)+
apply simp
done
@ -1264,11 +1264,8 @@ lemma delete_asid_respects:
"\<lbrace>integrity aag X st and pas_refined aag and invs and K (is_subject aag pd)\<rbrace>
delete_asid asid pd
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: delete_asid_def)
apply (wp set_asid_pool_respects_clear | simp | wpc)+
apply (wp hoare_vcg_all_lift)
apply (clarsimp simp: obj_at_def pas_refined_refl)
done
by (wpsimp wp: set_asid_pool_respects_clear hoare_vcg_all_lift
simp: obj_at_def pas_refined_refl delete_asid_def)
end

35
proof/access-control/CNode_AC.thy
View File

@ -99,13 +99,13 @@ lemma list_integ_lift:
assumes rq: "\<And>P. \<lbrace> \<lambda>s. P (ready_queues s) \<rbrace> f \<lbrace> \<lambda>rv s. P (ready_queues s) \<rbrace>"
shows "\<lbrace>integrity aag X st and Q\<rbrace> f \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
apply (rule hoare_pre)
apply (unfold integrity_def[abs_def])
apply (simp only: integrity_cdt_list_as_list_integ)
apply (rule hoare_lift_Pf2[where f="ekheap"])
apply (simp add: tcb_states_of_state_def get_tcb_def)
apply (wp li ekh rq)
apply (unfold integrity_def[abs_def])
apply (simp only: integrity_cdt_list_as_list_integ)
apply (simp add: tcb_states_of_state_def get_tcb_def)
apply (rule hoare_lift_Pf2[where f="ekheap"])
apply (simp add: tcb_states_of_state_def get_tcb_def)
apply (wp li ekh rq)+
apply (simp only: integrity_cdt_list_as_list_integ)
apply (simp add: tcb_states_of_state_def get_tcb_def)
done
end
@ -157,7 +157,7 @@ proof (induct arbitrary: s rule: resolve_address_bits'.induct)
apply (cases cap', simp_all add: P split del: if_split)
apply (rule hoare_pre_spec_validE)
apply (wp "1.hyps", (assumption | simp add: in_monad | rule conjI)+)
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply (auto simp: cte_wp_at_caps_of_state is_cap_simps cap_auth_conferred_def
dest: caps_of_state_pasObjectAbs_eq)
done
@ -562,11 +562,11 @@ interpretation Arch . (*FIXME: arch_split*)
lemma pas_refined_tcb_domain_map_wellformed[wp]:
assumes tdmw: "\<lbrace>tcb_domain_map_wellformed aag\<rbrace> f \<lbrace>\<lambda>_. tcb_domain_map_wellformed aag\<rbrace>"
shows "\<lbrace>pas_refined aag\<rbrace> f \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
apply (simp add: pas_refined_def)
apply (wp tdmw)
apply (wp lift_inv)
apply simp
done
apply (simp add: pas_refined_def)
apply (wp tdmw)
apply (wp lift_inv)
apply simp+
done
end
@ -1207,8 +1207,7 @@ crunch integrity_autarch: set_asid_pool "integrity aag X st"
(* FIXME: move *)
lemma a_type_arch_object_not_tcb[simp]:
"a_type (ArchObj arch_kernel_obj) \<noteq> ATCB"
apply (auto simp: a_type_def)
done
by auto
crunch cur_domain[wp]: cap_swap_for_delete, empty_slot, finalise_cap "\<lambda>s. P (cur_domain s)"
(wp: crunch_wps select_wp hoare_vcg_if_lift2 simp: unless_def)
@ -1219,17 +1218,13 @@ lemma preemption_point_cur_domain[wp]:
lemma rec_del_cur_domain[wp]:
"\<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> rec_del call \<lbrace>\<lambda>_ s. P (cur_domain s)\<rbrace>"
apply (rule rec_del_preservation)
apply wp
done
by (rule rec_del_preservation; wp)
crunch cur_domain[wp]: cap_delete "\<lambda>s. P (cur_domain s)"
lemma cap_revoke_cur_domain[wp]:
"\<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> cap_revoke slot \<lbrace>\<lambda>_ s. P (cur_domain s)\<rbrace>"
apply (rule cap_revoke_preservation2)
apply wp
done
by (rule cap_revoke_preservation2; wp)
lemma cnode_inv_auth_derivations_If_Insert_Move:
"cnode_inv_auth_derivations ((if P then MoveCall else InsertCall) cap src_slot dest_slot)

51
proof/access-control/DomainSepInv.thy
View File

@ -222,11 +222,11 @@ lemma weak_derived_DomainCap:
lemma cte_wp_at_weak_derived_domain_sep_inv_cap:
"\<lbrakk>domain_sep_inv irqs st s; cte_wp_at (weak_derived cap) slot s\<rbrakk> \<Longrightarrow> domain_sep_inv_cap irqs cap"
apply (cases slot)
apply (force simp: domain_sep_inv_def domain_sep_inv_cap_def
split: cap.splits
dest: cte_wp_at_eqD weak_derived_irq_handler weak_derived_DomainCap)
done
apply (cases slot)
apply (force simp: domain_sep_inv_def domain_sep_inv_cap_def
split: cap.splits
dest: cte_wp_at_eqD weak_derived_irq_handler weak_derived_DomainCap)
done
lemma is_derived_IRQHandlerCap:
"is_derived m src (IRQHandlerCap irq) cap \<Longrightarrow> (cap = IRQHandlerCap irq)"
@ -313,7 +313,7 @@ lemma deleted_irq_handler_domain_sep_inv:
apply(simp add: deleted_irq_handler_def)
apply(simp add: set_irq_state_def)
apply wp
apply(rule domain_sep_inv_triv, wp)
apply(rule domain_sep_inv_triv, wp+)
apply(simp add: domain_sep_inv_def)
done
@ -321,12 +321,9 @@ lemma empty_slot_domain_sep_inv:
"\<lbrace>\<lambda>s. domain_sep_inv irqs st s \<and> (\<not> irqs \<longrightarrow> b = None)\<rbrace>
empty_slot a b
\<lbrace>\<lambda>_ s. domain_sep_inv irqs st s\<rbrace>"
apply(simp add: empty_slot_def)
apply (wp | wpc)+
apply(wp get_cap_wp set_cap_domain_sep_inv set_original_wp dxo_wp_weak static_imp_wp deleted_irq_handler_domain_sep_inv | simp | blast)+
done
unfolding empty_slot_def
by (wpsimp wp: get_cap_wp set_cap_domain_sep_inv set_original_wp dxo_wp_weak static_imp_wp
deleted_irq_handler_domain_sep_inv)
lemma set_endpoint_neg_cte_wp_at[wp]:
"\<lbrace>\<lambda>s. \<not> cte_wp_at P slot s\<rbrace> set_endpoint a b \<lbrace>\<lambda>_ s. \<not> cte_wp_at P slot s\<rbrace>"
@ -486,6 +483,7 @@ crunch domain_sep_inv[wp]: finalise_cap "domain_sep_inv irqs st"
lemma finalise_cap_domain_sep_inv_cap:
"\<lbrace>\<lambda>s. domain_sep_inv_cap irqs cap\<rbrace> finalise_cap cap b \<lbrace>\<lambda>rv s. domain_sep_inv_cap irqs (fst rv)\<rbrace>"
including no_pre
apply(case_tac cap)
apply(wp | simp add: o_def split del: if_split split: cap.splits arch_cap.splits | fastforce split: if_splits simp: domain_sep_inv_cap_def)+
apply(rule hoare_pre, wp, fastforce)
@ -589,7 +587,7 @@ lemma cap_revoke_domain_sep_inv':
show ?case
apply(subst cap_revoke.simps)
apply(rule hoare_pre_spec_validE)
apply (wp "1.hyps", assumption+)
apply (wp "1.hyps")
apply(wp spec_valid_conj_liftE2 | simp)+
apply(wp drop_spec_validE[OF valid_validE[OF preemption_point_domain_sep_inv]]
drop_spec_validE[OF valid_validE[OF cap_delete_domain_sep_inv]]
@ -916,6 +914,7 @@ lemma invoke_control_domain_sep_inv:
"\<lbrace>domain_sep_inv irqs st and irq_control_inv_valid blah\<rbrace>
invoke_irq_control blah
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
including no_pre
apply(case_tac blah)
apply(wp cap_insert_domain_sep_inv' | simp )+
apply(case_tac irqs)
@ -965,13 +964,9 @@ lemma transfer_caps_domain_sep_inv:
real_cte_at (snd x) s))\<rbrace>
transfer_caps mi caps endpoint receiver receive_buffer
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply (simp add: transfer_caps_def)
apply (wpc | wp)+
apply(rule transfer_caps_loop_pres_dest)
apply(wp cap_insert_domain_sep_inv | simp )+
apply(wp hoare_vcg_all_lift hoare_vcg_imp_lift | simp)+
apply(fastforce elim: cte_wp_at_weakenE)
apply simp
unfolding transfer_caps_def
apply (wpsimp wp: transfer_caps_loop_pres_dest cap_insert_domain_sep_inv hoare_vcg_all_lift hoare_vcg_imp_lift)
apply (fastforce elim: cte_wp_at_weakenE)
done
@ -1014,8 +1009,8 @@ lemma send_ipc_domain_sep_inv:
apply (wp setup_caller_cap_domain_sep_inv | wpc | simp)+
apply(rule_tac Q="\<lambda> r s. domain_sep_inv irqs st s" in hoare_strengthen_post)
apply(wp do_ipc_transfer_domain_sep_inv dxo_wp_weak | wpc | simp)+
apply(wp_once hoare_drop_imps)
apply (wp get_endpoint_wp)
apply (wp_once hoare_drop_imps)
apply (wp get_endpoint_wp)+
apply clarsimp
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def ep_q_refs_of_def
ep_redux_simps neq_Nil_conv valid_ep_def case_list_cons_cong
@ -1120,9 +1115,7 @@ lemma thread_set_tcb_ipc_buffer_update_domain_sep_inv[wp]:
"\<lbrace>domain_sep_inv irqs st\<rbrace>
thread_set (tcb_ipc_buffer_update f) t
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply(rule domain_sep_inv_triv)
apply wp
done
by (rule domain_sep_inv_triv; wp)
lemma thread_set_tcb_fault_handler_update_neg_cte_wp_at[wp]:
"\<lbrace>\<lambda>s. \<not> cte_wp_at P slot s\<rbrace>
@ -1147,9 +1140,7 @@ lemma thread_set_tcb_fault_handler_update_domain_sep_inv[wp]:
"\<lbrace>domain_sep_inv irqs st\<rbrace>
thread_set (tcb_fault_handler_update blah) t
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply(rule domain_sep_inv_triv)
apply wp
done
by (rule domain_sep_inv_triv; wp)
lemma thread_set_tcb_tcb_mcpriority_update_neg_cte_wp_at[wp]:
"\<lbrace>\<lambda>s. \<not> cte_wp_at P slot s\<rbrace>
@ -1174,9 +1165,7 @@ lemma thread_set_tcb_tcp_mcpriority_update_domain_sep_inv[wp]:
"\<lbrace>domain_sep_inv irqs st\<rbrace>
thread_set (tcb_mcpriority_update blah) t
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
apply(rule domain_sep_inv_triv)
apply wp
done
by (rule domain_sep_inv_triv; wp)
lemma same_object_as_domain_sep_inv_cap:
"\<lbrakk>same_object_as a cap; domain_sep_inv_cap irqs cap\<rbrakk>

41
proof/access-control/Finalise_AC.thy
View File

@ -78,7 +78,7 @@ lemma cancel_badged_sends_respects[wp]:
apply (wp sts_respects_restart_ep hoare_vcg_const_Ball_lift sts_st_tcb_at_neq|simp)+
apply clarsimp
apply fastforce
apply (wp set_endpoinintegrity hoare_vcg_const_Ball_lift get_endpoint_wp)
apply (wp set_endpoinintegrity hoare_vcg_const_Ball_lift get_endpoint_wp)+
apply clarsimp
apply (frule(1) sym_refs_ko_atD)
apply (frule ko_at_state_refs_ofD)
@ -137,9 +137,9 @@ lemma gbn_pas_refined[wp]:
lemma set_bound_notification_ekheap[wp]:
"\<lbrace>\<lambda>s. P (ekheap s)\<rbrace> set_bound_notification t st \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
apply (simp add: set_bound_notification_def)
apply (wp set_scheduler_action_wp | simp)+
done
apply (simp add: set_bound_notification_def)
apply (wp set_scheduler_action_wp | simp)+
done
lemma sbn_thread_states[wp]:
"\<lbrace>\<lambda>s. P (thread_states s)\<rbrace> set_bound_notification t ntfn \<lbrace>\<lambda>rv s. P (thread_states s)\<rbrace>"
@ -191,6 +191,7 @@ crunch pas_refined[wp]: set_vm_root "pas_refined aag"
lemma reply_cancel_ipc_pas_refined[wp]:
"\<lbrace>pas_refined aag and K (is_subject aag t)\<rbrace> reply_cancel_ipc t \<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
including no_pre
apply (rule hoare_gen_asm)
apply (simp add: reply_cancel_ipc_def)
apply (wp select_wp)
@ -451,7 +452,8 @@ lemma finalise_cap_respects[wp]:
aag_cap_auth_def unbind_maybe_notification_def
elim!: pas_refined_Control[symmetric])+)[3]
(* tcb cap *)
apply (wp unbind_notification_respects unbind_notification_invs
including no_pre
apply (wp unbind_notification_respects unbind_notification_invs
| clarsimp simp: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def
unbind_maybe_notification_def
elim!: pas_refined_Control[symmetric]
@ -501,6 +503,7 @@ lemma finalise_cap_auth':
"\<lbrace>pas_refined aag and K (pas_cap_cur_auth aag cap)\<rbrace>
finalise_cap cap final
\<lbrace>\<lambda>rv s. pas_cap_cur_auth aag (fst rv)\<rbrace>"
including no_pre
apply (rule hoare_gen_asm)
apply (cases cap, simp_all add: arch_finalise_cap_def split del: if_split)
apply (wp
@ -517,11 +520,7 @@ lemma finalise_cap_auth':
lemma finalise_cap_obj_refs:
"\<lbrace>\<lambda>s. \<forall>x \<in> obj_refs cap. P x\<rbrace> finalise_cap cap slot \<lbrace>\<lambda>rv s. \<forall>x \<in> obj_refs (fst rv). P x\<rbrace>"
apply (cases cap)
apply (wp | simp add: o_def | rule impI TrueI conjI)+
apply (simp add: arch_finalise_cap_def)
apply (rule hoare_pre)
apply (wp | wpc)+
apply simp
apply (wpsimp simp: arch_finalise_cap_def o_def|rule conjI)+
done
lemma zombie_ptr_emptyable:
@ -609,7 +608,7 @@ next
apply (subst rec_del.simps)
apply (simp only: split_def)
apply (rule hoare_pre_spec_validE)
apply (wp set_cap_integrity_autarch "2.hyps" static_imp_wp, assumption+)
apply (wp set_cap_integrity_autarch "2.hyps" static_imp_wp)
apply ((wp preemption_point_inv' | simp add: integrity_subjects_def pas_refined_def)+)[1]
apply (simp(no_asm))
apply (rule spec_strengthen_postE)
@ -653,7 +652,7 @@ next
apply (erule_tac s = "{r}" in subst)
apply simp
apply (simp add: is_final_cap_def)
apply (wp get_cap_auth_wp [where aag = aag])
apply (wp get_cap_auth_wp [where aag = aag])+
apply (clarsimp simp: pas_refined_wellformed cte_wp_at_caps_of_state conj_comms)
apply (frule (1) caps_of_state_valid)
apply (frule if_unsafe_then_capD [OF caps_of_state_cteD], clarsimp+)
@ -666,7 +665,7 @@ next
case (3 ptr bits n slot s)
show ?case
apply (simp add: rec_del_call.simps simp_thms spec_validE_def)
apply (rule hoare_pre, wp static_imp_wp)
apply (wp static_imp_wp)
apply clarsimp
done
@ -803,10 +802,7 @@ lemma pas_refined_set_asid_table_empty_strg:
lemma set_asid_pool_ko_at[wp]:
"\<lbrace>\<top>\<rbrace> set_asid_pool ptr pool \<lbrace>\<lambda>rv. ko_at (ArchObj (arch_kernel_obj.ASIDPool pool)) ptr\<rbrace>"
apply (simp add: set_asid_pool_def set_object_def)
apply wp
apply (simp add: obj_at_def hoare_post_taut)
done
by (wpsimp simp: obj_at_def set_asid_pool_def set_object_def)
(* The contents of the delete_access_control locale *)
@ -840,7 +836,7 @@ proof (induct rule: cap_revoke.induct[where ?a1.0=s])
apply (subst cap_revoke.simps)
apply (rule hoare_pre_spec_validE)
apply (wp "1.hyps", assumption+)
apply (wp "1.hyps")
apply ((wp preemption_point_inv' | simp add: integrity_subjects_def pas_refined_def)+)[1]
apply (wp select_ext_weak_wp cap_delete_respects cap_delete_pas_refined
| simp split del: if_split | wp_once hoare_vcg_const_imp_lift hoare_drop_imps)+
@ -873,6 +869,7 @@ lemma valid_specE_validE:
lemma deleting_irq_handler_caps_of_state_nullinv:
"\<lbrace>\<lambda>s. \<forall>p. P (caps_of_state s(p \<mapsto> cap.NullCap))\<rbrace> deleting_irq_handler irq \<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
unfolding deleting_irq_handler_def
including no_pre
apply (wp cap_delete_one_caps_of_state hoare_drop_imps)
apply (rule hoare_post_imp [OF _ get_irq_slot_inv])
apply fastforce
@ -882,6 +879,7 @@ lemma finalise_cap_caps_of_state_nullinv:
"\<lbrace>\<lambda>s. P (caps_of_state s) \<and> (\<forall>p. P (caps_of_state s(p \<mapsto> cap.NullCap)))\<rbrace>
finalise_cap cap final
\<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
including no_pre
apply (cases cap, simp_all split del: if_split)
apply (wp suspend_caps_of_state unbind_notification_caps_of_state
unbind_notification_cte_wp_at
@ -903,6 +901,7 @@ lemma finalise_cap_cte_wp_at_nullinv:
lemma finalise_cap_fst_ret:
"\<lbrace>\<lambda>s. P cap.NullCap \<and> (\<forall>a b c. P (cap.Zombie a b c)) \<rbrace> finalise_cap cap is_final\<lbrace>\<lambda>rv s. P (fst rv)\<rbrace>"
including no_pre
apply (cases cap, simp_all add: arch_finalise_cap_def split del: if_split)
apply (wp | simp add: comp_def split del: if_split | fastforce)+
apply (rule hoare_pre)
@ -944,13 +943,13 @@ next
rec_del_call.simps)
apply (wp static_imp_wp)
apply (wp set_cap_cte_wp_at')[1]
apply (wp "2.hyps"[simplified without_preemption_def rec_del_call.simps], assumption+)
apply (wp "2.hyps"[simplified without_preemption_def rec_del_call.simps])
apply ((wp preemption_point_inv | simp)+)[1]
apply simp
apply (rule "2.hyps"[simplified exposed_rdcall.simps slot_rdcall.simps
simp_thms disj_not1], simp_all)[1]
apply (simp add: cte_wp_at_caps_of_state)
apply wp
apply wp+
apply (rule_tac Q = "\<lambda>rv' s. (slot \<noteq> p \<or> exposed \<longrightarrow> cte_wp_at P p s) \<and> P (fst rv')
\<and> cte_at slot s" in hoare_post_imp)
apply (clarsimp simp: cte_wp_at_caps_of_state)
@ -972,7 +971,7 @@ next
apply (subst rec_del.simps)
apply wp
apply (simp add: cte_wp_at_caps_of_state)
apply wp
apply wp+
apply simp
apply (wp get_cap_wp)[1]
apply (rule spec_strengthen_postE)

8
proof/access-control/Interrupt_AC.thy
View File

@ -30,10 +30,8 @@ lemma invoke_irq_control_pas_refined:
invoke_irq_control irq_ctl_inv
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (cases irq_ctl_inv, simp_all add: arch_invoke_irq_control_def)
apply (wp cap_insert_pas_refined | simp)+
apply (clarsimp simp add: clas_no_asid cap_links_irq_def
authorised_irq_ctl_inv_def aag_cap_auth_def)
apply simp
apply (wpsimp wp: cap_insert_pas_refined)
apply (clarsimp simp: clas_no_asid cap_links_irq_def authorised_irq_ctl_inv_def aag_cap_auth_def)
done
definition
@ -90,7 +88,7 @@ lemma decode_irq_control_invocation_authorised [wp]:
apply (simp add: Let_def split del: if_split cong: if_cong)
apply (wp whenE_throwError_wp hoare_vcg_imp_lift hoare_drop_imps
| strengthen aag_Control_owns_strg
| simp add: o_def del: hoare_post_taut hoare_True_E_R)+
| simp add: o_def del: hoare_True_E_R)+
apply (cases args, simp_all)
apply (cases caps, simp_all)
apply (simp add: ucast_mask_drop)

74
proof/access-control/Ipc_AC.thy
View File

@ -213,13 +213,11 @@ lemma store_word_offs_respects:
done
lemma ipc_buffer_has_auth_None [simp]:
"ipc_buffer_has_auth aag receiver None"
unfolding ipc_buffer_has_auth_def by simp
(* MOVE *)
(* FIXME: MOVE *)
lemma cap_auth_caps_of_state:
"\<lbrakk> caps_of_state s p = Some cap; pas_refined aag s\<rbrakk>
\<Longrightarrow> aag_cap_auth aag (pasObjectAbs aag (fst p)) cap"
@ -338,7 +336,7 @@ lemma set_mrs_respects_in_signalling':
apply (wp mapM_x_wp' dmo_storeWord_respects_ipc [where thread = thread and ep = ep])
apply (fastforce simp add: set_zip nth_append simp: msg_align_bits msg_max_length_def
split: if_split_asm)
apply wp
apply wp+
apply (rule impI)
apply (subgoal_tac "\<forall>c'. integrity aag X st
(s\<lparr>kheap := kheap s(thread \<mapsto>
@ -705,7 +703,7 @@ next
| assumption | simp split del: if_split)+
apply (rule cap_insert_assume_null)
apply (wp x hoare_vcg_const_Ball_lift cap_insert_cte_wp_at)
apply (wp x hoare_vcg_const_Ball_lift cap_insert_cte_wp_at)+
(* cannot blindly use derive_cap_is_derived_foo here , need to first hoist
out of the postcondition the conjunct that the return value is derived,
and solve this using derived_cap_is_derived, and then solve the rest
@ -716,7 +714,7 @@ next
prefer 2
apply clarsimp
apply assumption
apply(wp derive_cap_is_derived_foo)
apply(wp derive_cap_is_derived_foo)+
apply (simp only: tl_drop_1[symmetric])
apply (clarsimp simp: cte_wp_at_caps_of_state
ex_cte_cap_to_cnode_always_appropriate_strg
@ -802,7 +800,7 @@ lemma get_receive_slots_authorised:
| rule hoare_drop_imps
| simp add: add: lookup_cap_def split_def)+
apply (strengthen cnode_cap_all_auth_owns, simp add: aag_cap_auth_def)
apply (wp hoare_vcg_all_lift_R hoare_drop_imps)
apply (wp hoare_vcg_all_lift_R hoare_drop_imps)+
apply clarsimp
apply (fastforce simp: is_cap_simps)
done
@ -858,15 +856,14 @@ next
show ?case using Cons.prems
apply (cases c)
apply (simp split del: if_split cong: if_cong)
apply (rule hoare_pre)
apply (wp)
apply (elim conjE, erule subst, rule Cons.hyps)
apply fastforce
apply (wp hoare_vcg_ball_lift Cons.hyps)
apply (fastforce dest: in_set_dropD in_set_dropD[where n=1, folded tl_drop_1])
apply (wp cap_insert_pas_refined hoare_vcg_ball_lift hoare_whenE_wp hoare_drop_imps
derive_cap_aag_caps
| simp split del: if_split add: if_apply_def2)+
apply (elim conjE, erule subst, rule Cons.hyps)
apply fastforce
apply (wp hoare_vcg_ball_lift Cons.hyps)+
apply (fastforce dest: in_set_dropD in_set_dropD[where n=1, folded tl_drop_1])
apply (wp cap_insert_pas_refined hoare_vcg_ball_lift hoare_whenE_wp hoare_drop_imps
derive_cap_aag_caps
| simp split del: if_split add: if_apply_def2)+
done
qed
@ -941,10 +938,7 @@ lemma lcs_valid':
lemma lec_valid_cap':
"\<lbrace>valid_objs\<rbrace> lookup_extra_caps thread xa mi \<lbrace>\<lambda>rv s. (\<forall>x\<in>set rv. s \<turnstile> fst x)\<rbrace>, -"
unfolding lookup_extra_caps_def
apply (wp mapME_set lcs_valid')
apply clarsimp
apply wp
done
by (wpsimp wp: mapME_set lcs_valid')
lemma do_normal_transfer_pas_refined:
@ -1010,29 +1004,22 @@ lemma send_ipc_pas_refined:
apply (simp add: send_ipc_def)
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_pre)
apply wpc
apply wpc
apply (wp set_thread_state_pas_refined)
apply wpc
apply (wp set_thread_state_pas_refined)
apply wpc
apply (wp set_thread_state_pas_refined)
apply (simp add: hoare_if_r_and split del:if_split)
apply (rename_tac list x xs recv_state)
apply (rule_tac Q="\<lambda>rv. pas_refined aag and K (can_grant \<longrightarrow> is_subject aag (hd list))"
apply (wpc | wp set_thread_state_pas_refined)+
apply (simp add: hoare_if_r_and split del:if_split)
apply (rename_tac list x xs recv_state)
apply (rule_tac Q="\<lambda>rv. pas_refined aag and K (can_grant \<longrightarrow> is_subject aag (hd list))"
in hoare_strengthen_post[rotated])
apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid)
apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp
| wpc
| simp add: hoare_if_r_and)+
apply (rename_tac list x xs)
apply (rule_tac Q="\<lambda>rv. valid_objs and pas_refined aag and K (can_grant \<longrightarrow> is_subject aag (hd list))" in hoare_strengthen_post[rotated])
apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid)
apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp
| wpc
| simp add: hoare_if_r_and
| rule hoare_drop_imps)+
apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid)
apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp
| wpc
| simp add: hoare_if_r_and)+
apply (rename_tac list x xs)
apply (rule_tac Q="\<lambda>rv. valid_objs and pas_refined aag and K (can_grant \<longrightarrow> is_subject aag (hd list))" in hoare_strengthen_post[rotated])
apply (clarsimp simp: cli_no_irqs pas_refined_refl aag_cap_auth_def clas_no_asid)
apply (wp set_thread_state_pas_refined do_ipc_transfer_pas_refined static_imp_wp
| wpc
| simp add: hoare_if_r_and
| rule hoare_drop_imps)+
apply clarsimp
apply (rule obj_at_valid_objsE, assumption+)
apply (clarsimp cong: conj_cong imp_cong simp: tcb_at_st_tcb_at conj_comms)
@ -1264,7 +1251,7 @@ lemma get_mi_valid':
"\<lbrace>\<top>\<rbrace> get_message_info a \<lbrace>\<lambda>rv s. valid_message_info rv\<rbrace>"
apply (simp add: get_message_info_def)
apply (wp, rule hoare_post_imp, rule data_to_message_info_valid)
apply wp
apply wp+
done
lemma lookup_extra_caps_length:
@ -1728,6 +1715,7 @@ lemma cap_insert_ext_integrity_in_ipc:
apply (clarsimp simp: integrity_tcb_in_ipc_def integrity_def
tcb_states_of_state_def get_tcb_def
split del: if_split cong: if_cong)
including no_pre
apply wp
apply (rule hoare_vcg_conj_lift)
apply (simp add: list_integ_def del: split_paired_All)
@ -1855,7 +1843,7 @@ lemma set_mrs_respects_in_ipc:
apply (simp add: length_msg_registers)
apply arith
apply simp
apply wp
apply wp+
apply (fastforce intro: update_tcb_context_in_ipc [unfolded fun_upd_def])
done

42
proof/access-control/Retype_AC.thy
View File

@ -152,9 +152,9 @@ lemma copy_global_mappings_integrity:
apply (rule hoare_gen_asm)
apply (simp add: copy_global_mappings_def)
apply (wp mapM_x_wp[OF _ subset_refl] store_pde_integrity)
apply (drule subsetD[OF copy_global_mappings_index_subset])
apply (fastforce simp: pd_shifting')
apply(wp)
apply (drule subsetD[OF copy_global_mappings_index_subset])
apply (fastforce simp: pd_shifting')
apply wpsimp+
done
lemma dmo_mol_respects:
@ -164,7 +164,7 @@ lemma dmo_mol_respects:
apply wp
apply clarsimp
apply (erule use_valid)
apply (wp mol_respects)
apply (wp mol_respects)
apply simp
done
@ -182,11 +182,8 @@ lemma dmo_mapM_wp:
shows "set xs \<subseteq> S \<Longrightarrow> \<lbrace>P\<rbrace> do_machine_op (mapM f xs) \<lbrace>\<lambda>rv. P\<rbrace>"
apply (induct xs)
apply (simp add: mapM_def sequence_def)
apply (simp add: mapM_Cons)
apply (simp add: dmo_bind_valid dmo_bind_valid')
apply wp
apply assumption
apply (simp add: x)
apply (simp add: mapM_Cons dmo_bind_valid dmo_bind_valid')
apply (wpsimp | rule x)+
done
lemma dmo_mapM_x_wp:
@ -207,7 +204,7 @@ lemma dmo_cacheRangeOp_lift:
\<Longrightarrow> \<lbrace>P\<rbrace> do_machine_op (cacheRangeOp oper x y z) \<lbrace>\<lambda>_. P\<rbrace>"
apply (simp add: cacheRangeOp_def)
apply (wp dmo_mapM_x_wp_inv)
apply (simp add: split_def)
apply (simp add: split_def)+
done
lemma dmo_cleanCacheRange_PoU_respects [wp]:
@ -428,7 +425,7 @@ lemma dmo_clearMemory_respects':
apply (erule use_valid)
apply wp
apply (simp add: cleanByVA_PoU_def)
apply (wp mol_respects mapM_x_wp' storeWord_respects)
apply (wp mol_respects mapM_x_wp' storeWord_respects)+
apply simp
apply (clarsimp simp add: word_size_def upto_enum_step_shift_red [where us = 2, simplified])
apply (erule bspec)
@ -476,7 +473,7 @@ lemma reset_untyped_cap_integrity:
apply (simp add: word_bits_def)
apply clarsimp
apply (simp add: if_apply_def2)
apply (wp hoare_vcg_const_imp_lift get_cap_wp)
apply (wp hoare_vcg_const_imp_lift get_cap_wp)+
apply (clarsimp simp: cte_wp_at_caps_of_state)
apply (frule caps_of_state_valid_cap, clarsimp+)
apply (clarsimp simp: cap_aligned_def is_cap_simps valid_cap_simps bits_of_def)
@ -791,6 +788,7 @@ context begin interpretation Arch . (*FIXME: arch_split*)
lemma retype_region_ext_pas_refined:
"\<lbrace>pas_refined aag and pas_cur_domain aag and K (\<forall>x\<in> set xs. is_subject aag x)\<rbrace> retype_region_ext xs ty \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
including no_pre
apply (subst and_assoc[symmetric])
apply (wp retype_region_ext_extended.pas_refined_tcb_domain_map_wellformed')
apply (simp add: retype_region_ext_def, wp)
@ -817,12 +815,12 @@ lemma retype_region_pas_refined:
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (rule hoare_gen_asm)
apply (rule hoare_pre)
apply(rule use_retype_region_proofs_ext)
apply(erule (1) retype_region_proofs'.pas_refined[OF retype_region_proofs'.intro])
apply (wp retype_region_ext_pas_refined)
apply simp
apply auto
done
apply(rule use_retype_region_proofs_ext)
apply(erule (1) retype_region_proofs'.pas_refined[OF retype_region_proofs'.intro])
apply (wp retype_region_ext_pas_refined)
apply simp
apply auto
done
(* MOVE *)
lemma retype_region_aag_bits:
@ -919,8 +917,8 @@ lemma freeMemory_vms:
apply (simp add: freeMemory_def machine_op_lift_def
machine_rest_lift_def split_def)
apply (wp hoare_drop_imps | simp | wp mapM_x_wp_inv)+
apply (simp add: storeWord_def | wp)+
apply (simp add: word_rsplit_0)
apply (simp add: storeWord_def | wp)+
apply (simp add: word_rsplit_0)+
done
@ -1481,7 +1479,7 @@ lemma decode_untyped_invocation_authorised:
apply (fastforce simp: nonzero_unat_simp)
apply(clarsimp simp: K_def)
apply(wp lookup_slot_for_cnode_op_authorised
lookup_slot_for_cnode_op_inv whenE_throwError_wp)
lookup_slot_for_cnode_op_inv whenE_throwError_wp)+
apply(rule hoare_drop_imps)+
apply(clarsimp)
apply(rule_tac Q'="\<lambda>rv s. rv \<noteq> ArchObject ASIDPoolObj \<and>
@ -1495,7 +1493,7 @@ lemma decode_untyped_invocation_authorised:
in hoare_post_imp_R)
apply(wp data_to_obj_type_ret_not_asid_pool data_to_obj_type_inv2)
apply(case_tac "excaps ! 0", simp_all, fastforce simp: nonzero_unat_simp)[1]
apply(wp whenE_throwError_wp)
apply(wp whenE_throwError_wp)+
apply(auto dest!: bang_0_in_set
simp: valid_cap_def cap_aligned_def obj_ref_of_def is_cap_simps
cap_auth_conferred_def pas_refined_all_auth_is_owns

40
proof/access-control/Syscall_AC.thy
View File

@ -1161,6 +1161,7 @@ lemma dxo_current_ipc_buffer_register[wp]:
lemma dxo_current_ipc_buffer_register_kheap_upd:
"\<lbrace>\<lambda>s. P (current_ipc_buffer_register (s\<lparr>kheap:=kh\<rparr>))\<rbrace> do_extended_op eop \<lbrace>\<lambda>r s. P (current_ipc_buffer_register (s\<lparr>kheap:=kh\<rparr>))\<rbrace>"
including no_pre
apply (simp | wp dxo_wp_weak)+
apply (rule arg_cong[where f = P])
apply (simp add: trans_state_def current_ipc_buffer_register_def get_tcb_def)
@ -1224,6 +1225,7 @@ lemma retype_region_current_ipc_buffer_register:
lemma cancel_signal_current_ipc_buffer_register[wp]:
"\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> cancel_signal a b \<lbrace>\<lambda>r s. P (current_ipc_buffer_register s)\<rbrace>"
including no_pre
apply (clarsimp simp: cancel_signal_def get_notification_def)
apply (wp | wpc)+
apply (clarsimp simp: get_object_def set_object_def valid_def put_def
@ -1237,6 +1239,7 @@ crunch current_ipc_buffer_register [wp]: blocked_cancel_ipc "\<lambda>s. P (curr
lemma reply_cancel_ipc_current_ipc_buffer_register[wp]:
"\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> reply_cancel_ipc a \<lbrace>\<lambda>r s. P (current_ipc_buffer_register s)\<rbrace>"
including no_pre
apply (clarsimp simp: reply_cancel_ipc_def)
apply (wp select_wp| wpc)+
apply (rule_tac Q = "\<lambda>r s. P (current_ipc_buffer_register s)" in hoare_post_imp)
@ -1275,11 +1278,7 @@ abbreviation (input)
lemma rec_del_current_ipc_buffer_register [wp]:
"invariant (rec_del call) (\<lambda>s. P (current_ipc_buffer_register s))"
apply (rule rec_del_preservation)
apply wp
apply (wp preemption_point_inv)
apply simp+
done
by (rule rec_del_preservation; wpsimp wp: preemption_point_inv)
crunch current_ipc_buffer_register [wp]: cap_delete "\<lambda>s. P (current_ipc_buffer_register s)"
(wp: crunch_wps simp: crunch_simps)
@ -1287,9 +1286,7 @@ crunch current_ipc_buffer_register [wp]: cap_delete "\<lambda>s. P (current_ipc_
lemma cap_revoke_current_ipc_buffer_register [wp]:
"invariant (cap_revoke slot) (\<lambda>s. P (current_ipc_buffer_register s))"
apply (rule validE_valid)
apply (rule cap_revoke_preservation)
apply (wp preemption_point_inv)
apply simp+
apply (rule cap_revoke_preservation; wpsimp wp: preemption_point_inv)
done
end
@ -1510,12 +1507,11 @@ lemma cancel_all_ipc_ct_active[wp]:
"\<lbrace>ct_active\<rbrace>
cancel_all_ipc ptr
\<lbrace>\<lambda>_. ct_active \<rbrace>"
apply (rule hoare_pre)
apply (wp mapM_x_wp | wps | simp add: cancel_all_ipc_def | wpc)+
apply (wp mapM_x_wp | wps | simp add: cancel_all_ipc_def | wpc)+
apply force
apply (wp mapM_x_wp)
apply (wp mapM_x_wp)+
apply force
apply (wp hoare_drop_imps hoare_vcg_conj_lift hoare_vcg_all_lift)
apply (wp hoare_drop_imps hoare_vcg_conj_lift hoare_vcg_all_lift)+
apply simp
done
@ -1596,9 +1592,7 @@ crunch idle_thread[wp]: cap_swap_for_delete,finalise_cap,cap_move,cap_swap,cap_d
ignore: without_preemption filterM rec_del check_cap_at cap_revoke )
lemma cap_revoke_idle_thread[wp]:"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> cap_revoke a \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
apply (rule cap_revoke_preservation2)
apply wp
done
by (rule cap_revoke_preservation2; wp)
lemma invoke_cnode_idle_thread[wp]: "\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> invoke_cnode a \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
apply (simp add: invoke_cnode_def)
@ -1643,6 +1637,7 @@ lemma call_kernel_integrity':
and K (pasMayActivate aag \<and> pasMayEditReadyQueues aag)\<rbrace>
call_kernel ev
\<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
including no_pre
apply (simp add: call_kernel_def getActiveIRQ_def )
apply (simp add: spec_valid_def)
apply (wp activate_thread_respects schedule_integrity_pasMayEditReadyQueues
@ -1653,10 +1648,9 @@ lemma call_kernel_integrity':
rule_tac Q = "integrity aag X st and pas_refined aag and einvs and guarded_pas_domain aag and domain_sep_inv (pasMaySendIrqs aag) st'
and is_subject aag \<circ> cur_thread
and (\<lambda>_. pasMayActivate aag \<and> pasMayEditReadyQueues aag)" in valid_validE)
apply (rule hoare_pre)
apply ((wp handle_event_integrity he_invs handle_event_pas_refined
handle_event_cur_thread handle_event_cur_domain
handle_event_domain_sep_inv handle_event_valid_sched | simp)+)[1]
apply (wp handle_event_integrity he_invs handle_event_pas_refined
handle_event_cur_thread handle_event_cur_domain
handle_event_domain_sep_inv handle_event_valid_sched | simp)+
apply (fastforce simp: domain_sep_inv_def)+
apply(fastforce simp: domain_sep_inv_def guarded_pas_domain_def)
done
@ -1687,10 +1681,10 @@ lemma call_kernel_pas_refined:
apply (simp add: call_kernel_def getActiveIRQ_def)
apply (wp activate_thread_pas_refined schedule_pas_refined handle_interrupt_pas_refined
do_machine_op_pas_refined dmo_wp alternative_wp select_wp)
apply simp
apply (rule hoare_post_impErr [OF valid_validE [where Q = "pas_refined aag and invs"]])
apply (wp he_invs handle_event_pas_refined)
apply auto
apply simp
apply (rule hoare_post_impErr [OF valid_validE [where Q = "pas_refined aag and invs"]])
apply (wp he_invs handle_event_pas_refined)
apply auto
done
end

13
proof/access-control/Tcb_AC.thy
View File

@ -228,6 +228,7 @@ lemma invoke_tcb_tc_respects_aag:
and K (authorised_tcb_inv aag (ThreadControl t sl ep mcp priority croot vroot buf))\<rbrace>
invoke_tcb (ThreadControl t sl ep mcp priority croot vroot buf)
\<lbrace>\<lambda>rv. integrity aag X st and pas_refined aag\<rbrace>"
including no_pre
apply (rule hoare_gen_asm)+
apply (subst invoke_tcb.simps)
apply (subst set_priority_extended.dxo_eq)
@ -272,7 +273,7 @@ lemma invoke_tcb_tc_respects_aag:
checked_insert_no_cap_to
out_no_cap_to_trivial[OF ball_tcb_cap_casesI]
thread_set_ipc_tcb_cap_valid
cap_delete_pas_refined[THEN valid_validE_E])
cap_delete_pas_refined[THEN valid_validE_E])+
| simp add: ran_tcb_cap_cases dom_tcb_cap_cases[simplified]
emptyable_def
del: hoare_post_taut hoare_True_E_R
@ -349,7 +350,7 @@ lemma invoke_tcb_ntfn_control_respects[wp]:
invoke_tcb (tcb_invocation.NotificationControl t ntfn)
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (case_tac ntfn, simp_all del: invoke_tcb.simps Tcb_AI.tcb_inv_wf.simps K_def)
apply (wp invoke_tcb_bind_notification_respects invoke_tcb_unbind_notification_respects)
apply (wp invoke_tcb_bind_notification_respects invoke_tcb_unbind_notification_respects)+
done
lemma invoke_tcb_respects:
@ -504,7 +505,7 @@ lemma decode_set_priority_authorised:
\<lbrace>\<lambda>rv s. authorised_tcb_inv aag rv\<rbrace>, -"
unfolding decode_set_priority_def check_prio_def authorised_tcb_inv_def
apply (cases msg; simp add: Let_def)
apply (wp validE_validE_R[OF throwError_wp])
apply (wp validE_validE_R[OF throwError_wp])+
by simp
lemma decode_set_mcpriority_authorised:
@ -513,7 +514,7 @@ lemma decode_set_mcpriority_authorised:
\<lbrace>\<lambda>rv s. authorised_tcb_inv aag rv\<rbrace>, -"
unfolding decode_set_mcpriority_def check_prio_def authorised_tcb_inv_def
apply (cases msg; simp)
apply (wp validE_validE_R[OF throwError_wp])
apply (wp validE_validE_R[OF throwError_wp])+
by simp
lemma decode_unbind_notification_authorised:
@ -545,12 +546,12 @@ lemma decode_tcb_invocation_authorised:
\<lbrace>\<lambda>rv s. authorised_tcb_inv aag rv\<rbrace>,-"
unfolding decode_tcb_invocation_def
apply (rule hoare_pre)
apply wpc
apply wpc
apply (wp decode_registers_authorised decode_tcb_configure_authorised
decode_set_priority_authorised decode_set_mcpriority_authorised
decode_set_ipc_buffer_authorised decode_set_space_authorised
decode_bind_notification_authorised
decode_unbind_notification_authorised)
decode_unbind_notification_authorised)+
by (auto iff: authorised_tcb_inv_def)
text{*

131
proof/bisim/Syscall_S.thy
View File

@ -278,7 +278,7 @@ lemma send_fault_ipc_bisim:
apply (rule hoare_vcg_seqE)
apply (rule hoare_vcg_seqE)
apply wpc
apply wp
apply wp+
apply simp
apply (rule hoare_post_imp_R [OF lc_sep])
apply (clarsimp simp: separate_cap_def)
@ -293,7 +293,7 @@ lemma send_fault_ipc_bisim:
apply (wp not_empty_lc)
apply (rule_tac P = "separate_cap xa" in not_empty_gen_asm)
apply (erule separate_capE, simp_all)[1]
apply wp
apply wp+
apply simp
done
@ -304,11 +304,7 @@ lemma handle_fault_bisim:
apply (rule bisim_symb_exec_r [where Pe = \<top>])
apply simp
apply (rule send_fault_ipc_bisim)
apply wp
apply simp
apply (simp add: gets_the_def)
apply wp
apply (simp add: tcb_at_def)
apply (wpsimp simp: gets_the_def tcb_at_def)+
done
lemmas bisim_throwError_dc = bisim_throwError [where f = dc, OF dc_refl]
@ -414,14 +410,14 @@ lemma handle_invocation_bisim:
apply (rule syscall_bisim)
apply (rule bisim_split_reflE_dc [where Q = "\<lambda>_. \<top>" and Q' = "\<lambda>_. \<top>"])+
apply (rule bisim_reflE_dc)
apply wp
apply wp+
apply (rule bisim_when [OF _ refl])
apply (rule handle_fault_bisim)
apply simp
apply (rule bisim_split_reflE_eq)
apply simp
apply (rule decode_invocation_bisim)
apply wp
apply wp+
apply (simp, rule bisim_refl')
apply simp
apply (rule bisim_split_reflE_dc)
@ -491,15 +487,7 @@ lemma bisim_injection:
apply (simp add: z)
apply clarsimp
apply (rule bisim_return)
apply simp
apply wp
apply simp+
done
lemma cap_fault_injection:
"cap_fault_on_failure addr b = injection_handler (ExceptionTypes_A.CapFault addr b)"
apply (rule ext)
apply (simp add: cap_fault_on_failure_def injection_handler_def o_def)
apply wpsimp+
done
lemma separate_state_cdt [simp]:
@ -563,14 +551,14 @@ lemma cap_delete_one_sep [wp]:
apply (wps set_cdt_typ_at)
apply (wp)
apply assumption
apply (wp get_cap_inv hoare_drop_imps)
apply (wp get_cap_inv hoare_drop_imps)+
apply (simp add: conj_comms)
apply (rule separate_state_pres)
apply (rule hoare_pre)
apply (wps )
apply (wps)
apply wp
apply simp
apply (wp get_cap_wp')
apply (wp get_cap_wp')+
apply simp
done
@ -582,7 +570,7 @@ lemma bisim_caller_cap:
apply (rule_tac F = "rv = NullCap" in bisim_gen_asm_r)
apply simp
apply (rule bs)
apply (wp get_cap_wp')
apply (wp get_cap_wp')+
apply fastforce
apply wp
apply simp
@ -653,62 +641,57 @@ lemma handle_event_bisim:
handle_reply_def
cong: syscall.case_cong)
apply (rename_tac syscall)
apply (case_tac syscall, simp_all)[1]
apply (rename_tac syscall)
apply (case_tac syscall, simp_all)[1]
apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp)
apply (rule bisim_guard_imp_both)
apply (rule bisim_symb_exec_r_bs)
apply (rule handle_reply_bisim)
apply (rule handle_recv_bisim)
apply simp
apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp)
apply (rule bisim_guard_imp_both)
apply (rule bisim_symb_exec_r_bs)
apply (rule handle_reply_bisim)
apply (rule handle_recv_bisim)
apply simp
apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_reply_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_invocation_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_reply_bisim, simp)
apply (simp add: handle_yield_def Syscall_A.handle_yield_def)
apply (rule bisim_guard_imp_both, rule bisim_refl', simp)
apply (simp add: handle_yield_def Syscall_A.handle_yield_def)
apply (rule bisim_guard_imp_both, rule bisim_refl', simp)
apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp)
apply (rule bisim_guard_imp_both, rule handle_recv_bisim, simp)
apply (rule bisim_split_refl)
apply (rule handle_fault_bisim)
apply wp
apply (simp add: cur_tcb_def)
apply (rule bisim_split_refl)
apply (rule handle_fault_bisim)
apply wp+
apply (simp add: cur_tcb_def)
apply (rule bisim_split_refl)
apply (rule handle_fault_bisim)
apply wp
apply (simp add: cur_tcb_def)
apply (rule bisim_refl)
apply simp
apply (rule bisim_split_refl)
apply (rule handle_fault_bisim)
apply wp+
apply (simp add: cur_tcb_def)
apply (rule bisim_refl)
apply simp
apply (rename_tac vmfault_type)
apply (rule bisim_guard_imp_both)
apply (rule bisim_split_refl)
apply (rule bisim_split_catch_req)
apply (rule bisim_reflE)
apply (rule handle_fault_bisim)
apply wp
apply (case_tac vmfault_type, simp_all)[1]
apply (wp separate_state_pres)
apply (rule hoare_pre, wps, wp, simp)
apply wp
apply (rule hoare_pre, wps, wp, simp)
apply simp
apply (rule bisim_split_refl)
apply (rule bisim_split_catch_req)
apply (rule bisim_reflE)
apply (rule handle_fault_bisim)
apply wp
apply (case_tac vmfault_type, simp_all)[1]
apply (wp separate_state_pres)
apply (rule hoare_pre, wps, wp, simp)
apply wp
apply (rule hoare_pre, wps, wp, simp)
apply simp
apply (wp separate_state_pres)
apply (rule hoare_pre, wps, wp, simp)
apply wp
apply simp
apply wp
apply (simp_all add: cur_tcb_def)
apply (wp separate_state_pres)+
apply (rule hoare_pre, wps, wp+, simp)
apply wp+
apply (simp add: cur_tcb_def)
done
lemma call_kernel_bisim:
@ -721,10 +704,9 @@ lemma call_kernel_bisim:
apply (rule handle_event_bisim)
apply simp
apply (rule bisim_refl')
apply wp
apply (rule bisim_refl')
apply wp
apply simp
apply wp+
apply (rule bisim_refl')
apply wpsimp+
done
@ -787,10 +769,7 @@ lemma decode_invocation_separate_state [wp]:
"\<lbrace> separate_state \<rbrace>
Decode_SA.decode_invocation param_a param_b param_c param_d param_e param_f
\<lbrace> \<lambda>_. separate_state \<rbrace>"
unfolding decode_invocation_def
apply (rule hoare_pre, wpc, wp)
apply simp
done
unfolding decode_invocation_def by wpsimp
lemma separate_state_machine_state:
"separate_state (s\<lparr>machine_state := ms\<rparr>) = separate_state s"

76
proof/capDL-api/Arch_DP.thy
View File

@ -202,7 +202,7 @@ lemma seL4_Page_Table_Map:
[where check = True and Perror = \<top>,simplified])
apply fastforce
apply (rule set_cap_wp)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P = "\<exists>asid'. iv = InvokePageTable (PageTableMap
(PageTableCap ptr Real asid') (PageTableCap ptr Fake None)
(cnode_id,pt_offset) (cdl_lookup_pd_slot pd_ptr vaddr))"
@ -243,7 +243,7 @@ lemma seL4_Page_Table_Map:
apply assumption
apply clarsimp
apply (rule hoare_vcg_E_elim)
apply wp[1]
apply wp
apply wp
apply (rule validE_validE_R)
apply (rule hoare_weaken_preE[where P = \<top>])
@ -254,7 +254,7 @@ lemma seL4_Page_Table_Map:
apply (sep_solve)
apply (simp add:lookup_extra_caps_def conj_comms mapME_singleton)
apply (rule wp_no_exception_seq)
apply wp[1]
apply wp
apply (rule lookup_cap_and_slot_rvu[where r = root_size
and cap' = "PageDirectoryCap pd_ptr real_type None"])
apply (rule hoare_pre)
@ -268,35 +268,28 @@ lemma seL4_Page_Table_Map:
hoare_vcg_imp_lift)
apply clarsimp
defer
apply clarsimp
using misc sz
apply (intro conjI impI allI,
simp_all add:
reset_cap_asid_simps2)
apply clarsimp
using misc sz
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
apply (sep_solve)
apply simp
apply sep_solve
apply (clarsimp simp:user_pointer_at_def Let_def
word_bits_def sep_conj_assoc)
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
apply sep_solve
apply (clarsimp dest!:reset_cap_asid_simps2
simp:ep_related_cap_def)
apply (clarsimp simp:user_pointer_at_def Let_def
word_bits_def sep_conj_assoc)
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
apply (sep_solve)
apply (clarsimp dest!:reset_cap_asid_simps2
simp:ep_related_cap_def)
apply (clarsimp simp:user_pointer_at_def Let_def
word_bits_def sep_conj_assoc)
apply (sep_solve)
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
apply (sep_solve)
apply (drule_tac x = "PageTableCap ptr Real None" in spec)
apply clarsimp
apply clarsimp
apply (erule impE)
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
apply simp
apply clarsimp
apply (sep_solve)
done
apply (sep_solve)
done
lemma seL4_Section_Map_wp:
notes split_paired_Ex[simp del]
@ -326,8 +319,7 @@ lemma seL4_Section_Map_wp:
\<and>* (cnode_id, pd_offset) \<mapsto>c (PageDirectoryCap pd_ptr real_type None)
\<and>* cnode_id \<mapsto>f CNode (empty_cnode root_size)
\<and>* R \<guillemotright> s \<rbrace>"
apply (simp add:seL4_Page_Map_def sep_state_projection2_def
del:split_paired_Ex)
apply (simp add:seL4_Page_Map_def sep_state_projection2_def)
apply (rule hoare_name_pre_state)
apply (rule hoare_pre)
apply (rule do_kernel_op_pull_back)
@ -335,7 +327,7 @@ lemma seL4_Section_Map_wp:
[where check = True and Perror = \<top>,simplified])
apply fastforce
apply (rule set_cap_wp)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P = "\<exists>asid'. iv = InvokePage
(PageMap (FrameCap dev frame_ptr rights n Real asid')
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) (cnode_id,frame_offset)
@ -380,7 +372,7 @@ lemma seL4_Section_Map_wp:
in hoare_post_impErr[rotated -1])
apply assumption
apply (rule hoare_vcg_E_elim)
apply wp[1]
apply wp
apply wp
apply (rule validE_validE_R)
apply (rule hoare_weaken_preE[where P = \<top>])
@ -474,7 +466,7 @@ lemma seL4_Page_Map_wp:
[where check = True and Perror = \<top>,simplified])
apply fastforce
apply (rule set_cap_wp)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P = "\<exists>asid'. iv = InvokePage
(PageMap (FrameCap dev frame_ptr rights n Real asid')
(FrameCap False frame_ptr (validate_vm_rights (rights \<inter> perms)) n Fake None) (cnode_id,frame_offset)
@ -521,7 +513,7 @@ lemma seL4_Page_Map_wp:
in hoare_post_impErr[rotated -1])
apply assumption
apply (rule hoare_vcg_E_elim)
apply wp[1]
apply wp
apply wp
apply (rule validE_validE_R)
apply (rule_tac P = "<P>" for P in hoare_weaken_preE)
@ -543,32 +535,30 @@ lemma seL4_Page_Map_wp:
hoare_vcg_imp_lift)
apply clarsimp
defer
apply clarsimp
using misc sz
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
apply clarsimp
using misc sz
apply (intro conjI impI allI, simp_all add: reset_cap_asid_simps2)
apply (sep_solve)
apply (simp add:cdl_lookup_pd_slot_def)
apply sep_solve
apply simp
apply sep_solve
apply (clarsimp simp:user_pointer_at_def Let_def
word_bits_def sep_conj_assoc)
apply (clarsimp simp:user_pointer_at_def Let_def word_bits_def sep_conj_assoc)
apply sep_solve
apply (clarsimp dest!:reset_cap_asid_simps2
simp:ep_related_cap_def)
apply (clarsimp dest!:reset_cap_asid_simps2 simp: ep_related_cap_def)
apply (clarsimp simp:user_pointer_at_def Let_def
word_bits_def sep_conj_assoc)
apply (sep_solve)
apply sep_solve
apply clarsimp
apply (drule_tac x = "FrameCap dev frame_ptr rights n Real None" in spec)
apply clarsimp
apply clarsimp
apply (erule impE)
apply (rule_tac x = "PageDirectoryCap pd_ptr real_type None" in exI)
apply simp
apply clarsimp
apply (sep_solve)
done
apply (sep_solve)
done
lemma decode_invocation_asid_pool_assign:
"\<lbrace> \<lambda>s. (c = AsidPoolCap p base) \<rbrace>
@ -622,9 +612,9 @@ lemma invoke_asid_pool_wp:
apply simp
apply (rule hoare_strengthen_post[OF set_cap_wp])
apply (sep_solve)
apply wp
apply wp+
apply clarsimp
apply (safe,fastforce+)
apply (safe; fastforce?)
apply (subst (asm) set_split_single[where A = "(Collect (\<lambda>off. off < 2 ^ asid_low_bits))"])
apply simp
apply (subst (asm) sep.prod.union_disjoint)
@ -675,7 +665,7 @@ lemma seL4_ASIDPool_Assign_wp:
apply (rule call_kernel_with_intent_allow_error_helper[where check = True and Perror = \<top>,simplified])
apply fastforce
apply (rule set_cap_wp)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P = "\<exists>x. x < 2 ^ asid_low_bits
\<and> iv = (InvokeAsidPool (Assign (base, x) (cnode_id,pd_offset) (p, x)))"
in hoare_gen_asmEx)
@ -703,7 +693,7 @@ lemma seL4_ASIDPool_Assign_wp:
apply (rule decode_invocation_asid_pool_assign)
apply (clarsimp simp:conj_comms lookup_extra_caps_def mapME_singleton)
apply (rule wp_no_exception_seq)
apply wp[1]
apply wp
apply (rule lookup_cap_and_slot_rvu[where r = root_size
and cap' = "PageDirectoryCap pd Real None"])
apply (rule hoare_pre)
@ -727,7 +717,7 @@ lemma seL4_ASIDPool_Assign_wp:
apply (sep_solve)
apply clarsimp
apply (drule_tac x = "AsidPoolCap p base" in spec)
apply clarsimp
apply clarsimp
apply (erule impE)
apply (rule_tac x = "PageDirectoryCap pd Real None" in exI)
apply simp

30
proof/capDL-api/CNode_DP.thy
View File

@ -36,15 +36,15 @@ lemma decode_cnode_copy_same_parent_rvu:
apply (clarsimp simp:user_pointer_at_def Let_def)
apply (clarsimp simp: decode_cnode_invocation_def split_def split: sum.splits)
apply (wp hoare_whenE_wp | simp)+
apply (rule validE_validE_R)
apply (wp derive_cap_invE)
apply (rule validE_validE_R)
apply (rule lookup_slot_for_cnode_op_rvu' [where r=sz and cap=src_cap])
apply simp
apply wp
apply (rule validE_validE_R)
apply (wp derive_cap_invE)+
apply (rule validE_validE_R)
apply (rule lookup_slot_for_cnode_op_rvu' [where r=sz and cap=src_cap])
apply simp
apply wp+
apply (rule validE_validE_R)
apply (rule lookup_slot_for_cnode_op_rvu'[where r=sz and cap=NullCap])
apply (simp, wp throw_on_none_rv validE_R_validE)
apply (rule lookup_slot_for_cnode_op_rvu'[where r=sz and cap=NullCap])
apply (simp, wp throw_on_none_rv validE_R_validE)
apply (clarsimp split: option.splits)
apply (intro conjI)
apply (clarsimp dest!: mapu_dest_opt_cap simp:conj_comms)
@ -332,7 +332,8 @@ lemma seL4_CNode_Mutate_sep:
apply (rule hoare_post_imp[OF _
set_cap_wp])
apply (sep_select 5,assumption)
apply wp[2]
apply wp
apply wp
apply (rule_tac P = "\<exists>dcap.
reset_cap_asid dcap = reset_cap_asid src_cap \<and>
iv = InvokeCNode
@ -372,7 +373,7 @@ lemma seL4_CNode_Mutate_sep:
apply (clarsimp simp:sep_any_exist sep_conj_assoc
sep_map_c_conj sep_map_f_conj Let_def
split:if_splits option.splits,fastforce)
apply (wp set_cap_wp set_cap_all_scheduable_tcbs)[1]
apply (wp set_cap_wp set_cap_all_scheduable_tcbs)
apply (rule_tac P = "is_cnode_cap c" in hoare_gen_asmEx)
apply (simp add:decode_invocation_simps)
apply (rule liftME_wp)
@ -380,7 +381,7 @@ lemma seL4_CNode_Mutate_sep:
apply (simp add:lookup_extra_caps_def Let_def
mapME_def sequenceE_def get_index_def)
apply (rule wp_no_exception_seq)
apply wp[1]
apply wp
apply (rule lookup_cap_and_slot_rvu[where r = root_size])
apply (rule lookup_cap_and_slot_rvu[where r = root_size])
apply (rule validE_validE_R)
@ -495,7 +496,8 @@ lemma seL4_CNode_Move_sep:
apply (clarsimp simp:sep_conj_assoc)
apply (rule hoare_post_imp[OF _ set_cap_wp])
apply (sep_select 5,assumption)
apply wp[2]
apply wp
apply wp
apply (rule_tac P = "\<exists>dcap. reset_cap_asid dcap = reset_cap_asid src_cap \<and>
iv = InvokeCNode (MoveCall dcap
(cap_object cnode_cap', offset src_index root_size)
@ -529,7 +531,7 @@ lemma seL4_CNode_Move_sep:
in hoare_strengthen_post[rotated])
apply (clarsimp)
apply (sep_select 3,assumption)
apply (wp set_cap_wp set_cap_all_scheduable_tcbs)[1]
apply (wp set_cap_wp set_cap_all_scheduable_tcbs)
apply (rule_tac P = "is_cnode_cap c" in hoare_gen_asmEx)
apply (simp add:decode_invocation_simps)
apply (rule liftME_wp)
@ -537,7 +539,7 @@ lemma seL4_CNode_Move_sep:
apply (simp add:lookup_extra_caps_def Let_def
mapME_def sequenceE_def get_index_def)
apply (rule wp_no_exception_seq)
apply wp[1]
apply wp
apply (rule lookup_cap_and_slot_rvu[where r = root_size])
apply (rule lookup_cap_and_slot_rvu[where r = root_size])
apply (rule validE_validE_R)

12
proof/capDL-api/IRQ_DP.thy
View File

@ -36,29 +36,31 @@ lemma invoke_irq_handler_clear_handler_wp:
"\<lbrace>< irq \<mapsto>irq obj \<and>* (obj, 0) \<mapsto>c cap \<and>* R> and K (\<not> ep_related_cap cap)\<rbrace>
invoke_irq_handler (ClearIrqHandler irq)
\<lbrace>\<lambda>_. < irq \<mapsto>irq obj \<and>* (obj, 0) \<mapsto>c NullCap \<and>* R> \<rbrace>"
apply (clarsimp simp: invoke_irq_handler_def, wp )
including no_pre
apply (clarsimp simp: invoke_irq_handler_def, wp)
apply (sep_wp delete_cap_simple_format[where cap=cap])
apply (safe)
apply (frule sep_map_i_cdl_irq, clarsimp simp: get_irq_slot_def)
apply (sep_solve)
apply (clarsimp)
done
done
lemma invoke_irq_handler_set_handler_wp:
"\<lbrace>< irq \<mapsto>irq obj \<and>* (obj, 0) \<mapsto>c cap' \<and>* R> and
K (\<not> ep_related_cap cap' \<and> \<not> is_untyped_cap cap)\<rbrace>
invoke_irq_handler (SetIrqHandler irq cap slot)
\<lbrace>\<lambda>_. < irq \<mapsto>irq obj \<and>* (obj, 0) \<mapsto>c cap \<and>* R> \<rbrace>"
including no_pre
apply (clarsimp simp: invoke_irq_handler_def, wp)
apply (wp alternative_wp)
apply (wp sep_wp: insert_cap_child_wp insert_cap_sibling_wp)
apply (wp sep_wp: insert_cap_child_wp insert_cap_sibling_wp)+
apply (sep_wp delete_cap_simple_format[where cap=cap'])
apply (safe)
apply (clarsimp)
apply (frule sep_map_i_cdl_irq, clarsimp simp: get_irq_slot_def)
apply (sep_solve)
apply (clarsimp)
done
done
lemma invoke_irq_control_issue_handler_wp:
"\<lbrace> <(dest_slot) \<mapsto>c cap \<and>* R> \<rbrace>
@ -111,7 +113,7 @@ decode_irq_handler_invocation cap cap_ref caps (IrqHandlerSetEndpointIntent)
apply (clarsimp simp: decode_irq_handler_invocation_def)
apply (wp alternativeE_R_wp | wpc)+
apply (clarsimp split: cdl_cap.splits, safe)
apply (wp throw_on_none_rv, clarsimp simp: get_index_def)
apply ((wp throw_on_none_rv)+, clarsimp simp: get_index_def)
apply simp
done

47
proof/capDL-api/Invocation_DP.thy
View File

@ -139,9 +139,7 @@ lemma corrupt_tcb_intent_sep_inv[wp]:
"\<lbrace>\<lambda>s. < P > s\<rbrace>
corrupt_tcb_intent thread
\<lbrace>\<lambda>rv s. < P > s\<rbrace>"
apply (rule sep_nonimpact_valid_lift)
apply wp
done
by (rule sep_nonimpact_valid_lift; wp)
lemma corrupt_frame_sep_helper[wp]:
"\<lbrace>\<lambda>s. A (object_at (\<lambda>obj. P (object_clean obj)) ptr s)\<rbrace>
@ -185,7 +183,7 @@ lemma update_thread_intent_update:
lemma liftE_wp_no_exception:
"\<lbrakk>\<And>r. \<lbrace>P' r\<rbrace> g r \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>r s. False\<rbrace>;\<lbrace>P\<rbrace>f\<lbrace>\<lambda>r. P' r\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> liftE f >>=E g \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>r s. False\<rbrace>"
apply (simp add:liftE_bindE validE_def)
apply wp
including no_pre apply wp
apply assumption
apply simp
done
@ -194,7 +192,7 @@ lemma handle_event_no_exception:
"\<lbrace>P\<rbrace> handle_event (SyscallEvent SysCall) \<lbrace>\<lambda>r. Q\<rbrace>,\<lbrace>\<lambda>r s. False\<rbrace>
\<Longrightarrow> \<lbrace>P\<rbrace> handle_event (SyscallEvent SysCall) <handle> handler \<lbrace>\<lambda>r. Q\<rbrace>"
apply (rule validE_cases_valid)
apply (wp)
including no_pre apply (wp)
apply (rule hoare_FalseE)
apply simp
done
@ -306,6 +304,7 @@ lemma decode_invocation_nonep:
"\<lbrace>\<lambda>s. \<not> ep_related_cap cap \<rbrace>
decode_invocation cap cap_ref extra_caps intent
\<lbrace>\<lambda>rv s. nonep_invocation rv\<rbrace>, -"
including no_pre
apply (case_tac cap,simp_all add:ep_related_cap_def decode_invocation_def)
apply wp[1]
apply wp
@ -313,21 +312,21 @@ lemma decode_invocation_nonep:
apply (simp add:nonep_invocation_def)
apply wp
apply (intro conjI impI)
apply (wp hoare_FalseE)
apply (intro conjI impI,wp hoare_FalseE)[2]
apply wp[1]
apply (wp hoare_FalseE)+
apply (intro conjI impI,(wp hoare_FalseE)+)[2]
apply wp
apply wp
apply (rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI])
apply (simp add:nonep_invocation_def)
apply wp[1]
apply wp
apply (wp,rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI],
simp add:nonep_invocation_def,wp)+
simp add:nonep_invocation_def,wp+)+
apply (rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI])
apply (simp add:nonep_invocation_def)
apply wp[1]
apply (wp,rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI],
apply wp
apply (wp+, rule hoare_post_imp_R[OF validE_validE_R,OF hoareE_TrueI],
simp add:nonep_invocation_def)+
apply wp
apply wp+
done
lemma ep_related_cap_reset_simp[simp]:
@ -339,6 +338,7 @@ lemma ep_related_cap_reset_simp[simp]:
lemma liftE_wp_split_r:
"\<lbrakk>\<And>r. \<lbrace>P' r\<rbrace> g r \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>r. R\<rbrace>;\<lbrace>P\<rbrace>f\<lbrace>\<lambda>r. P' r\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> liftE f >>=E g \<lbrace>Q\<rbrace>,\<lbrace>\<lambda>r. R\<rbrace>"
apply (simp add:liftE_bindE validE_def)
including no_pre
apply wp
apply assumption
apply simp
@ -396,7 +396,7 @@ lemma handle_event_syscall_no_decode_exception:
apply (rule wp_no_exception_seq_r)
apply (rule liftE_wp_no_exception)
apply (rule hoare_whenE_wp)
apply (simp add:liftE_validE)
apply simp
apply wp
apply (rule_tac P = "y = cur_thread" in hoare_gen_asm)
apply simp
@ -509,9 +509,9 @@ lemma send_signal_no_pending:
apply (rule hoare_pre_cont)
apply (rule_tac P = "waiters = {}" in hoare_gen_asm)
apply (clarsimp simp: option_select_def)
apply wp
apply wp+
apply (rule hoare_pre_cont)
apply wp
apply wp+
apply (clarsimp simp: get_waiting_ntfn_recv_threads_def get_waiting_sync_bound_ntfn_threads_def
no_pending_def opt_cap_def)
apply (intro allI impI conjI)
@ -638,7 +638,7 @@ lemma call_kernel_with_intent_no_fault_helper:
apply (clarsimp simp: isLeft_def)
apply (rule_tac P = "thread_ptr = root_tcb_id" in hoare_gen_asm)
apply simp
apply (wp upd_thread update_thread_wp)
apply (wp upd_thread update_thread_wp)+
apply auto
done
@ -677,7 +677,8 @@ lemma decode_invocation_simps:
lemma liftME_wp:
"\<lbrace>P\<rbrace> m \<lbrace>\<lambda>r. Q (f r)\<rbrace>,\<lbrace>Q'\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftME f m \<lbrace>Q\<rbrace>,\<lbrace>Q'\<rbrace>"
apply wp
apply (simp add:Fun.comp_def)
apply (simp add:Fun.comp_def)
apply assumption
done
lemma sep_normal_conj_absorb:
@ -886,10 +887,10 @@ lemma syscall_valid_helper_allow_error:
apply simp
apply (rule hoare_vcg_handle_elseE)
apply assumption
apply wp
including no_pre apply wp
apply (wp mark_tcb_intent_error_no_error)
apply (rule hoare_drop_imp,simp)
apply simp
apply simp
apply (rule hoare_post_impErr)
apply fastforce
apply simp
@ -967,7 +968,7 @@ lemma handle_event_syscall_allow_error:
apply (rule wp_no_exception_seq_r)
apply (rule liftE_wp_no_exception)
apply (rule hoare_whenE_wp)
apply (simp add:liftE_validE)
apply (simp)
apply wp
apply (rule_tac P = "y = cur_thread" in hoare_gen_asm)
apply simp
@ -1094,7 +1095,7 @@ lemma call_kernel_with_intent_allow_error_helper:
apply (rule hoare_pre,(wp hoare_vcg_imp_lift|wpc|simp cong: if_cong)+)[1]
apply (wp | wpc | simp)+
apply (rule hoare_pre_cont)
apply (wp has_restart_cap_sep_wp[where cap = RunningCap])
apply (wp has_restart_cap_sep_wp[where cap = RunningCap])+
apply simp
apply (rule_tac current_thread1=root_tcb_id and current_domain1=minBound in
hoare_strengthen_post[OF schedule_no_choice_wp])
@ -1153,7 +1154,7 @@ lemma call_kernel_with_intent_allow_error_helper:
apply (clarsimp simp: isLeft_def)
apply (rule_tac P = "thread_ptr = root_tcb_id" in hoare_gen_asm)
apply simp
apply (wp upd_thread update_thread_wp)
apply (wp upd_thread update_thread_wp)+
apply (clarsimp)
apply (clarsimp simp:sep_map_c_conj sep_map_f_conj object_at_def
object_project_def sep_state_projection_def

27
proof/capDL-api/KHeap_DP.thy
View File

@ -445,7 +445,7 @@ lemma lookup_slot_for_cnode_op_wp [wp]:
apply (clarsimp simp: fault_to_except_def)
apply (wp)
apply (clarsimp simp: gets_the_resolve_cap[symmetric])
apply (wp gets_the_wpE hoare_whenE_wp)
apply (wp gets_the_wpE hoare_whenE_wp)+
apply (clarsimp split: option.splits sum.splits)
done
@ -457,7 +457,7 @@ lemma lookup_slot_for_cnode_op_wpE:
apply (wp)
apply (clarsimp simp: gets_the_resolve_cap[symmetric])
apply (clarsimp simp: fault_to_except_def)
apply (wp gets_the_wpE hoare_whenE_wp)
apply (wp gets_the_wpE hoare_whenE_wp)+
apply (clarsimp split: option.splits split: sum.splits)
done
@ -734,7 +734,7 @@ lemma decode_cnode_move_rvu:
apply wp
apply (rule_tac P = "src_capa \<noteq> NullCap" in hoare_gen_asmEx)
apply (simp add:whenE_def)
apply (wp derive_cap_non_exclusive)
apply (wp derive_cap_non_exclusive)+
apply (rule lookup_slot_for_cnode_op_rvu' [where r=sz and cap=src_cap and
R="\<box> (sz', (unat dest_depth)): target dest_index \<mapsto>u NullCap \<and>* R"])
apply simp
@ -760,6 +760,7 @@ crunch preserve [wp]: decode_cnode_invocation "P"
lemma decode_invocation_wp:
"\<lbrace>P\<rbrace> decode_invocation (CNodeCap x y z sz) ref caps (CNodeIntent intent) \<lbrace>\<lambda>_. P\<rbrace>, -"
apply (clarsimp simp: decode_invocation_def)
including no_pre
apply (wp)
apply (clarsimp simp: comp_def)
apply (wp)
@ -853,6 +854,7 @@ lemma lookup_cap_rvu :
lookup_cap thread cap_ptr
\<lbrace>Q\<rbrace>, \<lbrace>\<lambda>_ _. False\<rbrace>"
apply (clarsimp simp: lookup_cap_def)
including no_pre
apply (wp lookup_slot_rvu [where cnode_cap=cnode_cap] get_cap_rv)
apply (clarsimp)
apply safe
@ -866,11 +868,12 @@ lemma lookup_cap_wp:
"\<lbrace>P\<rbrace>
lookup_cap thread cap_ptr
\<lbrace>\<lambda>_. P\<rbrace>, \<lbrace>\<lambda>_ .P \<rbrace> "
apply (clarsimp simp: lookup_cap_def)
apply (wp lookup_slot_wp get_cap_wp)
apply (clarsimp)
apply (wp lookup_slot_wp)
done
apply (clarsimp simp: lookup_cap_def)
apply (wp lookup_slot_wp get_cap_wp)
apply (clarsimp)
apply (wp lookup_slot_wp)
apply assumption
done
lemma lookup_cap_and_slot_rvu:
@ -1004,8 +1007,8 @@ lemma decode_cnode_mint_rvu:
split: sum.splits)
apply wp
apply (simp add:whenE_def split del:if_splits)
apply (wp derive_cap_invE)
apply (wp update_cap_data)
apply (wp derive_cap_invE)+
apply (wp update_cap_data)+
apply (rule validE_validE_R)
apply (rule lookup_slot_for_cnode_op_rvu' [where r=src_sz and cap=src_cap and
R="\<box> (dest_sz, (unat dest_depth)): target dest_index \<mapsto>u NullCap \<and>* R"])
@ -1069,7 +1072,7 @@ lemma decode_cnode_mutate_rvu:
apply wp
apply (rule_tac P = "cap \<noteq> NullCap" in hoare_gen_asmEx)
apply (simp add:whenE_def)
apply (wp update_cap_data)
apply (wp update_cap_data)+
apply (rule lookup_slot_for_cnode_op_rvu' [where r=src_sz and cap=src_cap and
R="\<box> (dest_sz, (unat dest_depth)): target dest_index \<mapsto>u NullCap \<and>* R"])
apply simp
@ -1138,7 +1141,7 @@ lemma has_restart_cap_sep_wp:
apply (rule hoare_name_pre_state)
apply (clarsimp simp: object_at_def)
apply (simp add: object_at_def get_thread_def has_restart_cap_def
| wp | wpc | intro conjI)+
| wp+ | wpc | intro conjI)+
apply (clarsimp dest!: opt_cap_sep_imp
simp: opt_object_def opt_cap_def slots_of_def)
apply (clarsimp simp: object_slots_def)

26
proof/capDL-api/Retype_DP.thy
View File

@ -237,6 +237,7 @@ lemma mapME_x_wp:
using Cons.prems
apply (simp add: mapME_x_def sequenceE_x_def)
apply (fold mapME_x_def sequenceE_x_def)
including no_pre
apply wp
apply (rule Cons.hyps)
apply fastforce
@ -346,7 +347,7 @@ lemma invoke_untyped_wp:
apply (elim conjE)
apply (sep_select 3,sep_select 3)
apply assumption
apply wp
apply wp+
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_vcg_ex_lift)
apply (wp hoare_vcg_conj_lift)
@ -466,9 +467,9 @@ lemma invoke_untyped_one_has_children:
apply wp
apply simp
apply (clarsimp simp:neq_Nil_conv)
apply auto[1]
apply wp
apply (rule hoare_strengthen_post[OF generate_object_ids_rv])
apply auto[1]
apply wp+
apply (rule hoare_strengthen_post[OF generate_object_ids_rv])
apply (clarsimp simp:zip_is_empty)
apply (wp unlessE_wp hoare_drop_imps | simp)+
done
@ -492,7 +493,7 @@ lemma invoke_untyped_exception:
| wpc | simp add: reset_untyped_cap_def)+
apply (rule_tac P = "available_range cap = cap_objects cap" in hoare_gen_asmEx)
apply (simp add: whenE_def)
apply wp
apply wp+
apply clarsimp
apply (cut_tac p = "(a,b)" in opt_cap_sep_imp)
apply sep_solve
@ -626,7 +627,7 @@ lemma seL4_Untyped_Retype_sep:
[where check= False and tcb = tcb,simplified,rotated -1])
apply assumption
apply fastforce
apply (wp hoare_vcg_ex_lift set_cap_wp)[5]
apply ((wp hoare_vcg_ex_lift set_cap_wp)+)[5]
apply (rule_tac P = "\<exists>has_kids. iv = InvokeUntyped (Retype (root_cnode,ucptr_slot) nt (unat ts)
[(root_cnode, ncptr_slot)]
has_kids 1)"
@ -735,6 +736,7 @@ lemma unify_failure_cdt_lift:
\<Longrightarrow> \<lbrace>\<lambda>s. P (cdl_cdt s)\<rbrace> unify_failure f \<lbrace>\<lambda>r s. Q r s \<longrightarrow> P (cdl_cdt s)\<rbrace>,
\<lbrace>\<lambda>r s. Q' r s \<longrightarrow> P (cdl_cdt s)\<rbrace>"
apply (simp add:unify_failure_def)
including no_pre
apply (wp hoare_drop_imps)
apply (clarsimp simp:validE_def valid_def)
apply (case_tac a,fastforce+)
@ -790,6 +792,7 @@ crunch cdt_inc[wp]: handle_pending_interrupts "\<lambda>s. P (cdl_cdt s)"
lemma unify_failure_valid:
"\<lbrace>\<lambda>s. P s\<rbrace> f \<lbrace>\<lambda>r s. P s\<rbrace>
\<Longrightarrow> \<lbrace>\<lambda>s. P s\<rbrace> unify_failure f \<lbrace>\<lambda>r s. P s\<rbrace>"
including no_pre
apply (simp add:unify_failure_def)
apply (wp hoare_drop_imps)
apply (clarsimp simp:validE_def valid_def)
@ -899,8 +902,7 @@ lemma update_thread_no_pending:
K(\<forall>x. (case cdl_tcb_caps x tcb_pending_op_slot of Some cap \<Rightarrow> \<not> is_pending_cap cap | _ \<Rightarrow> True)\<longrightarrow>
(case cdl_tcb_caps (t x) tcb_pending_op_slot of Some cap \<Rightarrow> \<not> is_pending_cap cap | _ \<Rightarrow> True))\<rbrace>
update_thread thread_ptr t \<lbrace>\<lambda>rv. no_pending\<rbrace>"
apply (rule hoare_pre)
apply (simp add: update_thread_def set_object_def | wp modify_wp | wpc)+
apply (simp add: update_thread_def set_object_def | (wp modify_wp)+ | wpc)+
apply (clarsimp simp: no_pending_def)
apply (intro conjI impI allI, simp_all)
apply (drule_tac x = oid in spec)
@ -1007,7 +1009,7 @@ lemma invoke_untyped_preempt:
apply simp
apply simp
apply sep_solve
apply (wp select_wp)
apply (wp select_wp)+
apply clarsimp
apply (frule opt_cap_sep_imp)
apply (clarsimp dest!: reset_cap_asid_untyped_cap_eqD)
@ -1147,7 +1149,7 @@ lemma reset_untyped_cap_no_pending[wp]:
apply (wp hoare_whenE_wp)
apply (rule_tac P = "snd cref = tcb_pending_op_slot \<longrightarrow> \<not> is_pending_cap cap" in hoare_gen_asmEx)
apply (wp mapME_x_inv_wp alternativeE_wp | simp)+
apply (wp select_wp)
apply (wp select_wp)+
apply (clarsimp simp: detype_no_pending)
apply (cases cref, clarsimp simp: no_pending_def)
done
@ -1197,7 +1199,7 @@ lemma reset_untyped_cap_not_pending_cap[wp]:
apply (rule_tac P = " \<not> is_pending_cap cap" in hoare_gen_asmEx)
apply (wp mapME_x_inv_wp alternativeE_wp set_cap_opt_cap)
apply simp
apply (wp select_wp)
apply (wp select_wp)+
apply (clarsimp simp: detype_no_pending)
apply (cases cref)
apply (clarsimp simp: detype_def opt_cap_def slots_of_def opt_object_def object_slots_def
@ -1270,7 +1272,7 @@ lemma seL4_Untyped_Retype_inc_no_preempt:
[where check= False and tcb = tcb and Q = Q and Perror = Q
for Q , simplified])
apply fastforce
apply (wp hoare_vcg_ex_lift set_cap_wp)[5]
apply ((wp hoare_vcg_ex_lift set_cap_wp)+)[5]
apply (rule_tac P = "\<exists>has_kids. iv = InvokeUntyped (Retype (root_cnode,ucptr_slot) nt (unat ts)
[(root_cnode, ncptr_slot)]
has_kids 1)"

4
proof/capDL-api/Sep_Tactic_Examples.thy
View File

@ -104,9 +104,9 @@ lemma move_cap_wp_old:
"\<lbrace><dest \<mapsto>c - \<and>* src \<mapsto>c cap \<and>* R>\<rbrace>
move_cap cap' src dest
\<lbrace>\<lambda>_. <dest \<mapsto>c cap' \<and>* src \<mapsto>c NullCap \<and>* R>\<rbrace>"
including no_pre
apply (simp add: move_cap_def)
apply (wp swap_parents_wp)
thm set_cap_wp[no_vars]
apply (rule hoare_strengthen_post)
apply (wp set_cap_wp)
apply (sep_select 2)
@ -124,6 +124,7 @@ lemma invoke_cnode_rotate2_wp_old:
invoke_cnode (RotateCall cap1 cap2 dest src rnd)
\<lbrace>\<lambda>_. <dest \<mapsto>c NullCap \<and>* src \<mapsto>c cap1 \<and>*
rnd \<mapsto>c cap2 \<and>* R>\<rbrace>"
including no_pre
apply (clarsimp simp: invoke_cnode_def)
apply (wp)
apply (rule hoare_strengthen_post)
@ -296,5 +297,4 @@ schematic_goal "(P \<and>* ?A) s \<Longrightarrow> (A \<and>* B \<and>* P) s"
done
end

338
proof/capDL-api/TCB_DP.thy
View File

@ -54,19 +54,19 @@ lemma restart_wp:
\<lbrace> < (tcb,tcb_pending_op_slot) \<mapsto>c cap \<and>* R > \<rbrace>
restart tcb
\<lbrace>\<lambda>_. < (tcb,tcb_pending_op_slot) \<mapsto>c cap \<and>* R > \<rbrace>"
apply (clarsimp simp: restart_def)
apply (wp alternative_wp)
apply (wp set_cap_wp[sep_wand_wp])
apply (clarsimp simp: restart_def)
apply (wp alternative_wp)
apply (wp set_cap_wp[sep_wand_wp])+
apply (clarsimp)
apply (rule hoare_pre_cont)
apply wp
apply (clarsimp)
apply (sep_select_asm 2)
apply (sep_drule (direct) opt_cap_sep_imp)
apply (clarsimp)
apply (erule disjE)
apply (clarsimp)
apply (sep_select_asm 2)
apply (sep_drule (direct) opt_cap_sep_imp)
apply (clarsimp)
apply (erule disjE)
apply (clarsimp simp: reset_cap_asid_def split:cdl_cap.split_asm)+
done
done
lemma invoke_tcb_write:
"cap = RunningCap \<or> cap = RestartCap
@ -100,7 +100,7 @@ lemma tcb_update_thread_slot_wp:
apply (wp)
apply (wp alternative_wp)
apply (wp insert_cap_child_wp)
apply (wp insert_cap_sibling_wp get_cap_rv)
apply (wp insert_cap_sibling_wp get_cap_rv)+
apply (safe)
apply (sep_solve)
apply (drule not_memory_cap_reset_asid')
@ -110,21 +110,23 @@ done
lemma tcb_empty_thread_slot_wp: "\<lbrace><(target_tcb,slot) \<mapsto>c NullCap \<and>* R>\<rbrace> tcb_empty_thread_slot target_tcb slot \<lbrace>\<lambda>_. <(target_tcb,slot) \<mapsto>c NullCap \<and>* R>\<rbrace> "
apply (simp add:tcb_empty_thread_slot_def whenE_def | wp)+
apply (rule valid_validE)
apply (rule hoare_pre_cont)
apply simp
apply wp
apply (rule valid_validE)
apply (rule hoare_pre_cont)
apply simp
apply wp+
apply (clarsimp dest!:opt_cap_sep_imp simp:reset_cap_asid_simps2)
done
lemma tcb_empty_thread_slot_wpE: "\<lbrace><(target_tcb,slot) \<mapsto>c NullCap \<and>* R>\<rbrace> tcb_empty_thread_slot target_tcb slot \<lbrace>\<lambda>_. <(target_tcb,slot) \<mapsto>c NullCap \<and>* R>\<rbrace>,
\<lbrace>E\<rbrace> "
apply (clarsimp simp: tcb_empty_thread_slot_def | wp)+
apply (rule hoare_whenE_wp)
apply (simp add:validE_def)
apply (rule hoare_pre_cont)
apply simp
apply wp
lemma tcb_empty_thread_slot_wpE:
"\<lbrace><(target_tcb,slot) \<mapsto>c NullCap \<and>* R>\<rbrace>
tcb_empty_thread_slot target_tcb slot
\<lbrace>\<lambda>_. <(target_tcb,slot) \<mapsto>c NullCap \<and>* R>\<rbrace>, \<lbrace>E\<rbrace>"
apply (clarsimp simp: tcb_empty_thread_slot_def | wp)+
apply (rule hoare_whenE_wp)
apply (simp add:validE_def)
apply (rule hoare_pre_cont)
apply simp
apply wp
apply (clarsimp dest!:opt_cap_sep_imp simp:reset_cap_asid_simps2)
done
@ -136,17 +138,17 @@ lemma tcb_update_ipc_buffer_wp:
apply (clarsimp simp: tcb_update_ipc_buffer_def sep_any_All)
apply (rule hoare_name_pre_stateE)
apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE])
apply (clarsimp)
apply (wp get_cap_rv'[where cap=cap])
apply (clarsimp)
apply (wp)
apply (wp tcb_empty_thread_slot_wpE[sep_wandise])
apply (clarsimp)
apply (wp get_cap_rv'[where cap=cap])
apply (clarsimp)
apply (wp)
apply (wp tcb_empty_thread_slot_wpE[sep_wandise])
apply (clarsimp simp: pred_conj_def)
apply (sep_cancel)
apply (sep_cancel)
apply (safe)
apply (sep_solve)+
done
apply (sep_cancel)
apply (safe)
apply (sep_solve)+
done
lemma tcb_update_ipc_buffer_wp':
"\<lbrace>< (ipc_buffer_slot) \<mapsto>c cap \<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap \<and>* tcb_cap_slot \<mapsto>c (TcbCap target_tcb) \<and>* R>
@ -156,20 +158,20 @@ lemma tcb_update_ipc_buffer_wp':
apply (rule hoare_name_pre_stateE)
apply (clarsimp simp: tcb_update_ipc_buffer_def sep_any_All)
apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wandise] get_cap_rv[where cap=cap])
apply (rule hoare_allI)
apply (rule hoare_impI)
apply (clarsimp)
apply (safe)
apply (wp)
apply (clarsimp simp: cdl_same_arch_obj_as_def)
apply (clarsimp simp: cap_type_def split: cdl_cap.splits dest!:reset_cap_asid_cap_type)
apply (wp tcb_empty_thread_slot_wpE[sep_wandise])
apply (rule hoare_allI)
apply (rule hoare_impI)
apply (clarsimp)
apply (safe)
apply (wp)
apply (clarsimp simp: cdl_same_arch_obj_as_def)
apply (clarsimp simp: cap_type_def split: cdl_cap.splits dest!:reset_cap_asid_cap_type)
apply (wp tcb_empty_thread_slot_wpE[sep_wandise])
apply (clarsimp)
apply (sep_cancel)+
apply (safe)
apply (sep_solve)+
apply (clarsimp simp: cdl_same_arch_obj_as_def cap_type_def reset_cap_asid_def split: cdl_cap.splits dest!:reset_cap_asid_cap_type)
done
done
lemma tcb_update_vspace_root_wp:
@ -180,14 +182,13 @@ lemma tcb_update_vspace_root_wp:
apply (rule hoare_name_pre_stateE)
apply (clarsimp simp: tcb_update_vspace_root_def sep_any_All)
apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE] get_cap_rv)
apply (assumption)
apply (wp get_cap_rv'[where cap=cap])
apply (clarsimp)
apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])
apply (wp get_cap_rv'[where cap=cap])
apply (clarsimp)
apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])
apply (clarsimp)
apply (sep_cancel)
apply (sep_cancel, safe, sep_solve+)
done
done
lemma tcb_update_vspace_root_wp':
"\<lbrace>< (vrt_slot) \<mapsto>c cap \<and>* (target_tcb, tcb_vspace_slot) \<mapsto>c NullCap \<and>* tcb_cap_slot \<mapsto>c (TcbCap target_tcb) \<and>* R>
@ -196,6 +197,7 @@ lemma tcb_update_vspace_root_wp':
\<lbrace>\<lambda>_. < (target_tcb, tcb_vspace_slot) \<mapsto>c vrt_cap \<and>* tcb_cap_slot \<mapsto>c (TcbCap target_tcb) \<and>* (vrt_slot) \<mapsto>c cap \<and>* R>\<rbrace>, \<lbrace>E\<rbrace>"
apply (rule hoare_name_pre_stateE)
apply (clarsimp simp: tcb_update_vspace_root_def sep_any_All)
including no_pre
apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE'] get_cap_rv)
apply (intro validE_allI hoare_validE_conj validE_impI)
@ -238,16 +240,16 @@ lemma tcb_update_cspace_root_wp:
and K (\<not> is_untyped_cap (crt_cap) \<and> is_cnode_cap cap \<and> cap_object cap = cap_object crt_cap)\<rbrace>
tcb_update_cspace_root target_tcb tcb_cap_slot (crt_cap, crt_slot)
\<lbrace>\<lambda>_. < (target_tcb, tcb_cspace_slot) \<mapsto>c crt_cap \<and>* tcb_cap_slot \<mapsto>c (TcbCap target_tcb) \<and>* (crt_slot) \<mapsto>c cap \<and>* R>\<rbrace>, \<lbrace>E\<rbrace>"
apply (rule hoare_name_pre_stateE)
including no_pre
apply (rule hoare_name_pre_stateE)
apply (clarsimp simp: tcb_update_cspace_root_def sep_any_All_side cong:cap_type_bad_cong)
apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE] get_cap_rv )+
apply (assumption)
apply (wp hoare_whenE_wp tcb_update_thread_slot_wp[sep_wand_side_wpE] get_cap_rv )
apply (wp get_cap_rv)
apply (intro hoare_validE_conj)
apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])
apply (clarsimp simp: sep_conj_assoc)
apply (sep_cancel+)
apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])
apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])+
apply (clarsimp, sep_cancel+)
apply (rule validE_allI)
apply (rule validE_impI)
@ -259,7 +261,7 @@ lemma tcb_update_cspace_root_wp:
apply clarsimp
apply (wp tcb_empty_thread_slot_wpE[sep_wand_wpE])
apply (clarsimp simp: sep_conj_assoc pred_conj_def | sep_solve)+
done
done
lemma invoke_tcb_threadcontrol_wp:
"\<lbrace>< target_tcb \<mapsto>f Tcb tcb \<and>*
@ -334,7 +336,8 @@ lemma invoke_tcb_threadcontrol_wp':
(vrt_slot) \<mapsto>c vrt_cap \<and>*
(target_tcb, tcb_cspace_slot) \<mapsto>c crt_cap \<and>*
(crt_slot) \<mapsto>c crt_cap' \<and>*
target_tcb \<mapsto>f Tcb (tcb\<lparr>cdl_tcb_fault_endpoint := fltep\<rparr>) \<and>* R >\<rbrace>, \<lbrace>E\<rbrace> "
target_tcb \<mapsto>f Tcb (tcb\<lparr>cdl_tcb_fault_endpoint := fltep\<rparr>) \<and>* R >\<rbrace>, \<lbrace>E\<rbrace>"
including no_pre
apply (rule hoare_name_pre_stateE)
apply (clarsimp simp: invoke_tcb_def)
apply (wp set_cdl_tcb_fault_endpoint_wp[sep_wand_wp] tcb_update_ipc_buffer_wp'[sep_wand_side_wpE]
@ -387,7 +390,7 @@ decode_tcb_invocation cap cap_ref caps (TcbConfigureIntent fault_ep priority csp
\<lbrace>P\<rbrace>, -"
apply (clarsimp simp: decode_tcb_invocation_def)
apply (wp alternativeE_R_wp)
apply (wp throw_on_none_rvR)
apply (wp throw_on_none_rvR)+
apply (safe)
apply (clarsimp simp: get_index_def)
done
@ -475,7 +478,7 @@ lemma tcb_empty_thread_slot_wp_inv: "\<lbrace><(target_tcb,slot) \<mapsto>c Null
apply (rule valid_validE)
apply (rule hoare_pre_cont)
apply simp
apply wp
apply wp+
apply (clarsimp dest!:opt_cap_sep_imp simp:reset_cap_asid_simps2)
done
@ -490,60 +493,63 @@ lemma insert_cap_sibling_current_thread_inv:
\<lbrace>\<lambda>_ s. P (cdl_current_thread s)\<rbrace>"
apply (clarsimp simp: insert_cap_sibling_def)
apply (wp | wpc)+
apply (clarsimp)
apply (intro hoare_conjI hoare_impI)
apply (rule hoare_drop_imp)
apply (wp)
apply (rule hoare_drop_imp)
apply (wp)+
apply (clarsimp)
apply (intro hoare_conjI hoare_impI)
apply (rule hoare_drop_imp)
apply (wp)
apply (rule hoare_drop_imp)
apply (wp)
apply (clarsimp)
done
done
lemma tcb_update_vspace_root_inv:
"\<lbrace>\<lambda>s. <(a, tcb_vspace_slot) \<mapsto>c NullCap \<and>* R> s \<and> P (cdl_current_thread s)\<rbrace>
tcb_update_vspace_root a b c
\<lbrace>\<lambda>_ s. P (cdl_current_thread s)\<rbrace>"
apply (clarsimp simp: tcb_update_vspace_root_def)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
including no_pre
apply (clarsimp simp: tcb_update_vspace_root_def)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
| simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+
apply (intro hoare_drop_impE hoare_validE_conj)
apply (intro hoare_drop_impE hoare_validE_conj)
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
defer
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
apply (sep_solve)
apply (sep_solve)
done
defer
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
apply (sep_solve)
apply (sep_solve)
done
lemma tcb_update_cspace_root_inv:
"\<lbrace>\<lambda>s. <(a, tcb_cspace_slot) \<mapsto>c NullCap \<and>* R> s \<and> P (cdl_current_thread s)\<rbrace>
tcb_update_cspace_root a b c
\<lbrace>\<lambda>_ s. P (cdl_current_thread s)\<rbrace>"
apply (clarsimp simp: tcb_update_cspace_root_def)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
including no_pre
apply (clarsimp simp: tcb_update_cspace_root_def)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
| simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+
apply (intro hoare_drop_impE hoare_validE_conj)
apply (intro hoare_drop_impE hoare_validE_conj)
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
apply (sep_solve)
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
apply (sep_solve)
done
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
apply (sep_solve)
done
lemma tcb_update_ipc_buffer_inv:
"\<lbrace>\<lambda>s. <(a, tcb_ipcbuffer_slot) \<mapsto>c NullCap \<and>* R> s \<and> P (cdl_current_thread s)\<rbrace>
tcb_update_ipc_buffer a b c
\<lbrace>\<lambda>_ s. P (cdl_current_thread s)\<rbrace>"
apply (clarsimp simp: tcb_update_ipc_buffer_def)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
including no_pre
apply (clarsimp simp: tcb_update_ipc_buffer_def)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
| simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+
apply (wp tcb_empty_thread_slot_wp_inv)
apply (clarsimp)
apply (sep_solve)
done
apply (clarsimp)
apply (sep_solve)
done
lemma invoke_tcb_ThreadControl_cur_thread:
@ -556,6 +562,7 @@ lemma invoke_tcb_ThreadControl_cur_thread:
target_tcb \<mapsto>f Tcb tcb \<and>* R >
\<rbrace> invoke_tcb (ThreadControl target_tcb tcb_cap_slot faultep croot vroot ipc_buffer)
\<lbrace>\<lambda>_ s. P (cdl_current_thread s) \<rbrace>"
including no_pre
apply (simp add:invoke_tcb_def comp_def)
apply (wp alternative_wp hoare_whenE_wp
tcb_empty_thread_slot_wp_inv
@ -583,7 +590,7 @@ lemma invoke_tcb_ThreadControl_cur_thread:
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
" in hoare_post_imp)
apply (clarsimp simp:sep_conj_ac)
apply wp
apply wp+
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_thread s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c -
\<and>* (target_tcb,tcb_cspace_slot) \<mapsto>c -
@ -613,7 +620,7 @@ lemma invoke_tcb_ThreadControl_cur_thread:
\<and>* R> s)
" in hoare_post_imp)
apply (clarsimp simp:sep_conj_ac)
apply wp
apply wp+
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_thread s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_cspace_slot) \<mapsto>c -
@ -645,7 +652,7 @@ lemma invoke_tcb_ThreadControl_cur_thread:
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
\<and> cap_type (fst x2) \<noteq> Some UntypedType" in hoare_post_imp)
apply (clarsimp simp:sep_conj_ac, sep_solve)
apply wp
apply wp+
apply (rule_tac P = "cap_type (fst x2) \<noteq> Some UntypedType" in hoare_gen_asmEx)
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_thread s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c NullCap
@ -848,75 +855,75 @@ lemma invoke_tcb_ThreadControl_cdl_current_domain:
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
" in hoare_post_imp)
apply (clarsimp simp: sep_conj_ac, sep_solve)
apply wp
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
apply (clarsimp simp: sep_conj_ac, sep_solve)
apply wp+
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c -
\<and>* (target_tcb,tcb_cspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
" in hoare_post_impErr[rotated -1])
apply assumption
apply (wp tcb_empty_thread_slot_wp_inv)
apply clarsimp
apply (sep_solve)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
apply assumption
apply (wp tcb_empty_thread_slot_wp_inv)
apply clarsimp
apply (sep_solve)
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
| simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+
apply (rule hoare_post_imp[OF _ insert_cap_child_wp])
apply (rule hoare_post_imp[OF _ insert_cap_child_wp])
apply (sep_select 2)
apply (drule sep_map_c_any)
apply assumption
apply wp
apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp])
apply (sep_select 2)
apply (drule sep_map_c_any)
apply assumption
apply wp
apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp])
apply (sep_select 2)
apply (drule sep_map_c_any)
apply assumption
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c -
\<and>* (target_tcb,tcb_cspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f -
\<and>* R> s)
" in hoare_post_imp)
apply (clarsimp simp:sep_conj_ac)
apply wp
apply (clarsimp simp:sep_conj_ac)
apply wp+
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_cspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
" in hoare_post_impErr[rotated -1])
apply assumption
apply (wp tcb_empty_thread_slot_wp_inv)
apply clarsimp
apply sep_solve
apply assumption
apply (wp tcb_empty_thread_slot_wp_inv)
apply clarsimp
apply sep_solve
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c NullCap
\<and>* (target_tcb,tcb_cspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
" in hoare_post_impErr[rotated -1])
apply assumption
apply (wp hoare_whenE_wp |wpc|simp add:tcb_update_cspace_root_def)+
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
apply assumption
apply (wp hoare_whenE_wp |wpc|simp add:tcb_update_cspace_root_def)+
apply (wp hoare_drop_imps hoare_whenE_wp alternative_wp
| simp add: tcb_update_vspace_root_def tcb_update_thread_slot_def)+
apply (rule hoare_post_imp[OF _ insert_cap_child_wp])
apply (rule hoare_post_imp[OF _ insert_cap_child_wp])
apply (sep_select 2)
apply (drule sep_map_c_any)
apply assumption
apply wp
apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp])
apply (sep_select 2)
apply (drule sep_map_c_any)
apply assumption
apply wp
apply (rule hoare_post_imp[OF _ insert_cap_sibling_wp])
apply (sep_select 2)
apply (drule sep_map_c_any)
apply assumption
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c NullCap
\<and>* (target_tcb,tcb_cspace_slot) \<mapsto>c -
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
\<and> cap_type (fst x2) \<noteq> Some UntypedType" in hoare_post_imp)
apply (clarsimp simp:sep_conj_ac)
apply wp
apply (clarsimp simp:sep_conj_ac)
apply wp+
apply (rule_tac P = "cap_type (fst x2) \<noteq> Some UntypedType" in hoare_gen_asmEx)
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c NullCap
@ -924,34 +931,34 @@ lemma invoke_tcb_ThreadControl_cdl_current_domain:
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)
" in hoare_post_impErr[rotated -1])
apply clarsimp
apply assumption
apply (wp tcb_empty_thread_slot_wp_inv)
apply clarsimp
apply assumption
apply (wp tcb_empty_thread_slot_wp_inv)
apply clarsimp
apply clarsimp
apply clarsimp
apply (intro conjI impI impI allI)
apply sep_solve+
apply (rule hoare_pre)
apply (wp|wpc|simp)+
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
apply (intro conjI impI impI allI)
apply sep_solve+
apply (rule hoare_pre)
apply (wp|wpc|simp)+
apply (rule_tac Q = "\<lambda>r s. P (cdl_current_domain s)
\<and> (<(target_tcb, tcb_vspace_slot) \<mapsto>c NullCap
\<and>* (target_tcb,tcb_cspace_slot) \<mapsto>c NullCap
\<and>* (target_tcb, tcb_ipcbuffer_slot) \<mapsto>c NullCap
\<and>* target_tcb \<mapsto>f - \<and>* R> s)" in hoare_post_imp)
apply clarsimp
apply (sep_select_asm 2)
apply (intro conjI impI allI)
apply sep_solve
apply assumption+
apply sep_solve
apply wp
apply (rule hoare_post_imp[OF _ set_cdl_tcb_fault_endpoint_wp[where tcb = tcb]])
apply clarsimp
apply (sep_select_asm 2)
apply (intro conjI impI allI)
apply sep_solve
apply assumption+
apply sep_solve
apply wp
apply (rule hoare_post_imp[OF _ set_cdl_tcb_fault_endpoint_wp[where tcb = tcb]])
apply (drule sep_map_anyD)
apply (sep_select 4)
apply assumption
apply clarsimp
apply (auto, sep_solve+)
done
apply assumption+
apply clarsimp
apply (auto, sep_solve+)
done
lemma TCB_Configure_wp:
assumes unify: "cnode_id = cap_object cnode_cap \<and>
@ -1058,7 +1065,7 @@ shows
apply (fastforce)
apply (rule hoare_strengthen_post[OF set_cap_wp])
apply (sep_schem)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P= "
\<exists>cspace_cap' vspace_cap' buffer_frame_cap'.
iv = (InvokeTcb $
@ -1138,19 +1145,15 @@ shows
apply wp[1]
apply (rule no_exception_conjE)
apply (wp decode_invocation_tcb_rv''[simplified, where xs="[]" and
croot_slot="(cnode_id, cspace_slot)" and
vroot_slot="(cnode_id, vspace_slot)" and
ipcbuff_slot="(cnode_id, buffer_frame_slot)"])
apply (simp)
ipcbuff_slot="(cnode_id, buffer_frame_slot)"])+
apply (rule_tac P="is_tcb_cap c" in hoare_gen_asmEx )
apply (rule split_error_validE)
apply (clarsimp simp: decode_tcb_invocation_simps)
apply (wp)
apply (clarsimp simp: comp_def)
apply (wp)[2]
apply (wp+)[2]
apply (simp add:lookup_extra_caps_def Let_def
mapME_def sequenceE_def get_index_def bindE_assoc)
apply (rule wp_no_exception_seq)
@ -1173,7 +1176,7 @@ shows
apply (rule update_thread_intent_update)
apply (wp hoare_vcg_ball_lift
hoare_vcg_imp_lift hoare_vcg_ex_lift hoare_vcg_all_lift
update_thread_intent_update)
update_thread_intent_update)+
defer
apply (clarsimp)
apply (intro conjI allI impI disjI2)
@ -1200,7 +1203,7 @@ shows
apply assumption
apply (sep_select_asm 4)
apply (sep_solve)
done
done
crunch idle_thread[wp]: set_cap "\<lambda>s. P (cdl_current_thread s)"
(wp: crunch_wps)
@ -1212,12 +1215,13 @@ crunch current_domain[wp]: set_cap "\<lambda>s. P (cdl_current_domain s)"
lemma restart_cdl_current_domain:
"\<lbrace>\<lambda>s. <(ptr,tcb_pending_op_slot) \<mapsto>c cap \<and>* \<top> > s \<and> \<not> is_pending_cap cap
\<and> P (cdl_current_domain s)\<rbrace> restart ptr \<lbrace>\<lambda>r s. P (cdl_current_domain s)\<rbrace>"
including no_pre
apply (simp add:restart_def)
apply (wp alternative_wp)
apply (simp add:cancel_ipc_def)
apply wp
apply (simp add:cancel_ipc_def)
apply wp
apply (rule_tac P ="\<not> is_pending_cap capa" in hoare_gen_asm)
apply (wpc,simp_all add:is_pending_cap_def,wp)
apply (wpc,simp_all add:is_pending_cap_def,wp+)
apply clarsimp
apply (drule opt_cap_sep_imp)
apply auto[1]
@ -1228,17 +1232,17 @@ lemma restart_cdl_current_domain:
lemma restart_cdl_current_thread:
"\<lbrace>\<lambda>s. <(ptr,tcb_pending_op_slot) \<mapsto>c cap \<and>* \<top> > s \<and> \<not> is_pending_cap cap
\<and> P (cdl_current_thread s)\<rbrace> restart ptr \<lbrace>\<lambda>r s. P (cdl_current_thread s)\<rbrace>"
including no_pre
apply (simp add:restart_def)
apply (wp alternative_wp)
apply (simp add:cancel_ipc_def)
apply wp
apply (simp add:cancel_ipc_def)
apply wp
apply (rule_tac P ="\<not> is_pending_cap capa" in hoare_gen_asm)
apply (wpc,simp_all add:is_pending_cap_def,wp)
apply (wpc,simp_all add:is_pending_cap_def,wp+)
apply clarsimp
apply (drule opt_cap_sep_imp)
apply auto[1]
apply (simp add:reset_cap_asid_def
split:cdl_cap.splits)
apply (simp add:reset_cap_asid_def split:cdl_cap.splits)
done
lemma seL4_TCB_WriteRegisters_wp:
@ -1272,7 +1276,6 @@ lemma seL4_TCB_WriteRegisters_wp:
sep_state_projection2_def
is_tcb_def split:cdl_object.splits)
apply (rename_tac cdl_tcb)
apply (rule hoare_pre)
apply (wp do_kernel_op_pull_back)
apply (rule hoare_post_imp[OF _ call_kernel_with_intent_allow_error_helper
[where check = False,simplified]])
@ -1281,7 +1284,7 @@ lemma seL4_TCB_WriteRegisters_wp:
apply fastforce
apply (rule hoare_strengthen_post[OF set_cap_wp])
apply (sep_select 3,sep_cancel)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P= "
iv = (InvokeTcb $ WriteRegisters (cap_object tcb_cap) False [0] 0)" in hoare_gen_asmEx)
apply (clarsimp simp:invoke_tcb_def)
@ -1298,16 +1301,15 @@ lemma seL4_TCB_WriteRegisters_wp:
throw_opt_def get_tcb_intent_def decode_tcb_invocation_def)
apply wp
apply (rule alternativeE_wp)
apply wp[2]
apply (wp+)[2]
apply (clarsimp simp:conj_comms lookup_extra_caps_def
mapME_def sequenceE_def)
apply (rule returnOk_wp)
apply (rule lookup_cap_and_slot_rvu
[where r=root_size and cap=cnode_cap and cap'=tcb_cap])
apply clarsimp
apply (wp hoare_vcg_ball_lift hoare_vcg_conj_lift hoare_vcg_imp_lift
hoare_vcg_all_lift)
apply (wp update_thread_intent_update)
apply (wp hoare_vcg_ball_lift hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)
apply (wp update_thread_intent_update)+
apply clarify
apply (drule_tac x = tcb_cap in spec)
apply clarsimp
@ -1316,12 +1318,10 @@ lemma seL4_TCB_WriteRegisters_wp:
apply (intro conjI impI allI)
apply (clarsimp simp:is_tcb_def reset_cap_asid_tcb
split:cdl_object.splits cdl_cap.splits)+
apply (simp add: ep_related_cap_def
cap_type_def cap_object_def
apply (simp add: ep_related_cap_def cap_type_def cap_object_def
split:cdl_cap.splits)
apply ((rule conjI|sep_solve)+)[1]
apply (clarsimp simp: user_pointer_at_def
Let_unfold sep_conj_assoc is_tcb_def)
apply (clarsimp simp: user_pointer_at_def Let_unfold sep_conj_assoc is_tcb_def)
apply sep_cancel+
apply sep_solve
done
@ -1362,7 +1362,7 @@ lemma seL4_TCB_Resume_wp:
apply fastforce
apply (rule hoare_strengthen_post[OF set_cap_wp])
apply (sep_select 2,sep_cancel)
apply wp[4]
apply (wp+)[4]
apply (rule_tac P= "
iv = (InvokeTcb $ Resume (cap_object tcb_cap))" in hoare_gen_asmEx)
apply (clarsimp simp:invoke_tcb_def)
@ -1392,14 +1392,14 @@ lemma seL4_TCB_Resume_wp:
throw_opt_def get_tcb_intent_def decode_tcb_invocation_def)
apply wp
apply (rule alternativeE_wp)
apply wp[2]
apply (wp+)[2]
apply (clarsimp simp: lookup_extra_caps_def mapME_def sequenceE_def)
apply (rule returnOk_wp)
apply (rule lookup_cap_and_slot_rvu
[where r=root_size and cap=cnode_cap and cap'=tcb_cap])
apply clarsimp
apply (wp hoare_vcg_conj_lift hoare_vcg_imp_lift hoare_vcg_all_lift)
apply (wp update_thread_intent_update)
apply (wp update_thread_intent_update)+
apply clarify
apply (drule_tac x = tcb_cap in spec)
apply clarsimp
@ -1407,7 +1407,7 @@ lemma seL4_TCB_Resume_wp:
apply sep_solve
apply (intro conjI impI allI)
apply (clarsimp simp:is_tcb_def reset_cap_asid_tcb
split:cdl_object.splits cdl_cap.splits)+
split:cdl_object.splits cdl_cap.splits)+
apply (simp add: ep_related_cap_def cap_type_def cap_object_def
split: cdl_cap.splits)
apply ((rule conjI|sep_solve)+)[1]

16
proof/crefine/Arch_C.thy
View File

@ -478,7 +478,7 @@ shows
apply simp
apply (clarsimp simp: option_to_ptr_def option_to_0_def)
apply (clarsimp simp: asid_high_bits_def)
apply wp
apply wp+
apply (strengthen valid_pspace_mdb' vp_strgs' valid_pspace_valid_objs')
apply (clarsimp simp: is_simple_cap'_def isCap_simps conj_comms placeNewObject_def2)
apply (wp createObjects_valid_pspace'[where ty="Inl (KOArch (KOASIDPool f))" and sz = pageBits]
@ -826,7 +826,7 @@ lemma decodeARMPageTableInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_inst[where P=\<top> and P'=UNIV], simp)
apply wp
apply wp+
apply simp
apply (vcg exspec=setThreadState_modifies)
apply simp
@ -1666,7 +1666,7 @@ lemma performPageInvocationMapPTE_ccorres:
apply (clarsimp simp: valid_pte_slots'2_def del: disjCI)
apply (erule disjE, simp_all add: unat_arith_simps)[1]
apply (clarsimp simp: upt_conv_Cons[where i=0])
apply (wp valid_pte_slots_lift2)
apply (wp valid_pte_slots_lift2)+
apply (clarsimp simp: pte_range_relation_def map_is_Nil_conv hd_map_simp
ptr_range_to_list_def valid_pte_slots'2_def
word_le_nat_alt power_increasing[where a="2 :: nat" and N=4, simplified])
@ -2174,7 +2174,7 @@ lemma performPageInvocationRemapPTE_ccorres:
apply simp
apply (simp add: objBits_simps archObjSize_def)
apply (simp add: typ_at_to_obj_at_arches[symmetric])
apply (wp mapM_x_wp_inv valid_pte_slots_lift2)
apply (wp mapM_x_wp_inv valid_pte_slots_lift2)+
apply clarsimp
apply (simp add: typ_at_to_obj_at_arches)
apply (frule bspec, erule hd_in_set)
@ -2642,7 +2642,7 @@ lemma decodeARMFrameInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_inst[where P=\<top> and P'=UNIV], simp)
apply wp
apply wp+
apply (vcg exspec=setThreadState_modifies)
apply (rule ccorres_rhs_assoc)+
apply csymbr+
@ -3151,7 +3151,7 @@ lemma decodeARMFrameInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_inst[where P=\<top> and P'=UNIV], simp)
apply (wp sts_invs_minor' valid_pte_slots_lift2)
apply (wp sts_invs_minor' valid_pte_slots_lift2)+
apply simp
apply (vcg exspec=setThreadState_modifies)
apply simp
@ -4086,10 +4086,10 @@ lemma Arch_decodeInvocation_ccorres:
list_case_If2 split_def
del: Collect_const)
apply (simp add: if_1_0_0 from_bool_0 hd_conv_nth length_ineq_not_Nil
del: Collect_const )
del: Collect_const)
apply (clarsimp simp: eq_Nil_null[symmetric] asid_high_bits_word_bits hd_conv_nth
ThreadState_Restart_def mask_def)
apply wp
apply wp+
apply (simp add: cap_get_tag_isCap)
apply (rule HoarePartial.SeqSwap)
apply (rule_tac I="\<lbrace>Prop \<acute>ksCurThread \<acute>root\<rbrace>"

2
proof/crefine/CLevityCatch.thy
View File

@ -141,7 +141,7 @@ lemma asUser_get_registers:
apply (wp mapM_wp')
apply clarsimp
apply (erule(1) obj_at_conj')
apply (rule hoare_pre, wp)
apply (wp)
apply (simp add: asUser_def split_def threadGet_def)
apply (wp getObject_tcb_wp)
apply (clarsimp simp: getRegister_def simpler_gets_def

2
proof/crefine/CSpace_C.thy
View File

@ -1213,7 +1213,7 @@ thm cteInsert_body_def
apply (ctac ccorres:ccorres_updateMDB_set_mdbPrev)
apply (simp add:dc_def[symmetric])
apply (ctac ccorres: ccorres_updateMDB_skip)
apply (wp static_imp_wp)
apply (wp static_imp_wp)+
apply (clarsimp simp: Collect_const_mem dc_def split del: if_split)
apply vcg
apply (wp static_imp_wp)

2
proof/crefine/CSpace_RAB_C.thy
View File

@ -694,7 +694,7 @@ lemma lookupSlotForThread_ccorres':
apply (ctac add: ccorres_return_CE)
apply csymbr+
apply (ctac add: ccorres_return_C_errorE)
apply wp
apply wp+
apply vcg
apply (rule conjI)
apply (clarsimp simp add: conj_comms word_size tcbSlots Kernel_C.tcbCTable_def)

4
proof/crefine/Delete_C.thy
View File

@ -891,11 +891,11 @@ lemma finaliseSlot_ccorres:
apply (clarsimp simp: throwError_def return_def cintr_def)
apply vcg
apply (wp cutMon_validE_drop reduceZombie_invs reduceZombie_sch_act_simple)
apply (wp reduceZombie_cap_to[simplified imp_conv_disj, simplified])
apply (wp reduceZombie_cap_to[simplified imp_conv_disj, simplified])+
apply (simp add: guard_is_UNIV_def)
apply (simp add: conj_comms)
apply (wp make_zombie_invs' updateCap_cte_wp_at_cases
updateCap_cap_to' hoare_vcg_disj_lift static_imp_wp)
updateCap_cap_to' hoare_vcg_disj_lift static_imp_wp)+
apply (simp add: guard_is_UNIV_def)
apply wp
apply (simp add: guard_is_UNIV_def)

4
proof/crefine/DetWP.thy
View File

@ -19,7 +19,7 @@ lemma det_wp_doMachineOp [wp]:
apply (simp add: doMachineOp_def split_def)
apply (rule det_wp_pre, wp)
apply (erule det_wp_select_f)
apply wp
apply wp+
apply simp
done
@ -123,7 +123,7 @@ lemma det_wp_asUser [wp]:
apply wp
apply (drule det_wp_det)
apply (erule det_wp_select_f)
apply wp
apply wp+
apply (rule_tac Q="\<lambda>_. tcb_at' t" in hoare_post_imp)
apply simp
apply wp

121
proof/crefine/Fastpath_C.thy
View File

@ -698,15 +698,15 @@ lemma findPDForASID_pd_at_asid_noex:
apply (rule hoare_pre)
apply (rule seqE[rotated])
apply wpc
apply wp[1]
apply wp
apply (rule seqE[rotated])
apply (rule seqE[rotated])
apply (rule returnOk_wp)
apply (simp add:checkPDAt_def)
apply wp[1]
apply wp
apply (rule assertE_wp)
apply wpc
apply wp[1]
apply wp
apply (rule liftE_wp)
apply (rule getASID_wp)
apply (clarsimp simp: pd_at_asid'_def obj_at'_def projectKOs
@ -2139,7 +2139,7 @@ lemma cnotification_relation_isActive:
lemma option_case_liftM_getNotification_wp:
"\<lbrace>\<lambda>s. \<forall>rv. (case x of None \<Rightarrow> rv = v | Some p \<Rightarrow> obj_at' (\<lambda>ntfn. f ntfn = rv) p s)
\<longrightarrow> Q rv s\<rbrace> case x of None \<Rightarrow> return v | Some ptr \<Rightarrow> liftM f $ getNotification ptr \<lbrace> Q \<rbrace>"
apply (rule hoare_pre, wpc, wp getNotification_wp)
apply (rule hoare_pre, (wpc; wp getNotification_wp))
apply (auto simp: obj_at'_def)
done
@ -2164,7 +2164,7 @@ lemma fastpath_call_ccorres:
(ksCurThread s) s)
(UNIV \<inter> {s. cptr_' s = cptr} \<inter> {s. msgInfo_' s = msginfo}) []
(fastpaths SysCall) (Call fastpath_call_'proc)"
proof -
proof -
have [simp]: "scast Kernel_C.tcbCaller = tcbCallerSlot"
by (simp add:Kernel_C.tcbCaller_def tcbCallerSlot_def)
have [simp]: "scast Kernel_C.tcbVTable = tcbVTableSlot"
@ -3517,12 +3517,12 @@ lemma monadic_rewrite_add_lookup_both_sides:
\<Longrightarrow> monadic_rewrite E F (P and Q) f g"
apply (rule monadic_rewrite_imp)
apply (rule monadic_rewrite_trans[rotated])
apply (rule monadic_rewrite_symb_exec_l'[where m=lu], wp inv ef nf impI)
apply (rule monadic_rewrite_symb_exec_l'[where m=lu], (wp inv ef nf impI)+)
apply (rule monadic_rewrite_refl, wp)
apply (simp; erule monadic_rewrite_trans[rotated])
apply (rule monadic_rewrite_transverse[OF _ monadic_rewrite_refl])
apply (rule monadic_rewrite_symb_exec_l'[where m=lu], wp inv ef nf impI)
apply (rule monadic_rewrite_symb_exec_l'[where m=lu], (wp inv ef nf impI)+)
apply (rule monadic_rewrite_refl, wp)
apply simp
done
@ -3658,17 +3658,17 @@ lemma fastpath_callKernel_SysCall_corres:
apply simp
apply (rule monadic_rewrite_bind_tail)
apply (rule_tac x=thread in monadic_rewrite_symb_exec,
wp empty_fail_getCurThread)
(wp empty_fail_getCurThread)+)
apply (simp add: sendIPC_def bind_assoc)
apply (rule_tac x=send_ep in monadic_rewrite_symb_exec,
wp empty_fail_getEndpoint getEndpoint_obj_at')
(wp empty_fail_getEndpoint getEndpoint_obj_at')+)
apply (rule_tac P="epQueue send_ep \<noteq> []" in monadic_rewrite_gen_asm)
apply (simp add: isRecvEP_endpoint_case list_case_helper bind_assoc)
apply (rule monadic_rewrite_bind_tail)
apply (elim conjE)
apply (match premises in "isEndpointCap ep" for ep \<Rightarrow>
\<open>rule monadic_rewrite_symb_exec[where x="BlockedOnReceive (capEPPtr ep)"]\<close>,
wp empty_fail_getThreadState)
(wp empty_fail_getThreadState)+)
apply (rule monadic_rewrite_symb_exec2, (wp | simp)+)
apply (rule monadic_rewrite_bind)
apply (rule_tac msgInfo=msgInfo in doIPCTransfer_simple_rewrite)
@ -3677,7 +3677,7 @@ lemma fastpath_callKernel_SysCall_corres:
apply (rule_tac curPrio=curPrio and destPrio=destPrio
and curDom=curDom and destDom=destDom and thread=thread
in attemptSwitchTo_rewrite)
apply (rule monadic_rewrite_symb_exec2, wp empty_fail_threadGet)
apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_threadGet)+)
apply (rule monadic_rewrite_bind)
apply (rule monadic_rewrite_trans)
apply (rule setupCallerCap_rewrite)
@ -3685,7 +3685,7 @@ lemma fastpath_callKernel_SysCall_corres:
apply (rule setThreadState_blocked_rewrite, simp)
apply (rule monadic_rewrite_trans)
apply (rule_tac x=BlockedOnReply in monadic_rewrite_symb_exec,
wp empty_fail_getThreadState)
(wp empty_fail_getThreadState)+)
apply simp
apply (rule monadic_rewrite_refl)
apply (rule monadic_rewrite_trans)
@ -3706,7 +3706,7 @@ lemma fastpath_callKernel_SysCall_corres:
locateSlot_conv ct_in_state'_def cur_tcb'_def)
apply ((wp assert_inv threadSet_pred_tcb_at_state cteInsert_obj_at'_not_queued | wps)+)[1]
apply (simp add: setSchedulerAction_def)
apply wp[1]
apply wp
apply (simp cong: if_cong conj_cong add: if_bool_simps)
apply (simp_all only:)[5]
apply ((wp setThreadState_oa_queued[of _ "\<lambda>a _ _. \<not> a"]
@ -3782,10 +3782,9 @@ lemma fastpath_callKernel_SysCall_corres:
apply (wp getCTE_wp')
apply (rule resolveAddressBits_points_somewhere)
apply (simp cong: if_cong bool.case_cong)
apply wp[1]
apply wp
apply simp
apply (wp user_getreg_wp user_getregs_wp
threadGet_wp)
apply (wp user_getreg_wp user_getregs_wp threadGet_wp)+
apply (clarsimp simp: ct_in_state'_def pred_tcb_at')
apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp+)
apply (clarsimp simp: isCap_simps valid_cap'_def maskCapRights_def)
@ -3885,13 +3884,12 @@ lemma doReplyTransfer_simple:
setThreadState Running receiver;
attemptSwitchTo receiver
od )"
apply (simp add: doReplyTransfer_def liftM_def nullPointer_def
getSlotCap_def)
apply (simp add: doReplyTransfer_def liftM_def nullPointer_def getSlotCap_def)
apply (rule monadic_rewrite_bind_tail)+
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_threadGet)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_threadGet)+)
apply (rule_tac P="rv = None" in monadic_rewrite_gen_asm, simp)
apply (rule monadic_rewrite_refl)
apply (wp threadGet_const gts_wp' getCTE_wp')
apply (wp threadGet_const gts_wp' getCTE_wp')+
apply (simp add: o_def)
done
@ -3919,10 +3917,10 @@ lemma receiveIPC_simple_rewrite:
apply (simp add: receiveIPC_def)
apply (rule monadic_rewrite_imp)
apply (rule_tac rv=ep in monadic_rewrite_symb_exec_l_known,
wp empty_fail_getEndpoint)
(wp empty_fail_getEndpoint)+)
apply (rule monadic_rewrite_symb_exec_l, (wp | simp add: getBoundNotification_def)+)
apply (rule monadic_rewrite_symb_exec_l)
apply (rule hoare_pre, wpc, wp, simp)
apply (rule hoare_pre, wpc, wp+, simp)
apply (simp split: option.split)
apply (rule monadic_rewrite_trans, rule monadic_rewrite_if_known[where X=False], simp)
apply (rule monadic_rewrite_refl3[where P=\<top>])
@ -3942,7 +3940,7 @@ lemma cteDeleteOne_replycap_rewrite:
(emptySlot slot None)"
apply (simp add: cteDeleteOne_def)
apply (rule monadic_rewrite_imp)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rule_tac P="cteCap rv \<noteq> NullCap \<and> isReplyCap (cteCap rv)
\<and> \<not> isEndpointCap (cteCap rv)
\<and> \<not> isNotificationCap (cteCap rv)"
@ -3950,9 +3948,9 @@ lemma cteDeleteOne_replycap_rewrite:
apply (simp add: finaliseCapTrue_standin_def
capRemovable_def)
apply (rule monadic_rewrite_symb_exec_l,
wp isFinalCapability_inv empty_fail_isFinalCapability)
(wp isFinalCapability_inv empty_fail_isFinalCapability)+)
apply (rule monadic_rewrite_refl)
apply (wp getCTE_wp')
apply (wp getCTE_wp')+
apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
done
@ -3963,7 +3961,7 @@ lemma cteDeleteOne_nullcap_rewrite:
(return ())"
apply (simp add: cteDeleteOne_def)
apply (rule monadic_rewrite_imp)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rule_tac P="cteCap rv = NullCap" in monadic_rewrite_gen_asm)
apply simp
apply (rule monadic_rewrite_refl)
@ -3979,7 +3977,7 @@ lemma deleteCallerCap_nullcap_rewrite:
apply (simp add: deleteCallerCap_def getThreadCallerSlot_def locateSlot_conv
getSlotCap_def)
apply (rule monadic_rewrite_imp)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rule monadic_rewrite_assert)
apply (rule cteDeleteOne_nullcap_rewrite)
apply (wp getCTE_wp)
@ -4070,11 +4068,11 @@ lemma tcbSchedDequeue_rewrite_not_queued: "monadic_rewrite True False (tcb_at' t
apply (wp threadGet_const)
apply (rule monadic_rewrite_symb_exec_l)
apply wp
apply wp+
apply (rule monadic_rewrite_refl)
apply (wp)
apply (clarsimp simp: o_def obj_at'_def)
done
done
lemma schedule_known_rewrite:
"monadic_rewrite True False
@ -4104,7 +4102,7 @@ lemma schedule_known_rewrite:
apply (rule monadic_rewrite_refl)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_refl)
apply (wp Arch_switchToThread_obj_at_pre, simp, wp)
apply ((wp Arch_switchToThread_obj_at_pre)+, simp, wp+)
apply (rule monadic_rewrite_trans)
apply (rule monadic_rewrite_symb_exec_l)
apply (wp)
@ -4120,7 +4118,7 @@ lemma schedule_known_rewrite:
apply (wp, simp)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_refl)
apply (wp)
apply wp+
apply (rule monadic_rewrite_refl)
apply (clarsimp simp: st_tcb_at'_def o_def obj_at'_def)
done
@ -4133,8 +4131,8 @@ lemma setThreadState_schact_set:
apply (simp add: setThreadState_def)
apply (rule monadic_rewrite_imp)
apply (subst bind_return[symmetric], rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_isRunnable)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCurThread)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_isRunnable)+)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCurThread)+)
apply (rule monadic_rewrite_symb_exec_l, wp)
apply (simp add: getSchedulerAction_def)
apply (rename_tac sa)
@ -4233,7 +4231,7 @@ lemma setEndpoint_setCTE_pivot[unfolded K_bind_def]:
split: if_split)
apply (auto split: if_split simp: obj_at'_def projectKOs
intro!: arg_cong[where f=f] ext kernel_state.fold_congs)[1]
apply wp
apply wp+
apply simp
done
@ -4347,7 +4345,7 @@ lemma set_setCTE[unfolded K_bind_def]:
apply (auto simp: simpler_modify_def projectKO_opt_tcb
intro!: kernel_state.fold_congs ext
split: if_split)[1]
apply wp
apply wp+
apply (clarsimp intro!: all_tcbI)
apply (auto simp: tcb_cte_cases_def split: if_split_asm)
done
@ -4374,7 +4372,7 @@ lemma clearUntypedFreeIndex_simple_rewrite:
apply (rule monadic_rewrite_name_pre)
apply (clarsimp simp: cte_wp_at_ctes_of)
apply (rule monadic_rewrite_imp)
apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, wp)
apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, wp+)
apply (simp split: capability.split,
strengthen monadic_rewrite_refl, simp)
apply clarsimp
@ -4406,7 +4404,7 @@ lemma emptySlot_replymaster_rewrite[OF refl]:
apply (rule monadic_rewrite_bind_head)
apply (rule clearUntypedFreeIndex_simple_rewrite)
apply simp
apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, wp empty_fail_getCTE)
apply (rule_tac rv=cte in monadic_rewrite_symb_exec_l_known, (wp empty_fail_getCTE)+)
apply (simp add: updateMDB_def Let_def bind_assoc makeObject_cte case_Null_If)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_bind)
@ -4416,7 +4414,7 @@ lemma emptySlot_replymaster_rewrite[OF refl]:
apply (case_tac ctea, rename_tac mdbnode, case_tac mdbnode)
apply simp
apply (rule monadic_rewrite_refl)
apply (wp getCTE_wp')
apply (wp getCTE_wp')+
apply (clarsimp simp: cte_wp_at_ctes_of reply_masters_rvk_fb_def)
apply (fastforce simp: isCap_simps)
done
@ -4540,6 +4538,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
(invs' and ct_in_state' (op = Running) and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
and cnode_caps_gsCNodes')
(callKernel (SyscallEvent SysReplyRecv)) (fastpaths SysReplyRecv)"
including no_pre
apply (rule monadic_rewrite_introduce_alternative)
apply ( simp add: callKernel_def)
apply (rule monadic_rewrite_imp)
@ -4555,9 +4554,9 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
cong: if_cong)
apply (rule monadic_rewrite_rdonly_bind_l, wp)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac thread msgInfo)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac cptr)
apply (rule monadic_rewrite_symb_exec_r[OF threadGet_inv no_fail_threadGet])
apply (rename_tac tcbFault)
@ -4577,7 +4576,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
isRight_def[where x="Inr v" for v]
isRight_def[where x="Inl v" for v]
cong: if_cong)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac "cTableCTE")
apply (rule monadic_rewrite_transverse,
@ -4592,7 +4591,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply clarsimp
apply (simp add: isRight_case_sum liftE_bind
isRight_def[where x="Inr v" for v])
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac ep_cap)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
@ -4603,7 +4602,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (rename_tac ep)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac ep)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
@ -4615,20 +4614,20 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (simp add: bind_assoc)
apply (rule monadic_rewrite_rdonly_bind_l, wp assert_inv)
apply (rule monadic_rewrite_assert)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac callerFault)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
apply (simp add: getThreadVSpaceRoot_def locateSlot_conv)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rename_tac vTableCTE)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
apply (rule monadic_rewrite_symb_exec_r, wp)+
apply (rule monadic_rewrite_symb_exec_r, wp+)+
apply (rename_tac curPrio callerPrio)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
apply (rule monadic_rewrite_symb_exec_r, wp)
apply (rule monadic_rewrite_symb_exec_r, wp+)
apply (rule monadic_rewrite_if_rhs[rotated])
apply (rule monadic_rewrite_alternative_l)
apply (rule monadic_rewrite_symb_exec_r[OF curDomain_inv],
@ -4678,12 +4677,12 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (simp add: setMessageInfo_def)
apply (rule monadic_rewrite_bind_tail)
apply (rule_tac rv=thread in monadic_rewrite_symb_exec_l_known,
wp empty_fail_getCurThread)
(wp empty_fail_getCurThread)+)
apply (rule_tac rv=cptr in monadic_rewrite_symb_exec_l_known,
wp empty_fail_asUser empty_fail_getRegister)
(wp empty_fail_asUser empty_fail_getRegister)+)
apply (rule monadic_rewrite_bind)
apply (rule monadic_rewrite_catch[OF _ monadic_rewrite_refl True_E_E])
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rename_tac cTableCTE2,
rule_tac P="cteCap cTableCTE2 = cteCap cTableCTE"
in monadic_rewrite_gen_asm)
@ -4698,7 +4697,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
in monadic_rewrite_gets_known[where m="NonDetMonad.lift f"
for f, folded bindE_def])
apply (simp add: NonDetMonad.lift_def isRight_case_sum)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rename_tac ep_cap2)
apply (rule_tac P="cteCap ep_cap2 = cteCap ep_cap" in monadic_rewrite_gen_asm)
apply (simp add: cap_case_EndpointCap_NotificationCap)
@ -4710,7 +4709,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (wp, simp)
apply (rule monadic_rewrite_bind_head)
apply (rule setThreadState_schact_set)
apply (wp getCTE_known_cap)
apply (wp getCTE_known_cap)+
apply (rule monadic_rewrite_bind)
apply (rule_tac t="capTCBPtr (cteCap replyCTE)"
and t'=thread
@ -4719,8 +4718,8 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (rule activateThread_simple_rewrite)
apply wp
apply (simp add: ct_in_state'_def)
apply (wp setCurThread_ct_in_state[folded st_tcb_at'_def]
Arch_switchToThread_pred_tcb')[2]
apply ((wp setCurThread_ct_in_state[folded st_tcb_at'_def]
Arch_switchToThread_pred_tcb')+)[2]
apply (simp add: catch_liftE)
apply (wp setEndpoint_obj_at_tcb' threadSet_pred_tcb_at_state[unfolded if_bool_eq_conj])
apply (simp cong: rev_conj_cong)
@ -4728,7 +4727,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (unfold setSchedulerAction_def)[3]
apply ((wp setThreadState_oa_queued user_getreg_rv setThreadState_no_sch_change
setThreadState_obj_at_unchanged
sts_st_tcb_at'_cases sts_bound_tcb_at'
sts_st_tcb_at'_cases sts_bound_tcb_at'
emptySlot_obj_at'_not_queued
emptySlot_cte_wp_at_cteCap
emptySlot_cnode_caps
@ -4739,7 +4738,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
hoare_vcg_ex_lift
| simp del: comp_apply
| clarsimp simp: obj_at'_weakenE[OF _ TrueI])+)
apply (wp getCTE_wp' gts_imp')
apply (wp getCTE_wp' gts_imp')+
apply (simp add: ARM_H.switchToThread_def bind_assoc)
apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse])
@ -4755,7 +4754,7 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
apply (simp add: bind_assoc catch_liftE
receiveIPC_def Let_def liftM_def
setThreadState_runnable_simp)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getThreadState)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getThreadState)+)
apply (rule monadic_rewrite_assert)
apply (rule_tac P="inj (case_bool thread (capTCBPtr (cteCap replyCTE)))"
@ -4783,24 +4782,24 @@ lemma fastpath_callKernel_SysReplyRecv_corres:
and F=True and E=False in monadic_rewrite_weaken)
apply (rule monadic_rewrite_isolate_final2)
apply simp
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rename_tac callerCTE)
apply (rule monadic_rewrite_assert)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_getCTE)
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_getCTE)+)
apply (rule monadic_rewrite_assert)
apply (simp add: emptySlot_setEndpoint_pivot)
apply (rule monadic_rewrite_bind)
apply (rule monadic_rewrite_refl2)
apply (clarsimp simp: isSendEP_def split: Structures_H.endpoint.split)
apply (rule_tac Q="\<lambda>rv. (\<lambda>_. rv = callerCTE) and Q'" for Q'
in monadic_rewrite_symb_exec_r, wp)
in monadic_rewrite_symb_exec_r, wp+)
apply (rule monadic_rewrite_gen_asm, simp)
apply (rule monadic_rewrite_trans, rule monadic_rewrite_bind_head,
rule_tac cte=callerCTE in emptySlot_replymaster_rewrite)
apply (simp add: bind_assoc o_def)
apply (rule monadic_rewrite_refl)
apply (simp add: cte_wp_at_ctes_of pred_conj_def)
apply (wp getCTE_ctes_wp)
apply (wp getCTE_ctes_wp)+
apply (clarsimp simp: fun_eq_iff if_flip
cong: if_cong)
apply (drule obj_at_ko_at', clarsimp)

3
proof/crefine/Finalise_C.thy
View File

@ -2011,7 +2011,7 @@ lemma finaliseCap_ccorres:
apply (simp add: ctcb_offset_def)
apply (simp add: mask_def irq_opt_relation_def)
apply (simp add: cap_get_tag_isCap)
apply wp
apply wp+
apply (rule ccorres_if_lhs)
apply (simp add: Let_def)
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
@ -2098,4 +2098,5 @@ lemma finaliseCap_ccorres:
apply (clarsimp simp add:mask_eq_ucast_eq)
done
end
end

8
proof/crefine/Interrupt_C.thy
View File

@ -168,7 +168,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
apply (simp add: liftE_alternative returnOk_liftE[symmetric])
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (wp sts_invs_minor')
apply (wp sts_invs_minor')+
apply (rule ccorres_Cond_rhs)
apply (rule ccorres_rhs_assoc)+
apply csymbr
@ -252,7 +252,7 @@ lemma decodeIRQHandlerInvocation_ccorres:
apply (simp add: liftE_alternative returnOk_liftE[symmetric])
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (wp sts_invs_minor')
apply (wp sts_invs_minor')+
apply (rule ccorres_Cond_rhs)
apply (rule ccorres_equals_throwError)
apply (fastforce simp: invocationCatch_def throwError_bind split: invocation_label.split)
@ -307,7 +307,7 @@ lemma invokeIRQControl_ccorres:
apply csymbr
apply (ctac(no_vcg) add: cteInsert_ccorres)
apply (rule ccorres_return_CE, simp+)[1]
apply wp
apply wp+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setIRQState_modifies)
apply (rule conjI)
@ -535,7 +535,7 @@ lemma decodeIRQControlInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_return_C_errorE, simp+)[1]
apply (wp sts_invs_minor')
apply (wp sts_invs_minor')+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply simp

19
proof/crefine/Invoke_C.thy
View File

@ -963,7 +963,7 @@ lemma decodeCNodeInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_return_C_errorE, simp+)[1]
apply (wp sts_valid_pspace_hangers)
apply (wp sts_valid_pspace_hangers)+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply (simp add: Collect_const_mem exception_defs)
@ -1028,7 +1028,7 @@ lemma decodeCNodeInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_return_C_errorE, simp+)[1]
apply (wp sts_invs_minor')
apply (wp sts_invs_minor')+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply (vcg exspec=setThreadState_modifies exspec=invokeCNodeRevoke_modifies)
@ -1043,7 +1043,7 @@ lemma decodeCNodeInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_return_C_errorE, simp+)[1]
apply (wp sts_invs_minor')
apply (wp sts_invs_minor')+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply (vcg exspec=setThreadState_modifies exspec=invokeCNodeDelete_modifies)
@ -1062,7 +1062,7 @@ lemma decodeCNodeInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_return_C_errorE, simp+)[1]
apply (wp sts_valid_pspace_hangers)
apply (wp sts_valid_pspace_hangers)+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply (simp add: dc_def[symmetric])
@ -1111,7 +1111,7 @@ lemma decodeCNodeInvocation_ccorres:
apply (rule ccorres_alternative2)
apply (rule ccorres_return_CE, simp+)[1]
apply (rule ccorres_return_C_errorE, simp+)[1]
apply (wp sts_invs_minor')
apply (wp sts_invs_minor')+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply (simp add: Collect_const_mem)
@ -1296,7 +1296,7 @@ lemma decodeCNodeInvocation_ccorres:
apply (rule ccorres_return_C_errorE, simp+)[1]
apply wp
apply (vcg exspec=invokeCNodeRotate_modifies)
apply (wp static_imp_wp)
apply (wp static_imp_wp)+
apply (simp add: Collect_const_mem)
apply (vcg exspec=setThreadState_modifies)
apply (simp add: Collect_const_mem)
@ -1407,7 +1407,6 @@ lemma decodeCNodeInvocation_ccorres:
cte_wp_at_ctes_of excaps_in_mem_def slotcap_in_mem_def
sysargs_rel_def length_ineq_not_Nil
dest!: interpret_excaps_eq)
(* why does auto with these rules take ten times as long? *)
apply ((rule conjI | clarsimp simp:split_def neq_Nil_conv
| erule pred_tcb'_weakenE disjE
| drule st_tcb_at_idle_thread')+)[1]
@ -1476,7 +1475,7 @@ lemma resetUntypedCap_gsCNodes_at_pt:
apply (wp mapME_x_wp' | simp add: unless_def)+
apply (wp hoare_vcg_const_imp_lift
deleteObjects_gsCNodes_at_pt
getSlotCap_wp)
getSlotCap_wp)+
apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
apply (frule(1) ctes_of_valid')
apply (clarsimp simp: valid_cap_simps' capAligned_def)
@ -2757,9 +2756,9 @@ lemma mapME_ensureEmptySlot':
"\<lbrace>P\<rbrace>
mapME (\<lambda>x. injection_handler Inl (ensureEmptySlot (f x))) slots
\<lbrace>\<lambda>rva s. P s \<and> (\<forall>slot \<in> set slots. (\<exists>cte. cteCap cte = capability.NullCap \<and> ctes_of s (f slot) = Some cte))\<rbrace>, -"
including no_pre
apply (induct slots arbitrary: P)
apply simp
apply wp
apply wpsimp
apply (rename_tac a slots P)
apply (simp add: mapME_def sequenceE_def Let_def)
apply (rule_tac Q="\<lambda>rv. P and (\<lambda>s. \<exists>cte. cteCap cte = capability.NullCap \<and> ctes_of s (f a) = Some cte)" in validE_R_sp)

22
proof/crefine/IpcCancel_C.thy
View File

@ -1144,7 +1144,7 @@ proof -
apply (simp only: dc_def[symmetric])
apply ctac
prefer 2
apply (wp, clarsimp, wp)
apply (wp, clarsimp, wp+)
apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
\<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
\<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
@ -1497,7 +1497,7 @@ proof -
apply (simp only: dc_def[symmetric])
apply ctac
prefer 2
apply (wp, clarsimp, wp)
apply (wp, clarsimp, wp+)
apply (rule_tac P="(\<lambda>s. \<forall>d p. (\<forall>t\<in>set (ksReadyQueues s (d, p)). obj_at' (inQ d p) t s)
\<and> distinct(ksReadyQueues s (d, p)))
and valid_queues' and obj_at' (inQ rva rvb) t
@ -1862,7 +1862,7 @@ proof -
apply (simp only: dc_def[symmetric])
apply ctac
prefer 2
apply (wp, clarsimp, wp)
apply (wp, clarsimp, wp+)
apply (rule_tac P="\<lambda>s. valid_queues s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p))
\<and> (\<exists>tcb. ko_at' tcb t s \<and> tcbDomain tcb =rva
\<and> tcbPriority tcb = rvb \<and> valid_tcb' tcb s)"
@ -2041,7 +2041,7 @@ lemma rescheduleRequired_ccorres:
max_word_def)
apply wp
apply (simp add: guard_is_UNIV_def)
apply wp
apply wp+
apply (simp add: getSchedulerAction_def)
apply (clarsimp simp: weak_sch_act_wf_def rf_sr_def cstate_relation_def
Let_def cscheduler_action_relation_def)
@ -2197,9 +2197,9 @@ lemma scheduleTCB_ccorres':
split: scheduler_action.split_asm)
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
cscheduler_action_relation_def)
apply wp
apply wp+
apply (simp add: getSchedulerAction_def)
apply wp
apply wp+
apply (simp add: isRunnable_def isBlocked_def)
apply wp
apply (simp add: guard_is_UNIV_def)
@ -2255,9 +2255,9 @@ lemma scheduleTCB_ccorres_valid_queues'_pre:
split: scheduler_action.split_asm)+
apply (clarsimp simp: rf_sr_def cstate_relation_def cscheduler_action_relation_def
split: scheduler_action.split_asm)
apply wp
apply wp+
apply (simp add: getSchedulerAction_def)
apply wp
apply wp+
apply (simp add: isRunnable_def isBlocked_def)
apply wp
apply (simp add: guard_is_UNIV_def)
@ -2293,7 +2293,7 @@ lemma rescheduleRequired_ccorres_valid_queues'_simple:
max_word_def)
apply wp
apply (simp add: guard_is_UNIV_def)
apply wp
apply wp+
apply (simp add: getSchedulerAction_def)
apply (clarsimp simp: weak_sch_act_wf_def rf_sr_def cstate_relation_def
Let_def cscheduler_action_relation_def)
@ -2348,9 +2348,9 @@ lemma scheduleTCB_ccorres_valid_queues'_pre_simple:
split: scheduler_action.split_asm)
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
cscheduler_action_relation_def)
apply wp
apply wp+
apply (simp add: getSchedulerAction_def)
apply wp
apply wp+
apply (simp add: isRunnable_def isBlocked_def)
apply wp
apply (simp add: guard_is_UNIV_def)

55
proof/crefine/Ipc_C.thy
View File

@ -234,11 +234,12 @@ lemma tcbFault_submonad_args:
lemma threadGet_stateAssert_gets:
"threadGet ext t = do stateAssert (tcb_at' t) []; gets (thread_fetch ext t) od"
including no_pre
apply (rule is_stateAssert_gets [OF _ _ empty_fail_threadGet no_fail_threadGet])
apply (clarsimp simp: threadGet_def liftM_def, wp)[1]
apply (simp add: threadGet_def liftM_def, wp getObject_tcb_at')
apply (simp add: threadGet_def liftM_def, wp)
apply (rule hoare_strengthen_post, wp getObject_obj_at')
apply (clarsimp simp: threadGet_def liftM_def, wp+)[1]
apply (simp add: threadGet_def liftM_def, (wp getObject_tcb_at')+)
apply (simp add: threadGet_def liftM_def, wp+)
apply (rule hoare_strengthen_post, (wp getObject_obj_at')+)
apply (simp add: objBits_def objBitsKO_def)+
apply (clarsimp simp: obj_at'_def thread_fetch_def projectKOs)
done
@ -516,7 +517,7 @@ lemma stateAssert_mapM_loadWordUser_comm:
do y \<leftarrow> mapM loadWordUser ptrs; x \<leftarrow> stateAssert P []; n od"
apply (rule bind_inv_inv_comm)
apply (wp stateAssert_inv)
apply (wp mapM_wp_inv)
apply (wp mapM_wp_inv)+
apply simp
done
@ -622,7 +623,7 @@ lemma handleFaultReply':
zip_Cons ARM_H.exceptionMessage_def
ARM.exceptionMessage_def
mapM_x_Cons mapM_x_Nil)
apply (rule monadic_rewrite_symb_exec_l, wp)
apply (rule monadic_rewrite_symb_exec_l, wp+)
apply (rule_tac P="tcb_at' s and tcb_at' r" in monadic_rewrite_inst)
apply (case_tac rv; (case_tac "msgLength tag < scast n_msgRegisters",
(erule disjE[OF word_less_cases],
@ -639,7 +640,7 @@ lemma handleFaultReply':
| wp asUser_tcb_at' lookupIPCBuffer_inv')+)+))
apply wp
(* capFault *)
apply (rule monadic_rewrite_symb_exec_l, wp empty_fail_asUser)+
apply (rule monadic_rewrite_symb_exec_l, (wp empty_fail_asUser)+)+
apply(case_tac rv)
apply (clarsimp
| rule monadic_rewrite_bind_tail monadic_rewrite_refl
@ -752,7 +753,7 @@ lemma handleFaultReply':
fromIntegral_simp1 fromIntegral_simp2 shiftL_word)
apply (clarsimp simp: mapM_def sequence_def bind_assoc asUser_bind_distrib
asUser_return submonad_asUser.fn_stateAssert bit_def)
apply wp
apply wp+
done
end
@ -952,7 +953,7 @@ lemma replyFromKernel_success_empty_ccorres [corres]:
apply vcg
apply wp
apply vcg
apply wp
apply wp+
apply (simp add: ARM_H.msgInfoRegister_def ARM.msgInfoRegister_def
Kernel_C.msgInfoRegister_def Kernel_C.R1_def
ARM_H.badgeRegister_def ARM.badgeRegister_def
@ -1518,10 +1519,9 @@ lemma exceptionMessage_ccorres:
= index exceptionMessageC n"
apply (simp add: exceptionMessageC_def ARM_H.exceptionMessage_def
ARM.exceptionMessage_def MessageID_Exception_def)
apply (simp add: Arrays.update_def n_exceptionMessage_def fcp_beta nth_Cons'
fupdate_def
split: if_split)
done
by (simp add: Arrays.update_def n_exceptionMessage_def fcp_beta nth_Cons'
fupdate_def
split: if_split)
lemma asUser_obj_at_elsewhere:
"\<lbrace>obj_at' (P :: tcb \<Rightarrow> bool) t' and (\<lambda>_. t \<noteq> t')\<rbrace> asUser t m \<lbrace>\<lambda>rv. obj_at' P t'\<rbrace>"
@ -1633,6 +1633,7 @@ proof -
have mapM_x_return_gen: "\<And>v w xs. mapM_x (\<lambda>_. return v) xs = return w" (* FIXME mapM_x_return *)
by (induct_tac xs; simp add: mapM_x_Nil mapM_x_Cons)
show ?thesis
including no_pre
apply (unfold K_def)
apply (intro ccorres_gen_asm)
apply (cinit' lift: sender_' receiver_' receiveIPCBuffer_'
@ -1958,7 +1959,7 @@ proof -
apply (ctac(no_vcg) add: setMRs_lookup_failure_ccorres[unfolded msgMaxLength_unfold])
apply simp
apply (rule ccorres_return_C, simp+)[1]
apply (wp setMR_tcbFault_obj_at hoare_case_option_wp)
apply (wp setMR_tcbFault_obj_at hoare_case_option_wp)+
apply (clarsimp simp: option_to_ptr_def Collect_const_mem guard_is_UNIV_def)
apply (rule conjI)
apply (simp add: seL4_CapFault_InRecvPhase_def)
@ -2275,14 +2276,14 @@ lemma loadCapTransfer_ctReceiveDepth:
apply simp
apply (simp only: word_bits_len_of[symmetric])
apply (subst unat_lt2p, simp)
apply wp
done
apply wp+
done
(* FIXME: move *)
lemma cte_at_0' [dest!]:
"\<lbrakk> cte_at' 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> False"
apply (clarsimp simp: cte_wp_at_obj_cases')
apply (auto simp: tcb_cte_cases_def is_aligned_def dest!:tcb_aligned' split: if_split_asm)
done
by (auto simp: tcb_cte_cases_def is_aligned_def dest!:tcb_aligned' split: if_split_asm)
lemma getReceiveSlots_ccorres:
"ccorres (\<lambda>a c. (a = [] \<or> (\<exists>slot. a = [slot])) \<and>
@ -2354,7 +2355,7 @@ lemma getReceiveSlots_ccorres:
apply (simp add: cct_relation_def)
apply (case_tac rv, clarsimp)
apply (rule UNIV_I) -- "still a schematic here ..."
done
done
lemma setExtraBadge_ccorres:
@ -3088,7 +3089,7 @@ lemma transferCaps_ccorres [corres]:
apply (rule_tac R'=UNIV in ccorres_split_throws [OF ccorres_return_C], simp_all)[1]
apply vcg
apply simp
apply (wp empty_fail_getReceiveSlots)[3]
apply ((wp empty_fail_getReceiveSlots)+)[3]
apply (simp add: message_info_to_H_def word_sless_def word_sle_def)
apply (simp add: option_to_0_def ccorres_cond_iffs
interpret_excaps_test_null excaps_map_def
@ -3139,6 +3140,7 @@ lemma transferCaps_ccorres [corres]:
(* FIXME: move *)
lemma getMessageInfo_le3:
"\<lbrace>\<top>\<rbrace> getMessageInfo sender \<lbrace>\<lambda>rv s. unat (msgExtraCaps rv) \<le> 3\<rbrace>"
including no_pre
apply (simp add: getMessageInfo_def)
apply wp
apply (rule_tac Q="\<lambda>_. \<top>" in hoare_strengthen_post)
@ -3146,10 +3148,11 @@ lemma getMessageInfo_le3:
apply (simp add: messageInfoFromWord_def Let_def msgExtraCapBits_def)
apply (cut_tac y="r >> Types_H.msgLengthBits" in word_and_le1 [where a=3])
apply (simp add: word_le_nat_alt)
done
done
lemma getMessageInfo_msgLength:
"\<lbrace>\<top>\<rbrace> getMessageInfo sender \<lbrace>\<lambda>rv. K (unat (msgLength rv) \<le> msgMaxLength)\<rbrace>"
including no_pre
apply (simp add: getMessageInfo_def)
apply wp
apply (rule_tac Q="\<lambda>_. \<top>" in hoare_strengthen_post)
@ -3336,7 +3339,7 @@ proof -
unat_of_nat32[unfolded word_bits_conv]
word_of_nat_less)
apply (simp add: word_less_nat_alt)
apply wp
apply wp+
apply (clarsimp simp: ccorres_cond_iffs)
apply (rule_tac P= \<top>
and P'="{x. errstate x= lu_ret___struct_lookupSlot_raw_ret_C \<and>
@ -5217,9 +5220,9 @@ lemma sendIPC_ccorres [corres]:
apply (fastforce simp: weak_sch_act_wf_def valid_tcb_state'_def
elim: obj_at'_weakenE)
apply (wp attemptSwitchTo_sch_act_not sts_st_tcb' hoare_vcg_all_lift
attemptSwitchTo_ksQ sts_valid_queues sts_ksQ')
attemptSwitchTo_ksQ sts_valid_queues sts_ksQ')+
apply (clarsimp simp: valid_tcb_state'_def)
apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)
apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift)+
apply (rule_tac Q="\<lambda>rv. valid_queues and valid_pspace' and valid_objs'
and valid_mdb' and tcb_at' dest and cur_tcb'
and tcb_at' thread and K (dest \<noteq> thread)
@ -5229,8 +5232,8 @@ lemma sendIPC_ccorres [corres]:
in hoare_post_imp)
apply (clarsimp simp: st_tcb_at'_def obj_at'_def is_tcb weak_sch_act_wf_def)
apply (wp setEndpoint_ksQ hoare_vcg_all_lift set_ep_valid_objs'
setEndpoint_valid_mdb')
apply (clarsimp simp: guard_is_UNIV_def ThreadState_Inactive_def
setEndpoint_valid_mdb')+
apply (clarsimp simp: guard_is_UNIV_def ThreadState_Inactive_def
ThreadState_Running_def mask_def from_bool_def
option_to_ptr_def option_to_0_def
split: bool.split_asm)

37
proof/crefine/IsolatedThreadAction.thy
View File

@ -585,7 +585,7 @@ lemma monadic_rewrite_in_isolate_thread_actions:
apply (rule monadic_rewrite_bind_tail)+
apply (rule_tac P="\<lambda>_. P s" in monadic_rewrite_bind_head)
apply (simp add: monadic_rewrite_def select_f_def)
apply wp
apply wp+
apply simp
done
@ -669,7 +669,7 @@ lemma select_f_isolatable:
split_def select_f_selects liftM_def bind_assoc)
apply (rule monadic_rewrite_imp, rule monadic_rewrite_transverse)
apply (rule monadic_rewrite_drop_modify monadic_rewrite_bind_tail)+
apply wp
apply wp+
apply (simp add: gets_bind_ign getSchedulerAction_def)
apply (rule monadic_rewrite_refl)
apply (simp add: ksPSpace_update_partial_id o_def)
@ -768,11 +768,12 @@ lemma transferCaps_simple_rewrite:
"monadic_rewrite True True ((\<lambda>_. caps = []) and \<top>)
(transferCaps mi caps ep r rBuf)
(return (mi \<lparr> msgExtraCaps := 0, msgCapsUnwrapped := 0 \<rparr>))"
including no_pre
apply (rule monadic_rewrite_gen_asm)
apply (rule monadic_rewrite_imp)
apply (rule monadic_rewrite_trans)
apply (simp add: transferCaps_simple, rule monadic_rewrite_refl)
apply (rule monadic_rewrite_symb_exec2, wp empty_fail_getReceiveSlots)
apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_getReceiveSlots)+)
apply (rule monadic_rewrite_refl)
apply simp
done
@ -836,13 +837,13 @@ lemma doIPCTransfer_simple_rewrite:
apply (rule_tac P="fault = None" in monadic_rewrite_gen_asm, simp)
apply (rule monadic_rewrite_bind_tail)
apply (rule_tac x=msgInfo in monadic_rewrite_symb_exec,
wp empty_fail_user_getreg user_getreg_rv)
(wp empty_fail_user_getreg user_getreg_rv)+)
apply (simp add: lookupExtraCaps_simple_rewrite returnOk_catch_bind)
apply (rule monadic_rewrite_bind)
apply (rule monadic_rewrite_from_simple, rule copyMRs_simple)
apply (rule monadic_rewrite_bind_head)
apply (rule transferCaps_simple_rewrite)
apply (wp threadGet_const)
apply (wp threadGet_const)+
apply (simp add: bind_assoc)
apply (rule monadic_rewrite_symb_exec2[OF lookupIPC_inv empty_fail_lookupIPCBuffer]
monadic_rewrite_symb_exec2[OF threadGet_inv empty_fail_threadGet]
@ -895,7 +896,7 @@ lemma setThreadState_blocked_rewrite:
in monadic_rewrite_gen_asm)
apply (simp add: when_def)
apply (rule monadic_rewrite_refl)
apply wp
apply wp+
apply (rule monadic_rewrite_symb_exec2,
(wp empty_fail_isRunnable
| (simp only: getCurThread_def getSchedulerAction_def
@ -939,8 +940,8 @@ lemma setupCallerCap_rewrite:
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec2, (wp | simp)+)+
apply (rule monadic_rewrite_refl)
apply wp
apply (rule monadic_rewrite_symb_exec2, wp empty_fail_getCTE)+
apply wp+
apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_getCTE)+)+
apply (rule monadic_rewrite_refl)
apply (wp getCTE_wp' | simp add: cte_wp_at_ctes_of)+
apply (clarsimp simp: reply_masters_rvk_fb_def)
@ -971,11 +972,11 @@ lemma attemptSwitchTo_rewrite:
in monadic_rewrite_gen_asm)
apply (simp add: eq_commute le_less[symmetric])
apply (rule monadic_rewrite_refl)
apply (wp threadGet_wp)
apply (wp threadGet_wp)+
apply (rule monadic_rewrite_trans)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec2,
wp empty_fail_threadGet | simp add: getSchedulerAction_def curDomain_def)+
(wp empty_fail_threadGet)+ | simp add: getSchedulerAction_def curDomain_def)+
apply (rule monadic_rewrite_refl)
apply wp
apply (rule monadic_rewrite_symb_exec2, simp_all add: getCurThread_def)
@ -1067,7 +1068,7 @@ lemma schedule_rewrite:
apply (rule monadic_rewrite_bind_tail)
apply (rule_tac P="curRunnable \<and> action = SwitchToThread t" in monadic_rewrite_gen_asm, simp)
apply (rule monadic_rewrite_refl)
apply (wp,simp,wp)
apply (wp,simp,wp+)
apply (rule monadic_rewrite_trans)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec2, wp | simp add: isRunnable_def getSchedulerAction_def)+
@ -1096,7 +1097,7 @@ lemma schedule_rewrite_ct_not_runnable':
apply (rule monadic_rewrite_bind_tail)
apply (rule_tac P="\<not> curRunnable \<and> action = SwitchToThread t" in monadic_rewrite_gen_asm,simp)
apply (rule monadic_rewrite_refl)
apply (wp,simp,wp)
apply (wp,simp,wp+)
apply (rule monadic_rewrite_trans)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec2, wp |
@ -1122,7 +1123,7 @@ lemma activateThread_simple_rewrite:
apply simp
apply (rule monadic_rewrite_refl)
apply wp
apply (rule monadic_rewrite_symb_exec2, wp empty_fail_getThreadState)
apply (rule monadic_rewrite_symb_exec2, (wp empty_fail_getThreadState)+)
apply (rule monadic_rewrite_refl)
apply wp
apply (rule monadic_rewrite_symb_exec2,
@ -1169,7 +1170,7 @@ lemma setThreadState_no_sch_change:
apply (rule_tac Q="\<lambda>_. ?P and st_tcb_at' (op = st) t" in hoare_post_imp)
apply (clarsimp split: if_split)
apply (clarsimp simp: obj_at'_def st_tcb_at'_def projectKOs)
apply (rule hoare_pre, wp threadSet_pred_tcb_at_state)
apply (wp threadSet_pred_tcb_at_state)
apply simp
done
@ -1419,7 +1420,7 @@ lemma tcbSchedDequeue_rewrite:
apply (rule monadic_rewrite_refl)
apply (wp threadGet_const)
apply (rule monadic_rewrite_symb_exec2)
apply wp
apply wp+
apply (rule monadic_rewrite_refl)
apply (clarsimp)
done
@ -1436,10 +1437,10 @@ lemma switchToThread_rewrite:
apply (rule monadic_rewrite_bind)
apply (rule tcbSchedDequeue_rewrite)
apply (rule monadic_rewrite_refl)
apply (wp Arch_switchToThread_obj_at_pre)
apply (wp Arch_switchToThread_obj_at_pre)+
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_symb_exec)
apply (wp, simp)
apply (wp+, simp)
apply (rule monadic_rewrite_refl)
apply (wp)
apply (clarsimp simp: comp_def)
@ -1642,7 +1643,7 @@ lemma monadic_rewrite_isolate_final2:
\<and> sa = ksSchedulerAction s)"
in monadic_rewrite_refl3)
apply (clarsimp simp: exec_modify eqs return_def)
apply wp
apply wp+
apply (clarsimp simp: o_def eqs)
done

6
proof/crefine/Machine_C.thy
View File

@ -523,7 +523,7 @@ lemma cleanCacheRange_RAM_ccorres:
apply (rule ccorres_Guard_Seq)
apply (rule ccorres_basic_srnoop2, simp)
apply (ctac (no_vcg) add: cleanL2Range_ccorres[unfolded dc_def])
apply wp
apply wp+
apply clarsimp
apply (auto dest: ghost_assertion_size_logic simp: o_def)
done
@ -693,7 +693,7 @@ lemma cleanCaches_PoU_ccorres:
apply (ctac (no_vcg) add: dsb_ccorres)
apply (ctac (no_vcg) add: invalidate_I_PoU_ccorres)
apply (ctac (no_vcg) add: dsb_ccorres)
apply wp
apply wp+
apply clarsimp
done
@ -710,7 +710,7 @@ lemma setCurrentPD_ccorres:
apply (ctac (no_vcg) add: dsb_ccorres)
apply (ctac (no_vcg) add: writeTTBR0_ccorres)
apply (ctac (no_vcg) add: isb_ccorres)
apply wp
apply wp+
apply clarsimp
done

3
proof/crefine/Recycle_C.thy
View File

@ -911,8 +911,9 @@ lemma tcbSchedEnqueue_ep_at:
"\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ep\<rbrace>
tcbSchedEnqueue t
\<lbrace>\<lambda>rv. obj_at' P ep\<rbrace>"
including no_pre
apply (simp add: tcbSchedEnqueue_def unless_def null_def)
apply (wp threadGet_wp, clarsimp, wp)
apply (wp threadGet_wp, clarsimp, wp+)
apply (clarsimp split: if_split, wp)
done

2
proof/crefine/Refine_C.thy
View File

@ -691,7 +691,7 @@ lemma entry_corres_C:
prefer 2
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
apply (rule getContext_corres, simp)
apply (wp threadSet_all_invs_triv' callKernel_cur)
apply (wp threadSet_all_invs_triv' callKernel_cur)+
apply (clarsimp simp: all_invs'_def invs'_def cur_tcb'_def)
apply simp
done

15
proof/crefine/Retype_C.thy
View File

@ -6993,14 +6993,15 @@ lemma createObject_untypedRange:
Q {ptr..ptr + 2 ^ us - 1} s) \<and>
(toAPIType ty \<noteq> Some apiobject_type.Untyped \<longrightarrow> Q {} s)\<rbrace>"
shows "\<lbrace>P\<rbrace> createObject ty ptr us dev\<lbrace>\<lambda>m s. Q (untypedRange m) s\<rbrace>"
including no_pre
using split
apply (simp add: createObject_def)
apply (case_tac "toAPIType ty")
apply (simp add: split untypedRange.simps | wp)+
apply (simp add: split | wp)+
apply (simp add: valid_def return_def bind_def split_def)
apply (case_tac a, simp_all)
apply (simp add: untypedRange.simps valid_def return_def simpler_gets_def
simpler_modify_def bind_def split_def curDomain_def)+
apply (simp add: valid_def return_def simpler_gets_def simpler_modify_def
bind_def split_def curDomain_def)+
done
lemma createObject_capRange:
@ -7206,8 +7207,7 @@ lemma insertNewCap_untypedRange:
insertNewCap srcSlot destSlot x
\<lbrace>\<lambda>rv s. cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and> P untypedRange (cteCap cte)) srcSlot s\<rbrace>"
apply (simp add:insertNewCap_def)
apply (wp updateMDB_weak_cte_wp_at )
apply (wp setCTE_cte_wp_at_other getCTE_wp)
apply (wp updateMDB_weak_cte_wp_at setCTE_cte_wp_at_other getCTE_wp)
apply (clarsimp simp:cte_wp_at_ctes_of)
done
@ -7820,8 +7820,7 @@ lemma insertNewCap_ccorres:
apply (clarsimp simp: ccap_relation_def map_option_Some_eq2)
apply (simp add: untypedZeroRange_def Let_def)
done
find_theorems untypedZeroRange
term zero_ranges_are_zero
lemma createObject_untyped_region_is_zero_bytes:
"\<forall>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {s. let tp = (object_type_to_H (t_' s));
sz = APIType_capBits tp (unat (userSize_' s))
@ -8133,7 +8132,7 @@ shows "ccorres dc xfdc
hoare_vcg_prop createObject_gsCNodes_p createObject_cnodes_have_size)
apply (rule hoare_vcg_conj_lift[OF createObject_capRange_helper])
apply (wp createObject_cte_wp_at' createObject_ex_cte_cap_wp_to
createObject_no_inter[where sz = sz] hoare_vcg_all_lift static_imp_wp)
createObject_no_inter[where sz = sz] hoare_vcg_all_lift static_imp_wp)+
apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace'
field_simps range_cover.sz conj_comms range_cover.aligned range_cover_sz'
is_aligned_shiftl_self aligned_add_aligned[OF range_cover.aligned])

14
proof/crefine/Schedule_C.thy
View File

@ -101,9 +101,7 @@ qed
(* FIXME move *)
lemma setVMRoot_valid_queues':
"\<lbrace> valid_queues' \<rbrace> setVMRoot a \<lbrace> \<lambda>_. valid_queues' \<rbrace>"
apply (rule valid_queues_lift')
apply wp
done
by (rule valid_queues_lift'; wp)
(* FIXME move to REFINE *)
crunch valid_queues'[wp]: "Arch.switchToThread" valid_queues'
@ -180,7 +178,7 @@ lemma switchToIdleThread_ccorres:
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
carch_state_relation_def cmachine_state_relation_def)
apply (simp add: ARM_H.switchToIdleThread_def)
apply wp
apply wp+
apply simp
apply simp
done
@ -223,7 +221,7 @@ lemma switchToThread_ccorres:
apply (clarsimp simp: setCurThread_def simpler_modify_def)
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
carch_state_relation_def cmachine_state_relation_def)
apply wp
apply wp+
apply (clarsimp simp: all_invs_but_ct_idle_or_in_cur_domain'_def valid_state'_def)
done
@ -629,7 +627,7 @@ proof -
apply clarsimp
apply vcg_step (* vcg creates a state that's not printable in a sane amount of time *)
apply clarsimp
apply wp
apply wp+
apply (simp add: isRunnable_def)
apply wp
apply (rename_tac s' d)
@ -809,7 +807,7 @@ lemma schedule_ccorres:
apply (ctac (no_vcg) add: chooseThread_ccorres)
apply (rule ccorres_setSchedulerAction[unfolded dc_def])
apply (simp add: cscheduler_action_relation_def)
apply (wp nextDomain_invs_no_cicd')
apply (wp nextDomain_invs_no_cicd')+
apply clarsimp
apply assumption
(* else branch for rvb *)
@ -839,7 +837,7 @@ lemma schedule_ccorres:
apply (ctac (no_vcg) add: chooseThread_ccorres)
apply (rule ccorres_setSchedulerAction[unfolded dc_def])
apply (simp add: cscheduler_action_relation_def)
apply (wp nextDomain_invs_no_cicd')
apply (wp nextDomain_invs_no_cicd')+
apply clarsimp
apply assumption
(* else branch for rv *)

30
proof/crefine/SyscallArgs_C.thy
View File

@ -48,11 +48,11 @@ lemmas replyOnRestart_typ_ats[wp] = typ_at_lifts [OF replyOnRestart_typ_at']
lemma replyOnRestart_invs'[wp]:
"\<lbrace>invs'\<rbrace> replyOnRestart thread reply isCall \<lbrace>\<lambda>rv. invs'\<rbrace>"
including no_pre
apply (simp add: replyOnRestart_def)
apply (wp setThreadState_nonqueued_state_update rfk_invs' static_imp_wp)
apply (rule hoare_vcg_all_lift)
apply (wp setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift rfk_ksQ)
apply (rule hoare_strengthen_post, rule gts_sp')
apply (clarsimp simp: pred_tcb_at')
apply (auto elim!: pred_tcb'_weakenE st_tcb_ex_cap''
@ -173,7 +173,7 @@ lemma preemptionPoint_ccorres:
apply (simp add: from_bool_0 whenE_def returnOk_def throwError_def
return_def split: option.splits)
apply (clarsimp simp: cintr_def exception_defs)
apply wp
apply wp+
apply vcg
apply (unfold modifyWorkUnits_def)[1]
apply wp
@ -557,7 +557,7 @@ lemma is_nondet_refinement_bind:
"\<lbrakk> is_nondet_refinement a c; \<And>rv. is_nondet_refinement (b rv) (d rv) \<rbrakk>
\<Longrightarrow> is_nondet_refinement (a >>= b) (c >>= d)"
apply (clarsimp simp: is_nondet_refinement_def bind_def split_def)
apply blast
apply fast
done
lemma is_nondet_refinement_bindE:
@ -643,10 +643,10 @@ lemma asUser_cur_obj_at':
asUser t f \<lbrace>\<lambda>rv s. obj_at' (\<lambda>tcb. Q rv (atcbContextGet (tcbArch tcb))) (ksCurThread s) s\<rbrace>"
apply (simp add: asUser_def split_def)
apply (wp)
apply (rule hoare_lift_Pf2 [where f=ksCurThread])
apply (wp threadSet_obj_at'_really_strongest)
apply (clarsimp simp: threadGet_def)
apply (wp getObject_tcb_wp)
apply (rule hoare_lift_Pf2 [where f=ksCurThread])
apply (wp threadSet_obj_at'_really_strongest)+
apply (clarsimp simp: threadGet_def)
apply (wp getObject_tcb_wp)
apply clarsimp
apply (drule obj_at_ko_at')
apply clarsimp
@ -683,16 +683,15 @@ lemma getMRs_tcbContext:
apply (elim conjE)
apply (thin_tac "thread = t" for t)
apply (clarsimp simp add: getMRs_def)
apply (rule hoare_pre)
apply (wp|wpc)+
apply (rule_tac P="n < length x" in hoare_gen_asm)
apply (clarsimp simp: nth_append)
apply (wp mapM_wp' static_imp_wp)
apply (wp|wpc)+
apply (rule_tac P="n < length x" in hoare_gen_asm)
apply (clarsimp simp: nth_append)
apply (wp mapM_wp' static_imp_wp)+
apply simp
apply (rule asUser_cur_obj_at')
apply (simp add: getRegister_def msgRegisters_unfold)
apply (simp add: mapM_Cons bind_assoc mapM_empty)
apply wp[1]
apply wp
apply (wp hoare_drop_imps hoare_vcg_all_lift)
apply (wp asUser_cur_obj_at')
apply (simp add: getRegister_def msgRegisters_unfold)
@ -1069,8 +1068,7 @@ lemma getMRs_user_word:
defer
apply simp
apply (wp asUser_const_rv)
apply (simp add: msgRegisters_unfold n_msgRegisters_def)
apply simp
apply (simp add: msgRegisters_unfold n_msgRegisters_def)
apply (erule_tac x="unat i - unat n_msgRegisters" in allE)
apply (erule impE)
apply (simp add: msgRegisters_unfold
@ -1169,7 +1167,7 @@ lemma getMRs_length:
apply (simp add: getMRs_def)
apply (rule hoare_pre, wp)
apply simp
apply (wp mapM_length asUser_const_rv mapM_length)
apply (wp mapM_length asUser_const_rv mapM_length)+
apply (clarsimp simp: length_msgRegisters)
apply (simp add: min_def split: if_splits)
apply (clarsimp simp: word_le_nat_alt)

20
proof/crefine/Syscall_C.thy
View File

@ -204,7 +204,7 @@ lemma decodeInvocation_ccorres:
apply simp
apply (rule hoare_use_eq[where f=ksCurThread])
apply (wp sts_invs_minor' sts_st_tcb_at'_cases
setThreadState_ct' hoare_vcg_all_lift sts_ksQ')
setThreadState_ct' hoare_vcg_all_lift sts_ksQ')+
apply simp
apply (vcg exspec=setThreadState_modifies)
apply vcg
@ -536,7 +536,7 @@ lemma handleDoubleFault_ccorres:
apply (ctac (no_vcg))
apply (rule ccorres_symb_exec_l)
apply (rule ccorres_return_Skip)
apply (wp asUser_inv getRestartPC_inv)
apply (wp asUser_inv getRestartPC_inv)+
apply (rule empty_fail_asUser)
apply (simp add: getRestartPC_def)
apply wp
@ -781,6 +781,7 @@ lemma handleFault_ccorres:
lemma getMessageInfo_less_4:
"\<lbrace>\<top>\<rbrace> getMessageInfo t \<lbrace>\<lambda>rv s. msgExtraCaps rv < 4\<rbrace>"
including no_pre
apply (simp add: getMessageInfo_def)
apply wp
apply (rule hoare_strengthen_post, rule hoare_vcg_prop)
@ -815,7 +816,7 @@ lemma getMRs_length:
apply (simp add: getMRs_def)
apply (rule hoare_pre, wp)
apply simp
apply (wp mapM_length asUser_const_rv mapM_length)
apply (wp mapM_length asUser_const_rv mapM_length)+
apply (clarsimp simp: length_msgRegisters)
apply (simp add: min_def split: if_splits)
apply (clarsimp simp: word_le_nat_alt)
@ -824,6 +825,7 @@ lemma getMRs_length:
lemma getMessageInfo_msgLength':
"\<lbrace>\<top>\<rbrace> getMessageInfo t \<lbrace>\<lambda>rv s. msgLength rv \<le> 0x78\<rbrace>"
including no_pre
apply (simp add: getMessageInfo_def)
apply wp
apply (rule hoare_strengthen_post, rule hoare_vcg_prop)
@ -925,7 +927,7 @@ lemma handleInvocation_ccorres:
apply (ctac(no_vcg) add: replyFromKernel_success_empty_ccorres)
apply (ctac(no_vcg) add: setThreadState_ccorres)
apply (rule ccorres_return_CE[folded return_returnOk], simp+)[1]
apply (wp)
apply wp+
apply (rule hoare_strengthen_post, rule rfk_invs')
apply auto[1]
apply simp
@ -1028,7 +1030,7 @@ lemma handleInvocation_ccorres:
apply clarsimp
apply (vcg exspec= lookupCapAndSlot_modifies)
apply simp
apply (wp getMessageInfo_less_4 getMessageInfo_le3 getMessageInfo_msgLength')
apply (wp getMessageInfo_less_4 getMessageInfo_le3 getMessageInfo_msgLength')+
apply (simp add: msgMaxLength_def, wp getMessageInfo_msgLength')[1]
apply simp
apply wp
@ -1214,7 +1216,7 @@ lemma deleteCallerCap_ccorres [corres]:
gs_set_assn_Delete_cstate_relation[unfolded o_def])
apply (wp | simp)+
apply (simp add: getSlotCap_def)
apply (wp getCTE_wp)
apply (wp getCTE_wp)+
apply clarsimp
apply (simp add: guard_is_UNIV_def ghost_assertion_data_get_def
ghost_assertion_data_set_def)
@ -1639,7 +1641,7 @@ lemma getIRQSlot_ccorres3:
apply (clarsimp simp: getIRQSlot_ccorres_stuff
objBits_simps cte_level_bits_def
ucast_nat_def uint_ucast uint_up_ucast is_up)
apply wp
apply wp+
done
lemma ucast_eq_0[OF refl]:
@ -1851,7 +1853,7 @@ lemma handleInterrupt_ccorres:
apply (ctac (no_vcg) add: sendSignal_ccorres)
apply (ctac (no_vcg) add: maskInterrupt_ccorres)
apply (ctac add: ackInterrupt_ccorres [unfolded dc_def])
apply wp
apply wp+
apply (simp del: Collect_const)
apply (rule ccorres_cond_true_seq)
apply (rule ccorres_rhs_assoc)+
@ -1884,7 +1886,7 @@ lemma handleInterrupt_ccorres:
apply (ctac (no_vcg) add: timerTick_ccorres)
apply (ctac (no_vcg) add: resetTimer_ccorres)
apply (ctac add: ackInterrupt_ccorres )
apply wp
apply wp+
apply (simp add: Platform_maxIRQ maxIRQ_def del: Collect_const)
apply (rule ccorres_move_const_guards)+
apply (rule ccorres_cond_false_seq)

2
proof/crefine/TcbAcc_C.thy
View File

@ -114,7 +114,7 @@ lemma getRegister_ccorres [corres]:
apply (rule refl)
apply (erule threadSet_eq)
apply (clarsimp simp: ctcb_relation_def ccontext_relation_def carch_tcb_relation_def)
apply (wp threadGet_obj_at2)
apply (wp threadGet_obj_at2)+
apply simp
apply simp
apply (erule obj_atE')

38
proof/crefine/Tcb_C.thy
View File

@ -13,17 +13,18 @@ imports Move Delete_C Ipc_C
begin
lemma asUser_obj_at' :
" \<lbrace> K(t\<noteq>t') and obj_at' P t' \<rbrace> asUser t f \<lbrace> \<lambda>_. obj_at' (P::Structures_H.tcb \<Rightarrow> bool) t' \<rbrace>"
apply (simp add: asUser_def )
"\<lbrace> K(t\<noteq>t') and obj_at' P t' \<rbrace> asUser t f \<lbrace> \<lambda>_. obj_at' (P::Structures_H.tcb \<Rightarrow> bool) t' \<rbrace>"
including no_pre
apply (simp add: asUser_def)
apply wp
apply (simp add: split_def)
apply (wp threadSet_obj_at'_strongish)
apply (simp add: split_def)
apply (wp threadSet_obj_at'_strongish)+
apply (case_tac "t=t'")
apply clarsimp
apply clarsimp
apply (rule hoare_drop_imps)+
apply wp
done
done
lemma getObject_sched:
@ -355,8 +356,10 @@ lemma getMRs_rel_state:
apply (erule doMachineOp_state)
done
(* FIXME: move *)
lemma setTCB_cur:
"\<lbrace>cur_tcb'\<rbrace> setObject t (v::tcb) \<lbrace>\<lambda>_. cur_tcb'\<rbrace>"
including no_pre
apply (wp cur_tcb_lift)
apply (simp add: setObject_def split_def updateObject_default_def)
apply wp
@ -985,7 +988,7 @@ lemma restart_ccorres:
apply (wp sts_valid_queues setThreadState_st_tcb)[1]
apply (simp add: valid_tcb_state'_def)
apply wp
apply (wp_once sch_act_wf_lift, wp tcb_in_cur_domain'_lift)
apply (wp_once sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+)
apply (rule hoare_strengthen_post)
apply (rule hoare_vcg_conj_lift)
apply (rule delete_one_conc_fr.cancelIPC_invs)
@ -1092,7 +1095,7 @@ lemma invokeTCB_CopyRegisters_ccorres:
apply simp
apply (ctac(no_vcg) add: getRestartPC_ccorres)
apply (ctac add: setNextPC_ccorres)
apply wp
apply wp+
apply (clarsimp simp: guard_is_UNIV_def)
apply (rule ccorres_split_nothrow_novcg_dc)
apply (rule ccorres_when[where R=\<top>])
@ -1367,7 +1370,7 @@ lemma asUser_getMRs_rel:
apply wp
apply (simp del: fun_upd_apply)
apply (wp getObject_tcb_wp)
apply (wp threadGet_wp)
apply (wp threadGet_wp)+
apply (clarsimp simp del: fun_upd_apply)
apply (drule obj_at_ko_at')+
apply (clarsimp simp del: fun_upd_apply)
@ -1508,12 +1511,12 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
apply (rule ccorres_return_CE, simp+)[1]
apply wp
apply (simp add: guard_is_UNIV_def)
apply wp
apply (simp del: hoare_post_taut)
apply wp+
apply simp
apply (rule mapM_x_wp')
apply (rule hoare_pre, wp)
apply clarsimp
apply (simp del: hoare_post_taut)
apply simp
apply wp
apply (simp add: guard_is_UNIV_def)
apply (rule hoare_drop_imps)
@ -1521,8 +1524,7 @@ lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]:
apply (wp mapM_x_wp')
apply (rule hoare_pre, wp asUser_sysargs_rel)
apply clarsimp
apply (rule hoare_pre, wp)
apply simp
apply wpsimp
apply (simp add: guard_is_UNIV_def)
apply (wp)
apply vcg
@ -2004,11 +2006,11 @@ shows
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
apply (rule allI, rule conseqPre, vcg)
apply (simp add: return_def)
apply wp
apply wp+
apply (simp cong: rev_conj_cong)
apply wp
apply (wp asUser_inv mapM_wp' getRegister_inv
asUser_get_registers[simplified] static_imp_wp)
asUser_get_registers[simplified] static_imp_wp)+
apply (rule hoare_strengthen_post, rule asUser_get_registers)
apply (clarsimp simp: obj_at'_def genericTake_def
frame_gp_registers_convs)
@ -2966,7 +2968,7 @@ lemma decodeTCBConfigure_ccorres:
apply (rule ccorres_cond_true_seq)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
apply wp
apply wp+
apply (rule ccorres_rhs_assoc)+
apply csymbr
apply (simp del: Collect_const)
@ -3986,7 +3988,7 @@ lemma decodeSetSpace_ccorres:
apply (rule ccorres_cond_true_seq)
apply (rule syscall_error_throwError_ccorres_n)
apply (simp add: syscall_error_to_H_cases)
apply wp
apply wp+
apply (rule ccorres_rhs_assoc)+
apply csymbr
apply (simp add: tcb_cnode_index_defs[THEN ptr_add_assertion_positive[OF ptr_add_assertion_positive_helper]]
@ -4074,7 +4076,7 @@ lemma decodeSetSpace_ccorres:
apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+)
apply vcg
apply simp
apply (wp hoare_drop_imps)[1]
apply (wp hoare_drop_imps)
apply (wp injection_wp_E [OF refl])
apply (simp add: Collect_const_mem cintr_def intr_and_se_rel_def
all_ex_eq_helper syscall_error_rel_def

30
proof/crefine/VSpace_C.thy
View File

@ -278,7 +278,7 @@ lemma loadHWASID_ccorres:
apply simp
apply wp[1]
apply (rule findPDForASIDAssert_pd_at_wp2)
apply wp
apply wp+
apply (clarsimp simp: asidLowBits_handy_convs word_sless_def word_sle_def
Collect_const_mem asid_shiftr_low_bits_less)
done
@ -498,7 +498,7 @@ lemma handleVMFault_ccorres:
apply (clarsimp simp: errstate_def)
apply (clarsimp simp: EXCEPTION_FAULT_def EXCEPTION_NONE_def)
apply (simp add: seL4_Fault_VMFault_lift false_def)
apply wp
apply wp+
apply (simp add: vm_fault_type_from_H_def Kernel_C.ARMDataAbort_def Kernel_C.ARMPrefetchAbort_def)
apply (simp add: ccorres_cond_univ_iff ccorres_cond_empty_iff)
apply (rule ccorres_rhs_assoc)+
@ -507,13 +507,13 @@ lemma handleVMFault_ccorres:
apply (ctac (no_vcg) pre: ccorres_liftE_Seq)
apply (ctac (no_vcg) add: getIFSR_ccorres pre: ccorres_liftE_Seq)
apply (rule ccorres_from_vcg_throws [where P=\<top> and P'=UNIV])
apply (clarsimp simp add: throwError_def throw_def return_def)
apply (clarsimp simp add: throwError_def throw_def return_def)
apply (rule conseqPre)
apply vcg
apply (clarsimp simp: errstate_def)
apply (clarsimp simp: EXCEPTION_FAULT_def EXCEPTION_NONE_def)
apply (simp add: seL4_Fault_VMFault_lift true_def mask_def)
apply wp
apply wp+
apply simp
done
@ -930,11 +930,7 @@ lemma ccorres_pre_getObject_asidpool:
apply (rule_tac Q="ko_at' rv p s" in conjunct1)
apply assumption
apply assumption
apply (wp getASID_wp empty_fail_getObject | simp)
apply (wp getASID_wp empty_fail_getObject | simp)
apply (wp getASID_wp empty_fail_getObject | simp)
apply (wp getASID_wp empty_fail_getObject | simp)
apply clarsimp
apply (wpsimp wp: getASID_wp empty_fail_getObject)+
apply (erule cmap_relationE1 [OF rf_sr_cpspace_asidpool_relation],
erule ko_at_projectKO_opt)
apply simp
@ -1138,11 +1134,9 @@ lemma flushSpace_ccorres:
rule invalidateTLB_ASID_ccorres [simplified dc_def xfdc_def],
simp+)[1]
apply vcg
apply wp
apply simp
done
apply wp+
apply simp
done
@ -1424,7 +1418,7 @@ lemma getHWASID_ccorres:
apply (ctac(no_vcg) add: findFreeHWASID_ccorres)
apply (ctac(no_vcg) add: storeHWASID_ccorres)
apply (rule ccorres_return_C, simp+)[1]
apply wp
apply wp+
apply (strengthen all_invs_but_ct_idle_or_in_cur_domain_valid_pde_mappings')
apply (wp findFreeHWASID_invs_no_cicd')
apply (rule ccorres_cond_true)
@ -1751,7 +1745,7 @@ lemma doFlush_ccorres:
apply (ctac (no_vcg) add: invalidateCacheRange_I_ccorres)
apply (ctac (no_vcg) add: branchFlushRange_ccorres)
apply (ctac (no_vcg) add: isb_ccorres)
apply wp
apply wp+
apply simp
apply (clarsimp simp: Collect_const_mem)
apply (auto simp: flushtype_relation_def o_def
@ -1805,7 +1799,7 @@ lemma performPageFlush_ccorres:
apply (simp add: cur_tcb'_def[symmetric])
apply (rule_tac Q="\<lambda>_ s. invs' s \<and> cur_tcb' s" in hoare_post_imp)
apply (simp add: invs'_invs_no_cicd)
apply (wp)
apply wp+
apply (simp)
apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
apply (rule allI, rule conseqPre, vcg)
@ -1995,7 +1989,7 @@ lemma performPageDirectoryInvocationFlush_ccorres:
apply (simp add: cur_tcb'_def[symmetric])
apply (rule_tac Q="\<lambda>_ s. invs' s \<and> cur_tcb' s" in hoare_post_imp)
apply (simp add: invs'_invs_no_cicd)
apply (wp)
apply wp+
apply (simp)
apply (rule_tac P=\<top> and P'=UNIV in ccorres_from_vcg_throws)
apply (rule allI, rule conseqPre, vcg)

100
proof/drefine/Arch_DR.thy
View File

@ -192,18 +192,16 @@ lemma lookup_pt_slot_aligned_6':
apply (rule hoare_gen_asmE)
apply (simp add:lookup_pt_slot_def)
apply (wp|wpc)+
apply clarsimp
apply (rule hoare_strengthen_post[where Q = "\<lambda>r. valid_pde r and pspace_aligned"] )
apply wp
apply clarsimp
apply (rule hoare_strengthen_post[where Q = "\<lambda>r. valid_pde r and pspace_aligned"] )
apply wp
apply simp+
apply (clarsimp simp:valid_pde_def dest!:pt_aligned split:ARM_A.pde.splits)
apply (erule aligned_add_aligned)
apply (rule is_aligned_shiftl)
apply (rule is_aligned_andI1)
apply (rule is_aligned_shiftr)
apply simp+
apply (clarsimp simp:valid_pde_def dest!:pt_aligned
split:ARM_A.pde.splits)
apply (erule aligned_add_aligned)
apply (rule is_aligned_shiftl)
apply (rule is_aligned_andI1)
apply (rule is_aligned_shiftr)
apply simp
apply simp
done
lemma create_mapping_entries_dcorres:
@ -253,7 +251,7 @@ proof -
apply assumption
apply (clarsimp)
apply (rule dcorres_lookup_pt_slot)
apply wp
apply wp+
apply simp
apply (clarsimp simp:
dest!:page_directory_at_aligned_pd_bits )
@ -278,7 +276,7 @@ proof -
apply assumption
apply (clarsimp)
apply (rule dcorres_lookup_pt_slot)
apply (wp lookup_pt_slot_aligned_6')
apply (wp lookup_pt_slot_aligned_6')+
apply simp
apply (clarsimp simp:
dest!:page_directory_at_aligned_pd_bits )
@ -705,6 +703,7 @@ next
next
case (PageCap dev base rights pgsz asid)
thus ?case
including no_pre
apply (simp add: Decode_D.decode_invocation_def
decode_invocation_def arch_decode_invocation_def
split del: if_split)
@ -731,7 +730,7 @@ next
apply (rule_tac r'=dc and P'="I" and Q'="\<lambda>rv. I and (\<exists>\<rhd> (lookup_pd_slot rv x21 && ~~ mask pd_bits))" for I
in corres_alternative_throw_splitE[OF _ _ returnOk_wp[where x="()"], simplified])
apply (rule corres_from_rdonly, simp_all)[1]
apply (wp | simp)+
apply (wp+ | simp)+
apply (rule hoare_strengthen_post, rule hoare_post_taut)
apply (case_tac r, auto simp add: in_monad)[1]
apply (simp add: corres_whenE_throwError_split_rhs corres_alternate2
@ -749,16 +748,16 @@ next
apply simp
apply (fastforce simp: neq_Nil_conv valid_cap_simps dest!:page_directory_at_rev)
apply (rule corres_from_rdonly[where P=\<top> and P'=\<top>], simp_all)[1]
apply (wp | simp)+
apply (wp+ | simp)+
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp)+
apply (wp+ | simp)+
apply (clarsimp simp add: in_monad conj_disj_distribR[symmetric])
apply (simp add: conj_disj_distribR cong: conj_cong)
apply (simp add: arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def update_cap_rights_def
update_mapping_cap_status_def Types_D.cap_rights_def
mask_vm_rights_def transform_mapping_def)
apply wp
apply wp+
apply (rule hoare_pre, wp, simp)
apply (rule hoare_pre, wp, auto)[1]
apply (wp | simp add: whenE_def split del: if_split)+
@ -803,7 +802,7 @@ next
transform_page_inv_def update_cap_rights_def
update_mapping_cap_status_def Types_D.cap_rights_def
mask_vm_rights_def)
apply wp
apply wp+
apply (rule hoare_pre, wp, simp)
apply (rule hoare_pre, wp, auto)[1]
apply (wp | simp add: whenE_def split del: if_split)+
@ -814,8 +813,7 @@ next
apply (clarsimp)
apply (rule corres_from_rdonly)
apply (wp, clarsimp)
apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp)
apply (assumption)
apply (simp only: Let_unfold, wp+, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp+)
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
@ -825,8 +823,7 @@ next
apply (metis flush.exhaust)
apply (rule corres_from_rdonly)
apply (wp, clarsimp)
apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp)
apply (assumption)
apply (simp only: Let_unfold, wp+, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp+)
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
@ -836,8 +833,7 @@ next
apply (metis flush.exhaust)
apply (rule corres_from_rdonly)
apply (wp, clarsimp)
apply ( simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp)
apply (assumption)
apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp+)
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
@ -847,8 +843,7 @@ next
apply (metis flush.exhaust)
apply (rule corres_from_rdonly)
apply (wp, clarsimp)
apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, wp whenE_inv, clarsimp, wp)
apply (assumption)
apply (simp only: Let_unfold, wp, clarsimp, rule valid_validE, (wp whenE_inv)+, clarsimp, wp)
apply (rule validE_cases_valid, rule hoare_pre)
apply (wp | simp add: Let_unfold arch_invocation_relation_def translate_arch_invocation_def
transform_page_inv_def)+
@ -1323,7 +1318,7 @@ lemma invoke_page_table_corres:
apply (wp store_pte_cte_wp_at)
apply fastforce
apply (clarsimp simp:valid_cap_def vmsz_aligned_def mask_2pm1)+
apply (wp hoare_post_taut)
apply (wp hoare_post_taut)+
apply (rule_tac Q="\<lambda>rv s. invs s \<and> valid_etcbs s \<and> a \<noteq> idle_thread s \<and> cte_wp_at \<top> (a,b) s \<and>
caps_of_state s' = caps_of_state s" in hoare_strengthen_post)
apply wp
@ -1348,14 +1343,14 @@ lemma set_vm_root_for_flush_dwp[wp]:
"\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> set_vm_root_for_flush word1 word2 \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
apply (simp add:set_vm_root_for_flush_def)
apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+
apply (wpc)
apply wp
apply (rule hoare_conjI,rule hoare_drop_imp)
apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>rv s. transform s = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
done
apply (wpc)
apply wp+
apply (rule hoare_conjI,rule hoare_drop_imp)
apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>rv s. transform s = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
done
lemma diminished_page_is_page:
"diminished (cap.ArchObjectCap (arch_cap.PageCap dev x rs sz mp)) c
@ -1555,27 +1550,26 @@ lemma invoke_page_directory_corres:
(invoke_page_directory ip) (perform_page_directory_invocation ip')"
apply (clarsimp simp:invoke_page_directory_def)
apply (case_tac ip')
apply (simp_all add:perform_page_invocation_def)
apply (simp_all add: when_def transform_page_dir_inv_def)
apply safe
apply (clarsimp)
apply (simp_all add:perform_page_invocation_def)
apply (simp_all add: when_def transform_page_dir_inv_def)
apply safe
apply (clarsimp)
apply (rule corres_dummy_return_r)
apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\<top> and P'=\<top>]])
apply wp
apply (clarsimp simp: perform_page_directory_invocation_def)
apply (wp)
apply (rule dcorres_to_wp, rule dcorres_set_vm_root)
apply (wp)
apply (clarsimp)
apply (wp do_machine_op_wp, clarsimp, wp+)
apply (clarsimp)
apply (rule corres_dummy_return_r)
apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\<top> and P'=\<top>]])
apply wp
apply (clarsimp simp: perform_page_directory_invocation_def)
apply (wp)
apply (rule dcorres_to_wp, rule dcorres_set_vm_root)
apply (wp)
apply (clarsimp)
apply (wp do_machine_op_wp, clarsimp, wp)
apply (clarsimp)
apply (rule corres_dummy_return_r)
apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\<top> and P'=\<top>]])
apply wp
apply (clarsimp simp: perform_page_directory_invocation_def)
done
done
(* NOONE EVER SEES THIS OK *)
lemma pte_check_if_mapped_corres:
"dcorres dc \<top> \<top> (return a) (pte_check_if_mapped pte)"
apply (clarsimp simp add: pte_check_if_mapped_def get_master_pte_def get_pte_def get_pt_def bind_assoc in_monad get_object_def corres_underlying_def)
@ -1785,7 +1779,7 @@ lemma invoke_page_corres:
apply (erule notE)
apply (rule dcorres_symb_exec_r)+
apply (rule dcorres_set_vm_root)
apply (wp)
apply (wp)+
apply (erule notE)+
apply (clarsimp)
apply (wp do_machine_op_wp | clarsimp)+
@ -1897,7 +1891,7 @@ proof -
transform_current_thread_def)
apply (clarsimp simp:transform_asid_table_def transform_asid_def
fun_upd_def[symmetric] unat_map_upd)
apply wp
apply wp+
apply (rule_tac Q="\<lambda>rv s. cte_wp_at (\<lambda>c. \<exists>idx. c = (cap.UntypedCap False frame pageBits idx))
cref s
\<and> asid_pool_at frame s

99
proof/drefine/CNode_DR.thy
View File

@ -476,7 +476,7 @@ proof -
apply (rule corres_gets_the)
apply simp
apply (rule corres_trivial, rule gets_symb_exec_l)
apply (wp set_cap_caps_of_state2 set_cap_idle)
apply (wp set_cap_caps_of_state2 set_cap_idle)+
apply clarsimp
apply (clarsimp simp: cte_wp_at_caps_of_state
caps_of_state_transform_opt_cap
@ -522,18 +522,18 @@ lemma delete_cap_corres:
apply (simp add:bindE_assoc)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF _ dcorres_finalise_slot])
apply (clarsimp simp:bindE_assoc when_def)
apply (rule empty_slot_corres)
apply wp
apply (clarsimp simp:bindE_assoc when_def)
apply (rule empty_slot_corres)
apply wp+
apply (rule validE_validE_R)
apply (simp add:validE_def weak_valid_mdb_def)
apply (rule hoare_drop_imp)
apply (rule_tac Q = "\<lambda>r. invs and not_idle_thread a and valid_etcbs" in hoare_strengthen_post)
apply (wp rec_del_invs)
apply (simp add:not_idle_thread_def validE_def)
apply wp
apply (clarsimp simp:invs_def valid_state_def valid_mdb_def)
apply clarsimp+
apply (wp rec_del_invs)
apply (simp add:not_idle_thread_def validE_def)
apply wp
apply (clarsimp simp:invs_def valid_state_def valid_mdb_def)
apply clarsimp+
apply (simp add:cap_table_at_cte_at)
apply (clarsimp simp:emptyable_def obj_at_def is_cap_table_def)
apply (clarsimp simp:is_tcb_def split:Structures_A.kernel_object.splits)
@ -551,18 +551,18 @@ lemma delete_cap_corres':
apply (simp add:bindE_assoc)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF _ dcorres_finalise_slot])
apply (clarsimp simp:bindE_assoc when_def)
apply (rule empty_slot_corres)
apply wp
apply (clarsimp simp:bindE_assoc when_def)
apply (rule empty_slot_corres)
apply wp+
apply (rule validE_validE_R)
apply (simp add:validE_def weak_valid_mdb_def)
apply (rule hoare_drop_imp)
apply (rule_tac Q = "\<lambda>r. invs and not_idle_thread a and valid_etcbs" in hoare_strengthen_post)
apply (wp rec_del_invs)
apply (simp add:not_idle_thread_def validE_def)
apply wp
apply (clarsimp simp:invs_def valid_state_def valid_mdb_def)
apply (clarsimp simp:not_idle_thread_def)+
apply (wp rec_del_invs)
apply (simp add:not_idle_thread_def validE_def)
apply wp
apply (clarsimp simp:invs_def valid_state_def valid_mdb_def)
apply (clarsimp simp:not_idle_thread_def)+
done
definition boolean_exception :: "'c + bool \<Rightarrow> 'a+'b \<Rightarrow> bool"
@ -1029,7 +1029,7 @@ lemma dcorres_ep_cancel_badge_sends:
apply (clarsimp simp: valid_etcbs_2_def)
apply (drule_tac x=ptr in spec)
apply (clarsimp simp: st_tcb_at_kh_def obj_at_kh_def st_tcb_at_def obj_at_def)
apply wp
apply wp+
apply (clarsimp)
apply (rule corres_guard_imp)
apply (rule corres_split_noop_rhs[OF _ corres_dummy_set_sync_ep])
@ -1328,29 +1328,7 @@ lemma dcorres_clear_object_caps_asid_pool:
lemma valid_idle_invs_strg:
"invs s \<longrightarrow> valid_idle s" by fastforce
lemma store_hw_asid_idle[wp]:
"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> store_hw_asid a xa \<lbrace>\<lambda>xb a. P (idle_thread a)\<rbrace>"
apply (simp add:store_hw_asid_def)
apply wp
apply (rule_tac Q = "\<lambda>r s. P (idle_thread s)" in hoare_strengthen_post)
apply wp
apply simp
done
lemma invalidate_hw_asid_enty_idle[wp]:
"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> invalidate_hw_asid_entry xb \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
by (simp add:invalidate_hw_asid_entry_def | wp)+
lemma invalidate_asid_idle[wp]:
"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> invalidate_asid x \<lbrace>\<lambda>y s. P (idle_thread s)\<rbrace>"
by (simp add:invalidate_asid_def | wp)+
crunch idle[wp] : flush_space "\<lambda>s. P (idle_thread s)"
crunch idle[wp] : invalidate_tlb_by_asid "\<lambda>s. P (idle_thread s)"
crunch idle[wp] : page_table_mapped "\<lambda>s. P (idle_thread s)"
crunch idle[wp] : store_pte "\<lambda>s. P (idle_thread s)"
crunch idle[wp] : copy_global_mappings "\<lambda>s. P (idle_thread s)"
(wp: crunch_wps simp: crunch_simps)
crunch st_tcb_at[wp]: invalidate_tlb_by_asid "st_tcb_at P thread"
crunch st_tcb_at[wp] : copy_global_mappings "st_tcb_at P thread"
@ -1358,16 +1336,7 @@ crunch st_tcb_at[wp] : copy_global_mappings "st_tcb_at P thread"
lemma delete_asid_pool_idle [wp]:
"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> ARM_A.delete_asid_pool p q\<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
apply (simp add:delete_asid_pool_def)
apply wp
apply (rule mapM_wp)
apply wp
apply (rule_tac Q = "\<lambda>r s. P (idle_thread s)" in hoare_strengthen_post)
apply (clarsimp simp:load_hw_asid_def find_free_hw_asid_def invalidate_asid_entry_def arm_context_switch_def get_hw_asid_def | wp | wpc)+
apply fastforce
apply wp
apply clarsimp
done
by (rule delete_asid_pool_idle_thread)
crunch idle [wp]: cancel_badged_sends "\<lambda>s. P (idle_thread s)"
(wp: crunch_wps dxo_wp_weak filterM_preserved simp: crunch_simps)
@ -1402,7 +1371,7 @@ lemma dcorres_storeWord_mapM_x_cvt:
apply (rule_tac Cons.hyps)
using Cons
apply simp
apply wp
apply wp+
using Cons
apply fastforce
apply (wp|clarsimp|force)+
@ -1904,7 +1873,7 @@ lemma dcorres_thread_get_get_object_split:
apply (drule opt_object_tcb, simp, simp add: not_idle_thread_def)
apply (simp add: transform_tcb_def obj_tcb_def)
apply (rule c)
apply wp
apply wp+
apply clarsimp
apply simp
apply simp
@ -2059,7 +2028,7 @@ lemma invoke_cnode_corres:
apply (erule corres_if)
apply (rule swap_cap_corres)
apply (rule corres_split_nor [OF move_cap_corres move_cap_corres])
apply wp
apply wp+
apply (simp add: cte_wp_at_caps_of_state not_idle_thread_def)
apply (wp cap_move_caps_of_state)
apply simp
@ -2090,7 +2059,7 @@ lemma invoke_cnode_corres:
apply (rule move_cap_corres)
apply (rule corres_trivial[OF corres_free_fail])
apply (simp add: transform_tcb_slot_simp)
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply (auto simp: transform_def transform_current_thread_def
ct_in_state_def not_idle_thread_def
cte_wp_at_caps_of_state
@ -2148,7 +2117,7 @@ lemma decode_cnode_error_corres:
apply (rule corres_trivial)
apply (simp split: invocation_label.split list.split)
apply auto[1]
apply wp
apply wp+
apply (elim disjE, simp_all)
apply (simp add: whenE_def)
apply (clarsimp simp: whenE_def)
@ -2196,7 +2165,7 @@ lemma lookup_slot_for_cnode_op_corres:
apply clarsimp
apply (rule corres_returnOk, rule refl)
apply (clarsimp simp: neq_Nil_conv)
apply wp
apply wp+
done
lemma dcorres_ensure_empty:
@ -2228,7 +2197,7 @@ lemma derive_cap_dummy:
apply (rule corres_split [OF _ ensure_no_children_dummy, where R="\<lambda>_. \<top>" and R'="\<lambda>_. \<top>"])
apply (clarsimp simp: corres_underlying_def lift_def return_def split: sum.splits)
apply (fastforce simp: in_monad)
apply wp
apply wp+
apply simp
apply simp
apply (simp add: liftME_def)
@ -2294,7 +2263,8 @@ lemma derive_cap_dcorres:
apply (rule dcorres_returnOk)
apply simp
apply (rule dcorres_ensure_no_children)
apply wp[2]
apply wp
apply wp
apply simp
apply fastforce
apply (simp add: arch_derive_cap_def)
@ -2534,9 +2504,9 @@ lemma decode_cnode_corres:
apply (simp add:translate_cnode_invocation_def)
apply simp
apply (rule dcorres_throw)
apply wp
apply wp+
apply simp
apply wp
apply wp+
apply (rule hoare_post_imp_R[OF validE_validE_R])
apply (rule hoareE_TrueI[where P = \<top>])
apply (wp|simp)+
@ -2608,7 +2578,8 @@ lemma decode_cnode_corres:
apply (rule lookup_slot_for_cnode_op_corres, simp_all)[1]
apply (rule dcorres_returnOk)
apply (simp add: translate_cnode_invocation_def)
apply wp[2]
apply wp
apply wp
apply simp
apply fastforce
apply (clarsimp simp: defns split: splits)
@ -2618,7 +2589,7 @@ lemma decode_cnode_corres:
apply (rule lookup_slot_for_cnode_op_corres, simp_all)[1]
apply (rule dcorres_returnOk)
apply (simp add: translate_cnode_invocation_def)
apply wp[2]
apply (wp+)[2]
apply simp
apply fastforce
apply (clarsimp simp: defns split: splits)
@ -2632,7 +2603,7 @@ lemma decode_cnode_corres:
apply (rule dcorres_ensure_empty)
apply (rule dcorres_returnOk)
apply (simp add: translate_cnode_invocation_def)
apply (wp lsfco_not_idle)
apply (wp lsfco_not_idle)+
apply simp
apply fastforce
apply (clarsimp simp: defns split: splits)
@ -2734,7 +2705,7 @@ lemma decode_cnode_corres:
in hoare_post_imp_R)
apply (wp lsfco_not_idle)
apply (clarsimp simp:Invariants_AI.cte_wp_valid_cap)
apply (wp lsfco_not_idle)
apply (wp lsfco_not_idle)+
apply simp
apply fastforce
apply (erule disjE)

5
proof/drefine/Corres_D.thy
View File

@ -38,7 +38,7 @@ lemma OR_choice_OR[simp]: "(OR_choice c (f :: ('a,unit) s_monad) g) = (f OR g)"
apply (case_tac "g s")
by (intro conjI set_eqI; clarsimp?; blast)
lemma OR_choiceE_OR[simp]: "(OR_choiceE c (f :: ('a + 'b,unit) s_monad) g) = (f OR g)"
lemma OR_choiceE_OR[simp]: "(OR_choiceE c (f :: ('a + 'b,unit) s_monad) g) = (f \<sqinter> g)"
apply (clarsimp simp: OR_choiceE_def bindE_def liftE_def)
apply (clarsimp simp: alternative_def get_def select_def return_def bind_def select_f_def
mk_ef_def wrap_ext_unit_def wrap_ext_bool_unit_def image_def
@ -218,7 +218,7 @@ lemma dcorres_get:
apply (rule dcorres_expand_pfx)
apply (rule_tac r'="\<lambda>r r'. s=r \<and> s'=r'" and P="%x. op=s" and P'="%x. op=s'" in corres_underlying_split)
apply (clarsimp simp: corres_underlying_def get_def)
apply wp
apply wp+
apply (drule A)
apply clarsimp+
done
@ -278,7 +278,6 @@ lemma hoare_mapM_idempotent: "\<lbrakk> \<And> a R. \<lbrace> R \<rbrace> x a \<
apply (erule_tac x=R in allE)
apply (rule hoare_seq_ext)
apply wp
apply assumption
apply assumption
done

392
proof/drefine/Finalise_DR.thy
View File

@ -205,10 +205,10 @@ lemma delete_cdt_slot_shrink_descendants:
done
lemma delete_cap_one_shrink_descendants:
"\<lbrace>\<lambda>s. s = pres \<and> invs s \<and> slot \<in> CSpaceAcc_A.descendants_of p (cdt pres) \<rbrace> cap_delete_one slot
\<lbrace>\<lambda>r s. slot \<notin> CSpaceAcc_A.descendants_of p (cdt s) \<and>
CSpaceAcc_A.descendants_of p (cdt s) \<subseteq> CSpaceAcc_A.descendants_of p (cdt pres) \<rbrace>"
including no_pre
apply (simp add:cap_delete_one_def unless_def)
apply wp
apply (clarsimp simp add:empty_slot_def)
@ -297,7 +297,7 @@ lemma caps_of_state_transform_opt_cap_no_idle:
length_set_helper word_bl.Abs_inverse
object_slots_def nat_bl_to_bin_lt2p)
apply (frule(1) valid_etcbs_tcb_etcb)
apply (clarsimp simp: opt_cap_def transform_cslot_ptr_def
by (clarsimp simp: opt_cap_def transform_cslot_ptr_def
slots_of_def opt_object_def restrict_map_def
transform_def object_slots_def transform_objects_def
valid_irq_node_def obj_at_def is_cap_table_def
@ -305,7 +305,6 @@ lemma caps_of_state_transform_opt_cap_no_idle:
tcb_pending_op_slot_def tcb_cap_cases_def tcb_boundntfn_slot_def
bl_to_bin_tcb_cnode_index bl_to_bin_tcb_cnode_index_le0
split: if_split_asm option.splits)
done
lemma transform_cap_Null [simp]:
"(transform_cap cap = cdl_cap.NullCap) = (cap = cap.NullCap)"
@ -353,7 +352,7 @@ lemma dcorres_revoke_the_cap_corres:
apply (rule corres_split[OF dcorres_revoke_cap_no_descendants])
apply simp
apply (rule delete_cap_simple_corres)
apply (wp cap_delete_one_cte_at)
apply (wp cap_delete_one_cte_at)+
apply (rule_tac pres1 = s' and p1 = slot in hoare_strengthen_post[OF delete_cap_one_shrink_descendants])
apply (simp_all add:invs_def valid_state_def valid_mdb_def)
apply fastforce
@ -373,7 +372,7 @@ lemma valid_ntfn_after_remove_slot:
\<Longrightarrow> valid_ntfn (ntfn_set_obj ntfn
(case remove1 ptr list of [] \<Rightarrow> Structures_A.ntfn.IdleNtfn
| a # lista \<Rightarrow> Structures_A.ntfn.WaitingNtfn (remove1 ptr list))) s'"
apply (clarsimp simp: valid_ntfn_def distinct_remove1
apply (clarsimp simp: valid_ntfn_def
split: ntfn.splits list.split_asm list.splits option.splits)
by (metis (mono_tags) distinct.simps(2) distinct_length_2_or_more distinct_remove1 set_remove1)
@ -401,7 +400,7 @@ lemma finalise_cancel_ipc:
apply clarsimp
apply (rule corres_dummy_return_pr)
apply (rule corres_split [OF _ dcorres_revoke_cap_unnecessary])
apply (simp add:K_bind_def when_def dc_def[symmetric])
apply (simp add: when_def dc_def[symmetric])
apply (rule set_thread_state_corres)
apply (wp sts_only_idle sts_st_tcb_at' valid_ep_queue_subset | clarsimp simp:not_idle_thread_def)+
apply (simp add:get_blocking_object_def | wp)+
@ -511,17 +510,13 @@ lemmas dmo_dwp = do_machine_op_wp [OF allI]
lemma machine_op_lift[wp]:
"\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> machine_op_lift x \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
apply (clarsimp simp:machine_rest_lift_def ignore_failure_def machine_op_lift_def)
apply wp
apply (clarsimp simp:simpler_modify_def valid_def)
apply (assumption)
apply wp
apply clarsimp
done
apply (wpsimp simp:simpler_modify_def valid_def)
done
lemma invalidateTLB_ASID_underlying_memory[wp]:
"\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> invalidateTLB_ASID a \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
apply (clarsimp simp: invalidateTLB_ASID_def, wp)
done
apply (clarsimp simp: invalidateTLB_ASID_def, wp)
done
lemma dsb_underlying_memory[wp]: "\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> dsb \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
apply (clarsimp simp: dsb_def, wp)
@ -544,49 +539,50 @@ lemma flush_space_dwp[wp]:
"\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> flush_space x \<lbrace>\<lambda>r ps. transform ps = cs\<rbrace>"
apply (clarsimp simp:flush_space_def)
apply (wp|wpc)+
apply (clarsimp split:option.splits)
apply (rule do_machine_op_wp)
apply clarsimp
apply (wp static_imp_wp)
apply (rule do_machine_op_wp)
apply clarsimp
apply wp
apply (rule hoare_allI)
apply (rule hoare_drop_imp)
apply (rule do_machine_op_wp)
apply clarsimp
apply wp
apply (rule hoare_conjI)
apply (clarsimp split:option.splits)
apply (rule do_machine_op_wp)
apply clarsimp
apply (wp static_imp_wp)+
apply (rule do_machine_op_wp)
apply clarsimp
apply wp
apply (rule hoare_allI)
apply (rule hoare_drop_imp)
apply (clarsimp simp:load_hw_asid_def)
apply (rule do_machine_op_wp)
apply clarsimp
apply wp
apply (clarsimp simp:load_hw_asid_def)
apply (rule hoare_conjI)
apply (rule hoare_drop_imp)
apply (clarsimp simp:load_hw_asid_def)
apply wp
done
apply (clarsimp simp:load_hw_asid_def)
apply wp
apply assumption
done
lemma invalidate_asid_dwp[wp]:
"\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> invalidate_asid (the (hw_asid_table next_asid)) \<lbrace>\<lambda>x ps. transform ps = cs\<rbrace>"
apply (clarsimp simp:invalidate_asid_def)
apply wp
apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def)
done
done
lemma invalidate_asid_entry_dwp[wp]:
"\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> invalidate_asid_entry x \<lbrace>\<lambda>r ps. transform ps = cs\<rbrace>"
apply (clarsimp simp:invalidate_asid_entry_def)
apply wp
apply (clarsimp simp:invalidate_asid_def)
apply wp
apply (clarsimp simp:invalidate_asid_def)
apply wp+
apply (clarsimp simp:invalidate_hw_asid_entry_def)
apply wp
apply (subgoal_tac "transform s = cs")
prefer 2
apply (assumption)
apply wp+
apply (subgoal_tac "transform s = cs")
prefer 2
apply (assumption)
apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def)
apply (clarsimp simp:load_hw_asid_def)
apply wp
apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def)
apply (clarsimp simp:load_hw_asid_def)
apply wp
apply (clarsimp simp:transform_def transform_objects_def2 transform_current_thread_def transform_cdt_def transform_asid_table_def)
done
done
lemma invalidate_hw_asid_entry_dwp[wp]:
"\<lbrace>\<lambda>s. transform s = cs\<rbrace> invalidate_hw_asid_entry next_asid \<lbrace>\<lambda>xb a. transform a = cs\<rbrace>"
@ -698,18 +694,17 @@ lemma dcorres_set_vm_root:
"dcorres dc \<top> \<top> (return x) (set_vm_root rvd)"
apply (clarsimp simp: set_vm_root_def)
apply (rule dcorres_symb_exec_r)+
apply (clarsimp simp:catch_def throwError_def)
apply (clarsimp simp:catch_def throwError_def)
apply (rule corres_dummy_return_r)
apply (rule dcorres_symb_exec_r[OF corres_free_return[where P=\<top> and P'=\<top>]])+
apply wp
apply wp+
apply wpc
apply (wp do_machine_op_wp | clarsimp)+
apply (rule_tac Q = "\<lambda>_ s. transform s = cs" in hoare_post_imp)
apply (wp do_machine_op_wp | clarsimp)+
apply (rule_tac Q = "\<lambda>_ s. transform s = cs" in hoare_post_imp)
apply simp
apply (rule hoare_pre)
apply (wp hoare_whenE_wp do_machine_op_wp [OF allI] hoare_drop_imps find_pd_for_asid_inv
| wpc | simp add: arm_context_switch_def get_hw_asid_def load_hw_asid_def if_apply_def2)+
done
apply (wpsimp wp: hoare_whenE_wp do_machine_op_wp [OF allI] hoare_drop_imps find_pd_for_asid_inv
simp: arm_context_switch_def get_hw_asid_def load_hw_asid_def if_apply_def2)+
done
lemma dcorres_delete_asid_pool:
"dcorres dc \<top> \<top>
@ -753,7 +748,7 @@ lemma dcorres_delete_asid_pool:
apply clarsimp
apply wp
apply fastforce
apply wp
apply wp+
apply simp
done
@ -781,9 +776,8 @@ lemma page_table_aligned:
done
lemma invalidateTLB_VAASID_underlying_memory[wp]:
"\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> invalidateTLB_VAASID word \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
apply (clarsimp simp: invalidateTLB_VAASID_def, wp)
done
"\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> invalidateTLB_VAASID word \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
by (clarsimp simp: invalidateTLB_VAASID_def, wp)
lemma dcorres_flush_page:
"dcorres dc \<top> \<top> (return x) (flush_page aa a b word)"
@ -792,22 +786,22 @@ lemma dcorres_flush_page:
apply wp
apply (simp add:flush_page_def)
apply wp
apply (rule dcorres_to_wp[OF dcorres_set_vm_root])
apply wp
apply clarsimp
apply (wp do_machine_op_wp, clarsimp)
apply (wp)
apply (simp add:load_hw_asid_def)
apply wp
apply (clarsimp simp:set_vm_root_for_flush_def)
apply (rule dcorres_to_wp[OF dcorres_set_vm_root])
apply wp
apply clarsimp
apply (wp do_machine_op_wp, clarsimp)
apply (wp)
apply (simp add:load_hw_asid_def)
apply wp
apply (clarsimp simp:set_vm_root_for_flush_def)
apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+
apply (wpc)
apply wp
apply (rule hoare_conjI,rule hoare_drop_imp)
apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>rv s. transform s = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
apply (wpc)
apply wp+
apply (rule hoare_conjI,rule hoare_drop_imp)
apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>rv s. transform s = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
done
lemma dcorres_flush_table:
@ -817,21 +811,21 @@ lemma dcorres_flush_table:
apply wp
apply (simp add:flush_table_def)
apply wp
apply (rule dcorres_to_wp[OF dcorres_set_vm_root])
apply wp
apply clarsimp
apply (wp do_machine_op_wp|clarsimp)+
apply (clarsimp simp:load_hw_asid_def)
apply wp
apply (clarsimp simp:set_vm_root_for_flush_def)
apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+
apply (rule dcorres_to_wp[OF dcorres_set_vm_root])
apply wp
apply clarsimp
apply (wp do_machine_op_wp|clarsimp)+
apply (clarsimp simp:load_hw_asid_def)
apply wp
apply (clarsimp simp:set_vm_root_for_flush_def)
apply (wp do_machine_op_wp|clarsimp simp:arm_context_switch_def get_hw_asid_def)+
apply wpc
apply wp
apply wp+
apply (rule hoare_conjI,rule hoare_drop_imp)
apply (wp do_machine_op_wp|clarsimp simp:load_hw_asid_def)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>rv s. transform s = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>rv s. transform s = cs" in hoare_strengthen_post)
apply (wp|clarsimp)+
done
lemma flush_table_exec:
@ -1297,20 +1291,16 @@ lemma dcorres_delete_cap_simple_section:
(lookup_pd_slot pd v) and K (is_aligned pd pd_bits \<and> v < kernel_base))
(delete_cap_simple (cdl_lookup_pd_slot pd v))
(store_pde (lookup_pd_slot pd v) ARM_A.pde.InvalidPDE)"
apply (clarsimp simp:store_pde_def transform_pd_slot_ref_def
lookup_pd_slot_def)
apply (clarsimp simp: store_pde_def transform_pd_slot_ref_def lookup_pd_slot_def)
apply (rule corres_gen_asm2)
apply (subst dcorres_lookup_pd_slot,simp add:pd_bits_def pageBits_def)
apply (clarsimp simp:transform_pd_slot_ref_def lookup_pd_slot_def)
apply (subst dcorres_lookup_pd_slot, simp add: pd_bits_def pageBits_def)
apply (clarsimp simp: transform_pd_slot_ref_def lookup_pd_slot_def)
apply (rule corres_guard_imp)
apply (rule corres_symb_exec_r)
apply (rule dcorres_delete_cap_simple_set_pde[where oid = oid])
apply (drule(1) less_kernel_base_mapping_slots)
apply (simp add:lookup_pd_slot_def)
apply wp
apply simp
apply simp
apply simp
apply (simp add: lookup_pd_slot_def)
apply wpsimp+
apply fastforce
done
@ -1421,20 +1411,20 @@ lemma mask_compare_imply:
\<Longrightarrow> (x && mask l \<noteq>y && mask l) \<or> (x && ~~ mask (l+n)) \<noteq> (y && ~~ mask (l+n))"
apply (rule ccontr)
apply (subgoal_tac "x = y")
apply simp
apply simp
apply (rule word_eqI)
apply clarsimp
apply (case_tac "na<l")
apply (drule_tac na = na in test_bits_mask[where l = l and y = y])
apply clarsimp+
apply (drule_tac na = na in test_bits_mask[where l = l and y = y])
apply clarsimp+
apply (case_tac "l+n\<le> na")
apply (drule_tac na = na in test_bits_neg_mask)
apply clarsimp+
apply (drule_tac na = na in test_bits_neg_mask)
apply clarsimp+
apply (drule_tac na = "na-l" in test_bits_mask)
apply (clarsimp simp: linorder_not_le)
apply (subst (asm) add.commute[where a = l])+
apply (drule nat_diff_less)
apply (clarsimp simp:word_size)+
apply (clarsimp simp: linorder_not_le)
apply (subst (asm) add.commute[where a = l])+
apply (drule nat_diff_less)
apply (clarsimp simp:word_size)+
apply (clarsimp simp:nth_shiftr)
apply (auto simp:word_size)
done
@ -1444,8 +1434,8 @@ lemma aligned_in_step_up_to:
\<Longrightarrow> is_aligned x t"
apply (clarsimp simp:upto_enum_step_def image_def)
apply (rule aligned_add_aligned[where n = t])
apply (rule is_aligned_mult_triv2)
apply (simp add:word_bits_def)+
apply (rule is_aligned_mult_triv2)
apply (simp add:word_bits_def)+
done
lemma remain_pt_pd_relation:
@ -1454,84 +1444,84 @@ lemma remain_pt_pd_relation:
\<lbrace>\<lambda>r s. \<forall>y\<in>ys. pt_page_relation (y && ~~ mask pt_bits) pg_id y S s\<rbrace>"
apply (rule hoare_vcg_const_Ball_lift)
apply (subgoal_tac "ptr\<noteq> y")
apply (simp add:store_pte_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits)
and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp)
apply (clarsimp simp:set_pt_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits)
and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def set_object_def in_monad)
apply (drule_tac x= y in bspec,simp)
apply (clarsimp simp:pt_page_relation_def dest!: ucast_inj_mask| rule conjI)+
apply (drule mask_compare_imply)
apply ((simp add:word_size pt_bits_def pageBits_def is_aligned_mask)+)
apply (simp add:store_pte_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits)
and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp)
apply (clarsimp simp:set_pt_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageTable x)) (ptr && ~~ mask pt_bits)
and pt_page_relation (y && ~~ mask pt_bits) pg_id y S" in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def set_object_def in_monad)
apply (drule_tac x= y in bspec,simp)
apply (clarsimp simp:pt_page_relation_def dest!: ucast_inj_mask| rule conjI)+
apply (drule mask_compare_imply)
apply ((simp add:word_size pt_bits_def pageBits_def is_aligned_mask)+)
apply (clarsimp simp:pt_page_relation_def obj_at_def)
apply (assumption)
apply (clarsimp simp:pt_page_relation_def obj_at_def)
apply (assumption)
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp simp:obj_at_def)+
apply (assumption)
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp simp:obj_at_def)+
apply (assumption)
apply wp
apply (clarsimp simp:obj_at_def pt_page_relation_def)+
done
apply (clarsimp simp:obj_at_def pt_page_relation_def)+
done
lemma remain_pd_section_relation:
"\<lbrakk>is_aligned ptr 2; is_aligned y 2; ptr \<noteq> y\<rbrakk>
\<Longrightarrow> \<lbrace>\<lambda>s. pd_section_relation ( y && ~~ mask pd_bits) sid y s\<rbrace> store_pde ptr sp
\<lbrace>\<lambda>r s. pd_section_relation (y && ~~ mask pd_bits) sid y s\<rbrace>"
apply (simp add:store_pde_def)
apply wp
apply (simp add:store_pde_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits)
and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:set_pd_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits)
and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def set_object_def in_monad)
apply (clarsimp simp:pd_section_relation_def dest!:ucast_inj_mask | rule conjI)+
apply (drule mask_compare_imply)
apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+
apply (clarsimp simp:pt_page_relation_def obj_at_def)
and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:set_pd_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits)
and pd_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def set_object_def in_monad)
apply (clarsimp simp:pd_section_relation_def dest!:ucast_inj_mask | rule conjI)+
apply (drule mask_compare_imply)
apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+
apply (clarsimp simp:pt_page_relation_def obj_at_def)
apply (assumption)
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp simp:obj_at_def)+
apply (assumption)
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp simp:obj_at_def)+
apply (assumption)
apply wp
apply (clarsimp simp:obj_at_def pt_page_relation_def)+
apply wp
apply (clarsimp simp:obj_at_def pt_page_relation_def)+
done
lemma remain_pd_super_section_relation:
"\<lbrakk>is_aligned ptr 2; is_aligned y 2; ptr \<noteq> y\<rbrakk>
\<Longrightarrow> \<lbrace>\<lambda>s. pd_super_section_relation ( y && ~~ mask pd_bits) sid y s\<rbrace> store_pde ptr sp
\<lbrace>\<lambda>r s. pd_super_section_relation (y && ~~ mask pd_bits) sid y s\<rbrace>"
apply (simp add:store_pde_def)
apply wp
apply (simp add:store_pde_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits)
and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:set_pd_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits)
and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def set_object_def in_monad)
apply (clarsimp simp:pd_super_section_relation_def dest!:ucast_inj_mask | rule conjI)+
apply (drule mask_compare_imply)
apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+
apply (clarsimp simp:pt_page_relation_def obj_at_def)
and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:set_pd_def)
apply wp
apply (rule_tac Q = "ko_at (ArchObj (arch_kernel_obj.PageDirectory x)) (ptr && ~~ mask pd_bits)
and pd_super_section_relation (y && ~~ mask pd_bits) sid y " in hoare_vcg_precond_imp)
apply (clarsimp simp:valid_def set_object_def in_monad)
apply (clarsimp simp:pd_super_section_relation_def dest!:ucast_inj_mask | rule conjI)+
apply (drule mask_compare_imply)
apply (simp add:word_size pd_bits_def pt_bits_def pageBits_def is_aligned_mask)+
apply (clarsimp simp:pt_page_relation_def obj_at_def)
apply (assumption)
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp simp:obj_at_def)+
apply (assumption)
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp simp:obj_at_def)+
apply (assumption)
apply wp
apply (clarsimp simp:obj_at_def pt_page_relation_def)+
done
apply wp
apply (clarsimp simp:obj_at_def pt_page_relation_def)
done
lemma remain_pd_either_section_relation:
"\<lbrakk>\<forall>y \<in> set ys. is_aligned y 2;ptr\<notin> set ys;is_aligned ptr 2\<rbrakk>
@ -1541,18 +1531,16 @@ lemma remain_pd_either_section_relation:
\<lbrace>\<lambda>r s. \<forall>y\<in>set ys.
(pd_super_section_relation (y && ~~ mask pd_bits) pg_id y s \<or>
pd_section_relation (y && ~~ mask pd_bits) pg_id y s)\<rbrace>"
including no_pre
apply (rule hoare_vcg_const_Ball_lift)
apply (wp hoare_vcg_disj_lift)
apply (rule hoare_strengthen_post[OF remain_pd_super_section_relation])
apply fastforce+
apply (rule hoare_strengthen_post[OF remain_pd_section_relation])
apply fastforce+
done
apply (rule hoare_strengthen_post[OF remain_pd_super_section_relation]; fastforce)
apply (rule hoare_strengthen_post[OF remain_pd_section_relation]; fastforce)
done
lemma is_aligned_less_kernel_base_helper:
"\<lbrakk>is_aligned (ptr :: word32) 6;
ucast (ptr && mask pd_bits >> 2) \<notin> kernel_mapping_slots;
x < 0x40 \<rbrakk>
ucast (ptr && mask pd_bits >> 2) \<notin> kernel_mapping_slots; x < 0x40 \<rbrakk>
\<Longrightarrow> ucast (x + ptr && mask pd_bits >> 2) \<notin> kernel_mapping_slots"
apply (simp add: kernel_mapping_slots_def)
apply (simp add: word_le_nat_alt shiftr_20_unat_ucast
@ -1696,7 +1684,7 @@ lemma dcorres_store_invalid_pde_tail_super_section:
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ Cons.hyps[unfolded swp_def]])
apply (rule corres_free_return[where P=\<top> and P'=\<top>])
apply wp
apply wp+
apply simp
apply (wp store_pde_non_sense_wp)
apply simp
@ -1738,7 +1726,7 @@ lemma dcorres_store_invalid_pte_tail_large_page:
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF _ Cons.hyps[unfolded swp_def]])
apply (rule corres_free_return[where P=\<top> and P'=\<top>])
apply wp
apply wp+
apply simp
apply (wp store_pte_non_sense_wp)
apply simp
@ -1791,7 +1779,7 @@ lemma dcorres_unmap_large_section:
apply (rule_tac r'=dc
in corres_split[OF corres_free_return[where P=\<top> and P'=\<top>]])
apply (rule dcorres_store_invalid_pde_tail_super_section[where slot = ptr])
apply wp
apply wp+
apply (wp store_pde_non_sense_wp)
apply simp
apply (simp add: hd_map_simp upto_enum_step_def upto_enum_def drop_map)
@ -1912,7 +1900,7 @@ lemma dcorres_unmap_large_page:
apply (rule_tac r'=dc
in corres_split[OF corres_free_return[where P=\<top> and P'=\<top>]])
apply (rule dcorres_store_invalid_pte_tail_large_page[where slot = ptr])
apply wp
apply wp+
apply (wp store_pte_non_sense_wp)
apply simp
apply (clarsimp simp:unat_def pt_page_relation_univ)
@ -2110,19 +2098,19 @@ lemma pd_pt_relation_page_table_mapped_wp:
(lookup_pd_slot pd b && ~~ mask pd_bits) w (lookup_pd_slot pd b) s | _ \<Rightarrow> True)\<rbrace>"
apply (simp add:page_table_mapped_def)
apply wp
apply wpc
apply (clarsimp simp:validE_def valid_def return_def returnOk_def)
apply wp
apply wpc
apply (clarsimp simp:validE_def valid_def return_def returnOk_def)
apply wp+
apply simp
apply (simp add:get_pde_def)
apply wp
apply (simp add:validE_def)
apply (rule hoare_strengthen_post[where Q="\<lambda>rv. page_table_at w"])
apply wp
apply (clarsimp,rule conjI)
apply (simp add:validE_def)
apply (rule hoare_strengthen_post[where Q="\<lambda>rv. page_table_at w"])
apply wp
apply (clarsimp,rule conjI)
apply fastforce
apply (clarsimp simp:pd_pt_relation_def obj_at_def)
done
apply (clarsimp simp:pd_pt_relation_def obj_at_def)+
done
lemma hoare_post_Some_conj:
"\<lbrakk> \<lbrace>P\<rbrace>f\<lbrace>\<lambda>r s. case r of Some a \<Rightarrow> Q a s | _ \<Rightarrow> S \<rbrace>;
@ -2232,27 +2220,27 @@ lemma dcorres_page_table_mapped:
[where f = dc and E = dc and E' =dc]])
apply simp
apply (rule corres_splitEE[OF _ dcorres_find_pd_for_asid])
apply (rule_tac F =" is_aligned pda 14" in corres_gen_asm2)
apply (clarsimp simp:liftE_bindE dcorres_lookup_pd_slot)
apply (rule corres_split[OF _ dcorres_get_pde])
apply (rule_tac F =" is_aligned pda 14" in corres_gen_asm2)
apply (clarsimp simp:liftE_bindE dcorres_lookup_pd_slot)
apply (rule corres_split[OF _ dcorres_get_pde])
apply (case_tac rv')
apply (simp add:transform_pde_def)
apply (rule dcorres_returnOk,simp)
apply (simp add:transform_pde_def PPtrPAddr)
apply (intro conjI impI)
apply (simp add:transform_pde_def)
apply (rule dcorres_returnOk,simp)
apply (simp add:transform_pde_def PPtrPAddr)
apply (intro conjI impI)
apply (rule dcorres_returnOk,simp)
apply (rule dcorres_returnOk,simp)
apply (simp add:transform_pde_def)
apply (rule dcorres_returnOk,simp)
apply (simp add:transform_pde_def)
apply (rule dcorres_returnOk,simp)
apply (simp add:transform_pde_def)
apply (rule dcorres_returnOk,simp)
apply wp
apply wp+
apply (rule hoare_post_imp_R[OF find_pd_for_asid_aligned_pd])
apply simp
apply (erule less_kernel_base_mapping_slots)
apply (simp add:pd_bits_def pageBits_def)
apply wp
apply ((simp add:dc_def,rule hoareE_TrueI[where P = \<top>])|wp)+
apply ((simp add:dc_def,rule hoareE_TrueI[where P = \<top>])|wp)+
apply simp+
apply fastforce
done
@ -2310,7 +2298,7 @@ lemma dcorres_unmap_page_table:
apply (rule dcorres_flush_table)
apply (clarsimp)
apply (rule dcorres_machine_op_noop)
apply wp
apply wp+
apply (rule dcorres_unmap_page_table_store_pde)
apply (wp|simp)+
apply (wp hoare_post_Some_conj)
@ -2413,6 +2401,7 @@ lemma dcorres_unmap_page:
valid_cap (cap.ArchObjectCap (arch_cap.PageCap dev pg fun vmpage_size (Some (a, v)))))
(PageTableUnmap_D.unmap_page (transform_asid a,v) pg (pageBitsForSize vmpage_size))
(ARM_A.unmap_page vmpage_size a v pg)"
including no_pre
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:valid_cap_def)
apply (case_tac vmpage_size)
@ -2445,7 +2434,7 @@ prefer 2
| wp lookup_pt_slot_inv find_pd_for_asid_kernel_mapping_help
| safe)+
apply ((simp add:dc_def,wp)+)[3]
apply (simp add:dc_def,wp)
apply (simp add:dc_def,wp+)
-- ARMLargePage
@ -2600,7 +2589,7 @@ lemma dcorres_delete_asid:
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF corres_trivial,where r'=dc])
apply (rule dcorres_symb_exec_r[OF dcorres_set_vm_root])
apply wp
apply wp+
apply (rule dcorres_set_asid_pool)
apply simp
apply (clarsimp simp:transform_asid_def)
@ -2670,7 +2659,7 @@ lemma dcorres_finalise_cap:
apply (rule iffD2[OF corres_return[where P=\<top> and P'=\<top>]])
apply (clarsimp simp:transform_cap_def)
apply (rule set_cap_set_thread_state_inactive)
apply wp
apply wp+
apply (simp add:not_idle_thread_def)
apply (wp unbind_notification_invs | simp add: not_idle_thread_def)+
apply clarsimp
@ -3080,13 +3069,12 @@ lemma swap_for_delete_corres:
(swap_for_delete (transform_cslot_ptr p) (transform_cslot_ptr p'))
(cap_swap_for_delete p p')"
apply (rule corres_gen_asm2)
apply (simp add: swap_for_delete_def cap_swap_for_delete_def
when_def)
apply (simp add: swap_for_delete_def cap_swap_for_delete_def when_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ get_cap_corres[OF refl]])+
apply simp
apply (rule swap_cap_corres)
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply simp
apply (clarsimp simp: cte_wp_at_caps_of_state)
done
@ -3694,7 +3682,7 @@ next
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_rewrite_bindE_head)
apply (rule monadic_trancl_preemptible_return)
apply wp
apply wp+
apply simp
apply (rule corres_underlying_gets_pre_lhs)
apply (rule corres_drop_cutMon)
@ -3707,7 +3695,7 @@ next
apply (rule monadic_rewrite_pick_alternative_2)
apply (rule monadic_rewrite_bind_tail)
apply (rule monadic_trancl_preemptible_return)
apply wp
apply wp+
apply (rule corres_split[OF _ set_cap_corres])
apply (rule corres_underlying_gets_pre_lhs)
apply (rule corres_trivial, simp add: returnOk_liftE)
@ -3856,7 +3844,7 @@ next
apply (wp | simp)+
apply (simp add: in_monad)
apply simp
apply (wp cutMon_validE_R_drop)
apply (wp cutMon_validE_R_drop)+
apply clarsimp
apply (clarsimp simp: cte_wp_at_caps_of_state halted_emptyable)
apply (frule valid_global_refsD2, clarsimp+)

215
proof/drefine/Intent_DR.thy
View File

@ -1363,56 +1363,56 @@ lemma get_ipc_buffer_words_helper:
apply (clarsimp dest!:get_tcb_SomeD simp:get_ipc_buffer_words_def split:cap.splits arch_cap.splits)
apply (frule ipc_frame_ptr_at_frame_at[where buf = obuf],simp+)
apply (frule valid_tcb_obj_ipc_align_etc[where buf = obuf],simp+)
apply (erule get_tcb_rev)
apply (erule get_tcb_rev)
apply (rule arg_cong[where f = the])
apply (rule evalMonad_mapM)
defer
apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord)
apply (wp loadWord_inv)
defer
apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord)
apply (wp loadWord_inv)+
apply (clarsimp simp:obj_at_def ipc_frame_wp_at_def)
apply (drule_tac x = r in bspec,simp)
apply (clarsimp simp:evalMonad_loadWord get_tcb_SomeD | rule conjI)+
apply (rule arg_cong[where f = word_rcat])
apply clarsimp
apply clarsimp
apply (clarsimp simp:|rule conjI)
apply (rule underlying_memory_storeWord)
apply simp_all
apply (rule underlying_memory_storeWord)
apply simp_all
apply (rule aligned_add_aligned)+
apply simp+
apply (rule is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply simp+
apply (rule is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule conjI)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (simp_all)
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule conjI)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (simp_all)
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord[where n = 0,simplified])
apply (simp_all)
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7]
done
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7]
done
lemma get_ipc_buffer_words_separate_frame:
"\<lbrakk>valid_objs s;
@ -1429,64 +1429,64 @@ lemma get_ipc_buffer_words_separate_frame:
apply (frule ipc_frame_ptr_at_frame_at[where buf = buf],simp+)
apply (frule ipc_frame_ptr_at_frame_at[where buf = obuf],simp+)
apply (frule valid_tcb_obj_ipc_align_etc[where buf = obuf],simp+)
apply (erule get_tcb_rev)
apply (erule get_tcb_rev)
apply (subgoal_tac "\<exists>tcb. get_tcb s_id s = Some tcb")
prefer 2
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
apply (rule exI)
apply (erule get_tcb_rev)
prefer 2
apply (clarsimp simp:ipc_frame_wp_at_def obj_at_def)
apply (rule exI)
apply (erule get_tcb_rev)
apply clarify
apply (frule valid_tcb_obj_ipc_align_etc[where buf = buf],simp+)
apply (rule arg_cong[where f = the])
apply (rule evalMonad_mapM)
defer
apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord)
apply (wp loadWord_inv)
defer
apply (simp_all add:empty_when_fail_loadWord weak_det_spec_loadWord)
apply (wp loadWord_inv)+
apply (clarsimp simp:obj_at_def ipc_frame_wp_at_def)
apply (drule_tac x = r in bspec,simp)
apply (clarsimp split:cap.split_asm arch_cap.split_asm)
apply (clarsimp simp:evalMonad_loadWord get_tcb_SomeD | rule conjI)+
apply (rule arg_cong[where f = word_rcat])
apply clarsimp
apply clarsimp
apply (clarsimp simp:|rule conjI)
apply (rule underlying_memory_storeWord)
apply simp_all
apply (rule underlying_memory_storeWord)
apply simp_all
apply (rule aligned_add_aligned)+
apply simp+
apply (rule is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply simp+
apply (rule is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf =obuf and buf'=buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule conjI)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (simp_all)
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule conjI)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord)
apply (simp_all)
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply (simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+
apply (subst add.assoc[symmetric])+
apply (rule underlying_memory_storeWord[where n = 0,simplified])
apply (simp_all)
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7]
done
apply (rule aligned_add_aligned)+
apply simp+
apply (subst is_aligned_after_mask)
apply simp+
apply (rule ipc_buffer_within_frame[where buf = obuf and buf' = buf])
apply ((simp add:obj_at_def get_tcb_SomeD within_page_def add.assoc)+)[7]
done
lemma mask_inj_if:
"\<lbrakk>a && mask n = a; b && mask n = b; a && mask n = b && mask n\<rbrakk>\<Longrightarrow> a = b"
@ -1500,21 +1500,21 @@ lemma bound_preserve_mask:
"\<lbrakk>is_aligned (x::word32) n; x\<le> mask k; (z::word32)\<le> mask n;
n < 32;k<32;n\<le> k\<rbrakk> \<Longrightarrow> x+z \<le> mask k"
apply (rule less_less_trans[where b = "(mask k && ~~ mask n) + mask n"])
apply (rule less_less_trans[where b = "x + mask n"])
apply (erule word_plus_mono_right)
apply (rule is_aligned_no_wrap')
apply simp
apply (rule mask_lt_2pn)
apply (simp add:word_size)
apply (rule word_plus_mono_left)
apply (rule less_less_trans[where b = "x + mask n"])
apply (erule word_plus_mono_right)
apply (rule is_aligned_no_wrap')
apply simp
apply (rule mask_lt_2pn)
apply (simp add:word_size)
apply (rule word_plus_mono_left)
apply (rule less_less_trans[where b = "x && ~~ mask n"])
apply (simp add:mask_out_sub_mask is_aligned_mask)
apply (simp add:mask_out_sub_mask is_aligned_mask)
apply (erule neg_mask_mono_le)
apply (simp add:mask_out_sub_mask mask_and_mask min_def)
apply (rule word_leI)
apply (clarsimp simp:word_size)
apply (simp add:mask_out_sub_mask mask_and_mask min_def)
apply (rule word_leI)
apply (clarsimp simp:word_size)
apply (simp add:mask_out_sub_mask mask_and_mask min_def)
done
done
lemma nat_less_le:
"(a::nat) < b \<Longrightarrow> a \<le> b - 1"
@ -1526,7 +1526,7 @@ lemma within_page_ipc_buf:
\<Longrightarrow> within_page buf (buf + (bptr && mask (pageBitsForSize sz)) + of_nat x * of_nat word_size) sz"
apply (clarsimp simp:ipc_buffer_wp_at_def obj_at_def)
apply (frule valid_tcb_obj_ipc_align_etc,simp+)
apply (erule get_tcb_rev)
apply (erule get_tcb_rev)
apply (clarsimp simp: ipc_frame_wp_at_def obj_at_def within_page_def)
apply (clarsimp split: cap.split_asm arch_cap.split_asm)
apply (frule valid_tcb_objs, erule get_tcb_rev)
@ -1534,18 +1534,18 @@ lemma within_page_ipc_buf:
apply (subst add.assoc)
apply (erule is_aligned_add_helper[THEN conjunct2])
apply (rule iffD1[OF le_mask_iff_lt_2n[where n = "pageBitsForSize sz"],THEN iffD1])
apply (simp add:word_size)
apply (case_tac sz,simp_all)
apply (simp add:word_size)
apply (case_tac sz,simp_all)
apply (rule bound_preserve_mask[where n = msg_align_bits])
apply (rule is_aligned_after_mask)
apply (simp add:word_and_le1)+
apply (simp add:msg_align_bits mask_2pm1)
apply (rule div_le_mult)
apply (simp add:word_size_def)
apply (rule word_of_nat_le)
apply (simp add:word_size_def msg_align_bits)+
apply (cases sz,auto)
done
apply (rule is_aligned_after_mask)
apply (simp add:word_and_le1)+
apply (simp add:msg_align_bits mask_2pm1)
apply (rule div_le_mult)
apply (simp add:word_size_def)
apply (rule word_of_nat_le)
apply (simp add:word_size_def msg_align_bits)+
apply (cases sz,auto)
done
lemma eq_sym_helper: "(A = B) \<Longrightarrow> (B = A)"
by auto
@ -1838,7 +1838,7 @@ lemma zip_cpy_word_corres:
apply (rule Cons.hyps)
using Cons
apply clarsimp
apply wp
apply wp+
apply (rule corres_symb_exec_r)
apply (simp add: store_word_offs_def bind_assoc[symmetric]
state_assert_def[symmetric])
@ -1852,11 +1852,10 @@ lemma zip_cpy_word_corres:
apply (rule_tac x=sz in exI)
apply (frule (2) ipc_frame_ptr_at_frame_at)
apply (simp add: obj_at_def a_type_simps)
apply wp
apply wp+
apply clarsimp+
apply (wp store_word_offs_ipc_frame_wp)
apply (fastforce simp:ipc_frame_wp_at_def)+
done
by (fastforce simp:ipc_frame_wp_at_def)+
qed
lemma zip_store_word_corres:
@ -1894,7 +1893,7 @@ lemma zip_store_word_corres:
apply (rule_tac x=sz in exI)
apply (frule (2) ipc_frame_ptr_at_frame_at)
apply (simp add: obj_at_def a_type_simps)
apply (wp store_word_offs_ipc_frame_wp)
apply (wp store_word_offs_ipc_frame_wp)+
apply clarsimp+
done
@ -1998,7 +1997,7 @@ lemma set_mrs_corres:
apply (clarsimp simp del:upt.simps)
apply (rule within_page_ipc_buf)
apply ((simp add:msg_align_bits msg_max_length_def)+)[7]
apply wp
apply wp+
apply (clarsimp, drule(1) valid_etcbs_get_tcb_get_etcb)
apply (rule_tac s'=s' in set_cxt_none_det_intent_corres)
apply (clarsimp dest!:get_tcb_SomeD get_etcb_SomeD)+
@ -2055,7 +2054,7 @@ lemma copy_mrs_corres:
apply (rule corres_free_return[where P="\<top>" and P'="\<top>"])
apply (rule dcorres_dummy_corrupt_frame)
apply wp
apply (clarify,simp del:upt.simps )
apply (clarify,simp del:upt.simps )
apply (rule corres_dummy_return_l)
apply (rule corres_split[where r'="dc"])
apply (rule corres_free_return[where P="\<top>" and P'="\<top>"])
@ -2069,7 +2068,7 @@ lemma copy_mrs_corres:
apply (rule iffD2[OF Suc_le_mono])
apply (erule iffD1[OF word_le_nat_alt])
apply simp
apply wp
apply wp+
apply (rule set_registers_corres)
apply ((clarsimp|wp)+)[1]
apply (rule mapM_wp_inv)
@ -2079,7 +2078,7 @@ lemma copy_mrs_corres:
apply (clarsimp|rule conjI)+
apply ((wp|clarsimp)+)[3]
apply (case_tac rv)
apply (clarsimp simp: ipc_buffer_wp_at_def obj_at_def tcb_at_def)+
apply (fastforce simp: ipc_buffer_wp_at_def obj_at_def tcb_at_def)+
done
lemmas transform_cap_simps [simp] = transform_cap_def [split_simps cap.split arch_cap.split]
@ -2200,7 +2199,7 @@ lemma dcorres_store_word_conservative:
pspace_aligned and valid_etcbs)
(corrupt_frame obuf) (do_machine_op (storeWord ptr b))"
apply (rule dcorres_expand_pfx,clarsimp)
apply (case_tac "\<forall>buf. (\<exists>thread. ipc_frame_ptr_at buf thread s') \<longrightarrow> buf \<noteq> obuf")
apply (case_tac "\<forall>buf. (\<exists>thread. ipc_frame_ptr_at buf thread s') \<longrightarrow> buf \<noteq> obuf")
apply (rule corres_dummy_return_pl)
apply (rule corres_dummy_return_r)
apply (rule corres_underlying_split)

76
proof/drefine/Interrupt_DR.thy Executable file → Normal file
View File

@ -76,25 +76,25 @@ lemma decode_irq_control_corres:
apply (simp add: get_index_def transform_cap_list_def throw_on_none_def)
apply (cases "excaps' = []", simp_all)
apply (rule corres_alternative_throw_splitE)
apply (rule corres_alternate1)
apply (rule lookup_slot_for_cnode_op_corres)
apply simp+
apply (clarsimp simp: split_def,simp)
apply (rule corres_throw_skip_r)
apply (rule corres_alternate1)
apply (rule corres_returnOk [where P=\<top> and P'=\<top>])
apply (simp add: cdl_irq_control_invocation_relation_def)
apply (subst ucast_mask_drop)
apply simp
apply (rule corres_alternate1)
apply (rule lookup_slot_for_cnode_op_corres)
apply simp+
apply (clarsimp simp: split_def,simp)
apply (rule corres_throw_skip_r)
apply (rule corres_alternate1)
apply (rule corres_returnOk [where P=\<top> and P'=\<top>])
apply (simp add: cdl_irq_control_invocation_relation_def)
apply (subst ucast_mask_drop)
apply simp
apply simp
apply wp[1]
apply simp
apply wp[1]
apply simp
apply wp[3]
apply simp
apply (rule hoare_pre, wp)
apply simp
apply wp
apply (cases excaps', auto)[1]
apply (wp+)[3]
apply simp
apply (rule hoare_pre, wp)
apply simp
apply wp
apply (cases excaps', auto)[1]
apply wp[1]
apply (clarsimp simp: arch_decode_irq_control_invocation_def transform_intent_def)
apply (rule corres_guard_imp)
@ -208,13 +208,10 @@ lemma ackInterrupt_underlying_memory[wp]:
lemma resetTimer_underlying_memory[wp]:
"\<lbrace>\<lambda>ms. underlying_memory ms = m\<rbrace> resetTimer \<lbrace>\<lambda>rv ms. underlying_memory ms = m\<rbrace>"
apply (simp add:resetTimer_def machine_op_lift_def)
apply (simp add:machine_rest_lift_def ignore_failure_def)
apply (simp add:machine_rest_lift_def ignore_failure_def split_def)
apply wp
apply (clarsimp simp:valid_def simpler_modify_def)
apply simp
apply (simp add:select_f_def | rule conjI)+
apply (clarsimp simp:valid_def,simp)+
done
apply (clarsimp simp:valid_def simpler_modify_def)
done
lemma valid_state_get_cap_wp:
"\<lbrace>valid_state\<rbrace> CSpaceAcc_A.get_cap xa \<lbrace>\<lambda>rv s. (is_ntfn_cap rv \<longrightarrow> ntfn_at (obj_ref_of rv) s)\<rbrace>"
@ -281,6 +278,7 @@ lemma timer_tick_dcorres: "dcorres dc P P' (return ()) timer_tick"
lemma handle_interrupt_corres:
"dcorres dc \<top> (invs and valid_etcbs) (Interrupt_D.handle_interrupt x) (Interrupt_A.handle_interrupt x)"
including no_pre
apply (clarsimp simp:Interrupt_A.handle_interrupt_def)
apply (clarsimp simp:get_irq_state_def gets_def bind_assoc)
apply (rule conjI; rule impI)
@ -365,11 +363,11 @@ lemma set_irq_state_dwp:
set_irq_state irq_state.IRQSignal word \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
apply (simp add:set_irq_state_def)
apply (wp do_machine_op_wp)
apply clarsimp
apply (wp maskInterrupt_underlying_memory)
apply clarsimp
apply (wp maskInterrupt_underlying_memory)+
apply (clarsimp simp:transform_def transform_objects_def transform_cdt_def
transform_current_thread_def transform_asid_table_def)
done
done
lemma dcorres_invoke_irq_control:
"dcorres dc \<top> (invs and irq_control_inv_valid irq_control_invocation and valid_etcbs)
@ -462,18 +460,18 @@ lemma cte_wp_at_neq_slot_cap_delete_one:
\<lbrace>\<lambda>rv. cte_wp_at P slot\<rbrace>"
apply (clarsimp simp:cap_delete_one_def unless_def)
apply (wp hoare_when_wp)
apply (clarsimp simp:empty_slot_def)
apply (wp cte_wp_at_neq_slot_set_cap)
apply clarsimp
apply (wp dxo_wp_weak | simp)+
apply (clarsimp simp:set_cdt_def)
apply (wp | clarsimp)+
apply (rule_tac Q = "\<lambda>r s. cte_wp_at P slot s \<and> cte_at slot' s" in hoare_strengthen_post)
apply (rule hoare_vcg_conj_lift)
apply wp_once
apply (wp get_cap_cte)
apply (clarsimp|wp)+
done
apply (clarsimp simp:empty_slot_def)
apply (wp cte_wp_at_neq_slot_set_cap)
apply clarsimp
apply (wp dxo_wp_weak | simp)+
apply (clarsimp simp:set_cdt_def)
apply (wp | clarsimp)+
apply (rule_tac Q = "\<lambda>r s. cte_wp_at P slot s \<and> cte_at slot' s" in hoare_strengthen_post)
apply (rule hoare_vcg_conj_lift)
apply wp_once
apply (wp get_cap_cte)
apply (clarsimp|wp)+
done
lemma cap_delete_one_not_idle [wp]:
"\<lbrace>not_idle_thread t\<rbrace> cap_delete_one slot \<lbrace>\<lambda>_. not_idle_thread t\<rbrace>"

380
proof/drefine/Ipc_DR.thy
View File

@ -39,13 +39,7 @@ done
lemma as_user_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> as_user thread x \<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
apply (clarsimp simp:as_user_def)
apply (wp set_object_cur_thread_idle_thread)+
apply (fastforce simp:set_object_def valid_def get_def put_def return_def bind_def)
apply (simp add:select_f_def)
apply (simp add:valid_def)
apply (auto|wp)+
done
by (wpsimp wp: set_object_cur_thread_idle_thread simp: as_user_def split_def)
lemma do_fault_transfer_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> do_fault_transfer c a e recv_buffer \<lbrace>\<lambda>rv s. P (cur_thread s) (idle_thread s)\<rbrace>"
@ -80,13 +74,13 @@ lemma handle_reply_cur_thread_idle_thread:
apply (wp set_thread_state_cur_thread_idle_thread dxo_wp_weak
|wpc|simp add: trans_state_def)+
apply ((wps|wp cap_delete_one_it)+)[1]
apply (wp do_ipc_transfer_cur_thread_idle_thread dxo_wp_weak)
apply (wp do_ipc_transfer_cur_thread_idle_thread dxo_wp_weak)+
apply (clarsimp simp: trans_state_def)
apply (case_tac xf)
apply (simp | wp set_thread_state_cur_thread_idle_thread
thread_set_cur_thread_idle_thread)+
apply ((wps | wp)+)[1]
apply wp
apply wp+
apply ((wps | wp cap_delete_one_it)+)[1]
apply (rule hoare_drop_imp | rule hoare_conjI | rule hoare_allI | wp)+
apply simp+
@ -193,7 +187,8 @@ lemma mapM_functional:
shows "functional (mapM f ns)"
apply (rule functional_from_wp)
apply (wp mapM_wp')
apply (rule fn [unfolded functional_def, THEN spec])
apply (rule fn [unfolded functional_def, THEN spec])
apply assumption
done
lemma evalMonad_mapM_functional:
@ -537,11 +532,11 @@ lemma corres_update_waiting_ntfn_do_notification_transfer:
valid_ntfn (\<lparr>ntfn_obj = case ys of [] \<Rightarrow> Structures_A.ntfn.IdleNtfn | a # list \<Rightarrow> Structures_A.ntfn.WaitingNtfn ys, ntfn_bound_tcb = bound_tcb\<rparr> ))
(Endpoint_D.do_notification_transfer y)
(update_waiting_ntfn epptr (y # ys) bound_tcb badge)"
apply (simp add: Endpoint_D.do_notification_transfer_def update_waiting_ntfn_def assert_def)
apply (rule corres_dummy_return_pl)
apply (rule corres_split_keep_pfx[where r'="dc" and Q="%x. \<top>" and Q'="%x. \<top>"])
apply (rule corres_guard_imp,rule corres_dummy_set_notification,clarsimp+)
apply (rule dcorres_expand_pfx)
apply (simp add: Endpoint_D.do_notification_transfer_def update_waiting_ntfn_def assert_def)
apply (rule corres_dummy_return_pl)
apply (rule corres_split_keep_pfx[where r'="dc" and Q="%x. \<top>" and Q'="%x. \<top>"])
apply (rule corres_guard_imp,rule corres_dummy_set_notification,clarsimp+)
apply (rule dcorres_expand_pfx)
apply clarsimp
apply (frule_tac y = y in generates_pending_not_idle)
apply (clarsimp simp:st_tcb_at_def obj_at_def)
@ -551,14 +546,14 @@ lemma corres_update_waiting_ntfn_do_notification_transfer:
apply (rule dcorres_dc_rhs_noop_below_2_True[OF allI[OF switch_if_required_to_dcorres]])
apply (rule corres_split[OF _ set_thread_state_corres])
apply (rule set_register_corres)
apply (wp hoare_TrueI)
apply (wp)+
apply simp
apply (frule generates_pending_not_idle[where y = y])
apply (clarsimp simp: pred_tcb_at_def obj_at_def generates_pending_def)
apply (drule_tac t = "tcb_state tcb" in sym)
apply ((clarsimp simp:pred_tcb_at_def obj_at_def not_idle_thread_def split:Structures_A.thread_state.splits)+)[3]
apply (wp set_ntfn_aligned set_ntfn_mdb set_ntfn_valid_objs sts_typ_ats)
apply (simp_all add:not_idle_thread_def)+
apply (simp_all add:not_idle_thread_def)+
apply (clarsimp simp: pred_tcb_at_def obj_at_def)
apply (drule valid_tcb_objs,erule get_tcb_rev)
apply (drule_tac t = "tcb_state tcb" in sym)
@ -725,7 +720,7 @@ lemma dcorres_dat:
apply (rule dcorres_dc_rhs_noop_below_2_True[OF allI[OF switch_if_required_to_dcorres]])
apply (rule corres_split[OF _ set_thread_state_corres])
apply (rule set_register_corres)
apply (wp hoare_TrueI)
apply (wp)+
apply simp
apply (clarsimp simp: not_idle_thread_def valid_state_def)
done
@ -733,24 +728,25 @@ lemma dcorres_dat:
lemma not_idle_after_blocked_cancel_ipc:
"\<lbrace>valid_idle and not_idle_thread obj_id' and valid_objs and st_tcb_at (op = state) obj_id'\<rbrace>
blocked_cancel_ipc state obj_id' \<lbrace>\<lambda>y. valid_idle\<rbrace>"
including no_pre
apply (simp add:blocked_cancel_ipc_def)
apply wp
apply (clarsimp simp:not_idle_thread_def)
apply (clarsimp simp:get_blocking_object_def)
apply (case_tac state)
apply clarsimp+
apply (clarsimp simp:valid_def return_def st_tcb_at_def valid_objs_def obj_at_def)
apply (drule_tac x = obj_id' in bspec)
apply wp
apply (clarsimp simp:not_idle_thread_def)
apply (clarsimp simp:get_blocking_object_def)
apply (case_tac state)
apply clarsimp+
apply (clarsimp simp:valid_def return_def st_tcb_at_def valid_objs_def obj_at_def)
apply (drule_tac x = obj_id' in bspec)
apply (clarsimp simp:valid_obj_def valid_tcb_def valid_tcb_state_def)+
apply (drule_tac t = "tcb_state tcb" in sym)
apply (clarsimp simp:obj_at_def)
apply (clarsimp simp:valid_def return_def st_tcb_at_def obj_at_def valid_objs_def)
apply (drule_tac t = "tcb_state tcb" in sym)
apply (clarsimp simp:obj_at_def)
apply (clarsimp simp:valid_def return_def st_tcb_at_def obj_at_def valid_objs_def)
apply (drule_tac x = obj_id' in bspec)
apply (clarsimp simp:valid_obj_def valid_tcb_def valid_tcb_state_def)+
apply (drule_tac t = "tcb_state tcb" in sym)
apply (clarsimp simp:obj_at_def)
apply (clarsimp)+
done
apply (clarsimp simp:valid_obj_def valid_tcb_def valid_tcb_state_def)+
apply (drule_tac t = "tcb_state tcb" in sym)
apply (clarsimp simp:obj_at_def)
apply (clarsimp)+
done
lemma valid_idle_set_thread_state:
"\<lbrace>not_idle_thread xa and valid_idle :: det_state \<Rightarrow> bool\<rbrace> set_thread_state xa Structures_A.thread_state.Restart \<lbrace>\<lambda>xa. valid_idle\<rbrace>"
@ -772,57 +768,58 @@ lemma tcb_sched_action_tcb_at_not_idle[wp]:
lemma valid_idle_cancel_all_ipc:
"\<lbrace>valid_idle and valid_state :: det_state \<Rightarrow> bool\<rbrace> IpcCancel_A.cancel_all_ipc word1 \<lbrace>\<lambda>a. valid_idle\<rbrace>"
including no_pre
apply (simp add:cancel_all_ipc_def)
apply (wp|wpc|simp)+
apply (rename_tac queue list)
apply (rule_tac I = "(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp)
apply clarsimp
apply (wp KHeap_DR.tcb_at_set_thread_state_wp)
apply (rule hoare_conjI)
apply (rule_tac P="(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1"
in hoare_vcg_precond_imp)
apply (wp | clarsimp)+
apply (rule set_thread_state_ko)
apply (simp add:is_tcb_def)
apply (wp valid_idle_set_thread_state)
apply (clarsimp simp:)+
apply (rename_tac queue list)
apply (rule_tac I = "(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp)
apply clarsimp
apply (wp KHeap_DR.tcb_at_set_thread_state_wp)
apply (rule hoare_conjI)
apply (rule_tac P="(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1"
in hoare_vcg_precond_imp)
apply (wp | clarsimp)+
apply (rule set_thread_state_ko)
apply (simp add:is_tcb_def)
apply (wp valid_idle_set_thread_state)
apply (clarsimp simp:)+
apply wp
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_Ball_helper)
apply (wp set_endpoint_obj_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+
apply (rename_tac queue list)
apply (rule_tac I = "(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp)
apply clarsimp
apply (wp KHeap_DR.tcb_at_set_thread_state_wp)
apply (rule hoare_conjI)
apply (rule_tac P="(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1"
in hoare_vcg_precond_imp)
apply (rule set_thread_state_ko)
apply (simp add:is_tcb_def)
apply (wp valid_idle_set_thread_state)
apply (clarsimp simp:)+
apply wp
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_Ball_helper)
apply (rule hoare_Ball_helper)
apply (wp set_endpoint_obj_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+
apply (rename_tac queue list)
apply (rule_tac I = "(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1 and valid_idle" in mapM_x_inv_wp)
apply clarsimp
apply (wp KHeap_DR.tcb_at_set_thread_state_wp)
apply (rule hoare_conjI)
apply (rule_tac P="(\<lambda>s. (queue = list) \<and> (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and valid_idle and ko_at (kernel_object.Endpoint Structures_A.endpoint.IdleEP) word1"
in hoare_vcg_precond_imp)
apply (rule set_thread_state_ko)
apply (simp add:is_tcb_def)
apply (wp valid_idle_set_thread_state)
apply (clarsimp simp:)+
apply wp
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_Ball_helper)
apply (wp set_endpoint_obj_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+
apply (rule hoare_strengthen_post[OF get_endpoint_sp])
apply (clarsimp | rule conjI)+
apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def)
apply (drule(1) valid_objs_valid_ep_simp)
apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def)
apply (drule(1) pending_thread_in_send_not_idle)
apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+
apply (clarsimp | rule conjI)+
apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def)
apply (drule(1) valid_objs_valid_ep_simp)
apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def)
apply (drule(1) pending_thread_in_recv_not_idle)
apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+
done
apply (rule hoare_strengthen_post[OF get_endpoint_sp])
apply (clarsimp | rule conjI)+
apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def)
apply (drule(1) valid_objs_valid_ep_simp)
apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def)
apply (drule(1) pending_thread_in_send_not_idle)
apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+
apply (clarsimp | rule conjI)+
apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def)
apply (drule(1) valid_objs_valid_ep_simp)
apply (clarsimp simp:is_tcb_def valid_ep_def obj_at_def)
apply (drule(1) pending_thread_in_recv_not_idle)
apply (simp add:not_idle_thread_def obj_at_def is_ep_def)+
done
lemma set_ntfn_obj_at:
"\<lbrace>\<lambda>s. P (kernel_object.Notification ep)\<rbrace> set_notification ptr ep \<lbrace>\<lambda>rv. obj_at P ptr\<rbrace>"
@ -835,61 +832,65 @@ done
lemma valid_idle_cancel_all_signals:
"\<lbrace>valid_idle and valid_state :: det_state \<Rightarrow> bool\<rbrace> IpcCancel_A.cancel_all_signals word1 \<lbrace>\<lambda>a. valid_idle\<rbrace>"
including no_pre
apply (simp add:cancel_all_signals_def)
apply (wp|wpc|simp)+
apply (rename_tac list)
apply (rule_tac I = "(\<lambda>s. (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1 and valid_idle" in mapM_x_inv_wp)
apply clarsimp
apply (wp KHeap_DR.tcb_at_set_thread_state_wp)
apply (rule hoare_conjI)
apply (rule_tac P="(\<lambda>s. (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and valid_idle and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1"
in hoare_vcg_precond_imp)
apply (rule set_thread_state_ko)
apply (simp add:is_tcb_def)
apply (wp valid_idle_set_thread_state)
apply (clarsimp simp:)+
apply (rename_tac list)
apply (rule_tac I = "(\<lambda>s. (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1 and valid_idle" in mapM_x_inv_wp)
apply clarsimp
apply (wp KHeap_DR.tcb_at_set_thread_state_wp)
apply (rule hoare_conjI)
apply (rule_tac P="(\<lambda>s. (\<forall>a\<in> set list. tcb_at a s \<and> not_idle_thread a s))
and valid_idle and ko_at (kernel_object.Notification (ntfn_set_obj ntfn Structures_A.ntfn.IdleNtfn)) word1"
in hoare_vcg_precond_imp)
apply (rule set_thread_state_ko)
apply (simp add:is_tcb_def)
apply (wp valid_idle_set_thread_state)+
apply (clarsimp simp:)+
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_Ball_helper)
apply (rule hoare_Ball_helper)
apply (wp set_ntfn_tcb| clarsimp simp : not_idle_thread_def)+
apply (wp set_ntfn_obj_at)
apply (rule hoare_strengthen_post[OF get_ntfn_sp])
apply (clarsimp | rule conjI)+
apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def)
apply (drule(1) valid_objs_valid_ntfn_simp)
apply (clarsimp simp:is_tcb_def valid_ntfn_def obj_at_def)
apply (drule(1) pending_thread_in_wait_not_idle)
apply (wp set_ntfn_obj_at)+
apply (rule hoare_strengthen_post[OF get_ntfn_sp])
apply (clarsimp | rule conjI)+
apply (clarsimp simp:obj_at_def valid_pspace_def valid_state_def)
apply (drule(1) valid_objs_valid_ntfn_simp)
apply (clarsimp simp:is_tcb_def valid_ntfn_def obj_at_def)
apply (drule(1) pending_thread_in_wait_not_idle)
apply (simp add:not_idle_thread_def obj_at_def is_ntfn_def)+
done
lemma not_idle_after_reply_cancel_ipc:
"\<lbrace>not_idle_thread obj_id' and invs :: det_state \<Rightarrow> bool \<rbrace> reply_cancel_ipc obj_id'
\<lbrace>\<lambda>y. valid_idle\<rbrace>"
including no_pre
apply (simp add:reply_cancel_ipc_def)
apply wp
apply (simp add:cap_delete_one_def unless_def)
apply wp
apply wp+
apply (simp add:IpcCancel_A.empty_slot_def)
apply (wp set_cap_idle)+
apply simp
apply (rule hoare_strengthen_post[OF get_cap_idle])
apply simp
apply (case_tac capa)
apply (simp_all add:fast_finalise.simps)
apply (simp_all add:fast_finalise.simps)
apply (clarsimp simp:when_def | rule conjI)+
apply (wp valid_idle_cancel_all_ipc valid_idle_cancel_all_signals | clarsimp simp: unbind_maybe_notification_def | wpc)+
apply (wp valid_idle_cancel_all_ipc valid_idle_cancel_all_signals
| clarsimp simp: unbind_maybe_notification_def | wpc)+
apply (rule hoare_strengthen_post[where Q="\<lambda>r. valid_state and valid_idle"])
apply (wp select_inv|simp)+
apply (rule hoare_strengthen_post[where Q="\<lambda>r. valid_state and valid_idle"])
apply wp
apply wp+
apply (rule hoare_strengthen_post)
apply (rule hoare_vcg_precond_imp[OF thread_set_invs_trivial])
apply (simp add:tcb_cap_cases_def invs_def valid_state_def)+
apply (simp add:tcb_cap_cases_def invs_def valid_state_def)+
done
lemma not_idle_thread_cancel_signal:
"\<lbrace>not_idle_thread obj_id' and valid_idle\<rbrace> cancel_signal obj_id' word \<lbrace>\<lambda>r. valid_idle\<rbrace>"
"\<lbrace>not_idle_thread obj_id' and valid_idle\<rbrace> cancel_signal obj_id' word \<lbrace>\<lambda>r. valid_idle\<rbrace>"
including no_pre
apply (simp add:cancel_signal_def)
apply (wp valid_idle_set_thread_state|wpc)+
apply (rule hoare_strengthen_post[OF get_ntfn_sp])
@ -1044,7 +1045,7 @@ lemma corres_setup_caller_cap:
apply (clarsimp simp:not_idle_thread_def set_thread_state_def)
apply wp
apply (simp add:set_object_def)
apply wp
apply wp+
apply simp
apply (clarsimp simp:not_idle_thread_def tcb_at_def obj_at_def st_tcb_at_def)
apply (rule conjI|clarsimp simp:is_tcb_def)+
@ -1073,22 +1074,23 @@ lemma evalMonad_mapM:
next
case (Cons l ls)
show ?case
using Cons.prems
apply clarsimp
apply (clarsimp simp:mapM_Cons)
apply (subst (asm) evalMonad_compose)
apply (simp add: Cons assms)+
apply (clarsimp split:option.splits)
apply (subst (asm) evalMonad_compose)
apply (rule empty_when_fail_mapM)
apply (simp add: Cons assms)+
apply (rule weak_det_spec_mapM)
apply (simp add: Cons assms)+
apply (wp mapM_wp)
apply (simp add: Cons assms)+
apply fastforce
apply (clarsimp split:option.splits)
apply (simp add: Cons)
using Cons.prems
apply clarsimp
apply (clarsimp simp:mapM_Cons)
apply (subst (asm) evalMonad_compose)
apply (simp add: Cons assms)+
apply (clarsimp split:option.splits)
apply (subst (asm) evalMonad_compose)
apply (rule empty_when_fail_mapM)
apply (simp add: Cons assms)+
apply (rule weak_det_spec_mapM)
apply (simp add: Cons assms)+
apply (wp mapM_wp)
apply (simp add: Cons assms)+
apply fastforce
apply simp
apply (clarsimp split:option.splits)
apply (simp add: Cons)
done
qed
@ -1097,14 +1099,15 @@ lemma evalMonad_get_extra_cptrs:
(evalMonad (Ipc_A.get_extra_cptrs (Some buf) (data_to_message_info (arch_tcb_context_get (tcb_arch tcb) msg_info_register))) s) = Some a
\<rbrakk>
\<Longrightarrow> a = (map (to_bl) (cdl_intent_extras $ transform_full_intent (machine_state s) thread tcb))"
including no_pre
apply (clarsimp simp:get_extra_cptrs_def)
apply (clarsimp simp:liftM_def)
apply (subst (asm) evalMonad_compose)
apply (rule empty_when_fail_mapM)
apply (simp add:weak_det_spec_load_word_offs empty_when_fail_load_word_offs)
apply (rule empty_when_fail_mapM)
apply (simp add:weak_det_spec_load_word_offs empty_when_fail_load_word_offs)
apply (rule weak_det_spec_mapM)
apply (simp add:weak_det_spec_load_word_offs)
apply (wp mapM_wp,fastforce)
apply (wp mapM_wp,fastforce)
apply (clarsimp split:option.splits)
apply (rule_tac x = x2 in arg_cong)
apply (clarsimp simp:transform_full_intent_def Let_def)
@ -1112,14 +1115,14 @@ lemma evalMonad_get_extra_cptrs:
apply (drule lookup_ipc_buffer_SomeB_evalMonad)
apply (clarsimp simp:cte_wp_at_cases obj_at_def dest!: get_tcb_SomeD)
apply (drule sym[where t = "tcb_ipcframe tcb"])
apply clarsimp
apply clarsimp
apply (simp add:mapM_load_word_offs_do_machine_op)
apply (subst (asm) evalMonad_do_machine_op[symmetric])
apply (rule weak_det_spec_mapM[OF weak_det_spec_loadWord])
apply (rule empty_when_fail_mapM)
apply (clarsimp simp:empty_when_fail_loadWord weak_det_spec_loadWord)
apply (rule empty_when_fail_mapM)
apply (clarsimp simp:empty_when_fail_loadWord weak_det_spec_loadWord)
apply (clarsimp simp:get_tcb_message_info_def)
done
done
lemma dcorres_symb_exec_r_evalMonad:
assumes wp:"\<And>sa. \<lbrace>op = sa\<rbrace> f \<lbrace>\<lambda>r. op = sa\<rbrace>"
@ -1291,7 +1294,7 @@ lemma ipc_buffer_wp_at_cap_insert[wp]:
apply (rule_tac Q = "\<lambda>r. ipc_buffer_wp_at buf t" in hoare_strengthen_post)
apply wp
apply (clarsimp simp:ipc_buffer_wp_at_def)
apply (wp get_cap_inv hoare_drop_imp)
apply (wp get_cap_inv hoare_drop_imp)+
apply simp
done
@ -1304,7 +1307,7 @@ shows "\<lbrace>cte_wp_at (P and op \<noteq> cap.NullCap) slot :: det_state \<Ri
apply wp
apply (rule hoare_pre_cont)
apply (rule hoare_pre_cont)
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (wp cap_insert_weak_cte_wp_at2)
apply (clarsimp simp:assms)
@ -1377,7 +1380,7 @@ next
apply (erule cte_wp_at_weakenE)
apply (simp add:ipc_buffer_wp_at_def)+
apply wp
apply (wp hoare_vcg_ex_lift valid_irq_node_typ hoare_vcg_ball_lift)[3]
apply ((wp hoare_vcg_ex_lift valid_irq_node_typ hoare_vcg_ball_lift)+)[3]
apply simp
subgoal by (fastforce simp: not_idle_thread_def ipc_frame_wp_at_def ipc_buffer_def)
apply (subgoal_tac "\<not>(Types_D.is_ep_cap (transform_cap cap) \<and>
@ -1422,7 +1425,7 @@ next
apply (rule hoare_pre)
apply (rule cap_insert_weak_cte_wp_at_not_null)
apply clarsimp+
apply (wp cap_insert_idle valid_irq_node_typ hoare_vcg_ball_lift cap_insert_cte_wp_at)
apply (wp cap_insert_idle valid_irq_node_typ hoare_vcg_ball_lift cap_insert_cte_wp_at)+
apply (rule validE_validE_R)
apply (wp whenE_throwError_wp)[1]
apply wp
@ -1447,7 +1450,7 @@ next
apply (rule hoare_vcg_conj_liftE_R)
apply (rule derive_cap_is_derived)
apply (rule derive_cap_is_derived_foo)
apply wp
apply wp+
apply (simp split del: if_split)
apply (clarsimp split del: if_split cong: conj_cong)
apply (rule conjI)
@ -1539,6 +1542,7 @@ lemma get_receive_slot_dcorres:
and valid_global_refs and valid_irq_node and valid_idle and not_idle_thread t and valid_etcbs)
(get_receive_slot t)
(get_receive_slots t (buffer))"
including no_pre
apply (case_tac buffer)
apply (simp add:get_receive_slot_def empty_on_failure_def)
apply (rule dcorres_expand_pfx)
@ -1585,8 +1589,8 @@ lemma get_receive_slot_dcorres:
[Suc (Suc (msg_max_length + msg_max_extra_caps))..<5 + (msg_max_length + msg_max_extra_caps)]
\<and> s = s'a" in corres_symb_exec_r)
prefer 2
apply (wp get_ipc_buffer_words)
apply (wp mapM_wp)
apply (wp get_ipc_buffer_words)+
apply (wp mapM_wp)+
apply fastforce
apply clarsimp
apply (clarsimp,intro conjI,(simp add:obj_at_def)+)
@ -1678,7 +1682,7 @@ lemma transfer_caps_loop_None:
apply (rule corres_guard_imp)
apply (rule corres_split [where r'=dc], assumption)
apply (rule dcorres_dummy_corrupt_ipc_buffer)
apply wp
apply wp+
apply simp
apply simp
done
@ -1714,7 +1718,7 @@ lemma transfer_caps_dcorres:
apply simp
apply simp
apply (rule transfer_caps_loop_None)
apply wp
apply wp+
apply simp
apply simp
apply (simp del: get_receive_slots.simps)
@ -1966,30 +1970,26 @@ lemma ipc_buffer_wp_at_copy_mrs[wp]:
\<lbrace>\<lambda>r. ipc_buffer_wp_at buf t\<rbrace>"
unfolding copy_mrs_def
apply (wp|wpc)+
apply (wp mapM_wp)
apply (simp add:store_word_offs_def ipc_buffer_wp_at_def)
apply wp
prefer 2
apply (wp mapM_wp)
apply (simp add:store_word_offs_def ipc_buffer_wp_at_def)
apply wp+
prefer 2
apply fastforce
apply (clarsimp simp:ipc_buffer_wp_at_def)
apply (rule_tac Q="\<lambda>rv. ipc_buffer_wp_at buf t" in hoare_strengthen_post)
apply (wp mapM_wp)
apply fastforce
apply (clarsimp simp:ipc_buffer_wp_at_def)
apply (rule_tac Q="\<lambda>rv. ipc_buffer_wp_at buf t" in hoare_strengthen_post)
apply (wp mapM_wp)
apply fastforce
apply (clarsimp)
apply wp
apply (clarsimp)
apply wp
apply assumption
done
lemma copy_mrs_valid_irq_node:
"\<lbrace>valid_irq_node\<rbrace> copy_mrs a b c d e
\<lbrace>\<lambda>rva s. valid_irq_node s\<rbrace>"
apply (simp add:valid_irq_node_def)
apply (wp)
apply (rule hoare_allI)
apply (rule hoare_pre)
apply wps
apply wp
apply clarsimp
done
apply (wpsimp wp: hoare_vcg_all_lift|wps)+
done
lemma corres_complete_ipc_transfer:
"ep' = ep
@ -2058,7 +2058,7 @@ lemma corres_complete_ipc_transfer:
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_strengthen_post[OF get_extra_cptrs_length])
apply (simp add:msg_max_length_def max_ipc_words msg_max_extra_caps_def)
apply wp
apply wp+
apply fastforce
apply clarsimp
apply (intro conjI|clarsimp simp:obj_at_def dest!:get_tcb_SomeD)+
@ -2085,9 +2085,9 @@ lemma corres_complete_ipc_transfer:
unfolding K_bind_def
apply (rule corrupt_tcb_intent_as_user_corres)
apply (wp|clarsimp simp:not_idle_thread_def)+
apply (wpc,wp)
apply wpsimp+
apply (rule hoare_pre)
apply (wpc,wp)
apply (wpc, wp+)
apply clarsimp+
apply (rule hoare_allI[OF hoare_drop_imp])
apply (wp|clarsimp)+
@ -2293,6 +2293,8 @@ lemma when_return:
crunch valid_etcbs[wp]: handle_fault_reply valid_etcbs
lemma do_reply_transfer_corres:
notes wp_post_taut [wp]
shows
"slot' = transform_cslot_ptr slot \<Longrightarrow>
dcorres dc \<top>
(invs and tcb_at recver and tcb_at sender and cte_wp_at (op = (cap.ReplyCap recver False)) slot
@ -2300,6 +2302,7 @@ lemma do_reply_transfer_corres:
and not_idle_thread recver and not_idle_thread sender and valid_etcbs)
(Endpoint_D.do_reply_transfer sender recver slot')
(Ipc_A.do_reply_transfer sender recver slot)"
including no_pre
apply (clarsimp simp:do_reply_transfer_def Endpoint_D.do_reply_transfer_def)
apply (clarsimp simp:get_thread_state_def thread_get_def get_thread_fault_def)
apply (rule dcorres_absorb_gets_the)
@ -2326,9 +2329,9 @@ lemma do_reply_transfer_corres:
apply (rule corres_symb_exec_r)
apply (rule corres_split[OF _ dcorres_handle_fault_reply])
apply (rule corres_split[OF _ thread_set_fault_corres])
apply (simp add:when_return split del:if_splits)
apply (simp add:dc_def[symmetric] if_distrib[where f = "set_thread_state recver"]
split del:if_splits)
apply (simp add: when_return split del: if_split)
apply (simp add: dc_def[symmetric] if_distrib[where f = "set_thread_state recver"]
split del: if_split)
apply (rule corres_split_noop_rhs2)
apply (rule corres_trivial)
apply (clarsimp simp: when_def dc_def[symmetric])
@ -2338,10 +2341,10 @@ lemma do_reply_transfer_corres:
apply (rule set_thread_state_corres)
apply (rule corres_alternate1)
apply (rule set_thread_state_corres)
apply wp
apply wp+
apply simp
apply clarsimp+
apply (wp thread_set_no_change_tcb_state
apply (wp wp_post_taut thread_set_no_change_tcb_state
hoare_drop_imps thread_set_cur_thread_idle_thread
thread_set_valid_idle
| simp add:not_idle_thread_def)+
@ -2349,9 +2352,9 @@ lemma do_reply_transfer_corres:
\<and> tcb_at recver s "
in hoare_strengthen_post)
apply (clarsimp simp:not_idle_thread_def)
apply (wp cap_delete_one_reply_st_tcb_at)
apply (wp cap_delete_one_reply_st_tcb_at)+
apply (clarsimp simp:not_idle_thread_def invs_valid_idle st_tcb_at_tcb_at)
apply (wp|clarsimp)+
apply (wp |clarsimp)+
apply (rule conjI)
apply (case_tac slot)
apply (clarsimp simp:invs_def not_idle_thread_def valid_state_def)
@ -2360,27 +2363,26 @@ lemma do_reply_transfer_corres:
apply (fastforce simp:valid_state_def cte_wp_at_caps_of_state)
apply simp
apply (rule emptyable_cte_wp_atD)
apply (simp add:is_master_reply_cap_def invs_def valid_state_def
valid_pspace_def valid_idle_def)+
done
apply (simp add: is_master_reply_cap_def invs_def valid_state_def valid_pspace_def valid_idle_def)+
done
lemma set_endpoint_valid_irq_node[wp]:
"\<lbrace>valid_irq_node and ep_at w\<rbrace> set_endpoint w ep \<lbrace>\<lambda>rv. valid_irq_node\<rbrace>"
including no_pre
apply (clarsimp simp:valid_irq_node_def)
apply wp
apply simp_all
apply simp_all
apply (simp add:set_endpoint_def)
apply wp
apply (rule hoare_allI)
apply (rule_tac Q="\<lambda>s. \<forall>irq. cap_table_at 0 (interrupt_irq_node s irq) s \<and> ep_at w s" in hoare_vcg_precond_imp)
apply (wp hoare_vcg_all_lift)
apply (rule_tac Q="\<lambda>s. \<forall>irq. cap_table_at 0 (interrupt_irq_node s irq) s \<and> ep_at w s" in hoare_vcg_precond_imp)
apply (clarsimp simp:set_object_def get_def put_def bind_def return_def valid_def obj_at_def)
apply (drule_tac x = irq in spec)
apply (clarsimp simp:is_cap_table_def is_ep_def)
apply (simp split:Structures_A.kernel_object.splits)
apply assumption
apply assumption
apply wp
apply (clarsimp simp:get_object_def|wp)+
done
done
lemma dcorres_if_rhs:
assumes G: "G \<Longrightarrow> corres_underlying sr nf nf' rvr P Q a b"
@ -2435,10 +2437,11 @@ lemma dcorres_receive_sync:
set_endpoint word1 (Structures_A.endpoint.RecvEP (queue @ [thread]))
od
| False \<Rightarrow> do_nbrecv_failed_transfer thread)"
including no_pre
apply (clarsimp simp: receive_sync_def gets_def)
apply (rule dcorres_absorb_get_l)
apply (case_tac rv)
(* IdleEP *)
(* IdleEP *)
apply clarsimp
apply (frule_tac get_endpoint_pick)
apply (simp add:obj_at_def)
@ -2482,9 +2485,9 @@ lemma dcorres_receive_sync:
apply (erule get_tcb_rev)
apply (fastforce simp: get_etcb_def)
apply (frule_tac a = y and list = "y # ys" in pending_thread_in_send_not_idle)
apply ((simp add:valid_state_def insertI obj_at_def not_idle_thread_def )+)[4]
apply (clarsimp simp:assert_opt_def transform_tcb_def infer_tcb_pending_op_def tcb_slots
split del:if_splits)
apply ((simp add: valid_state_def insertI obj_at_def not_idle_thread_def )+)[4]
apply (clarsimp simp: assert_opt_def transform_tcb_def infer_tcb_pending_op_def tcb_slots
split del: if_split)
apply (rule dcorres_symb_exec_r)
apply (rule corres_symb_exec_r)
apply (rule_tac F="sender_state = tcb_state t" in corres_gen_asm2)
@ -2506,7 +2509,7 @@ lemma dcorres_receive_sync:
apply (rule dcorres_rhs_noop_below_True[OF switch_if_required_to_dcorres])
apply (rule set_thread_state_corres[unfolded tcb_slots])
apply clarsimp
apply (wp hoare_drop_imps)
apply (wp hoare_drop_imps)+
apply clarsimp
apply (wp gts_st_tcb_at | simp add:not_idle_thread_def )+
apply (rule_tac Q="\<lambda>fault. valid_mdb and valid_objs and pspace_aligned
@ -2522,8 +2525,7 @@ lemma dcorres_receive_sync:
apply (simp add:obj_at_def not_idle_thread_def)+
apply (rule hoare_pre)
apply ((wp | clarsimp simp:not_idle_thread_def | wps )+)[1]
apply (clarsimp simp:valid_state_def st_tcb_at_def obj_at_def
valid_pspace_def)
apply (clarsimp simp:valid_state_def st_tcb_at_def obj_at_def valid_pspace_def)
apply (drule valid_objs_valid_ep_simp)
apply (simp add:is_ep_def)
apply (clarsimp simp:valid_ep_def split:Structures_A.endpoint.splits list.splits)
@ -2786,6 +2788,7 @@ lemma tcb_fault_update_valid_state[wp]:
"\<lbrace>valid_state and (\<lambda>_. valid_fault ft')\<rbrace>
thread_set (tcb_fault_update (\<lambda>_. Some ft')) thread
\<lbrace>\<lambda>rv. valid_state\<rbrace>"
including no_pre
apply (clarsimp simp:valid_state_def pred_conj_def)
apply (rule hoare_conjI)
apply (simp add:valid_pspace_def)
@ -2795,7 +2798,7 @@ lemma tcb_fault_update_valid_state[wp]:
apply (simp add:thread_set_def)
apply wp
apply (simp add:set_object_def)
apply (wp,clarsimp)
apply (wp+,clarsimp)
apply (rule delta_sym_refs)
apply (simp add:state_refs_of_def refs_of_def)+
apply (case_tac "x = thread")
@ -2823,7 +2826,7 @@ lemma tcb_fault_update_valid_state[wp]:
apply (simp add:thread_set_def)
apply wp
apply (simp add:KHeap_A.set_object_def)
apply wp
apply wp+
apply (clarsimp simp:obj_at_def)
apply (drule_tac x = irq in spec)
apply (clarsimp simp:is_cap_table_def dest!: get_tcb_SomeD)
@ -2851,7 +2854,7 @@ lemma thread_set_fault_obj_at:
apply (clarsimp simp:thread_set_def)
apply wp
apply (simp add:set_object_def)
apply wp
apply wp+
apply (clarsimp simp:obj_at_def)
done
@ -2861,7 +2864,7 @@ lemma thread_set_fault_st_tcb_at:
apply (clarsimp simp:thread_set_def)
apply wp
apply (simp add:set_object_def)
apply wp
apply wp+
apply (clarsimp simp:st_tcb_at_def obj_at_def dest!:get_tcb_SomeD split:if_splits)
apply (simp add:get_tcb_def)
done
@ -2914,6 +2917,7 @@ lemma send_fault_ipc_corres:
valid_state and ko_at (TCB tcb) thread and (\<lambda>s. ekheap s thread = Some etcb) and
(\<lambda>s. not_idle_thread (cur_thread s) s) and (\<lambda>_. valid_fault ft') and valid_etcbs)
(Endpoint_D.send_fault_ipc did) (Ipc_A.send_fault_ipc thread ft')"
including no_pre
apply (simp add:Endpoint_D.send_fault_ipc_def Ipc_A.send_fault_ipc_def)
apply (rule dcorres_expand_pfx)
apply (rule corres_guard_imp)
@ -2953,11 +2957,11 @@ lemma send_fault_ipc_corres:
apply (rule lookup_cap_corres)
apply simp
apply (simp add:tcb_fault_handler_length)
apply wp
apply wp+
apply (rule validE_validE_R)
apply (rule hoare_validE_conj)
prefer 2
apply wp
apply wp+
apply (rule hoare_post_impErr[THEN validE_validE_R])
apply (rule hoare_vcg_precond_impE)
apply (rule lookup_cap_valid[THEN validE_R_validE])

67
proof/drefine/KHeap_DR.thy
View File

@ -306,8 +306,7 @@ lemma caps_of_state_transform_opt_cap:
slots_of_def opt_object_def
transform_def transform_objects_def object_slots_def
valid_irq_node_def obj_at_def is_cap_table_def
transform_tcb_def tcb_slot_defs tcb_slots
tcb_pending_op_slot_def tcb_cap_cases_def
transform_tcb_def tcb_slots tcb_cap_cases_def
bl_to_bin_tcb_cnode_index bl_to_bin_tcb_cnode_index_le0
split: if_split_asm)
done
@ -769,7 +768,7 @@ proof -
update_slots_def
split del: if_split)
apply (case_tac "nat (bl_to_bin sl') = tcb_ipcbuffer_slot")
apply (simp add: tcb_slots tcb_pending_op_slot_def)
apply (simp add: tcb_slots)
apply (clarsimp simp: bl_to_bin_tcb_cnode_index|rule conjI)+
apply (rule corres_guard_imp)
apply (rule select_pick_corres)
@ -777,8 +776,7 @@ proof -
apply (clarsimp simp: transform_tcb_def)
apply (rule conjI)
apply (rule ext)
apply (clarsimp simp: transform_tcb_def tcb_slots
tcb_pending_op_slot_def)
apply (clarsimp simp: transform_tcb_def tcb_slots)
apply (rule refl)
apply assumption
apply simp
@ -790,7 +788,7 @@ proof -
apply (clarsimp simp: transform_tcb_def)
apply (rule conjI)
apply (rule ext)
apply (clarsimp simp: transform_tcb_def tcb_pending_op_slot_def tcb_slots)
apply (clarsimp simp: transform_tcb_def tcb_slots)
apply (erule transform_full_intent_same_cap)
apply simp
apply simp
@ -799,7 +797,7 @@ proof -
apply (rule conjI)
apply (clarsimp simp: bl_to_bin_tcb_cnode_index)
apply (rule conjI ext dcorres_set_object_tcb|simp|
clarsimp simp: transform_tcb_def tcb_slot_defs tcb_slots corres_free_fail
clarsimp simp: transform_tcb_def tcb_slot_defs corres_free_fail
cong: transform_full_intent_caps_cong_weak)+
done
qed
@ -857,7 +855,7 @@ lemma set_thread_state_ext_dcorres: "dcorres dc P P' (return ()) (set_thread_sta
apply (clarsimp simp: corres_underlying_def when_def set_scheduler_action_def
modify_def bind_def put_def gets_def get_def return_def
split: option.splits)
apply wp
apply wp+
done
(*Special set_cap case which is related to thread_state *)
@ -890,7 +888,7 @@ lemma set_cap_null_cap_corres:
apply (clarsimp simp:transform_cap_def)
apply (rule refl)
apply (rule set_original_dummy_corres)
apply wp
apply wp+
apply clarsimp
apply (clarsimp simp: cte_wp_at_caps_of_state)
done
@ -1333,7 +1331,7 @@ lemma set_irq_state_dcorres:
transform_asid_table_def)
apply simp
apply (rule dmo_maskIRQ_dcorres)
apply wp
apply wp+
done
lemma dcorres_gets_all_param:
@ -1385,7 +1383,7 @@ lemma empty_slot_corres:
apply (clarsimp simp:transform_cap_def split:cap.splits arch_cap.splits)
apply (rule get_cap_corres)
apply simp
apply wp
apply wp+
apply clarsimp
apply (simp add: not_idle_thread_def)+
done
@ -1393,7 +1391,7 @@ lemma empty_slot_corres:
lemma valid_idle_fast_finalise[wp]:
"\<lbrace>invs\<rbrace> IpcCancel_A.fast_finalise p q \<lbrace>%r. valid_idle\<rbrace>"
apply (case_tac p)
apply (simp_all add:fast_finalise.simps)
apply simp_all
apply (wp,simp add:valid_state_def invs_def)
apply (rule hoare_post_imp[where Q="%r. invs"])
apply (clarsimp simp:valid_state_def invs_def,wp cancel_all_ipc_invs)
@ -2046,10 +2044,10 @@ lemma tcb_at_set_thread_state_wp:
set_thread_state a Structures_A.thread_state.Restart
\<lbrace>\<lambda>x s. (\<forall>x\<in>set list. tcb_at x s \<and> not_idle_thread x s)\<rbrace>"
apply (rule hoare_Ball_helper)
apply wp
apply (simp add:not_idle_thread_def)
apply wp
done
including no_pre apply wp
apply (simp add:not_idle_thread_def)
apply wp+
done
lemma invalid_cte_wp_at_pending_slot:
"\<lbrakk>tcb_at y s;transform_cslot_ptr (ad, bd) = (y, tcb_pending_op_slot);
@ -2556,7 +2554,7 @@ lemma dcorres_do_unbind_notification:
apply (clarsimp simp: tcb_slots)
apply (rule set_bound_notification_corres[where ntfn_opt=None, unfolded infer_tcb_bound_notification_def
not_idle_thread_def tcb_slots, simplified])
apply wp
apply wp+
apply simp
apply (clarsimp simp: not_idle_thread_def)
done
@ -2580,7 +2578,7 @@ lemma dcorres_unbind_maybe_notification:
apply (rule_tac P'="R' (the (ntfn_bound_tcb ntfna)) ntfna" for R' in corres_inst)
apply simp
apply (rule dcorres_do_unbind_notification[unfolded dc_def, simplified])
apply (wp get_ntfn_wp)
apply (wp get_ntfn_wp)+
apply (clarsimp split: option.splits)
apply (clarsimp simp: valid_state_def valid_pspace_def split: option.splits)
apply (simp add: obj_at_def)
@ -2588,13 +2586,10 @@ lemma dcorres_unbind_maybe_notification:
apply (clarsimp simp: valid_idle_def pred_tcb_at_def not_idle_thread_def obj_at_def)
done
(*
definition
"unbind_maybe_notification' ntfn \<equiv> do ntfn_obj \<leftarrow> get_notification ntfn; unbind_maybe_notification ntfn_obj od"
*)
lemma unbind_notification_valid_state[wp]:
"\<lbrace>valid_state\<rbrace> IpcCancel_A.unbind_notification t \<lbrace>\<lambda>rv. valid_state\<rbrace>"
including no_pre
apply (simp add: unbind_notification_def valid_state_def valid_pspace_def)
apply (rule hoare_seq_ext [OF _ gbn_sp])
apply (case_tac ntfnptr, clarsimp, wp, simp)
@ -2626,6 +2621,7 @@ lemma unbind_notification_valid_state[wp]:
lemma unbind_maybe_notification_valid_state[wp]:
"\<lbrace>valid_state\<rbrace> IpcCancel_A.unbind_maybe_notification a \<lbrace>\<lambda>rv. valid_state\<rbrace>"
including no_pre
apply (simp add: unbind_maybe_notification_def valid_state_def valid_pspace_def)
apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
apply (case_tac "ntfn_bound_tcb ntfn", clarsimp, wp, simp+)
@ -2681,7 +2677,7 @@ lemma fast_finalise_corres:
(IpcCancel_A.fast_finalise rv' final)"
apply (case_tac rv')
apply (simp_all add:transform_cap_def)
apply (simp_all add:PageTableUnmap_D.fast_finalise_def fast_finalise.simps PageTableUnmap_D.fast_finalise.simps corres_free_fail)
apply (simp_all add:PageTableUnmap_D.fast_finalise_def corres_free_fail)
apply (simp_all add:when_def)
apply (clarsimp simp:dcorres_cancel_all_ipc)
apply clarsimp
@ -2753,6 +2749,7 @@ lemma get_tcb_reply_cap_wp_cte_at:
apply (frule cte_wp_tcb_cap_valid)
apply simp+
apply (clarsimp simp :cte_wp_at_def tcb_cap_valid_def st_tcb_at_def obj_at_def is_master_reply_cap_def split:cap.splits)
including no_pre
apply (wp get_cap_cte_wp_at_rv)
apply (rule tcb_cap_wp_at)
apply (simp add:dom_tcb_cap_cases)+
@ -2914,7 +2911,7 @@ lemma always_empty_slot_corres:
apply (rule dcorres_rhs_noop_above[OF empty_slot_ext_dcorres])
apply (rule corres_bind_ignore_ret_rhs)
apply (rule set_cap_null_cap_corres)
apply wp
apply wp+
apply simp
apply (rule remove_parent_corres)
apply (wp get_cap_wp|simp add: set_cdt_def)+
@ -3363,14 +3360,14 @@ lemma dcorres_injection_handler_rhs:
apply (clarsimp simp:injection_handler_def)
apply (clarsimp simp:handleE'_def)
apply (rule corres_dummy_return_l)
apply (rule corres_guard_imp)
apply (rule corres_underlying_split[where P'="\<lambda>a. \<top>" and P = "\<lambda>a. \<top>"])
apply assumption
apply wp
apply (clarsimp simp:return_def)
apply (case_tac v)
apply (clarsimp simp:throwError_def return_def corres_underlying_def)+
done
apply (rule corres_guard_imp)
apply (rule corres_underlying_split[where P'="\<lambda>a. \<top>" and P = "\<lambda>a. \<top>"])
apply assumption
apply wp+
apply (clarsimp simp:return_def)
apply (case_tac v)
apply (clarsimp simp:throwError_def return_def corres_underlying_def)+
done
crunch valid_etcbs[wp]: resolve_address_bits "valid_etcbs"
@ -3458,11 +3455,7 @@ lemma dcorres_lookup_slot:
apply (rule corres_returnOk [where P=\<top> and P'=\<top>])
apply clarsimp
apply (clarsimp simp: word_bits_def)
apply assumption
apply simp
apply wp
apply simp
apply clarsimp
apply wpsimp+
apply (erule (1) objs_valid_tcb_ctable)
done

2
proof/drefine/Refine_D.thy
View File

@ -28,7 +28,7 @@ lemma handle_event_invs_and_valid_sched:
"\<lbrace>invs and valid_sched and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_active s)
and (\<lambda>s. scheduler_action s = resume_cur_thread)\<rbrace> Syscall_A.handle_event e
\<lbrace>\<lambda>rv. invs and valid_sched\<rbrace>"
by (wp he_invs handle_event_valid_sched, simp)
including no_pre by ((wp he_invs handle_event_valid_sched), simp)
lemma dcorres_call_kernel:
"dcorres dc \<top>

32
proof/drefine/Schedule_DR.thy
View File

@ -81,16 +81,17 @@ lemma change_current_domain_and_switch_to_idle_thread_dcorres:
Schedule_D.switch_to_thread None
od)
switch_to_idle_thread"
including no_pre
apply (clarsimp simp: Schedule_D.switch_to_thread_def switch_to_idle_thread_def)
apply (rule dcorres_symb_exec_r)
apply (rule corres_guard_imp)
apply (rule corres_symb_exec_l)
apply (rule corres_split_noop_rhs)
apply (rule_tac R=\<top> in corres_split_noop_rhs)
apply (clarsimp simp: corres_underlying_def gets_def modify_def get_def put_def do_machine_op_def select_f_def split_def bind_def in_return)
apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def)
apply assumption
apply (rule dcorres_arch_switch_to_idle_thread_return)
apply (wp change_current_domain_same| simp)+
apply (wp change_current_domain_same | simp)+
done
lemma arch_switch_to_thread_dcorres:
@ -116,22 +117,21 @@ crunch idle_thread [wp]: arch_switch_to_thread "\<lambda>s. P (idle_thread s)"
lemma switch_to_thread_corres:
"dcorres dc \<top> (invs and (\<lambda>s. idle_thread s \<noteq> x) and valid_etcbs)
(Schedule_D.switch_to_thread (Some x)) (Schedule_A.switch_to_thread x)"
apply (clarsimp simp: Schedule_D.switch_to_thread_def
Schedule_A.switch_to_thread_def)
apply (clarsimp simp: Schedule_D.switch_to_thread_def Schedule_A.switch_to_thread_def)
apply (rule corres_dummy_return_pl)
apply (rule corres_symb_exec_r)
apply (rule corres_symb_exec_r)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ arch_switch_to_thread_dcorres])
apply simp
apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres])
apply (rule corres_symb_exec_r)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ arch_switch_to_thread_dcorres])
apply simp
apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres])
apply (rule corres_modify [where P=\<top> and P'="\<lambda>s. idle_thread s \<noteq> x"])
apply (clarsimp simp: transform_def)
apply (simp add: transform_current_thread_def transform_asid_table_def)
apply wp[4]
apply simp
apply assumption
apply (clarsimp|wp)+
apply (wp+)[4]
apply simp
apply assumption
apply (clarsimp|wp)+
done
lemma corrupt_intents_current_thread:
@ -174,7 +174,7 @@ lemma switch_to_thread_same_corres:
apply (rule corres_modify [where P'="\<lambda>s. idle_thread s \<noteq> x"])
apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def)
apply (simp add: transform_current_thread_def transform_asid_table_def)
apply wp[4]
apply (wp+)[4]
apply simp
apply assumption
apply (clarsimp|wp)+
@ -455,7 +455,7 @@ lemma schedule_choose_new_thread_dcorres_fragment:
apply (simp only: schedule_def_2)
apply (rule corres_guard_imp)
apply (rule_tac r'="\<lambda>_ _. True" and P=\<top> and P'=\<top> and R="\<lambda>_. \<top>" and R'="\<lambda>_ s. valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread" in corres_split)
apply (clarsimp simp: K_bind_def)
apply (clarsimp)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_symb_exec_r, rename_tac rq)
apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
@ -658,7 +658,7 @@ lemma activate_thread_corres:
apply (rule dcorres_symb_exec_r)
apply (rule set_thread_state_corres[unfolded tcb_pending_op_slot_def])
apply simp
apply (wp dcorres_to_wp[OF as_user_setNextPC_corres,simplified])
apply (wp dcorres_to_wp[OF as_user_setNextPC_corres,simplified])+
apply (simp add:invs_mdb pred_tcb_at_def obj_at_def invs_valid_idle
generates_pending_def not_idle_thread_def)
apply (clarsimp simp:infer_tcb_pending_op_def arch_activate_idle_thread_def

326
proof/drefine/Syscall_DR.thy
View File

@ -352,18 +352,19 @@ lemma transform_type_eq_None:
lemma transform_intent_untyped_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.UntypedCap dev w n idx\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
including no_pre
apply (clarsimp simp:Decode_A.decode_invocation_def)
apply wp
apply (case_tac "invocation_type label")
(* 43 subgoals *)
apply (clarsimp simp:Decode_A.decode_untyped_invocation_def unlessE_def)
apply wp
apply wp+
apply (clarsimp simp:transform_intent_def Decode_A.decode_untyped_invocation_def unlessE_def split del:if_split)
apply (clarsimp simp:transform_intent_untyped_retype_def split del:if_split)
apply (case_tac "args")
apply (clarsimp,wp)[1]
apply (clarsimp split:list.split_asm split del:if_split)
apply wp[5]
apply (wp+)[5]
apply (clarsimp simp: transform_type_eq_None split del:if_split split:option.splits)
apply (wp|clarsimp simp:whenE_def|rule conjI)+
apply (clarsimp simp: Decode_A.decode_untyped_invocation_def unlessE_def split del:if_split,wp)+
@ -372,12 +373,13 @@ lemma transform_intent_untyped_cap_None:
lemma transform_intent_cnode_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.CNodeCap w n list\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
including no_pre
apply (clarsimp simp:Decode_A.decode_invocation_def)
apply wp
apply wp+
apply (case_tac "invocation_type label")
apply (simp add:Decode_A.decode_cnode_invocation_def unlessE_def upto_enum_def fromEnum_def toEnum_def enum_invocation_label,wp)+
apply (simp add:Decode_A.decode_cnode_invocation_def unlessE_def upto_enum_def fromEnum_def toEnum_def enum_invocation_label,wp+)+
apply (simp add:transform_intent_def transform_cnode_index_and_depth_def whenE_def split:list.split_asm)
apply wp
apply wp+
apply (simp add:transform_intent_def transform_cnode_index_and_depth_def
Decode_A.decode_cnode_invocation_def unlessE_def whenE_def split del:if_splits split:list.split_asm)
apply (wp|clarsimp|rule conjI)+
@ -408,34 +410,36 @@ done
lemma transform_intent_thread_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.ThreadCap w\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
including no_pre
apply (clarsimp simp:Decode_A.decode_invocation_def)
apply wp
apply wp+
apply (simp add:Decode_A.decode_tcb_invocation_def)
apply (case_tac "invocation_type label")
apply simp_all
apply wp
apply wp+
apply (clarsimp simp: transform_intent_def decode_read_registers_def decode_write_registers_def
decode_copy_registers_def decode_tcb_configure_def decode_set_priority_def
decode_set_mcpriority_def decode_set_ipc_buffer_def transform_intent_tcb_defs
split: list.split_asm
| wp)+
| wp+)+
apply (clarsimp simp: transform_intent_def decode_set_space_def decode_bind_notification_def
decode_unbind_notification_def transform_intent_tcb_set_space_def
split: list.split_asm
, wp
, wp+
| clarsimp simp: transform_intent_def)+
done
lemma transform_intent_irq_control_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.IRQControlCap\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
including no_pre
apply (clarsimp simp:Decode_A.decode_invocation_def)
apply wp
apply (clarsimp simp:decode_irq_control_invocation_def arch_decode_irq_control_invocation_def split del:if_splits)
apply (case_tac "invocation_type label")
apply (clarsimp,wp)+
apply (clarsimp simp:transform_intent_issue_irq_handler_def transform_intent_def split:list.split_asm split del:if_splits,wp)
apply (clarsimp simp:arch_decode_irq_control_invocation_def,wp)+
apply (clarsimp, wp)+
apply (clarsimp simp:transform_intent_issue_irq_handler_def transform_intent_def split:list.split_asm split del:if_splits,wp+)
apply (clarsimp simp:arch_decode_irq_control_invocation_def, wp)+
done
lemma transform_intent_irq_handler_None:
@ -458,6 +462,7 @@ done
lemma transform_intent_domain_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.DomainCap\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap.DomainCap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
including no_pre
apply (clarsimp simp: Decode_A.decode_invocation_def)
apply wp
apply (case_tac excaps, simp_all)
@ -468,55 +473,49 @@ lemma transform_intent_domain_cap_None:
apply (case_tac args, simp_all)
apply ((wp whenE_inv | simp)+)[1]
apply (case_tac "invocation_type label \<noteq> DomainSetSet", simp_all)
apply wp[1]
apply wp
apply (clarsimp simp: transform_intent_def transform_intent_domain_def)
done
lemma transform_intent_arch_cap_None:
"\<lbrakk>transform_intent (invocation_type label) args = None; cap = cap.ArchObjectCap arch_cap\<rbrakk>
\<Longrightarrow> \<lbrace>op = s\<rbrace> Decode_A.decode_invocation label args cap_i slot cap excaps \<lbrace>\<lambda>r. \<bottom>\<rbrace>, \<lbrace>\<lambda>x. op = s\<rbrace>"
including no_pre
apply (clarsimp simp:Decode_A.decode_invocation_def)
apply wp
apply wp
apply (simp add: arch_decode_invocation_def split del: if_split)
apply (case_tac arch_cap)
apply (case_labels "invocation_type label")
apply (simp_all add:arch_decode_invocation_def split del:if_splits)
apply wp
apply (clarsimp split:if_splits | rule conjI)+
apply (case_tac "excaps ! 0")
apply (clarsimp split:cap.splits | rule conjI | wp)+
apply (clarsimp split:arch_cap.splits | rule conjI | wp)+
apply ((clarsimp simp:transform_intent_def | wp) +)[2]
apply (case_labels "invocation_type label")
apply (simp_all add:arch_decode_invocation_def split del:if_splits)
apply wp
apply (case_tac "excaps ! 0")
apply (clarsimp simp:transform_intent_def transform_cnode_index_and_depth_def split:list.split_asm)
apply wp
apply (case_labels "invocation_type label")
apply (simp_all add:arch_decode_invocation_def isPageFlushLabel_def split del:if_splits)
apply (wp)
apply (clarsimp simp:transform_intent_def transform_intent_page_map_def split:list.split_asm )
apply wp
apply (clarsimp | rule conjI)+
apply (case_tac "excaps ! 0")
apply (clarsimp simp:transform_intent_def
transform_intent_page_remap_def split:list.split_asm)
apply ((clarsimp simp:transform_intent_def | wp)+)
apply (case_labels "invocation_type label")
apply (simp_all)
apply (case_labels "invocation_type label"; simp split del: if_split, wp?)
apply (clarsimp split:if_splits | rule conjI)+
apply (case_tac "excaps ! 0")
apply (clarsimp split:cap.splits | rule conjI | wp)+
apply (clarsimp split:arch_cap.splits | rule conjI | wp)+
apply ((clarsimp simp:transform_intent_def | wp) +)[2]
apply (case_labels "invocation_type label";
simp add:arch_decode_invocation_def split del: if_split; wp?)
apply (case_tac "excaps ! 0")
apply (clarsimp simp:transform_intent_def transform_cnode_index_and_depth_def split:list.split_asm)
apply wp+
apply (case_labels "invocation_type label";
simp add: arch_decode_invocation_def isPageFlushLabel_def
split del: if_split, wp?)
apply (clarsimp simp: transform_intent_def transform_intent_page_map_def
split: list.split_asm )
apply wp+
apply (clarsimp | rule conjI)+
apply (case_tac "excaps ! 0")
apply (clarsimp simp:transform_intent_def transform_intent_page_remap_def split:list.split_asm)
apply ((clarsimp simp:transform_intent_def | wp)+)
apply (case_labels "invocation_type label"; simp)
apply (intro conjI impI | wp)+
apply (clarsimp | rule conjI)+
apply (clarsimp simp: transform_intent_def transform_intent_page_table_map_def
split: list.split_asm)
apply (intro conjI impI | wp)+
apply (clarsimp | rule conjI)+
apply (clarsimp simp:transform_intent_def transform_intent_page_table_map_def
split:list.split_asm)
apply (intro conjI impI | wp)+
apply ((clarsimp simp:transform_intent_def
split:list.split_asm
| wp)+)[1]
apply (case_labels "invocation_type label")
apply (simp_all add: isPDFlushLabel_def)
apply (wp)
done
apply ((clarsimp simp: transform_intent_def split: list.split_asm | wp)+)[1]
apply (case_labels "invocation_type label"; simp add: isPDFlushLabel_def)
apply (wp)+
done
lemma decode_invocation_error_branch:
"\<lbrakk>transform_intent (invocation_type label) args = None; \<not> ep_related_cap (transform_cap cap)\<rbrakk>
@ -529,11 +528,11 @@ lemma decode_invocation_error_branch:
apply (rule transform_intent_cnode_cap_None,fastforce+)
apply (rule transform_intent_thread_cap_None,fastforce+)
apply (rule transform_intent_domain_cap_None,fastforce+)
apply (rule transform_intent_irq_control_None,fastforce+)
apply (rule transform_intent_irq_handler_None,fastforce+)
apply (rule transform_intent_zombie_cap_None,fastforce+)
apply (rule transform_intent_irq_control_None,fastforce+)
apply (rule transform_intent_irq_handler_None,fastforce+)
apply (rule transform_intent_zombie_cap_None,fastforce+)
apply (rule transform_intent_arch_cap_None,fastforce+)
done
done
lemma decode_invocation_ep_related_branch:
"\<lbrakk>ep_related_cap (transform_cap cap);\<not> is_master_reply_cap cap\<rbrakk>
@ -669,7 +668,7 @@ lemma invoke_domain_corres:
apply clarsimp
apply (drule get_tcb_at)
apply (clarsimp simp:opt_object_tcb)
apply wp
apply wp+
apply simp
apply wp
apply simp
@ -1009,9 +1008,6 @@ lemma lookup_cap_and_slot_inv:
"\<lbrace>P\<rbrace> CSpace_A.lookup_cap_and_slot t (to_bl (arch_tcb_context_get (tcb_arch obj'a) cap_register)) \<lbrace>\<lambda>x. P\<rbrace>, \<lbrace>\<lambda>ft s. True\<rbrace>"
apply (simp add:CSpace_A.lookup_cap_and_slot_def)
apply (wp | clarsimp simp:liftE_bindE)+
apply (simp add:validE_def)
apply (rule hoare_drop_imp)
apply (wp lookup_slot_for_thread_inv)
done
(* We need following lemma because we need to match get_mrs in abstract and cdl_intent_op in capdl after state s is fixed *)
@ -1081,7 +1077,7 @@ lemma reply_from_kernel_error:
apply (simp add:word_bits_def mask_def le_mask_iff[symmetric])+
apply unat_arith
apply simp
apply (wp hoare_drop_imp hoare_vcg_all_lift)
apply (wp hoare_drop_imp hoare_vcg_all_lift)+
apply clarsimp
apply (rule conjI)
apply (rule word_of_nat_le)
@ -1133,29 +1129,29 @@ lemma dcorres_reply_from_syscall:
transform_tcb_def assert_opt_def when_def returnOk_liftE[symmetric]
split: Structures_A.thread_state.splits)
apply (intro conjI impI)
apply (rule dcorres_returnOk',simp)+
apply (rule dcorres_returnOk',simp)+
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ dcorres_reply_from_kernel])
apply (rule corres_dummy_return_pr)
apply (rule corres_split[OF _ dcorres_set_intent_error])
apply (simp add:liftE_bindE returnOk_liftE)
apply (rule set_thread_state_corres[unfolded tcb_slots])
apply (wp rfk_invs reply_from_kernel_error)
apply (wp rfk_invs reply_from_kernel_error)+
apply (simp add:not_idle_thread_def)
apply (wp rfk_invs)
apply simp
apply (clarsimp simp:tcb_at_def st_tcb_at_def obj_at_def
not_idle_thread_def dest!:get_tcb_SomeD)
apply (clarsimp simp: tcb_at_def st_tcb_at_def obj_at_def not_idle_thread_def
dest!: get_tcb_SomeD)
apply (rule corres_dummy_return_pr)
apply (rule corres_guard_imp[OF corres_split[where r' = "dc"]])
apply (simp add:K_bind_def returnOk_liftE)
apply (simp add: returnOk_liftE)
apply (rule set_thread_state_corres[unfolded tcb_slots])
apply (rule dcorres_dummy_corrupt_ipc_buffer)
apply wp
apply simp
apply (clarsimp simp:tcb_at_def invs_mdb st_tcb_at_def
not_idle_thread_def obj_at_def dest!:get_tcb_SomeD)
apply (rule dcorres_returnOk',simp)+
apply wp+
apply simp
apply (clarsimp simp: tcb_at_def invs_mdb st_tcb_at_def not_idle_thread_def obj_at_def
dest!: get_tcb_SomeD)
apply (rule dcorres_returnOk', simp)+
done
lemmas mapM_x_def_symmetric = mapM_x_def[symmetric]
@ -1189,15 +1185,16 @@ lemma without_preemption_idle:
lemma invoke_cnode_idle:
"\<lbrace>\<lambda>s. P (idle_thread s)\<rbrace> invoke_cnode pa \<lbrace>\<lambda>r s. P (idle_thread (s :: det_ext state))\<rbrace>"
apply (case_tac pa)
apply (clarsimp simp:invoke_cnode_def|wp)+
apply (rule cap_revoke_preservation)
apply (wp cap_move_idle_thread|clarsimp simp:invoke_cnode_def)+
including no_pre
apply (cases pa)
apply (clarsimp simp:invoke_cnode_def|wp)+
apply (rule cap_revoke_preservation)
apply (wp cap_move_idle_thread|clarsimp simp:invoke_cnode_def)+
apply (intro conjI)
apply (clarsimp simp:invoke_cnode_def|wp)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>x s. P (idle_thread s)" in hoare_strengthen_post)
apply wp
apply (clarsimp simp:invoke_cnode_def|wp)+
apply (wpc|wp)+
apply (rule_tac Q="\<lambda>x s. P (idle_thread s)" in hoare_strengthen_post)
apply wp+
apply clarsimp+
apply (clarsimp simp:invoke_cnode_def)
apply (wp | wpc | simp | rule hoare_pre)+
@ -1212,6 +1209,7 @@ lemma invoke_domain_idle:
lemma perform_invocation_idle[wp]:
"\<lbrace>not_idle_thread x :: det_ext state \<Rightarrow> bool\<rbrace> Syscall_A.perform_invocation blocking call i \<lbrace>\<lambda>rv. not_idle_thread x\<rbrace>"
including no_pre
apply (case_tac i)
apply (simp_all add:not_idle_thread_def)
apply (wp invoke_cnode_idle invoke_domain_idle |clarsimp)+
@ -1221,8 +1219,8 @@ lemma perform_invocation_idle[wp]:
apply (simp add: arch_invoke_irq_control_def)
apply (rename_tac irq_handler_invocation)
apply (case_tac irq_handler_invocation)
apply simp_all
apply (wp|simp)+
apply simp_all
apply (wp|simp)+
done
lemma msg_from_syscall_error_simp:
@ -1237,9 +1235,8 @@ lemma msg_from_syscall_error_simp:
lemma not_master_reply_cap_lcs[wp]:
"\<lbrace>valid_reply_masters and valid_objs\<rbrace>CSpace_A.lookup_cap_and_slot t ptr
\<lbrace>\<lambda>rv s. \<not> is_master_reply_cap (fst rv)\<rbrace>,-"
apply (rule hoare_pre)
apply (simp add:lookup_cap_and_slot_def)
apply wp
apply (simp add:lookup_cap_and_slot_def)
apply wp
apply (simp add:split_def)
apply wp
apply (rule_tac Q ="\<lambda>cap. cte_wp_at (\<lambda>x. x = cap) (fst x) and real_cte_at (fst x)
@ -1329,11 +1326,11 @@ lemma handle_invocation_corres:
apply (clarsimp simp:transform_cap_list_def dcorres_symb_exec_r_evalMonad Ipc_A.lookup_extra_caps_def liftE_bindE)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF _ dcorres_lookup_extra_caps])
apply (rule dcorres_returnOk)
apply simp
apply (wp|clarsimp simp:not_idle_thread_def)+
apply (rule dcorres_returnOk)
apply simp
apply (wp|clarsimp simp:not_idle_thread_def)+
apply (simp add:empty_when_fail_lookup_ipc_buffer weak_det_spec_lookup_ipc_buffer)+
apply (wp lookup_cap_and_slot_inv)
apply (wp lookup_cap_and_slot_inv)+
apply (simp add:liftE_bindE)
apply (rule corres_when,simp)
apply (rule handle_fault_corres)
@ -1344,39 +1341,37 @@ lemma handle_invocation_corres:
apply (rule corres_dummy_return_r)
apply (rule corres_guard_imp[OF corres_split[OF _ dcorres_reply_from_kernel]])
apply (simp add:when_def)
apply (rule dcorres_set_intent_error)
apply (wp rfk_invs reply_from_kernel_error | simp add:not_idle_thread_def)+
apply (rule dcorres_set_intent_error)
apply (wp rfk_invs reply_from_kernel_error | simp add:not_idle_thread_def)+
apply (rule dcorres_dummy_corrupt_ipc_buffer)
apply (rule corres_split[OF _ dcorres_set_thread_state_Restart2])
apply (rule corres_splitEE[where r' = dc])
apply (simp add:
whenE_def bind_assoc )
apply (simp add: whenE_def bind_assoc)
apply (rule dcorres_reply_from_syscall)
apply (rule perform_invocation_corres,simp)
apply wp
apply wp+
apply (rule validE_validE_R)
apply (clarsimp simp:validE_def)
apply (rule hoare_drop_imp)
apply (wp hoare_vcg_conj_lift hoare_strengthen_post[OF pinv_invs])
apply (clarsimp simp:invs_def valid_state_def)
apply wp
apply (simp add:conj_comms not_idle_thread_def split_def)
apply (wp sts_Restart_invs set_thread_state_ct_active)
apply (simp add:conj_comms split_def msg_from_syscall_error_simp)
apply (wp | simp add:split_def)+
apply (rule_tac Q'="\<lambda>r s. s = s'a \<and> ex_nonz_cap_to (cur_thread s) s \<and>
apply wp+
apply (simp add:conj_comms not_idle_thread_def split_def)
apply (wp sts_Restart_invs set_thread_state_ct_active)+
apply (simp add:conj_comms split_def msg_from_syscall_error_simp)
apply (wp | simp add:split_def)+
apply (rule_tac Q'="\<lambda>r s. s = s'a \<and> ex_nonz_cap_to (cur_thread s) s \<and>
valid_invocation r s \<and> invocation_duplicates_valid r s"
in hoare_post_imp_R)
apply (simp add:split_def liftE_bindE[symmetric])
apply (wp decode_inv_wf)
apply (clarsimp simp:ct_in_state_def st_tcb_at_def obj_at_def
not_idle_thread_def)+
apply (simp add:split_def liftE_bindE[symmetric])
apply (wp decode_inv_wf)
apply (clarsimp simp:ct_in_state_def st_tcb_at_def obj_at_def not_idle_thread_def)+
apply (rule wp_post_tautE)
apply clarsimp
apply wp
apply (simp add:split_def liftE_bindE[symmetric])
apply (wp | simp add: split_def liftE_bindE[symmetric])+
apply (rule_tac Q="\<lambda>r s. s = s'a \<and>
apply (simp add:split_def liftE_bindE[symmetric])
apply (wp | simp add: split_def liftE_bindE[symmetric])+
apply (rule_tac Q="\<lambda>r s. s = s'a \<and>
evalMonad (lookup_ipc_buffer False (cur_thread s'a)) s'a = Some r \<and>
cte_wp_at (Not \<circ> is_master_reply_cap) (snd x) s \<and>
cte_wp_at (diminished (fst x)) (snd x) s \<and> s \<turnstile> fst x \<and>
@ -1384,18 +1379,18 @@ lemma handle_invocation_corres:
(\<forall>r\<in>zobj_refs (fst x). ex_nonz_cap_to r s) \<and>
(\<forall>r\<in>cte_refs (fst x) (interrupt_irq_node s). ex_cte_cap_wp_to \<top> r s)"
in hoare_strengthen_post)
apply (wp evalMonad_wp)
apply (simp add:empty_when_fail_lookup_ipc_buffer
apply (wp evalMonad_wp)
apply (simp add:empty_when_fail_lookup_ipc_buffer
weak_det_spec_lookup_ipc_buffer)+
apply wp
apply (clarsimp simp:invs_def valid_state_def valid_pspace_def valid_idle_def
apply wp
apply (clarsimp simp:invs_def valid_state_def valid_pspace_def valid_idle_def
ct_in_state_def pred_tcb_at_def
not_idle_thread_def obj_at_def st_tcb_ex_cap dest!:get_tcb_SomeD)
apply (wp | rule hoare_pre)+
apply (wp)+
apply (clarsimp simp:invs_def valid_state_def not_idle_thread_def
pred_tcb_at_def obj_at_def)
apply simp_all
done
done
crunch cur_thread[wp]: complete_signal "\<lambda>s. P (cur_thread s)"
@ -1482,11 +1477,11 @@ lemma handle_recv_corres:
apply clarsimp
apply (rule lookup_cap_corres, simp)
apply (simp add: word_bits_def)
apply wp
apply wp+
apply (rule hoare_vcg_conj_liftE_R)
apply (rule hoare_post_imp_R, rule lookup_cap_valid)
apply (clarsimp simp: valid_cap_def)
apply wp
apply wp+
apply (simp add:injection_handler_def)
apply (wp get_ntfn_wp |wpc)+
apply (simp only: conj_ac)
@ -1513,7 +1508,7 @@ lemma handle_recv_corres:
obj_at_def valid_pspace_def not_idle_thread_def)
apply (clarsimp, frule(1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp:opt_object_tcb not_idle_thread_def)
apply wp
apply wp+
apply simp
apply (clarsimp simp:emptyable_def not_idle_thread_def)
apply (clarsimp simp: liftE_bindE get_notification_def get_object_def gets_def bind_assoc)
@ -1547,13 +1542,13 @@ lemma handle_reply_corres:
apply simp
apply (clarsimp simp:ct_running_not_idle_etc)
apply (frule caps_of_state_valid(1))
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (simp add:valid_cap_def)+
apply (clarsimp simp:valid_state_def invs_def valid_reply_caps_def dest!:has_reply_cap_cte_wpD)
apply (drule_tac x = word in spec,simp)
apply (clarsimp simp:not_idle_thread_def pred_tcb_at_def obj_at_def valid_idle_def)
apply (clarsimp simp: transform_tcb_slot_simp|wp get_cap_wp)+
apply (clarsimp simp:ct_in_state_def invs_def valid_state_def pred_tcb_at_def tcb_at_def obj_at_def)
apply (clarsimp simp:cte_wp_at_caps_of_state)
apply (simp add:valid_cap_def)+
apply (clarsimp simp:valid_state_def invs_def valid_reply_caps_def dest!:has_reply_cap_cte_wpD)
apply (drule_tac x = word in spec,simp)
apply (clarsimp simp:not_idle_thread_def pred_tcb_at_def obj_at_def valid_idle_def)
apply (clarsimp simp: transform_tcb_slot_simp|(wp get_cap_wp)+)+
apply (clarsimp simp:ct_in_state_def invs_def valid_state_def pred_tcb_at_def tcb_at_def obj_at_def)
done
lemma handle_vm_fault_wp:
@ -1561,14 +1556,14 @@ lemma handle_vm_fault_wp:
apply (case_tac vmfault_type)
apply (simp)
apply wp
apply (clarsimp simp:do_machine_op_def getDFSR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply (clarsimp simp:do_machine_op_def getDFSR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp+
apply (clarsimp simp:gets_def alternative_def get_def bind_def select_def return_def)
apply (clarsimp simp:do_machine_op_def getFAR_def)
apply wp
@ -1577,20 +1572,19 @@ lemma handle_vm_fault_wp:
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp
apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def)
apply simp
apply (simp)
apply wp+
apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def)
apply simp
apply wp
apply (clarsimp simp:do_machine_op_def getIFSR_def)
apply wp
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply (clarsimp simp:do_machine_op_def getIFSR_def)
apply wp
apply (clarsimp simp: gets_def get_def bind_def return_def)
apply (case_tac x)
apply clarsimp
apply (rule_tac P="P and (\<lambda>x. snd (aa,ba) = machine_state x)" in hoare_post_imp)
apply (assumption)
apply (clarsimp simp:valid_def simpler_modify_def return_def bind_def)
apply wp+
apply (clarsimp simp:gets_def alternative_def select_def bind_def get_def return_def)
done
lemma get_active_irq_corres:
@ -1633,40 +1627,40 @@ lemma handle_event_corres:
apply (simp add:not_idle_thread_def)
apply (wp handle_reply_cur_thread_idle_thread handle_reply_valid_etcbs)
apply (rule hoare_post_imp[OF _ hr_ct_active_and_valid_etcbs])
apply (clarsimp simp:ct_in_state_def)
apply clarsimp+
apply (frule (1) ct_running_not_idle_etc)
apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def
apply (clarsimp simp:ct_in_state_def)
apply clarsimp+
apply (frule (1) ct_running_not_idle_etc)
apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def
ct_in_state_def st_tcb_at_def obj_at_def)+)[1]
apply (rule handle_invocation_corres[THEN corres_guard_imp] | simp)+
apply (rule handle_invocation_corres[THEN corres_guard_imp] | simp)+
apply (rule corres_guard_imp[OF handle_recv_corres])
apply simp+
apply (simp add: ct_running_not_idle_etc)
apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def generates_pending_def)
apply (rule corres_guard_imp[OF handle_reply_corres])
apply simp
apply (simp add: ct_running_not_idle_etc)
apply (clarsimp simp:not_idle_thread_def ct_in_state_def st_tcb_at_def)
apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def
apply (clarsimp simp: ct_in_state_def st_tcb_at_def obj_at_def generates_pending_def)
apply (rule corres_guard_imp[OF handle_reply_corres])
apply simp
apply (simp add: ct_running_not_idle_etc)
apply (clarsimp simp:not_idle_thread_def ct_in_state_def st_tcb_at_def)
apply ((clarsimp simp: handle_yield_def returnOk_def liftE_def not_idle_thread_def
ct_in_state_def st_tcb_at_def obj_at_def)+)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_return, simp)
apply (wp hoare_TrueI)
apply (rule corres_guard_imp)
apply (rule handle_recv_corres, simp)
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (clarsimp simp: not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def)
apply (rule dcorres_symb_exec_r)
apply (rule dcorres_return, simp)
apply (wp hoare_TrueI)+
apply (rule corres_guard_imp)
apply (rule handle_recv_corres, simp)
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (clarsimp simp: not_idle_thread_def ct_in_state_def st_tcb_at_def obj_at_def)
apply (rule corres_symb_exec_r[OF handle_fault_corres])
apply wp[1]
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def gets_def get_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (rule corres_symb_exec_r[OF handle_fault_corres])
apply wp[1]
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def gets_def get_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (rule corres_symb_exec_r[OF handle_fault_corres])
apply wp[1]
apply clarsimp
apply (frule (1) ct_running_not_idle_etc)
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (fastforce simp:st_tcb_at_def obj_at_def generates_pending_def valid_fault_def split:Structures_A.thread_state.splits)+
apply (simp add:handle_pending_interrupts_def)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ get_active_irq_corres])

139
proof/drefine/Tcb_DR.thy
View File

@ -62,6 +62,7 @@ lemma decode_set_ipc_buffer_translate_tcb_invocation:
translate_tcb_invocation_thread_ctrl_buffer (tc_new_buffer rv) = (if (x ! 0) = 0 then None
else Some (reset_mem_mapping (transform_cap a), transform_cslot_ptr (b, c)))
\<rbrace>,\<lbrace>\<lambda>ft. op = s\<rbrace>)"
including no_pre
apply (clarsimp simp:decode_set_ipc_buffer_def whenE_def | rule conjI)+
apply (wp , simp_all add:translate_tcb_invocation_thread_ctrl_buffer_def)
apply (clarsimp | rule conjI)+
@ -69,21 +70,21 @@ lemma decode_set_ipc_buffer_translate_tcb_invocation:
apply (wp | clarsimp | rule conjI)+
apply (simp add:check_valid_ipc_buffer_def)
apply (wpc|wp)+
apply (wp hoare_whenE_wp)
apply (wp hoare_whenE_wp)+
apply (case_tac a)
apply (simp_all add:derive_cap_def split del:if_split)
apply (wp|clarsimp split del:if_split)+
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (simp_all add:arch_derive_cap_def split del: if_split)
apply (wp | clarsimp split del: if_split)+
apply (wp+ | clarsimp split del: if_split)+
apply (clarsimp simp:transform_mapping_def)
apply (rule hoare_pre)
apply wpc
apply (wp | clarsimp split del: if_split)+
apply (rule hoare_pre)
apply wpc
apply wp
apply wp+
apply clarsimp
done
@ -92,11 +93,11 @@ lemma derive_cap_translate_tcb_invocation:
apply (simp add:derive_cap_def)
apply (case_tac b)
apply (clarsimp simp:ensure_no_children_def whenE_def |wp)+
apply (clarsimp simp:arch_derive_cap_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (clarsimp simp:ensure_no_children_def whenE_def |wp)+
apply (clarsimp split:option.splits | rule conjI | wp)+
apply (clarsimp simp:arch_derive_cap_def)
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (clarsimp simp:ensure_no_children_def whenE_def |wp)+
apply (clarsimp split:option.splits | rule conjI | wp)+
done
lemma derive_cnode_cap_as_vroot:
@ -107,13 +108,13 @@ lemma derive_cnode_cap_as_vroot:
apply (simp add:derive_cap_def is_valid_vtable_root_def)
apply (case_tac aa)
apply (clarsimp|wp)+
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (intro conjI)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (intro conjI)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (intro conjI)
apply (clarsimp simp:arch_derive_cap_def | wp)+
apply (clarsimp simp:arch_derive_cap_def | wp)+
done
lemma derive_cnode_cap_as_croot:
@ -122,13 +123,13 @@ lemma derive_cnode_cap_as_croot:
apply (clarsimp simp:derive_cap_def is_cap_simps)
apply (case_tac a)
apply (clarsimp|wp)+
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (rename_tac arch_cap)
apply (case_tac arch_cap)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (intro conjI)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (intro conjI)
apply (clarsimp simp:arch_derive_cap_def split:option.splits |wp)+
apply (intro conjI)
apply (clarsimp simp:arch_derive_cap_def | wp)+
apply (clarsimp simp:arch_derive_cap_def | wp)+
done
lemma valid_vtable_root_update:
@ -286,7 +287,7 @@ lemma decode_tcb_corres:
apply simp
apply (rule corres_alternate1)
apply (clarsimp simp: returnOk_def translate_tcb_invocation_def)
apply(wp)
apply(wp)+
apply(simp add: range_check_def unlessE_def[abs_def])
(* TCBWriteRegisters *)
apply(clarsimp simp: decode_write_registers_def split: list.split)
@ -303,7 +304,7 @@ lemma decode_tcb_corres:
apply(fastforce intro: corres_alternate2 simp: throwError_def)
apply(fastforce intro: corres_alternate1 simp: returnOk_def
translate_tcb_invocation_def)
apply(wp)
apply(wp)+
(* TCBCopyRegisters *)
apply(clarsimp simp: decode_copy_registers_def)
apply (case_tac args')
@ -365,7 +366,7 @@ lemma decode_tcb_corres:
apply (clarsimp simp:throw_on_none_def get_index_def dcorres_alternative_throw | rule conjI)+
apply (rule corres_return_throw_thingy)
apply (rule decode_set_space_translate_tcb_invocation)
apply (clarsimp split del:if_splits)+
apply (clarsimp split del: if_split)+
apply (clarsimp simp:translate_tcb_invocation_def translate_tcb_invocation_thread_ctrl_buffer_def)
apply (case_tac "excaps' ! 0",simp,case_tac "excaps' ! Suc 0",simp)
apply (simp add:update_cnode_cap_data)
@ -466,12 +467,11 @@ lemma dcorres_setup_reply_master:
apply (rule_tac Q'="\<lambda>rv. valid_objs and tcb_at obj_id and not_idle_thread obj_id and valid_idle and valid_etcbs and
cte_wp_at (\<lambda>c. c = rv) (obj_id,tcb_cnode_index 2)" in corres_symb_exec_r)
prefer 2
apply (wp get_cap_cte_wp_at)
apply simp
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:tcb_at_def)
apply (frule valid_tcb_objs)
apply (simp add:tcb_at_def)
apply (wp get_cap_cte_wp_at)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:tcb_at_def)
apply (frule valid_tcb_objs)
apply (simp add:tcb_at_def)
apply (clarsimp simp:cte_wp_at_cases dest!:get_tcb_SomeD)
apply (clarsimp simp:valid_tcb_def)
apply (clarsimp simp:tcb_cap_cases_def)
@ -482,7 +482,7 @@ lemma dcorres_setup_reply_master:
apply (rule set_cap_corres)
apply (clarsimp simp:transform_cap_def)
apply (clarsimp simp:transform_tcb_slot_simp)
apply wp[2]
apply (wp+)[2]
apply (clarsimp simp:transform_def transform_current_thread_def)
apply (rule TrueI)
apply (clarsimp simp: not_idle_thread_def)
@ -500,7 +500,7 @@ lemma dcorres_setup_reply_master:
apply (clarsimp simp:cte_wp_at_cases)
apply wp
apply simp
done
done
lemma set_cdl_cap_noop:
" dcorres dc \<top> (cte_wp_at (\<lambda>cap. cdlcap = transform_cap cap) slot and not_idle_thread (fst slot) and valid_etcbs)
@ -613,7 +613,7 @@ lemma invoke_tcb_corres_read_regs:
apply (rule corres_symb_exec_r)
apply (rule dcorres_idempotent_as_user)
apply (rule hoare_mapM_idempotent)
apply wp
apply wp+
apply simp
apply (rule suspend_corres, simp)
apply wp
@ -644,7 +644,7 @@ lemma invoke_tcb_corres_write_regs:
apply (clarsimp simp: dc_def, rule restart_corres [unfolded dc_def])
apply (clarsimp simp: when_def)
apply (rule corrupt_tcb_intent_as_user_corres)
apply (wp | simp add:invs_def valid_state_def | fastforce)+
apply (wp wp_post_taut | simp add:invs_def valid_state_def | fastforce)+
done
context begin interpretation Arch . (*FIXME: arch_split*)
@ -712,6 +712,7 @@ crunch idle_thread_constant [wp]: "Tcb_A.restart", "IpcCancel_A.suspend" "\<lamb
lemma not_idle_after_restart [wp]:
"\<lbrace>invs and not_idle_thread obj_id' :: det_state \<Rightarrow> bool\<rbrace> Tcb_A.restart obj_id'
\<lbrace>\<lambda>rv. valid_idle \<rbrace>"
including no_pre
apply (simp add:Tcb_A.restart_def)
apply wp
apply (simp add:cancel_ipc_def)
@ -781,9 +782,9 @@ lemma invoke_tcb_corres_copy_regs:
apply (rule restart_corres, simp)
apply (rule corres_alternate2)
apply (rule corres_free_return [where P="\<top>" and P'="\<top>"])
apply (wp)
apply (wp wp_post_taut)
apply (clarsimp simp:conj_comms)
apply (clarsimp simp :not_idle_thread_def | wp)+
apply (clarsimp simp: not_idle_thread_def | wp)+
apply (rule corres_cases [where R="a"])
apply (clarsimp simp: when_def)
apply (rule corres_alternate1)
@ -900,7 +901,7 @@ lemma thread_set_valid_irq_node:
apply (simp add:valid_irq_node_def thread_set_def)
apply wp
apply (simp add:KHeap_A.set_object_def)
apply wp
apply wp+
apply (clarsimp simp:obj_at_def is_cap_table_def dest!:get_tcb_SomeD)
apply (drule_tac x = irq in spec)
apply clarsimp
@ -1105,13 +1106,13 @@ lemma dcorres_tcb_update_ipc_buffer:
\<and> valid_mdb s \<and> valid_objs s\<and> not_idle_thread ab s \<and> valid_etcbs s
\<and> ((is_thread_cap r \<and> obj_ref_of r = obj_id') \<longrightarrow>
ex_cte_cap_wp_to (\<lambda>_. True) (obj_id', tcb_cnode_index 4) s)"
in hoare_strengthen_post)
in hoare_strengthen_post)
apply (wp get_cap_ex_cte_cap_wp_to,clarsimp)
apply (clarsimp simp:same_object_as_def)
apply (drule ex_cte_cap_to_not_idle, auto simp: not_idle_thread_def)[1]
apply (wp hoare_when_wp)
apply (wp hoare_when_wp)+
apply (rule hoare_strengthen_post[OF hoare_TrueI[where P = \<top>]],clarsimp+)
apply (wp hoare_drop_imp get_cap_weak_wp)
apply (wp wp_post_taut hoare_drop_imp get_cap_weak_wp)+
apply (clarsimp simp:conj_comms)
apply (wp thread_set_global_refs_triv thread_set_valid_idle)
apply (clarsimp simp:tcb_cap_cases_def)
@ -1211,11 +1212,11 @@ lemma dcorres_tcb_update_vspace_root:
in hoare_post_impErr[where E="\<lambda>x. \<top>"])
apply (simp add: not_idle_thread_def)
apply (wp cap_delete_cte_at cap_delete_deletes)
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
apply (erule cte_wp_at_weakenE,clarsimp+)
apply (simp add: emptyable_def not_idle_thread_def)
apply (erule tcb_at_cte_at,clarsimp)
done
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def)
apply (erule cte_wp_at_weakenE,clarsimp+)
apply (simp add: emptyable_def not_idle_thread_def)
apply (erule tcb_at_cte_at,clarsimp)
done
lemma dcorres_tcb_update_cspace_root:
"dcorres (dc \<oplus> dc) (\<top> ) ( invs and valid_etcbs and valid_pdpt_objs
@ -1375,11 +1376,10 @@ done
lemma reschedule_required_transform: "\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> reschedule_required \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
by (clarsimp simp: reschedule_required_def set_scheduler_action_def etcb_at_def
| wp tcb_sched_action_transform | wpc)+
| wp tcb_sched_action_transform | wpc | assumption)+
lemma thread_set_priority_transform: "\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> thread_set_priority tptr prio \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
apply (clarsimp simp: thread_set_priority_def ethread_set_def set_eobject_def | wp)+
apply (clarsimp simp: transform_def transform_objects_def transform_cdt_def transform_current_thread_def transform_asid_table_def)
apply (rule_tac y="\<lambda>ptr. map_option (transform_object (machine_state s) ptr ((ekheap s |` (- {idle_thread s})) ptr)) ((kheap s |` (- {idle_thread s})) ptr)" in arg_cong)
apply (rule ext)
@ -1493,6 +1493,7 @@ lemma dcorres_thread_control:
\<and> (case fault_ep' of None \<Rightarrow> True | Some bl \<Rightarrow> length bl = word_bits))
(Tcb_D.invoke_tcb t) (Tcb_A.invoke_tcb t')"
(is "\<lbrakk> ?eq; ?eq' \<rbrakk> \<Longrightarrow> dcorres (dc \<oplus> dc) \<top> ?P ?f ?g")
including no_pre
apply (clarsimp simp: Tcb_D.invoke_tcb_def translate_tcb_invocation_def)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF _ option_update_thread_corres])
@ -1503,17 +1504,17 @@ lemma dcorres_thread_control:
apply (rule corres_splitEE[OF _ dcorres_tcb_update_cspace_root])
apply (rule corres_splitEE[OF _ dcorres_tcb_update_vspace_root])
apply (rule dcorres_tcb_update_ipc_buffer)
apply (wp)
apply (wp)+
apply (wp|wpc)+
apply (wp checked_insert_tcb_invs | clarsimp)+
apply (rule check_cap_at_stable, (clarsimp simp: not_idle_thread_def | wp)+)+
apply (rule check_cap_at_stable, (clarsimp simp: not_idle_thread_def | wp+)+)+
apply (rule check_cap_at_stable)
apply (rule case_option_wp, clarsimp split: option.splits, wp)
apply (rule case_option_wp, clarsimp split: option.splits, wp+)
apply (rule case_option_wp)
apply simp
apply (rule case_option_wp)
apply (rule check_cap_at_stable,
clarsimp simp: not_idle_thread_def split: option.splits, wp)
clarsimp simp: not_idle_thread_def split: option.splits, wp+)
apply (simp,rule check_cap_at_stable)
apply (case_tac ipc_buffer')
apply (clarsimp simp:not_idle_thread_def)+
@ -1526,7 +1527,7 @@ lemma dcorres_thread_control:
apply (strengthen is_cnode_or_valid_arch_cap_asid[simplified,THEN conjunct2])
apply (wp hoare_case_someE)
apply (clarsimp simp: not_idle_thread_def)
apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap)
apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap)+
apply (wp case_option_wpE)
apply simp
apply (rule case_option_wpE)
@ -1534,55 +1535,55 @@ lemma dcorres_thread_control:
apply (wp cap_delete_cte_at)
apply (wp case_option_wpE)
apply (simp add: not_idle_thread_def)
apply (wp cap_delete_cte_at cap_delete_valid_cap)
apply (wp cap_delete_cte_at cap_delete_valid_cap)+
apply (rule_tac Q'="\<lambda>_. ?P" in hoare_post_imp_R[rotated])
apply (clarsimp simp: is_valid_vtable_root_def is_cnode_or_valid_arch_def
is_arch_cap_def not_idle_thread_def emptyable_def
split: option.splits)
apply (wpc|wp)+
apply (wp checked_insert_tcb_invs | clarsimp)+
apply (rule check_cap_at_stable, (simp add: not_idle_thread_def | wp)+)+
apply (wp checked_insert_no_cap_to hoare_case_some)
apply (rule check_cap_at_stable, (simp add: not_idle_thread_def | wp+)+)+
apply (wp checked_insert_no_cap_to hoare_case_some)+
apply (simp, rule check_cap_at_stable, simp add: not_idle_thread_def)
apply wp
apply wp+
apply (simp, rule check_cap_at_stable)
apply (rule case_option_wp, clarsimp split: option.splits, wp)
apply (rule case_option_wp, clarsimp split: option.splits, wp+)
apply (rule case_option_wp)
apply simp
apply (rule check_cap_at_stable, clarsimp simp: not_idle_thread_def split: option.splits, wp)
apply (rule check_cap_at_stable, clarsimp simp: not_idle_thread_def split: option.splits, wp+)
apply (rule case_option_wp)
apply simp
apply (rule check_cap_at_stable,wp)
apply (rule check_cap_at_stable, wp+)
apply (rule case_option_wp)
apply simp
apply (wp checked_insert_no_cap_to)
apply (wp hoare_case_some)
apply (wp hoare_case_some)
apply (simp, rule check_cap_at_stable, simp add: not_idle_thread_def)
apply (wp case_option_wp)
apply simp
apply (wp case_option_wp)+
apply simp
apply (rule case_option_wp, simp add: not_idle_thread_def)
apply (rule check_cap_at_stable, wp)
apply (rule check_cap_at_stable, wp+)
apply (wp case_option_wp check_cap_at_stable | simp)+
apply (wp cap_delete_deletes cap_delete_valid_cap)
apply (wp cap_delete_deletes cap_delete_valid_cap)+
apply (strengthen tcb_cap_always_valid_strg use_no_cap_to_obj_asid_strg)
apply (simp add: tcb_cap_cases_def)
apply (strengthen is_cnode_or_valid_arch_cap_asid[simplified,THEN conjunct1])
apply (strengthen is_cnode_or_valid_arch_cap_asid[simplified,THEN conjunct2])
apply simp
apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap)
apply (wp case_option_wpE cap_delete_valid_cap cap_delete_deletes cap_delete_cte_at
hoare_case_someE
apply (wp cap_delete_deletes cap_delete_cte_at cap_delete_valid_cap)+
apply ((wp case_option_wpE cap_delete_valid_cap cap_delete_deletes cap_delete_cte_at
hoare_case_someE)+
| simp add: not_idle_thread_def)+
apply (case_tac prio', clarsimp, rule return_wp, clarsimp)
subgoal by (wp case_option_wp dxo_wp_weak
subgoal by ((wp case_option_wp dxo_wp_weak)+
| clarsimp split: option.splits
| rule conjI)+
apply (simp, wp)
apply (simp, wp+)
apply (case_tac mcp', clarsimp, rule return_wp, clarsimp)
subgoal by (wp case_option_wp set_mcpriority_valid_cap_fst
| clarsimp split: option.splits
| rule conjI)+
apply (wp case_option_wpE)
apply (wp case_option_wpE)+
apply (rule_tac Q="\<lambda>_. ?P" in hoare_strengthen_post[rotated])
apply (clarsimp simp: is_valid_vtable_root_def is_cnode_or_valid_arch_def
is_arch_cap_def not_idle_thread_def emptyable_def

33
proof/drefine/Untyped_DR.thy
View File

@ -622,7 +622,7 @@ lemma retype_region_dcorres:
apply clarsimp
apply simp
apply assumption
apply wp
apply wp+
apply fastforce
apply simp
apply (case_tac type, simp_all add:translate_object_type_def)
@ -1052,7 +1052,7 @@ lemma create_caps_loop_dcorres:
apply (erule corres_split_nor)
apply (rule create_cap_dcorres)
apply (wp create_cap_invs hoare_vcg_const_Ball_lift
create_cap_mdb_cte_at[unfolded swp_def])
create_cap_mdb_cte_at[unfolded swp_def])+
apply simp
apply (clarsimp simp: not_idle_thread_def swp_def)
apply (auto simp: cte_wp_at_caps_of_state image_def)
@ -1358,7 +1358,7 @@ lemma reset_untyped_cap_corres:
apply (rule throw_or_return_preemption_corres[where P=\<top> and P'=\<top>])
apply (clarsimp simp: is_cap_simps bits_of_def)
apply simp
apply wp
apply wp+
apply (clarsimp simp add: is_cap_simps cap_aligned_def bits_of_def
aligned_add_aligned is_aligned_shiftl)
apply (simp add: reset_chunk_bits_def)
@ -1373,14 +1373,12 @@ lemma reset_untyped_cap_corres:
apply (rule shiftl_less_t2n[OF word_of_nat_less])
apply simp
apply (simp add: word_bits_def)
apply (rule hoare_pre, wp)
apply simp
apply (rule hoare_pre)
apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift
update_untyped_cap_valid_objs set_cap_no_overlap
set_cap_idle preemption_point_inv'
set_cap_cte_wp_at
| simp)+
apply wpsimp
apply (wp hoare_vcg_all_lift hoare_vcg_const_imp_lift
update_untyped_cap_valid_objs set_cap_no_overlap
set_cap_idle preemption_point_inv'
set_cap_cte_wp_at
| simp)+
apply (clarsimp simp: cte_wp_at_caps_of_state exI
is_cap_simps bits_of_def)
apply (frule(1) cte_wp_at_valid_objs_valid_cap[OF caps_of_state_cteD])
@ -1535,7 +1533,7 @@ lemma invoke_untyped_corres:
simp: vslot image_def invs_def valid_state_def valid_mdb_def cte_wp_at_caps_of_state
| intro conjI | drule (1) bspec | drule(1) mdb_cte_atD[rotated])+)[2]
apply (wp retype_region_cte_at_other'[where sz= sz] retype_region_post_retype_invs[where sz = sz]
hoare_vcg_const_Ball_lift retype_region_aligned_for_init)
hoare_vcg_const_Ball_lift retype_region_aligned_for_init)+
apply (clarsimp simp:conj_comms misc cover)
apply (rule_tac Q="\<lambda>r s.
cte_wp_at (\<lambda>cp. \<exists>idx. cp = (cap.UntypedCap dev ptr' sz idx)) cref s \<and>
@ -1578,9 +1576,9 @@ lemma invoke_untyped_corres:
apply simp
apply wp
apply (simp split del: if_split)
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply (wp_once hoare_drop_imps)
apply wp
apply wp+
apply (rule validE_validE_R, rule_tac E="\<top>\<top>" and Q="\<lambda>_. valid_etcbs and invs
and valid_untyped_inv_wcap untyped_invocation
(Some (cap.UntypedCap dev ptr' sz (if reset then 0 else idx))) and ct_active
@ -1782,6 +1780,7 @@ lemma decode_untyped_corres:
and (\<lambda>s. \<forall>x \<in> set excaps'. cte_wp_at (diminished (fst x)) (snd x) s) and valid_etcbs)
(Untyped_D.decode_untyped_invocation cap slot excaps ui)
(Decode_A.decode_untyped_invocation label' args' slot' cap' (map fst excaps'))"
including no_pre
apply (simp add: transform_intent_def map_option_Some_eq2
transform_intent_untyped_retype_def
split: invocation_label.split_asm arch_invocation_label.split_asm list.split_asm
@ -1850,13 +1849,13 @@ lemma decode_untyped_corres:
apply simp
apply (simp add:const_on_failure_def)
apply clarsimp
apply wp
apply wp+
apply (clarsimp simp:conj_comms)
apply (wp mapME_x_inv_wp[OF hoare_pre(2)] | simp split del: if_split)+
apply (wp hoare_whenE_wp)
apply (wp hoare_whenE_wp)+
apply (simp add:validE_def split del:if_splits)
apply (rule_tac Q = "\<lambda>r. op = s" in hoare_strengthen_post)
apply wp
apply wp+
apply fastforce
apply (case_tac r,clarsimp+)
apply (rule corres_alternate1)

62
proof/infoflow/ADT_IF.thy
View File

@ -852,16 +852,14 @@ crunch cur_domain[wp]: do_user_op_if "\<lambda>s. P (cur_domain s)" (wp: select_
crunch idle_thread[wp]: do_user_op_if "\<lambda>s. P (idle_thread s)" (wp: select_wp ignore: user_memory_update)
lemma do_use_op_guarded_pas_domain[wp]: "\<lbrace>guarded_pas_domain aag\<rbrace> do_user_op_if f tc \<lbrace>\<lambda>_. guarded_pas_domain aag\<rbrace>"
apply (rule guarded_pas_domain_lift)
apply wp
done
by (rule guarded_pas_domain_lift; wp)
crunch domain_fields[wp]: do_user_op_if "domain_fields P" (wp: select_wp ignore: user_memory_update)
definition
do_user_op_A_if :: "user_transition_if \<Rightarrow>
((user_context \<times> det_state) \<times> event option \<times> (user_context \<times> det_state)) set"
where
where
"do_user_op_A_if uop \<equiv> {(s,e,(tc,s'))| s e tc s'. ((e,tc),s') \<in> fst (split (do_user_op_if uop) s)}"
text {*
@ -871,7 +869,7 @@ text {*
*}
definition
kernel_entry_if :: "event \<Rightarrow> user_context \<Rightarrow> (((interrupt + unit) \<times> user_context),det_ext) s_monad"
where
where
"kernel_entry_if e tc \<equiv> do
t \<leftarrow> gets cur_thread;
thread_set (\<lambda>tcb. tcb \<lparr> tcb_arch := arch_tcb_context_set tc (tcb_arch tcb)\<rparr>) t;
@ -1147,9 +1145,7 @@ crunch cur_domain[wp]: handle_preemption_if " \<lambda>s. P (cur_domain s)"
crunch idle_thread[wp]: handle_preemption_if "\<lambda>s. P (idle_thread s)"
lemma handle_preemption_if_guarded_pas_domain[wp]: "\<lbrace>guarded_pas_domain aag\<rbrace> handle_preemption_if tc \<lbrace>\<lambda>_. guarded_pas_domain aag\<rbrace>"
apply (rule guarded_pas_domain_lift)
apply wp
done
by (rule guarded_pas_domain_lift; wp)
crunch valid_sched[wp]: handle_preemption_if "valid_sched"
(wp: crunch_wps simp: crunch_simps ignore: getActiveIRQ)
@ -1205,9 +1201,7 @@ crunch cur_domain[wp]: activate_thread "\<lambda>s. P (cur_domain s)"
crunch idle_thread[wp]: activate_thread "\<lambda>s. P (idle_thread s)"
lemma activate_thread_guarded_pas_domain[wp]: "\<lbrace>guarded_pas_domain aag\<rbrace> activate_thread \<lbrace>\<lambda>_. guarded_pas_domain aag\<rbrace>"
apply (rule guarded_pas_domain_lift)
apply (wp activate_thread_cur_thread)
done
by (rule guarded_pas_domain_lift; wp activate_thread_cur_thread)
lemma guarded_pas_domain_arch_state_update[simp]: "guarded_pas_domain aag (s\<lparr>arch_state := x\<rparr>) = guarded_pas_domain aag s"
apply (simp add: guarded_pas_domain_def)
@ -1696,18 +1690,17 @@ lemma schedule_if_domain_time_nonzero':
schedule_if tc
\<lbrace>(\<lambda>_ s. domain_time s > 0)\<rbrace>"
apply(simp add: schedule_if_def schedule_def)
apply (rule hoare_pre)
apply (wp next_domain_domain_time_nonzero
| wpc | simp add: crunch_simps guarded_switch_to_def switch_to_thread_def
choose_thread_def switch_to_idle_thread_def
arch_switch_to_idle_thread_def)+
apply(wp hoare_drop_imps)
apply(simp add: choose_thread_def switch_to_idle_thread_def arch_switch_to_idle_thread_def guarded_switch_to_def switch_to_thread_def | wp)+
apply(wp hoare_drop_imps)
apply(wp hoare_drop_imps)+
apply simp
apply(wp next_domain_domain_time_nonzero)
apply(wp next_domain_domain_time_nonzero)+
apply (clarsimp simp: if_apply_def2)
apply(wp gts_wp)
apply(wp gts_wp)+
apply (auto)
done
@ -1877,33 +1870,19 @@ lemma ptrFromPAddr_add_helper:
done
lemma dmo_user_memory_update_idle_equiv:
"\<lbrace>idle_equiv st\<rbrace>
do_machine_op
(user_memory_update um)
\<lbrace>\<lambda>y. idle_equiv st\<rbrace>"
apply(wp dmo_wp)
apply(simp add: user_memory_update_def)
apply(wp modify_wp)
done
"\<lbrace>idle_equiv st\<rbrace> do_machine_op (user_memory_update um) \<lbrace>\<lambda>y. idle_equiv st\<rbrace>"
by (wpsimp wp: dmo_wp)
lemma dmo_device_memory_update_idle_equiv:
"\<lbrace>idle_equiv st\<rbrace>
do_machine_op
(device_memory_update um)
\<lbrace>\<lambda>y. idle_equiv st\<rbrace>"
apply(wp dmo_wp)
apply(simp add: device_memory_update_def)
apply(wp modify_wp)
done
"\<lbrace>idle_equiv st\<rbrace> do_machine_op (device_memory_update um) \<lbrace>\<lambda>y. idle_equiv st\<rbrace>"
by (wpsimp wp: dmo_wp)
lemma do_user_op_if_idle_equiv[wp]:
"\<lbrace>idle_equiv st and invs\<rbrace>
do_user_op_if tc uop
\<lbrace>\<lambda>_. idle_equiv st\<rbrace>"
apply (simp add: do_user_op_if_def)
apply (wp dmo_user_memory_update_idle_equiv dmo_device_memory_update_idle_equiv
select_wp | wpc | simp)+
done
unfolding do_user_op_if_def
by (wpsimp wp: dmo_user_memory_update_idle_equiv dmo_device_memory_update_idle_equiv select_wp)
lemma ct_active_not_idle': "ct_active s \<Longrightarrow> \<not> ct_idle s"
apply (clarsimp simp add: ct_in_state_def st_tcb_at_def obj_at_def)
@ -1911,15 +1890,11 @@ lemma ct_active_not_idle': "ct_active s \<Longrightarrow> \<not> ct_idle s"
lemma Init_Fin_serial_weak_strengthen:
"Init_Fin_serial_weak A s0 I \<Longrightarrow> A [> J \<Longrightarrow> J \<subseteq> I \<Longrightarrow> Init A s0 \<subseteq> J \<Longrightarrow> Init_Fin_serial_weak A s0 J"
apply (simp add: Init_Fin_serial_weak_def serial_system_weak_def Init_Fin_serial_weak_axioms_def)
apply safe
apply force+
done
by (force simp: Init_Fin_serial_weak_def serial_system_weak_def Init_Fin_serial_weak_axioms_def)
lemma rel_terminate_weaken:
"rel_terminate A s0 R I measuref \<Longrightarrow> J \<subseteq> I \<Longrightarrow> rel_terminate A s0 R J measuref"
apply (force simp: rel_terminate_def)
done
by (force simp: rel_terminate_def)
end
@ -2071,7 +2046,7 @@ lemma kernel_entry_if_was_not_Interrupt:
apply wp
apply simp
apply(rule handle_event_was_not_Interrupt[simplified validE_E_def validE_def])
apply wp
apply wp+
done
lemma ct_idle_lift:
@ -2779,7 +2754,7 @@ lemma cap_revoke_irq_state_inv'':
apply(subst cap_revoke.simps)
apply(rule hoare_spec_gen_asm)
apply(rule hoare_pre_spec_validE)
apply (wp "1.hyps", assumption+)
apply (wp "1.hyps")
apply(wp spec_valid_conj_liftE2 | simp)+
apply(wp drop_spec_validE[OF preemption_point_irq_state_inv[simplified validE_R_def]]
drop_spec_validE[OF preemption_point_irq_state_inv'[where irq=irq]]
@ -2954,6 +2929,7 @@ lemma perform_invocation_irq_state_inv:
domain_sep_inv False sta and
valid_invocation oper and K (irq_is_recurring irq st)\<rbrace>
perform_invocation x y oper \<lbrace>\<lambda>_. irq_state_inv st\<rbrace>, \<lbrace>\<lambda>_. irq_state_next st\<rbrace>"
including no_pre
apply(case_tac oper)
apply(simp | wp)+
apply((wp invoke_untyped_irq_state_inv[where irq=irq] irq_state_inv_triv | simp)+)[4]

20
proof/infoflow/ADT_IF_Refine.thy
View File

@ -98,7 +98,7 @@ lemma kernel_entry_if_valid_domain_time:
| clarsimp | wpc)+
-- "strengthen post of do_machine_op; we know interrupt occurred"
apply (rule_tac Q="\<lambda>_ s. 0 < domain_time s" in hoare_post_imp, fastforce)
apply (wp, simp)
apply (wp+, simp)
done
lemma kernel_entry_if_no_preempt:
@ -332,7 +332,7 @@ lemma do_user_op_if_corres:
apply (clarsimp simp: select_def corres_underlying_def)
apply (simp only: comp_def | wp hoare_TrueI)+
apply (rule corres_underlying_trivial)
apply (wp hoare_TrueI)
apply (wp hoare_TrueI)+
apply clarsimp
apply force
apply force
@ -378,7 +378,7 @@ lemma doUserOp_if_invs'[wp]:
apply (simp add: doUserOp_if_def split_def ex_abs_def)
apply (wp device_update_invs' dmo_setExMonitor_wp' dmo_invs' | simp)+
apply (clarsimp simp add: no_irq_modify user_memory_update_def)
apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp)
apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp)+
apply (clarsimp simp: user_memory_update_def simpler_modify_def
restrict_map_def
split: option.splits)
@ -573,7 +573,7 @@ lemma check_active_irq_if_corres:
apply (simp add: checkActiveIRQ_if_def check_active_irq_if_def)
apply (rule corres_underlying_split[where r'="op ="])
apply (rule dmo_getActiveIRQ_corres)
apply (wp del: dmo_silc_dom add: do_machine_op_domain_list)
apply (wp del: dmo_silc_dom add: do_machine_op_domain_list)+
apply clarsimp
done
@ -721,7 +721,7 @@ lemma schedule_if_corres:
apply (rule activate_corres)
apply (rule hoare_post_taut[where P=\<top>])+
apply (rule schedule_corres)
apply (wp schedule_invs')
apply (wp schedule_invs')+
apply clarsimp+
done
@ -748,7 +748,6 @@ lemma schedule_if'_rct[wp]:
"\<lbrace>invs'\<rbrace> schedule'_if tc \<lbrace>\<lambda>r s. ksSchedulerAction s = ResumeCurrentThread\<rbrace>"
apply (simp add: schedule'_if_def)
apply (wp activate_sch_act schedule_sch)
apply simp
done
@ -770,7 +769,7 @@ lemma schedule_if_domain_time_left:
\<and> (domain_time s = 0 \<longrightarrow> scheduler_action s = choose_new_thread)"
in hoare_post_imp)
apply fastforce
apply wp
apply wp+
apply simp
done
@ -810,9 +809,9 @@ lemma kernel_exit_if_corres:
apply (clarsimp simp: tcb_relation_def arch_tcb_relation_def
arch_tcb_context_get_def atcbContextGet_def)
apply (rule gct_corres)
apply wp
apply wp+
apply clarsimp+
done
done
lemma kernelExit_inv[wp]:
"\<lbrace>P\<rbrace> kernelExit_if tc \<lbrace>\<lambda>_. P\<rbrace>"
@ -1231,6 +1230,7 @@ lemma haskell_invs:
"global_automaton_invs checkActiveIRQ_H_if (doUserOp_H_if uop)
kernelCall_H_if handlePreemption_H_if
schedule'_H_if kernelExit_H_if full_invs_if' (ADT_H_if uop) UNIV"
including no_pre
supply conj_cong[cong]
apply (unfold_locales)
apply (simp add: ADT_H_if_def)
@ -1248,7 +1248,7 @@ lemma haskell_invs:
apply (rule hoare_drop_imps)
apply wp
apply (wp_once hoare_disjI1)
apply wp
apply wp+
apply (clarsimp simp: active_from_running')+
apply (rule preserves_lifts)
apply (simp add: full_invs_if'_def)

21
proof/infoflow/ADT_IF_Refine_C.thy
View File

@ -323,15 +323,16 @@ lemma kernelEntry_corres_C:
apply simp
apply (rule_tac P="\<top>" and P'="\<top>" in corres_inst)
apply (clarsimp simp: prod_lift_def split: if_split)
apply wp
apply wp+
apply (rule hoare_strengthen_post)
apply (subst archTcbUpdate_aux2[symmetric])
apply (rule threadSet_all_invs_triv'[where e=e])
apply (clarsimp simp: all_invs'_def)
apply force
apply (rule exI, (rule conjI, assumption)+)
subgoal by force
apply simp
apply (rule hoare_post_taut[where P=\<top>])
apply wp
apply wp+
apply (clarsimp simp: all_invs'_def invs'_def cur_tcb'_def)
apply fastforce
done
@ -427,13 +428,13 @@ lemma corres_dmo_getExMonitor_C:
apply clarsimp
apply (rule corres_modify)
apply (clarsimp simp: rf_sr_def cstate_relation_def carch_state_relation_def cmachine_state_relation_def Let_def)
apply (wp hoare_TrueI)
apply (wp hoare_TrueI)+
apply (rule corres_select_f')
apply (clarsimp simp: getExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def)
apply (clarsimp simp: getExMonitor_no_fail[simplified no_fail_def])
apply (wp hoare_TrueI)
apply (wp hoare_TrueI)+
apply (clarsimp simp: corres_gets rf_sr_def cstate_relation_def cmachine_state_relation_def Let_def)
apply (wp hoare_TrueI)
apply (wp hoare_TrueI)+
apply (rule TrueI conjI | clarsimp simp: getExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def)+
done
@ -451,9 +452,9 @@ lemma corres_dmo_setExMonitor_C:
apply (rule corres_select_f')
apply (clarsimp simp: setExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def)
apply (clarsimp simp: setExMonitor_no_fail[simplified no_fail_def])
apply (wp hoare_TrueI)
apply (wp hoare_TrueI)+
apply (clarsimp simp: corres_gets rf_sr_def cstate_relation_def cmachine_state_relation_def Let_def)
apply (wp hoare_TrueI)
apply (wp hoare_TrueI)+
apply (rule TrueI conjI | clarsimp simp: setExMonitor_def machine_rest_lift_def NonDetMonad.bind_def gets_def get_def return_def modify_def put_def select_f_def)+
done
@ -753,7 +754,7 @@ lemma kernel_exit_corres_C:
apply simp
apply (rule_tac P="\<top>" and P'="\<top>" in corres_inst)
apply (clarsimp simp: getCurThread_def rf_sr_def cstate_relation_def Let_def)
apply wp
apply wp+
apply clarsimp+
done
@ -888,7 +889,7 @@ lemma c_to_haskell: "uop_nonempty uop \<Longrightarrow> global_automata_refine c
apply (fastforce simp: full_invs_if'_def ex_abs_def)
apply simp+
apply (simp add: ct_running'_C)
apply wp
apply wp+
apply (clarsimp simp: full_invs_if'_def)
apply (clarsimp)
apply (drule use_valid[OF _ kernelEntry_if_no_preempt]; simp)

122
proof/infoflow/Arch_IF.thy
View File

@ -19,24 +19,19 @@ abbreviation irq_state_of_state :: "det_state \<Rightarrow> nat" where
lemma do_extended_op_irq_state_of_state[wp]:
"\<lbrace>\<lambda>s. P (irq_state_of_state s)\<rbrace> do_extended_op f \<lbrace>\<lambda>_ s. P (irq_state_of_state s)\<rbrace>"
apply(wp dxo_wp_weak)
apply simp
done
by (wpsimp wp: dxo_wp_weak)
lemma no_irq_underlying_memory_update[simp]:
"no_irq (modify (underlying_memory_update f))"
apply(simp add: no_irq_def | wp modify_wp | clarsimp)+
done
by (wpsimp simp: no_irq_def)
crunch irq_state_of_state[wp]: cap_insert "\<lambda>s. P (irq_state_of_state s)"
(wp: crunch_wps)
crunch irq_state_of_state[wp]: set_extra_badge "\<lambda>s. P (irq_state_of_state s)"
(wp: crunch_wps dmo_wp simp: storeWord_def)
lemma transfer_caps_loop_irq_state[wp]:
"\<lbrace>\<lambda>s. P (irq_state_of_state s)\<rbrace> transfer_caps_loop a b c d e f \<lbrace>\<lambda>_ s. P (irq_state_of_state s)\<rbrace>"
apply(wp transfer_caps_loop_pres)
@ -118,9 +113,9 @@ lemma get_object_revrv:
apply(simp)
apply(rule assert_ev2)
apply(simp)
apply(wp)
apply fastforce+
done
apply(wp)+
apply fastforce
done
lemma get_object_revrv':
"reads_equiv_valid_rv_inv (affects_equiv aag l) aag
@ -136,9 +131,9 @@ lemma get_object_revrv':
apply(simp)
apply(rule assert_ev2)
apply(simp add: equiv_for_def)
apply(wp)
apply fastforce+
done
apply(wp)+
apply fastforce
done
lemma get_asid_pool_revrv':
"reads_equiv_valid_rv_inv (affects_equiv aag l) aag
@ -291,7 +286,7 @@ lemma find_pd_for_asid_reads_respects:
apply(intro conjI impI allI)
apply(rule return_ev2, simp)
apply(rule return_ev2, simp)
apply wp
apply wp+
apply(rule_tac R'="op =" and Q="\<lambda> rv s. rv = (arm_asid_table (arch_state s)) (asid_high_bits_of asid) \<and> is_subject_asid aag asid \<and> asid \<noteq> 0" and Q'="\<lambda> rv s. rv = (arm_asid_table (arch_state s)) (asid_high_bits_of asid) \<and> is_subject_asid aag asid \<and> asid \<noteq> 0" in equiv_valid_2_bindE)
apply (simp add: equiv_valid_def2[symmetric])
apply (split option.splits)
@ -301,7 +296,7 @@ lemma find_pd_for_asid_reads_respects:
apply(rule equiv_valid_2_liftE)
apply(clarsimp)
apply(rule get_asid_pool_revrv)
apply(wp gets_apply_wp)
apply(wp gets_apply_wp)+
apply(subst rel_sum_comb_equals)
apply(subst equiv_valid_def2[symmetric])
apply(wp gets_apply_ev | simp)+
@ -660,9 +655,7 @@ lemma set_vm_root_reads_respects:
lemma get_pte_reads_respects:
"reads_respects aag l (K (is_subject aag (ptr && ~~ mask pt_bits))) (get_pte ptr)"
unfolding get_pte_def fun_app_def
apply(wp get_pt_reads_respects)
apply(simp)
done
by (wp get_pt_reads_respects)
lemma gets_cur_thread_revrv:
"reads_equiv_valid_rv_inv (affects_equiv aag l) aag op = \<top> (gets cur_thread)"
@ -853,11 +846,10 @@ lemma invalidate_tlb_by_asid_reads_respects:
"reads_respects aag l (\<lambda>_. True) (invalidate_tlb_by_asid asid)"
apply(rule reads_respects_unobservable_unit_return)
apply (rule invalidate_tlb_by_asid_states_equiv_for)
apply wp
apply wp+
done
lemma get_master_pte_reads_respects:
"reads_respects aag l (K (is_subject aag (p && ~~ mask pt_bits))) (get_master_pte p)"
unfolding get_master_pte_def
@ -1028,7 +1020,7 @@ lemma equiv_valid_get_assert:
apply(rule_tac W="\<top>\<top>" in equiv_valid_rv_bind)
apply(rule equiv_valid_rv_guard_imp)
apply(rule equiv_valid_rv_trivial)
apply wp
apply wp+
apply(rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
apply(simp add: equiv_valid_def2)
apply(rule assert_ev2)
@ -1109,7 +1101,7 @@ lemma arm_asid_table_update_reads_respects:
apply(simp add: equiv_valid_def2)
apply(rule_tac W="\<top>\<top>" and Q="\<lambda> rv s. is_subject aag pool_ptr \<and> rv = arm_asid_table (arch_state s)" in equiv_valid_rv_bind)
apply(rule equiv_valid_rv_guard_imp[OF equiv_valid_rv_trivial])
apply wp
apply wp+
apply(rule modify_ev2)
apply clarsimp
apply (drule(1) is_subject_kheap_eq[rotated])
@ -1126,7 +1118,6 @@ lemma delete_objects_reads_respects:
"reads_respects aag l (\<lambda>_. True) (delete_objects p b)"
apply (simp add: delete_objects_def)
apply (wp detype_reads_respects dmo_freeMemory_reads_respects)
apply simp
done
lemma another_hacky_rewrite:
@ -1175,7 +1166,7 @@ lemma set_asid_pool_reads_respects:
apply(fold equiv_valid_def2)
apply(rule set_object_reads_respects)
apply(rule assert_ev2, rule refl)
apply (wp get_object_wp)
apply (wp get_object_wp)+
apply(clarsimp, rule impI, rule TrueI)
done
@ -1280,11 +1271,11 @@ lemma delete_asid_pool_reads_respects:
apply(rule equiv_valid_2_bind)
apply(rule equiv_valid_2_bind)
apply(rule equiv_valid_2_unobservable)
apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread)
apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread)+
apply(rule arm_asid_table_delete_ev2)
apply(wp)
apply(wp)+
apply(rule equiv_valid_2_unobservable)
apply(wp mapM_wp' invalidate_asid_entry_states_equiv_for flush_space_states_equiv_for invalidate_asid_entry_cur_thread invalidate_asid_entry_sched_act invalidate_asid_entry_wuc flush_space_cur_thread flush_space_sched_act flush_space_wuc | clarsimp)+
apply(wp mapM_wp' invalidate_asid_entry_states_equiv_for flush_space_states_equiv_for invalidate_asid_entry_cur_thread invalidate_asid_entry_sched_act invalidate_asid_entry_wuc flush_space_cur_thread flush_space_sched_act flush_space_wuc | clarsimp)+
apply( wp return_ev2 |
drule (1) requiv_arm_asid_table_asid_high_bits_of_asid_eq' |
clarsimp | rule conjI |
@ -1409,23 +1400,23 @@ lemma delete_asid_reads_respects:
apply(rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
apply(subst equiv_valid_def2[symmetric])
apply(rule reads_respects_unobservable_unit_return)
apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread)
apply(wp set_vm_root_states_equiv_for set_vm_root_cur_thread)+
apply(rule set_asid_pool_delete_ev2)
apply(wp)
apply(wp)+
apply(rule equiv_valid_2_unobservable)
apply(wp invalidate_asid_entry_states_equiv_for
invalidate_asid_entry_cur_thread)
invalidate_asid_entry_cur_thread)+
apply(simp add: invalidate_asid_entry_def
| wp invalidate_asid_kheap invalidate_hw_asid_entry_kheap
load_hw_asid_kheap)+
apply(rule equiv_valid_2_unobservable)
apply(wp flush_space_states_equiv_for flush_space_cur_thread)
apply(wp flush_space_states_equiv_for flush_space_cur_thread)+
apply(wp load_hw_asid_kheap | simp add: flush_space_def | wpc)+
apply(clarsimp | rule return_ev2)+
apply(rule equiv_valid_2_guard_imp)
apply(wp get_asid_pool_revrv)
apply(simp)+
apply(wp)
apply(wp)+
apply(clarsimp simp: obj_at_def)+
apply(clarsimp simp: equiv_valid_2_def reads_equiv_def equiv_asids_def equiv_asid_def states_equiv_for_def)
apply(erule_tac x="pasASIDAbs aag asid" in ballE)
@ -1715,7 +1706,7 @@ declare dmo_mol_globals_equiv[wp]
lemma unmap_page_table_globals_equiv:
"\<lbrace>pspace_aligned and valid_arch_objs and valid_global_objs and valid_vs_lookup
and valid_global_refs and valid_arch_state and globals_equiv st\<rbrace> unmap_page_table asid vaddr pt \<lbrace>\<lambda>rv. globals_equiv st\<rbrace>"
unfolding unmap_page_table_def page_table_mapped_def
unfolding unmap_page_table_def page_table_mapped_def including no_pre
apply(wp store_pde_globals_equiv | wpc | simp add: cleanByVA_PoU_def)+
apply(rule_tac Q="\<lambda>_. globals_equiv st and (\<lambda>sa. lookup_pd_slot pd vaddr && ~~ mask pd_bits \<noteq> arm_global_pd (arch_state sa))" in hoare_strengthen_post)
apply(wp | simp)+
@ -1909,16 +1900,16 @@ lemma unmap_page_globals_equiv:
"\<lbrace>globals_equiv st and valid_arch_state and pspace_aligned and valid_arch_objs
and valid_global_objs and valid_vs_lookup and valid_global_refs \<rbrace> unmap_page pgsz asid vptr pptr
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding unmap_page_def cleanCacheRange_PoU_def
unfolding unmap_page_def cleanCacheRange_PoU_def including no_pre
apply (induct pgsz)
prefer 4
apply (simp only: vmpage_size.simps)
apply(wp mapM_swp_store_pde_globals_equiv dmo_cacheRangeOp_lift | simp add: cleanByVA_PoU_def)+
apply(rule hoare_drop_imps)
apply(wp)
apply(wp)+
apply(simp)
apply(rule hoare_drop_imps)
apply(wp)
apply(wp)+
apply (rule hoare_pre)
apply (rule_tac Q="\<lambda>x. globals_equiv st and (\<lambda>sa. lookup_pd_slot x vptr && mask 6 = 0 \<longrightarrow> (\<forall>xa\<in>set [0 , 4 .e. 0x3C]. xa + lookup_pd_slot x vptr && ~~ mask pd_bits \<noteq> arm_global_pd (arch_state sa)))" and E="\<lambda>_. globals_equiv st" in hoare_post_impErr)
apply(wp find_pd_for_asid_not_arm_global_pd_large_page)
@ -1926,7 +1917,7 @@ lemma unmap_page_globals_equiv:
apply simp
apply simp
apply(wp store_pte_globals_equiv | simp add: cleanByVA_PoU_def)+
apply(wp hoare_drop_imps)
apply(wp hoare_drop_imps)+
apply(wp_once lookup_pt_slot_inv)
apply(wp_once lookup_pt_slot_inv)
apply(wp_once lookup_pt_slot_inv)
@ -1941,7 +1932,7 @@ lemma unmap_page_globals_equiv:
apply(simp add: valid_arch_state_ko_at_arm)
apply(rule hoare_pre)
apply(wp store_pde_globals_equiv | simp add: valid_arch_state_ko_at_arm cleanByVA_PoU_def)+
apply(wp find_pd_for_asid_not_arm_global_pd hoare_drop_imps)
apply(wp find_pd_for_asid_not_arm_global_pd hoare_drop_imps)+
apply(clarsimp)
done (* don't know what happened here. wp deleted globals_equiv from precon *)
@ -1952,12 +1943,10 @@ lemma cte_wp_parent_not_global_pd: "valid_global_refs s \<Longrightarrow> cte_wp
apply (drule valid_global_refsD2,simp)
apply (unfold parent_for_refs_def)
apply (simp add: image_def global_refs_def cap_range_def)
apply (elim conjE)
apply (intro ballI)
apply clarsimp
apply (subgoal_tac "arm_global_pd (arch_state s) \<in> set b")
apply auto
done
done
definition authorised_for_globals_page_inv :: "page_invocation \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
where "authorised_for_globals_page_inv pgi \<equiv>
@ -1985,9 +1974,9 @@ lemma as_user_globals_equiv:
\<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
unfolding as_user_def
apply(wp)
apply(simp add: split_def)
apply(wp set_object_globals_equiv)
apply(clarsimp simp: valid_ko_at_arm_def get_tcb_def obj_at_def)
apply(simp add: split_def)
apply(wp set_object_globals_equiv)+
apply(clarsimp simp: valid_ko_at_arm_def get_tcb_def obj_at_def)
done
@ -2043,7 +2032,7 @@ lemma set_mrs_globals_equiv:
apply(insert length_msg_lt_msg_max)
apply(simp)
apply(wp set_object_globals_equiv static_imp_wp)
apply(wp hoare_vcg_all_lift set_object_globals_equiv static_imp_wp)
apply(wp hoare_vcg_all_lift set_object_globals_equiv static_imp_wp)+
apply(clarsimp simp:arm_global_pd_not_tcb)+
done
@ -2077,7 +2066,7 @@ lemma retype_region_ASIDPoolObj_globals_equiv:
unfolding retype_region_def
apply(wp modify_wp dxo_wp_weak | simp | fastforce simp: globals_equiv_def default_arch_object_def obj_bits_api_def)+
apply (simp add: trans_state_update[symmetric] del: trans_state_update)
apply wp
apply wp+
apply (fastforce simp: globals_equiv_def idle_equiv_def tcb_at_def2)
done
@ -2087,7 +2076,8 @@ lemma cap_insert_globals_equiv'':
"\<lbrace>globals_equiv s and valid_global_objs and valid_ko_at_arm\<rbrace>
cap_insert new_cap src_slot dest_slot \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
unfolding cap_insert_def
apply(wp set_original_globals_equiv update_cdt_globals_equiv set_cap_globals_equiv'' dxo_wp_weak | rule hoare_drop_imps | simp)+
apply(wp set_original_globals_equiv update_cdt_globals_equiv set_cap_globals_equiv'' dxo_wp_weak
| rule hoare_drop_imps | simp)+
done
@ -2255,10 +2245,13 @@ lemma arch_perform_invocation_globals_equiv:
arch_perform_invocation ai \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
unfolding arch_perform_invocation_def
apply wp
apply(rule hoare_weaken_pre)
apply(wpc)
apply(wp perform_page_table_invocation_globals_equiv perform_page_directory_invocation_globals_equiv perform_page_invocation_globals_equiv perform_asid_control_invocation_globals_equiv perform_asid_pool_invocation_globals_equiv)
apply(auto simp: authorised_for_globals_arch_inv_def dest: valid_arch_state_ko_at_arm simp: invs_def valid_state_def valid_arch_inv_def invs_valid_vs_lookup)
apply(wp perform_page_table_invocation_globals_equiv perform_page_directory_invocation_globals_equiv
perform_page_invocation_globals_equiv perform_asid_control_invocation_globals_equiv
perform_asid_pool_invocation_globals_equiv)+
apply(auto simp: authorised_for_globals_arch_inv_def
dest: valid_arch_state_ko_at_arm
simp: invs_def valid_state_def valid_arch_inv_def invs_valid_vs_lookup)
done
lemma find_pd_for_asid_authority3:
@ -2378,12 +2371,9 @@ lemma delete_asid_pool_valid_arch_obsj[wp]:
delete_asid_pool base pptr
\<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
unfolding delete_asid_pool_def
apply (wp)
apply (wp modify_wp)
apply (strengthen valid_arch_objs_arm_asid_table_unmap)
apply simp
apply (rule hoare_vcg_conj_lift)
apply (wp mapM_wp' | simp)+
apply (wp modify_wp)
apply (strengthen valid_arch_objs_arm_asid_table_unmap)
apply (wpsimp wp: mapM_wp')+
done
crunch pspace_aligned[wp]: cap_swap_for_delete, set_cap, empty_slot "pspace_aligned" (ignore: empty_slot_ext wp: dxo_wp_weak)
@ -2407,14 +2397,8 @@ lemma restrict_eq_asn_none: "f(N := None) = f |` {s. s \<noteq> N}" by auto
lemma delete_asid_valid_arch_objs[wp]:
"\<lbrace>valid_arch_objs and pspace_aligned\<rbrace> delete_asid a b \<lbrace>\<lambda>_. valid_arch_objs\<rbrace>"
unfolding delete_asid_def
apply (wp | wpc | simp)+
apply (wp set_asid_pool_arch_objs_unmap'')[2]
apply (rule hoare_strengthen_post)
prefer 2
apply (subst restrict_eq_asn_none)
apply simp
apply wp
apply fastforce
apply (wpsimp wp: set_asid_pool_arch_objs_unmap'')
apply (fastforce simp: restrict_eq_asn_none)
done
crunch valid_arch_objs[wp]: finalise_cap "valid_arch_objs"
@ -2491,17 +2475,11 @@ lemma mapM_x_swp_store_pde_reads_respects':
lemma mapM_x_swp_store_pte_pas_refined_simple:
"invariant (mapM_x (swp store_pte InvalidPTE) A) (pas_refined aag)"
apply (wp mapM_x_wp')
apply simp
apply (wp store_pte_pas_refined_simple)
done
by (wpsimp wp: mapM_x_wp' store_pte_pas_refined_simple)
lemma mapM_x_swp_store_pde_pas_refined_simple:
"invariant (mapM_x (swp store_pde InvalidPDE) A) (pas_refined aag)"
apply (wp mapM_x_wp')
apply simp
apply (wp store_pde_pas_refined_simple)
done
by (wpsimp wp: mapM_x_wp' store_pde_pas_refined_simple)
end

28
proof/infoflow/Decode_IF.thy
View File

@ -93,21 +93,17 @@ lemma whenE_throwError_bindE_ev:
shows "equiv_valid I A A P (whenE b (throwError x) >>=E (\<lambda>_. f))"
apply(rule_tac Q="\<lambda> rv s. \<not> b \<and> P s" in bindE_ev_pre)
using ev apply(fastforce simp: equiv_valid_def2 equiv_valid_2_def)
apply(wp whenE_throwError_sp)
apply(wp whenE_throwError_sp)+
by simp
lemma hoare_vcg_imp_lift_R:
assumes "Q \<Longrightarrow> \<lbrace> P \<rbrace> f \<lbrace> R \<rbrace>,-"
shows "\<lbrace> \<lambda>s. Q \<longrightarrow> P s \<rbrace> f \<lbrace> \<lambda> rv s. Q \<longrightarrow> R rv s \<rbrace>,-"
using assms
apply(fastforce simp: validE_R_def validE_def valid_def split: sum.splits)
done
lemma expand_len_gr_Suc_0:
"Suc 0 < length xs = (xs \<noteq> [] \<and> Suc (Suc 0) \<le> length xs)"
apply fastforce
done
(* FIXME: remove *)
lemmas hoare_vcg_imp_lift_R = hoare_vcg_const_imp_lift_R
lemma decode_cnode_invocation_rev:
"reads_equiv_valid_inv A aag (pas_refined aag and
K (\<forall>c\<in>{cap} \<union> set excaps. pas_cap_cur_auth aag c))
@ -163,7 +159,7 @@ lemma slot_cap_long_running_delete_reads_respects_f:
apply(wpc)
apply(wp)[1]
apply(fastforce simp: long_running_delete_def is_final_cap_def gets_bind_ign intro: return_ev)+
apply(wp is_final_cap_reads_respects[where slot=slot and st=st])[2]
apply((wp is_final_cap_reads_respects[where slot=slot and st=st])+)[2]
apply(fastforce simp: long_running_delete_def is_final_cap_def gets_bind_ign intro: return_ev)+
apply(wp is_final_cap_reads_respects[where st=st])[1]
apply(fastforce simp: long_running_delete_def is_final_cap_def gets_bind_ign intro: return_ev)+
@ -199,8 +195,7 @@ lemma check_valid_ipc_buffer_rev:
lemma OR_choice_def2: "(\<And>P. \<lbrace>P\<rbrace> (c :: bool det_ext_monad) \<lbrace>\<lambda>_.P\<rbrace>) \<Longrightarrow>
empty_fail c \<Longrightarrow>
(OR_choice c f g) = (do b \<leftarrow> c; if b then f else g od)"
apply (simp add: OR_choice_def wrap_ext_bool_det_ext_ext_def
ef_mk_ef)
apply (simp add: OR_choice_def wrap_ext_bool_det_ext_ext_def ef_mk_ef)
by (subst no_state_changes[where f=c],simp,fastforce simp: bind_assoc split_def)
lemma check_prio_rev:
@ -212,14 +207,13 @@ lemma check_prio_rev:
lemma decode_set_priority_rev:
"reads_respects aag l (is_subject aag \<circ> cur_thread) (decode_set_priority args cap slot)"
apply (clarsimp simp: decode_set_priority_def wp_ev)
apply (wp check_prio_rev)
by simp
by (wp check_prio_rev)
lemma decode_set_mcpriority_rev:
"reads_respects aag l (is_subject aag \<circ> cur_thread) (decode_set_mcpriority args cap slot)"
apply (clarsimp simp: decode_set_mcpriority_def wp_ev)
apply (wp check_prio_rev)
by simp
by (wp check_prio_rev)+
lemma decode_tcb_invocation_reads_respects_f:
notes respects_f = reads_respects_f[where st=st and Q=\<top>]
@ -727,7 +721,9 @@ lemma decode_invocation_reads_respects_f:
crunch globals_equiv: decode_invocation "globals_equiv st"
lemmas decode_invocation_reads_respects_f_g = reads_respects_f_g[OF decode_invocation_reads_respects_f doesnt_touch_globalsI, where Q="\<top>", simplified, OF decode_invocation_globals_equiv]
lemmas decode_invocation_reads_respects_f_g =
reads_respects_f_g[OF decode_invocation_reads_respects_f doesnt_touch_globalsI,
where Q="\<top>", simplified, OF decode_invocation_globals_equiv]
end

29
proof/infoflow/Example_Valid_State.thy
View File

@ -14,8 +14,6 @@ imports
"../../lib/Distinct_Cmd"
begin
context begin interpretation Arch . (*FIXME: arch_split*)
section {* Example *}
(* This example is a classic 'one way information flow'
@ -25,10 +23,20 @@ section {* Example *}
implement a ring-buffer. We consider the NTFN to be in the domain of High,
and the shared memory to be in the domain of Low. *)
(* basic machine-level declarations that need to happen outside the locale *)
consts s0_context :: user_context
(* define the irqs to come regularly every 10 *)
axiomatization where
irq_oracle_def: "ARM.irq_oracle \<equiv> \<lambda>pos. if pos mod 10 = 0 then 10 else 0"
context begin interpretation Arch . (*FIXME: arch_split*)
subsection {* We show that the authority graph does not let
information flow from High to Low *}
datatype auth_graph_label = High | Low | IRQ0
abbreviation partition_label where
@ -778,7 +786,7 @@ lemma kh0_dom:
irq_node_offs_range"
apply (rule equalityI)
apply (simp add: kh0_def dom_def)
apply (clarsimp simp: irq_node_offs_in_range irq_node_offs_distinct)
apply (clarsimp simp: irq_node_offs_in_range)
apply (clarsimp simp: dom_def)
apply (rule conjI, clarsimp simp: kh0_def)+
apply (force simp: kh0_def cte_level_bits_def dest: irq_node_offs_range_correct)
@ -1000,8 +1008,6 @@ lemma Sys1_pas_wellformed:
Sys1AuthGraph_def)
done
declare AllowSend_def[simp] AllowRecv_def[simp]
lemma domains_of_state_s0[simp]:
"domains_of_state s0_internal = {(High_tcb_ptr, High_domain), (Low_tcb_ptr, Low_domain), (idle_tcb_ptr, default_domain)}"
apply(rule equalityI)
@ -1144,10 +1150,6 @@ lemma silc_inv_s0:
apply (clarsimp simp: all_children_def s0_internal_def silc_dom_equiv_def equiv_for_refl)
done
text {* define the irq's to come regularly every 10 *}
defs irq_oracle_def: "irq_oracle \<equiv> \<lambda>pos. if pos mod 10 = 0 then 10 else 0"
lemma only_timer_irq_s0:
"only_timer_irq timer_irq s0_internal"
@ -1176,11 +1178,6 @@ lemma s0_valid_domain_list:
"valid_domain_list s0_internal"
by (clarsimp simp: valid_domain_list_2_def s0_internal_def exst0_def)
end
consts s0_context :: user_context
context begin interpretation Arch . (*FIXME: arch_split*)
definition
"s0 \<equiv> ((if ct_idle s0_internal then idle_context s0_internal else s0_context,s0_internal),KernelExit)"
@ -1750,7 +1747,7 @@ lemma respects_device_trivial:
cap_range_respects_device_region_def machine_state0_def)
apply (intro conjI impI)
apply (drule s0_caps_of_state)
apply (fastforce simp: cap_is_device.simps)[1]
apply fastforce
apply (clarsimp simp: s0_internal_def machine_state0_def)
done

74
proof/infoflow/FinalCaps.thy
View File

@ -1166,8 +1166,8 @@ lemma reply_cancel_ipc_silc_inv:
"\<lbrace>silc_inv aag st and pas_refined aag and K (is_subject aag t) \<rbrace>
reply_cancel_ipc t
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
unfolding reply_cancel_ipc_def
apply (wp cap_delete_one_silc_inv select_wp hoare_vcg_if_lift | simp)+
unfolding reply_cancel_ipc_def including no_pre
apply ((wp cap_delete_one_silc_inv select_wp hoare_vcg_if_lift)+ | simp)+
(* there must be a better way to do this... *)
apply (clarsimp simp: valid_def)
apply (rule conjI)
@ -1440,7 +1440,8 @@ lemma finalise_cap_ret:
done
lemma finalise_cap_ret_is_subject:
"\<lbrace>K ((is_cnode_cap cap \<or> is_thread_cap cap \<or> is_zombie cap) \<longrightarrow> is_subject aag (obj_ref_of cap))\<rbrace> finalise_cap cap is_final \<lbrace>\<lambda>rv _. case (fst rv) of Zombie ptr bits n \<Rightarrow> is_subject aag (obj_ref_of (fst rv)) | _ \<Rightarrow> True\<rbrace>"
"\<lbrace>K ((is_cnode_cap cap \<or> is_thread_cap cap \<or> is_zombie cap) \<longrightarrow> is_subject aag (obj_ref_of cap))\<rbrace> finalise_cap cap is_final \<lbrace>\<lambda>rv _. case (fst rv) of Zombie ptr bits n \<Rightarrow> is_subject aag (obj_ref_of (fst rv)) | _ \<Rightarrow> True\<rbrace>"
including no_pre
apply(case_tac cap, simp_all add: is_zombie_def)
apply(wp | simp add: comp_def | rule impI | rule conjI)+
apply(fastforce simp: valid_def dest: arch_finalise_cap_ret)
@ -1557,7 +1558,7 @@ next
apply(simp add: rec_del.simps)
apply(rule hoare_pre_spec_validE)
apply(wp)
apply(rule drop_spec_validE, wp)
apply(rule drop_spec_validE, wp+)
apply(simp add: split_def)
apply(rule conjI | rule impI)+
apply(rule_tac P="pas_refined aag and K (is_subject aag (fst slot) \<and> (is_zombie (fst rvb) \<longrightarrow> is_subject aag (obj_ref_of (fst rvb)) \<and> aag_cap_auth aag (pasObjectAbs aag (fst slot)) (fst rvb)))" in hoare_pre_spec_validE)
@ -1814,7 +1815,7 @@ lemma cap_revoke_silc_inv':
show ?case
apply(subst cap_revoke.simps)
apply(rule hoare_pre_spec_validE)
apply (wp "1.hyps", assumption+)
apply (wp "1.hyps")
apply(wp spec_valid_conj_liftE2 | simp)+
apply(wp drop_spec_validE[OF valid_validE[OF preemption_point_silc_inv]] cap_delete_silc_inv preemption_point_inv' | simp)+
apply(rule spec_valid_conj_liftE1)
@ -1825,7 +1826,7 @@ lemma cap_revoke_silc_inv':
apply(rule spec_valid_conj_liftE1, (wp | simp)+)
apply(rule spec_valid_conj_liftE1, (wp | simp)+)
apply(rule drop_spec_validE[OF valid_validE[OF cap_delete_silc_inv]])
apply (wp drop_spec_validE[OF assertE_wp] drop_spec_validE[OF without_preemption_wp] get_cap_wp select_wp drop_spec_validE[OF returnOk_wp])
apply (wp drop_spec_validE[OF assertE_wp] drop_spec_validE[OF without_preemption_wp] get_cap_wp select_wp drop_spec_validE[OF returnOk_wp])+
apply clarsimp
apply (clarsimp cong: conj_cong simp: conj_comms)
apply (subst conj_commute)
@ -1880,7 +1881,7 @@ lemma invoke_cnode_silc_inv:
apply(wp cap_delete_silc_inv | simp)+
apply(fastforce simp: authorised_cnode_inv_def)
apply(rule hoare_pre)
apply(wp cap_move_silc_inv cap_swap_silc_inv cap_move_cte_wp_at_other | simp split del: if_splits)+
apply(wp cap_move_silc_inv cap_swap_silc_inv cap_move_cte_wp_at_other | simp split del: if_split)+
apply(fastforce simp: silc_inv_def authorised_cnode_inv_def)
apply(wp cap_move_silc_inv get_cap_wp | wpc | simp)+
apply(clarsimp simp: silc_inv_def authorised_cnode_inv_def)
@ -1924,7 +1925,7 @@ lemma retype_region_silc_inv:
foldr_upd_app_if fun_app_def K_bind_def)
apply(wp modify_wp dxo_wp_weak | simp)+
apply (simp add: trans_state_update[symmetric] del: trans_state_update)
apply wp
apply wp+
apply (clarsimp simp: not_less)
apply (clarsimp simp add: silc_inv_def)
apply (intro conjI impI allI)
@ -2582,9 +2583,8 @@ lemma invoke_irq_control_silc_inv:
apply(case_tac blah)
apply(wp cap_insert_silc_inv'' hoare_vcg_ex_lift slots_holding_overlapping_caps_lift
| simp add: authorised_irq_ctl_inv_def)+
apply(fastforce dest: new_irq_handler_caps_are_intra_label)
apply simp
apply(wp | simp)+
apply(fastforce dest: new_irq_handler_caps_are_intra_label)
apply simp
done
@ -2636,12 +2636,11 @@ lemma transfer_caps_silc_inv:
apply (rule hoare_gen_asm)
apply (simp add: transfer_caps_def)
apply (wpc | wp)+
apply (rule_tac P = "\<forall>x \<in> set dest_slots. is_subject aag (fst x)" in hoare_gen_asm)
apply (wp transfer_caps_loop_pres_dest cap_insert_silc_inv)
apply(fastforce simp: silc_inv_def)
apply(wp get_receive_slots_authorised hoare_vcg_all_lift hoare_vcg_imp_lift | simp)+
apply(fastforce elim: cte_wp_at_weakenE)
apply simp
apply (rule_tac P = "\<forall>x \<in> set dest_slots. is_subject aag (fst x)" in hoare_gen_asm)
apply (wp transfer_caps_loop_pres_dest cap_insert_silc_inv)
apply(fastforce simp: silc_inv_def)
apply(wp get_receive_slots_authorised hoare_vcg_all_lift hoare_vcg_imp_lift | simp)+
apply(fastforce elim: cte_wp_at_weakenE)
done
crunch silc_inv[wp]: copy_mrs, set_message_info "silc_inv aag st"
@ -2695,29 +2694,18 @@ lemma send_ipc_silc_inv:
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
unfolding send_ipc_def
apply (wp setup_caller_cap_silc_inv | wpc | simp)+
apply(rename_tac xs word ys recv_state)
apply(rule_tac Q="\<lambda> r s. (can_grant \<longrightarrow> is_subject aag thread \<and> is_subject aag (hd xs)) \<and> silc_inv aag st s" in hoare_strengthen_post)
apply simp
apply(wp do_ipc_transfer_silc_inv | wpc | simp)+
apply(wp_once hoare_drop_imps)
apply (wp get_endpoint_wp)
apply(rename_tac xs word ys recv_state)
apply(rule_tac Q="\<lambda> r s. (can_grant \<longrightarrow> is_subject aag thread \<and> is_subject aag (hd xs)) \<and> silc_inv aag st s" in hoare_strengthen_post)
apply simp
apply(wp do_ipc_transfer_silc_inv | wpc | simp)+
apply(wp_once hoare_drop_imps)
apply (wp get_endpoint_wp)+
apply clarsimp
apply(rule conjI)
apply(fastforce simp: obj_at_def ep_q_refs_of_def)
apply(clarsimp simp: valid_ep_recv_dequeue' obj_at_def)
done
lemma hd_tl_in_set:
"tl xs = (x # xs') \<Longrightarrow> x \<in> set xs"
apply(case_tac xs, auto)
done
lemma set_tl_subset:
"list \<noteq> [] \<Longrightarrow> set (tl list) \<subseteq> set list"
apply(case_tac list)
apply auto
done
lemma receive_ipc_base_silc_inv:
notes do_nbrecv_failed_transfer_def[simp]
shows "\<lbrace>silc_inv aag st and valid_objs and valid_mdb and pas_refined aag and
@ -2927,22 +2915,21 @@ lemma invoke_tcb_silc_inv:
Tcb_AI.tcb_inv_wf tinv and K (authorised_tcb_inv aag tinv)\<rbrace>
invoke_tcb tinv
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
including no_pre
apply(case_tac tinv)
apply((wp restart_silc_inv hoare_vcg_if_lift suspend_silc_inv mapM_x_wp[OF _ subset_refl] static_imp_wp
apply((wp restart_silc_inv hoare_vcg_if_lift suspend_silc_inv mapM_x_wp[OF _ subset_refl] static_imp_wp
| wpc
| simp split del: if_split add: authorised_tcb_inv_def check_cap_at_def
| clarsimp)+)[3]
defer
apply((wp suspend_silc_inv restart_silc_inv | simp add: authorised_tcb_inv_def)+)[2]
defer
apply((wp suspend_silc_inv restart_silc_inv | simp add: authorised_tcb_inv_def)+)[2]
(* NotificationControl *)
apply (rename_tac option)
apply (case_tac option)
apply ((wp | simp)+)[2]
apply (rename_tac option)
apply (case_tac option)
apply ((wp | simp)+)[2]
(* just ThreadControl left *)
apply (simp add: split_def cong: option.case_cong)
apply (wp
checked_cap_insert_silc_inv hoare_vcg_all_lift_R
apply (wp checked_cap_insert_silc_inv hoare_vcg_all_lift_R
hoare_vcg_all_lift hoare_vcg_const_imp_lift_R
cap_delete_silc_inv itr_wps(19) cap_insert_pas_refined
cap_delete_pas_refined cap_delete_deletes
@ -2973,6 +2960,7 @@ lemma perform_invocation_silc_inv:
and pas_refined aag and is_subject aag \<circ> cur_thread\<rbrace>
perform_invocation block call iv
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
including no_pre
apply(case_tac iv)
apply(wp invoke_untyped_silc_inv send_ipc_silc_inv
invoke_tcb_silc_inv invoke_cnode_silc_inv

55
proof/infoflow/Finalise_IF.thy
View File

@ -62,10 +62,9 @@ lemma empty_slot_reads_respects:
apply (simp add: bind_assoc empty_slot_ext_def cong: if_cong)
apply(rule gen_asm_ev)
apply (wp deleted_irq_handler_reads_respects set_cap_reads_respects set_original_reads_respects update_cdt_list_reads_respects | wpc | simp | (frule aag_can_read_self,fastforce simp: equiv_for_def split: option.splits))+
apply (wp update_cdt_reads_respects get_cap_wp get_cap_rev)
apply (wp update_cdt_reads_respects get_cap_wp get_cap_rev)+
apply(intro impI allI conjI)
apply(fastforce simp: reads_equiv_def2 equiv_for_def elim: states_equiv_forE_cdt dest: aag_can_read_self split: option.splits)+
done
apply(fastforce simp: reads_equiv_def2 equiv_for_def elim: states_equiv_forE_cdt dest: aag_can_read_self split: option.splits)+ done
lemma requiv_get_tcb_eq':
"\<lbrakk>reads_equiv aag s t; aag_can_read aag thread\<rbrakk> \<Longrightarrow>
@ -124,9 +123,8 @@ lemma set_thread_state_ext_reads_respects:
apply (simp add: equiv_valid_def2[symmetric] | wp)+
apply (clarsimp simp: reads_equiv_def)
apply (subst equiv_valid_def2[symmetric])
apply wp
apply force
apply (simp add: reads_equiv_def)
apply wp+
apply force
done
lemma set_thread_state_reads_respects:
@ -468,7 +466,7 @@ lemma get_endpoint_revrv:
unfolding get_endpoint_def
apply(rule_tac Q="\<lambda> rv. ko_at rv epptr and pas_refined aag and valid_objs and sym_refs \<circ> state_refs_of and (K ((pasSubject aag, Reset, pasObjectAbs aag epptr) \<in> pasPolicy aag))" in equiv_valid_rv_bind)
apply(rule equiv_valid_rv_guard_imp[OF equiv_valid_rv_trivial])
apply wp
apply wp+
apply(case_tac "\<exists> ep. rv = Endpoint ep")
apply(case_tac "\<exists> ep. rv' = Endpoint ep")
apply (clarsimp split: kernel_object.splits)
@ -483,35 +481,16 @@ lemma get_endpoint_revrv:
lemma gen_asm_ev2_r:
"\<lbrakk>P' \<Longrightarrow> equiv_valid_2 I A B R P \<top> f f'\<rbrakk> \<Longrightarrow>
equiv_valid_2 I A B R P (\<lambda>s. P') f f'"
apply(fastforce simp: equiv_valid_2_def)
done
by (rule gen_asm_ev2_r')
lemma gen_asm_ev2_l:
"\<lbrakk>P \<Longrightarrow> equiv_valid_2 I A B R \<top> P' f f'\<rbrakk> \<Longrightarrow>
equiv_valid_2 I A B R (\<lambda>s. P) P' f f'"
apply(fastforce simp: equiv_valid_2_def)
done
(*
lemma scheduler_action_equiv_but_for_labels[simp]: "equiv_but_for_labels aag A (scheduler_action_update f st) (scheduler_action_update f s) = equiv_but_for_labels aag A st s"
apply (simp add: equiv_but_for_labels_def equiv_for_def equiv_asids_def equiv_asid_def)
done
crunch equiv_but_for_labels[wp]: set_thread_state_ext "equiv_but_for_labels aag L st"
*)
(*
lemma set_thread_state_equiv_but_for:
"invariant (set_thread_state ptr ts) (equiv_but_for_labels aag {pasObjectAbs aag ptr} st)"
unfolding set_thread_state_def
apply (wp set_object_equiv_but_for_labels hoare_drop_imps | simp | auto dest!: get_tcb_not_asid_pool_at)+
done
*)
by (rule gen_asm_ev2_l')
lemma bind_return_unit2:
"f = return () >>= (\<lambda>_. f)"
apply simp
done
by simp
lemma mapM_x_ev2_invisible:
assumes
@ -742,7 +721,7 @@ lemma tcb_sched_action_reads_respects:
apply (rule set_tcb_queue_modifies_at_most)
apply (simp | wp)+
apply (clarsimp simp: equiv_valid_2_def gets_apply_def get_def bind_def return_def labels_are_invisible_def)
apply wp
apply wp+
apply clarsimp
apply (rule conjI, force)
apply (clarsimp simp: pas_refined_def tcb_domain_map_wellformed_aux_def)
@ -1428,7 +1407,7 @@ lemma suspend_reads_respects_f:
(K (is_subject aag thread))) (suspend thread)"
unfolding suspend_def
apply(wp reads_respects_f[OF set_thread_state_owned_reads_respects, where st=st and Q="\<top>"] reads_respects_f[OF tcb_sched_action_reads_respects, where st=st and Q=\<top>] set_thread_state_pas_refined| simp)+
apply(wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv)
apply(wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv)+
apply(simp)
done
@ -1938,18 +1917,13 @@ crunch globals_equiv[wp]: deleted_irq_handler "globals_equiv st"
lemma transfer_caps_valid_ko_at_arm[wp]:
"\<lbrace> valid_ko_at_arm \<rbrace> transfer_caps a b c d e \<lbrace>\<lambda>_. valid_ko_at_arm\<rbrace>"
unfolding transfer_caps_def
apply (wp | wpc)+
apply (wp transfer_caps_loop_pres cap_insert_valid_ko_at_arm)
apply (simp)
done
by (wpsimp wp: transfer_caps_loop_pres cap_insert_valid_ko_at_arm)
lemma empty_slot_globals_equiv:
"\<lbrace>globals_equiv st and valid_ko_at_arm\<rbrace> empty_slot s b\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding empty_slot_def
apply (wp set_cap_globals_equiv'' set_original_globals_equiv hoare_vcg_if_lift2
set_cdt_globals_equiv dxo_wp_weak
hoare_drop_imps hoare_vcg_all_lift | wpc| simp)+
done
by (wpsimp wp: set_cap_globals_equiv'' set_original_globals_equiv hoare_vcg_if_lift2
set_cdt_globals_equiv dxo_wp_weak hoare_drop_imps hoare_vcg_all_lift)
crunch globals_equiv: cap_delete_one "globals_equiv st"
(wp: set_cap_globals_equiv'' hoare_drop_imps simp: crunch_simps unless_def)
@ -2021,8 +1995,7 @@ lemma mapM_x_swp_store_kernel_base_globals_equiv:
apply (simp add: cte_wp_at_page_directory_not_in_globals
cte_wp_at_page_directory_not_in_kernel_mappings
not_in_global_not_arm
pde_ref_def
)+
pde_ref_def)+
done
end

24
proof/infoflow/IRQMasks_IF.thy
View File

@ -181,8 +181,7 @@ lemma cap_delete_irq_masks:
"\<lbrace> (\<lambda>s. P (irq_masks_of_state s)) and domain_sep_inv False st\<rbrace>
cap_delete blah
\<lbrace>\<lambda>_ s. P (irq_masks_of_state s)\<rbrace>,\<lbrace>\<lambda>_ s. P (irq_masks_of_state s)\<rbrace>"
apply(simp add: cap_delete_def | wp rec_del_irq_masks)+
done
by (simp add: cap_delete_def) (wpsimp wp: rec_del_irq_masks)
lemma invoke_irq_control_irq_masks:
"\<lbrace>domain_sep_inv False st and irq_control_inv_valid invok\<rbrace>
@ -297,7 +296,7 @@ lemma cap_revoke_irq_masks':
show ?case
apply(subst cap_revoke.simps)
apply(rule hoare_pre_spec_validE)
apply (wp "1.hyps", assumption+)
apply (wp "1.hyps")
apply(wp spec_valid_conj_liftE2 | simp)+
apply(wp drop_spec_validE[OF valid_validE[OF preemption_point_irq_masks]]
drop_spec_validE[OF valid_validE[OF preemption_point_domain_sep_inv]]
@ -428,6 +427,7 @@ lemma handle_event_irq_masks:
"\<lbrace> (\<lambda>s. P (irq_masks_of_state s)) and domain_sep_inv False st and invs\<rbrace>
handle_event ev
\<lbrace> \<lambda> rv s. P (irq_masks_of_state s) \<rbrace>"
including no_pre
apply(case_tac ev)
prefer 4
apply (rule hoare_pre)
@ -437,12 +437,10 @@ lemma handle_event_irq_masks:
apply (wp | clarsimp)+
apply (rename_tac syscall)
apply (case_tac syscall)
apply (simp add: handle_send_def handle_call_def
| wp handle_invocation_irq_masks[where st=st] handle_interrupt_irq_masks[where st=st] hoare_vcg_all_lift
apply (simp add: handle_send_def handle_call_def
| wp handle_invocation_irq_masks[where st=st] handle_interrupt_irq_masks[where st=st] hoare_vcg_all_lift
| wpc
| wp_once hoare_drop_imps)+
| wp_once hoare_drop_imps)+
done
crunch irq_masks[wp]: activate_thread "\<lambda>s. P (irq_masks_of_state s)"
@ -456,11 +454,11 @@ lemma call_kernel_irq_masks:
\<lbrace> \<lambda> rv s. P (irq_masks_of_state s) \<rbrace>"
apply(simp add: call_kernel_def)
apply (wp handle_interrupt_irq_masks[where st=st])+
apply (rule_tac Q="\<lambda>rv s. P (irq_masks_of_state s) \<and> domain_sep_inv False st s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> maxIRQ)" in hoare_strengthen_post)
apply (wp | simp)+
apply(rule_tac Q="\<lambda> x s. P (irq_masks_of_state s) \<and> domain_sep_inv False st s" and F="E" for E in hoare_post_impErr)
apply(rule valid_validE)
apply(wp handle_event_irq_masks[where st=st] valid_validE[OF handle_event_domain_sep_inv] | simp)+
apply (rule_tac Q="\<lambda>rv s. P (irq_masks_of_state s) \<and> domain_sep_inv False st s \<and> (\<forall>x. rv = Some x \<longrightarrow> x \<le> maxIRQ)" in hoare_strengthen_post)
apply (wp | simp)+
apply(rule_tac Q="\<lambda> x s. P (irq_masks_of_state s) \<and> domain_sep_inv False st s" and F="E" for E in hoare_post_impErr)
apply(rule valid_validE)
apply(wp handle_event_irq_masks[where st=st] valid_validE[OF handle_event_domain_sep_inv] | simp)+
done
end

2
proof/infoflow/InfoFlow.thy
View File

@ -1398,7 +1398,7 @@ lemma do_machine_op_rev:
apply(clarsimp simp: select_f_def equiv_valid_2_def)
apply(insert equiv_dmo, clarsimp simp: equiv_valid_def2 equiv_valid_2_def)[1]
apply(blast)
apply(wp select_f_inv)
apply(wp select_f_inv)+
apply(fastforce simp: select_f_def dest: state_unchanged[OF mo_inv])+
done

82
proof/infoflow/Ipc_IF.thy
View File

@ -223,7 +223,7 @@ lemma set_thread_state_ext_runnable_equiv_but_for_labels:
apply (simp add: set_thread_state_ext_def)
apply wp
apply (rule hoare_pre_cont)
apply (wp gts_wp)
apply (wp gts_wp)+
apply (force simp: st_tcb_at_def obj_at_def)
done
@ -233,7 +233,7 @@ lemma set_thread_state_runnable_equiv_but_for_labels:
\<lbrace>\<lambda>_. equiv_but_for_labels aag L st\<rbrace>"
unfolding set_thread_state_def
apply (wp set_object_equiv_but_for_labels set_thread_state_ext_runnable_equiv_but_for_labels | simp add: split_def)+
apply (simp add: set_object_def, wp)
apply (simp add: set_object_def, wp+)
apply (fastforce dest: get_tcb_not_asid_pool_at simp: st_tcb_at_def obj_at_def)
done
@ -266,8 +266,8 @@ lemma possible_switch_to_equiv_but_for_labels:
\<lbrace>\<lambda>_. equiv_but_for_labels aag L st\<rbrace>"
apply (simp add: possible_switch_to_def)
apply (wp tcb_sched_action_equiv_but_for_labels)
apply (rule hoare_pre_cont)
apply wp
apply (rule hoare_pre_cont)
apply wp+
apply (clarsimp simp: etcb_at_def split: option.splits)
done
@ -436,9 +436,9 @@ lemma sts_noop:
apply (rule_tac x="tcb_state (the (get_tcb tcb x))" in monadic_rewrite_symb_exec)
apply (wp gts_wp | simp)+
apply (rule monadic_rewrite_symb_exec)
apply wp
apply wp+
apply (rule monadic_rewrite_symb_exec)
apply wp
apply wp+
apply (simp only: when_def)
apply (rule monadic_rewrite_trans)
apply (rule monadic_rewrite_if)
@ -530,7 +530,7 @@ lemma cancel_ipc_to_blocked_nosts:
apply (simp add: modify_modify)
apply (rule monadic_rewrite_refl2)
apply (fastforce simp add: simpler_modify_def o_def get_tcb_def)
apply (wp gts_wp)
apply (wp gts_wp)+
apply (simp add: set_thread_state_def bind_assoc gets_the_def)
apply (clarsimp simp add: pred_tcb_at_def receive_blocked_def obj_at_def is_tcb_def split: thread_state.splits)
by (case_tac "tcb_state tcba";fastforce)
@ -1337,7 +1337,7 @@ lemma mapM_ev''':
shows "equiv_valid_inv D A (\<lambda> s. Q s \<and> (\<forall>x\<in>set lst. P x s)) (mapM m lst)"
apply(rule mapM_ev)
apply(rule equiv_valid_guard_imp[OF reads_res], simp+)
apply(wp inv, simp)
apply(wpsimp wp: inv)
done
lemma cancel_badged_sends_reads_respects:
@ -2117,7 +2117,7 @@ next
apply(wp)
apply(erule conjE, erule subst, rule Cons.hyps)
apply(clarsimp)
apply(wp set_extra_badge_globals_equiv)
apply(wp set_extra_badge_globals_equiv)+
apply(rule Cons.hyps)
apply(simp)
apply(wp cap_insert_globals_equiv'')
@ -2127,7 +2127,7 @@ next
apply(simp add: whenE_def, rule conjI)
apply(rule impI, wp)+
apply(simp)+
apply wp
apply wp+
apply(fastforce)
done
qed
@ -2144,12 +2144,12 @@ lemma copy_mrs_globals_equiv:
"\<lbrace>globals_equiv s and valid_ko_at_arm and (\<lambda>s. receiver \<noteq> idle_thread s)\<rbrace>
copy_mrs sender sbuf receiver rbuf n
\<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
unfolding copy_mrs_def
unfolding copy_mrs_def including no_pre
apply(wp | wpc)+
apply(rule_tac Q="\<lambda>_. globals_equiv s"
in hoare_strengthen_post)
apply(wp mapM_wp' | wpc)+
apply(wp store_word_offs_globals_equiv)
apply(wp store_word_offs_globals_equiv)+
apply fastforce
apply simp
apply(rule_tac Q="\<lambda>_. globals_equiv s and valid_ko_at_arm and (\<lambda>sa. receiver \<noteq> idle_thread sa)"
@ -2183,8 +2183,6 @@ lemma do_normal_transfer_globals_equiv:
lemma do_fault_transfer_globals_equiv:
"\<lbrace>globals_equiv s and valid_ko_at_arm and
(\<lambda>sa. receiver \<noteq> idle_thread sa)\<rbrace>
@ -2231,7 +2229,7 @@ lemma do_ipc_transfer_globals_equiv:
and pspace_distinct and pspace_aligned and valid_global_objs and (\<lambda>s. receiver \<noteq> idle_thread s)\<rbrace>
do_ipc_transfer sender ep badge grant receiver
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding do_ipc_transfer_def
unfolding do_ipc_transfer_def including no_pre
apply(wp do_normal_transfer_globals_equiv do_fault_transfer_globals_equiv | wpc)+
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_ko_at_arm and valid_global_objs and
(\<lambda>sa. receiver \<noteq> idle_thread sa) and
@ -2260,10 +2258,10 @@ lemma send_ipc_globals_equiv:
apply(fastforce)
apply(wp set_thread_state_globals_equiv dxo_wp_weak | simp)+
apply wpc
apply(wp do_ipc_transfer_globals_equiv)
apply(wp do_ipc_transfer_globals_equiv)+
apply(clarsimp)
apply(rule hoare_drop_imps)
apply(wp set_endpoint_globals_equiv)
apply(wp set_endpoint_globals_equiv)+
apply(rule_tac Q="\<lambda>ep. ko_at (Endpoint ep) epptr and globals_equiv st and valid_objs
and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned
and valid_global_objs and (\<lambda>s. sym_refs (state_refs_of s)) and valid_idle"
@ -2274,17 +2272,8 @@ lemma send_ipc_globals_equiv:
apply(rule valid_ep_recv_dequeue')
apply(simp)+
apply (frule_tac x=xa in receive_endpoint_threads_blocked,simp+)
by (clarsimp simp add: valid_idle_def pred_tcb_at_def obj_at_def)
by (clarsimp simp add: valid_idle_def pred_tcb_at_def obj_at_def)+
lemma valid_ep_recv_dequeue':
"\<lbrakk> ko_at (Endpoint (Structures_A.endpoint.RecvEP (t # ts))) epptr s;
valid_objs s\<rbrakk>
\<Longrightarrow> valid_ep (case ts of [] \<Rightarrow> Structures_A.endpoint.IdleEP
| b # bs \<Rightarrow> Structures_A.endpoint.RecvEP ts) s"
unfolding valid_objs_def valid_obj_def valid_ep_def obj_at_def
apply (drule bspec)
apply (auto split: list.splits)
done
lemma valid_ep_send_enqueue: "\<lbrakk>ko_at (Endpoint (SendEP (t # ts))) a s; valid_objs s\<rbrakk>
\<Longrightarrow> valid_ep (case ts of [] \<Rightarrow> IdleEP | b # bs \<Rightarrow> SendEP (b # bs)) s"
@ -2302,7 +2291,7 @@ lemma receive_ipc_globals_equiv:
and pspace_aligned and valid_global_objs and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace>
receive_ipc thread cap is_blocking
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding receive_ipc_def thread_get_def
unfolding receive_ipc_def thread_get_def including no_pre
apply(wp)
apply(simp add: split_def)
apply(wp set_endpoint_globals_equiv set_thread_state_globals_equiv
@ -2315,18 +2304,17 @@ lemma receive_ipc_globals_equiv:
apply (wp gts_wp get_endpoint_sp | wpc)+
apply (wp hoare_vcg_all_lift hoare_drop_imps)[1]
apply(wp set_endpoint_globals_equiv | wpc)+
apply(wp set_thread_state_globals_equiv)
apply (wp get_ntfn_wp gbn_wp get_endpoint_wp as_user_globals_equiv | wpc | simp)+
apply(wp set_thread_state_globals_equiv)
apply (wp get_ntfn_wp gbn_wp get_endpoint_wp as_user_globals_equiv | wpc | simp)+
apply (rule hoare_pre)
apply(wpc)
apply(rule fail_wp | rule return_wp)+
by (auto intro: valid_arch_state_ko_at_arm valid_ep_send_enqueue
simp: neq_Nil_conv cong: case_list_cons_cong)
subsection "Notifications"
lemma valid_ntfn_dequeue:
"\<lbrakk> ko_at (Notification ntfn) ntfnptr s; ntfn_obj ntfn = (WaitingNtfn (t # ts));
valid_objs s; ts \<noteq> []\<rbrakk>
@ -2464,27 +2452,27 @@ lemma send_ipc_valid_global_objs:
\<lbrace>\<lambda>_. valid_global_objs\<rbrace>"
unfolding send_ipc_def
apply(wp | wpc)+
apply(rule_tac Q="\<lambda>_. valid_global_objs" in hoare_strengthen_post)
apply(wp, simp, (wp dxo_wp_weak |simp)+)
apply(wpc)
apply(rule fail_wp | rule return_wp | wp)+
apply(simp)
apply(rule hoare_drop_imps)
apply(wp)
apply(rule_tac Q="\<lambda>_. valid_global_objs" in hoare_strengthen_post)
apply(wp, simp)
done
apply(rule_tac Q="\<lambda>_. valid_global_objs" in hoare_strengthen_post)
apply(wp, simp, (wp dxo_wp_weak |simp)+)
apply(wpc)
apply(rule fail_wp | rule return_wp | wp)+
apply(simp)
apply(rule hoare_drop_imps)
apply(wp)+
apply(rule_tac Q="\<lambda>_. valid_global_objs" in hoare_strengthen_post)
apply(wp, simp+)
done
lemma send_fault_ipc_valid_global_objs:
"\<lbrace>valid_global_objs \<rbrace> send_fault_ipc tptr fault
\<lbrace>\<lambda>_. valid_global_objs\<rbrace>"
unfolding send_fault_ipc_def
apply(wp)
apply(simp add: Let_def)
apply(wp send_ipc_valid_global_objs | wpc)+
apply(rule_tac Q'="\<lambda>_. valid_global_objs" in hoare_post_imp_R)
apply(wp | simp)+
done
apply(simp add: Let_def)
apply(wp send_ipc_valid_global_objs | wpc)+
apply(rule_tac Q'="\<lambda>_. valid_global_objs" in hoare_post_imp_R)
apply(wp | simp)+
done
crunch valid_ko_at_arm[wp]: send_ipc "valid_ko_at_arm"
(wp: hoare_drop_imps hoare_vcg_if_lift2 dxo_wp_weak

18
proof/infoflow/Noninterference.thy
View File

@ -391,7 +391,7 @@ lemma kernel_entry_if_integrity:
| simp add: tcb_cap_cases_def schact_is_rct_def arch_tcb_update_aux2)+
apply(wp_once prop_of_two_valid[where f="ct_active" and g="cur_thread"])
apply (wp | simp)+
apply(wp thread_set_tcb_context_update_wp)
apply(wp thread_set_tcb_context_update_wp)+
apply(clarsimp simp: schact_is_rct_def)
apply(rule conjI)
apply(erule integrity_update_reference_state[where blah="the (kheap st (cur_thread st))", OF _ integrity_refl])
@ -634,7 +634,7 @@ lemma schedule_cur_domain:
\<lbrace>\<lambda> r s. P (cur_domain s)\<rbrace>"
apply(simp add: schedule_def | wp | wpc)+
apply(rule hoare_pre_cont)
apply wp
apply wp+
apply(rule_tac Q="\<lambda>rv s. P (cur_domain s) \<and> domain_time s \<noteq> 0" in hoare_strengthen_post)
apply(simp split del: if_split | wp gts_wp | wp_once hoare_drop_imps)+
apply clarsimp
@ -646,7 +646,7 @@ lemma schedule_domain_fields:
\<lbrace>\<lambda> r. domain_fields P\<rbrace>"
apply(simp add: schedule_def | wp | wpc)+
apply(rule hoare_pre_cont)
apply wp
apply wp+
apply(rule_tac Q="\<lambda>rv s. domain_fields P s \<and> domain_time s \<noteq> 0" in hoare_strengthen_post)
apply(simp split del: if_split | wp gts_wp | wp_once hoare_drop_imps)+
apply clarsimp
@ -2084,7 +2084,7 @@ lemma tcb_sched_action_reads_respects_g':
apply (rule set_tcb_queue_modifies_at_most)
apply (rule doesnt_touch_globalsI | simp | wp)+
apply (clarsimp simp: equiv_valid_2_def gets_apply_def get_def bind_def return_def labels_are_invisible_def)
apply wp
apply wp+
apply clarsimp
apply (rule conjI, force)
apply (clarsimp simp: pas_refined_def tcb_domain_map_wellformed_aux_def)
@ -2099,11 +2099,12 @@ lemma switch_to_thread_reads_respects_g:
apply(subst bind_assoc[symmetric])
apply(rule equiv_valid_guard_imp)
apply(rule bind_ev)
apply (wp bind_ev_general cur_thread_update_reads_respects_g' tcb_sched_action_reads_respects_g' arch_switch_to_thread_reads_respects_g')[1]
apply (wp bind_ev_general cur_thread_update_reads_respects_g' tcb_sched_action_reads_respects_g'
arch_switch_to_thread_reads_respects_g')
apply(simp add: equiv_valid_def2)
apply(rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
apply(rule assert_ev2 | simp)+
apply(rule equiv_valid_rv_trivial, wp)
apply(rule equiv_valid_rv_trivial, wp+)
apply fastforce
done
@ -2237,7 +2238,7 @@ lemma schedule_reads_respects_g:
get_thread_state_reads_respects_g
| wpc | simp)+
apply(wp_once hoare_drop_imps)
apply(wp get_thread_state_reads_respects_g gts_wp)
apply(wp get_thread_state_reads_respects_g gts_wp)+
apply(clarsimp simp: invs_valid_idle)
by(fastforce intro: requiv_g_cur_thread_eq simp: reads_equiv_g_def reads_equiv_def globals_equiv_idle_thread_ptr dest: scheduler_action_switch_thread_is_subject simp: not_cur_thread_2_def st_tcb_at_def obj_at_def valid_sched_2_def)
@ -2539,6 +2540,7 @@ lemma do_user_op_A_if_confidentiality:
(t_aux,yy,fst t') \<in> do_user_op_A_if utf; snd s' = f xx; snd t' = f yy\<rbrakk> \<Longrightarrow>
xx = yy \<and>
(s', t') \<in> uwr u \<and> (s', t') \<in> uwr PSched \<and> (s', t') \<in> uwr (part s)"
including no_pre
apply(frule (1) uwr_part_sys_mode_of_user_context_of_eq)
apply(clarsimp simp: check_active_irq_A_if_def)
apply(case_tac s, case_tac t, simp_all)
@ -2551,7 +2553,7 @@ lemma do_user_op_A_if_confidentiality:
apply (clarsimp dest!: invs_if_Invs simp: Invs_def)
apply (drule uwr_PSched_cur_domain)
apply (clarsimp dest!: invs_if_Invs simp: Invs_def)
apply(clarsimp simp: current_aag_def)
subgoal by(clarsimp simp: current_aag_def)
apply simp
apply fastforce
apply(simp add: do_user_op_A_if_def | elim exE conjE)+

34
proof/infoflow/PasUpdates.thy
View File

@ -23,42 +23,27 @@ crunch idle_thread[wp]: preemption_point "\<lambda>s::det_state. P (idle_thread
crunch idle_thread[wp]: cap_swap_for_delete,finalise_cap,cap_move,cap_swap,cap_delete,cancel_badged_sends "\<lambda>s::det_state. P (idle_thread s)" (wp: syscall_valid crunch_wps rec_del_preservation cap_revoke_preservation modify_wp dxo_wp_weak simp: crunch_simps check_cap_at_def filterM_mapM unless_def ignore: without_preemption filterM rec_del check_cap_at cap_revoke)
lemma cap_revoke_idle_thread[wp]:"\<lbrace>\<lambda>s::det_state. P (idle_thread s)\<rbrace> cap_revoke a \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
apply (rule cap_revoke_preservation2)
apply wp
done
lemma invoke_cnode_idle_thread[wp]: "\<lbrace>\<lambda>s::det_state. P (idle_thread s)\<rbrace> invoke_cnode a \<lbrace>\<lambda>r s. P (idle_thread s)\<rbrace>"
apply (simp add: invoke_cnode_def)
apply (rule hoare_pre)
apply (wp | wpc | clarsimp simp: without_preemption_def crunch_simps | intro impI conjI | wp_once hoare_drop_imps hoare_vcg_all_lift)+
done
crunch idle_thread[wp]: handle_event "\<lambda>s::det_state. P (idle_thread s)" (wp: syscall_valid crunch_wps rec_del_preservation cap_revoke_preservation dxo_wp_weak simp: crunch_simps check_cap_at_def filterM_mapM unless_def ignore: without_preemption filterM rec_del check_cap_at cap_revoke resetTimer ackInterrupt getFAR getDFSR getIFSR getActiveIRQ)
abbreviation (input) domain_fields where "domain_fields P s \<equiv> P (domain_time s) (domain_index s) (domain_list s)"
lemma preemption_point_domain_fields[wp]:
"\<lbrace>domain_fields P\<rbrace> preemption_point \<lbrace>\<lambda>_. domain_fields P\<rbrace>"
apply(simp add: preemption_point_def | wp OR_choiceE_weak_wp modify_wp | wpc | simp add: reset_work_units_def update_work_units_def)+
done
by (simp add: preemption_point_def
| wp OR_choiceE_weak_wp modify_wp
| wpc
| simp add: reset_work_units_def update_work_units_def)+
crunch domain_fields[wp]: retype_region_ext,create_cap_ext,cap_insert_ext,ethread_set,cap_move_ext,empty_slot_ext,cap_swap_ext,set_thread_state_ext,tcb_sched_action,reschedule_required,cap_swap_for_delete,finalise_cap,cap_move,cap_swap,cap_delete,cancel_badged_sends,cap_insert "domain_fields P" (wp: syscall_valid select_wp crunch_wps rec_del_preservation cap_revoke_preservation modify_wp simp: crunch_simps check_cap_at_def filterM_mapM unless_def ignore: without_preemption filterM rec_del check_cap_at cap_revoke)
lemma cap_revoke_domain_fields[wp]:"\<lbrace>domain_fields P\<rbrace> cap_revoke a \<lbrace>\<lambda>_. domain_fields P\<rbrace>"
apply (rule cap_revoke_preservation2)
apply wp
done
by (rule cap_revoke_preservation2; wp)
lemma invoke_cnode_domain_fields[wp]: "\<lbrace>domain_fields P\<rbrace> invoke_cnode a \<lbrace>\<lambda>_. domain_fields P\<rbrace>"
apply (simp add: invoke_cnode_def)
apply (rule hoare_pre)
apply (wp | wpc | clarsimp simp: without_preemption_def crunch_simps | intro impI conjI | wp_once hoare_drop_imps hoare_vcg_all_lift)+
done
unfolding invoke_cnode_def
by (wpsimp simp: without_preemption_def crunch_simps
wp: get_cap_wp hoare_vcg_all_lift hoare_vcg_imp_lift
| rule conjI)+
crunch domain_fields[wp]: set_domain,set_priority,switch_if_required_to,set_extra_badge,attempt_switch_to,handle_send,handle_recv,handle_reply "domain_fields P"
(wp: syscall_valid crunch_wps rec_del_preservation cap_revoke_preservation
@ -68,7 +53,6 @@ crunch domain_fields[wp]: set_domain,set_priority,switch_if_required_to,set_extr
crunch cur_domain[wp]: transfer_caps_loop, ethread_set, thread_set_priority, set_priority, set_domain, invoke_domain, cap_move_ext,timer_tick,
cap_move,cancel_badged_sends, attempt_switch_to, switch_if_required_to
"\<lambda>s. P (cur_domain s)" (wp: transfer_caps_loop_pres crunch_wps simp: crunch_simps filterM_mapM unless_def ignore: without_preemption filterM const_on_failure )
lemma invoke_cnode_cur_domain[wp]: "\<lbrace>\<lambda>s. P (cur_domain s)\<rbrace> invoke_cnode a \<lbrace>\<lambda>r s. P (cur_domain s)\<rbrace>"

2
proof/infoflow/PolicyExample.thy
View File

@ -209,7 +209,7 @@ lemmas subjectReads_C' = reads_lrefl[of "partition_label C"]
lemma subjectReads_C:
"subjectReads example_auth_graph (partition_label C) = {partition_label C,partition_label CTR,partition_label NTFN1, partition_label EP, partition_label RM, partition_label NTFN2}"
apply(clarsimp simp: example_auth_graph_def)
apply(clarsimp)
apply(rule equalityI)
apply(rule subsetI)
apply(erule subjectReads.induct)

14
proof/infoflow/PolicySystemSAC.thy
View File

@ -163,11 +163,11 @@ lemma abd_reads_all_bw : "x \<in> {NicA, NicB, NicD} \<Longrightarrow> {partitio
(* non refl cases *)
apply (case_tac "xa \<in> RMControls")
apply (rule reads_all_rm_controlled_subjects, rule abd_reads_rm, simp, simp)
apply (erule_tac a = xa in insertE, simp add:RMControls_def)
apply (erule_tac a = xa in insertE, simp)
apply (erule_tac a = xa in insertE, simp only:, rule abd_reads_rm, simp)
apply (erule_tac a = xa in insertE, simp add:RMControls_def)
apply (erule_tac a = xa in insertE, simp add:RMControls_def)
apply (erule_tac a = xa in insertE, simp add:RMControls_def)
apply (erule_tac a = xa in insertE, simp)
apply (erule_tac a = xa in insertE, simp)
apply (erule_tac a = xa in insertE, simp)
apply (erule_tac a = xa in insertE, simp only:, rule abdrm_reads_ep, simp, blast)
apply (erule_tac a = xa in insertE, simp only:, rule abdrm_reads_sc, simp, blast)
apply (erule_tac a = xa in insertE, simp only:, rule abd_reads_c, simp)
@ -625,7 +625,7 @@ lemma ep_affects: "subjectAffects SACAuthGraph (partition_label EP) = {partition
(* forward *)
apply (rule subsetI)
apply (erule subjectAffects.induct)
by (simp add:SACAuthGraph_def, blast?)+
by (simp, blast?)+
subsection {* NTFN1,2,3 *}
@ -899,8 +899,6 @@ lemma t_affects : "subjectAffects SACAuthGraph (partition_label T) = {partition_
subsection {* Policy *}
declare SACAuthGraph_def [simp del]
lemmas SAC_reads = sc_reads ep_reads c_reads rm_reads r_reads abd_reads ntfn123_reads t_reads
lemmas SAC_affects = sc_affects ep_affects c_affects rm_affects r_affects abd_affects ntfn1_affects ntfn2_affects ntfn3_affects t_affects
@ -961,7 +959,7 @@ lemma SAC_policyFlows : "policyFlows SACAuthGraph = SACPolicyFlows"
(* scheduler flows to all *)
apply (simp add:PSched_flows_to_all)
(* all subjects flow to all subjects *)
apply (clarify, simp del:SACAuthGraph_def)
apply (clarify, simp)
apply (rule policy_affects)
apply (case_tac l, case_tac[1-12] k, auto simp:SAC_partsSubjectAffects_T SAC_partsSubjectAffects_exceptT)
done

12
proof/infoflow/Retype_IF.thy
View File

@ -326,17 +326,13 @@ lemma get_pde_rev:
"reads_equiv_valid_inv A aag (K (is_subject aag (ptr && ~~ mask pd_bits)))
(get_pde ptr)"
unfolding get_pde_def fun_app_def
apply(wp get_pd_rev)
apply(clarsimp)
done
by (wp get_pd_rev)
lemma get_pde_revg:
"reads_equiv_valid_g_inv A aag (\<lambda> s. (ptr && ~~ mask pd_bits) = arm_global_pd (arch_state s))
(get_pde ptr)"
unfolding get_pde_def fun_app_def
apply(wp get_pd_revg)
apply(clarsimp)
done
by (wp get_pd_revg)
lemma copy_global_mappings_reads_respects_g:
"is_aligned x pd_bits \<Longrightarrow>
@ -564,7 +560,7 @@ lemma copy_global_mappings_globals_equiv:
"\<lbrace> globals_equiv s and (\<lambda> s. x \<noteq> arm_global_pd (arch_state s) \<and> is_aligned x pd_bits)\<rbrace>
copy_global_mappings x
\<lbrace> \<lambda>_. globals_equiv s \<rbrace>"
unfolding copy_global_mappings_def
unfolding copy_global_mappings_def including no_pre
apply simp
apply wp
apply(rule_tac Q="\<lambda>_. globals_equiv s and (\<lambda> s. x \<noteq> arm_global_pd (arch_state s) \<and> is_aligned x pd_bits)" in hoare_strengthen_post)
@ -1304,7 +1300,7 @@ lemma reset_untyped_cap_globals_equiv:
apply (clarsimp simp: reset_chunk_bits_def)
apply (strengthen invs_valid_global_objs)
apply (wp delete_objects_invs_ex
hoare_vcg_const_imp_lift get_cap_wp)
hoare_vcg_const_imp_lift get_cap_wp)+
apply (clarsimp simp: cte_wp_at_caps_of_state
descendants_range_def2
is_cap_simps bits_of_def

87
proof/infoflow/Scheduler_IF.thy
View File

@ -423,7 +423,7 @@ lemma tcb_action_reads_respects_scheduler[wp]: "reads_respects_scheduler aag l (
)
apply (rule ext)
apply clarsimp
apply wp
apply wp+
apply (clarsimp simp add: etcb_at_def split: option.splits)
apply (frule(1) tcb_domain_wellformed)
apply simp
@ -456,7 +456,7 @@ lemma dmo_no_mem_globals_equiv_scheduler:
done
lemma clearExMonitor_globals_equiv_scheduler[wp]: "\<lbrace> globals_equiv_scheduler sta \<rbrace> do_machine_op clearExMonitor \<lbrace> \<lambda>_. globals_equiv_scheduler sta \<rbrace>"
unfolding clearExMonitor_def
unfolding clearExMonitor_def including no_pre
apply (wp dmo_no_mem_globals_equiv_scheduler)
apply simp
apply (simp add: simpler_modify_def valid_def)
@ -465,7 +465,7 @@ lemma clearExMonitor_globals_equiv_scheduler[wp]: "\<lbrace> globals_equiv_sched
lemma arch_switch_to_thread_globals_equiv_scheduler:
"\<lbrace>invs and globals_equiv_scheduler sta\<rbrace> arch_switch_to_thread thread
\<lbrace>\<lambda>_. globals_equiv_scheduler sta\<rbrace>"
unfolding arch_switch_to_thread_def storeWord_def
unfolding arch_switch_to_thread_def storeWord_def including no_pre
apply (wp clearExMonitor_globals_equiv_scheduler dmo_wp modify_wp thread_get_wp')
apply (rule_tac Q="\<lambda>r s. invs s \<and> globals_equiv_scheduler sta s" in hoare_strengthen_post)
apply wp
@ -648,14 +648,10 @@ lemma [wp]: "\<lbrace>\<lambda>s. P (irq_state_of_state s)\<rbrace> do_machine_o
done
lemma [wp]: "\<lbrace>\<lambda>s. P (irq_state_of_state s)\<rbrace> do_machine_op clearExMonitor \<lbrace>\<lambda>_ s. P (irq_state_of_state s)\<rbrace>"
apply (rule hoare_pre)
apply (wp dmo_wp irq_state_clearExMonitor | simp)+
done
by (wpsimp wp: dmo_wp irq_state_clearExMonitor)
lemma [wp]: "\<lbrace> scheduler_equiv aag st \<rbrace> do_machine_op clearExMonitor \<lbrace> \<lambda>_. scheduler_equiv aag st \<rbrace>"
apply (rule scheduler_equiv_lift)
apply wp
done
by (rule scheduler_equiv_lift; wp)
lemma dmo_ev:
"(\<And>s s'. equiv_valid (\<lambda>ms ms'. I (s\<lparr>machine_state := ms\<rparr>) (s'\<lparr>machine_state := ms'\<rparr>))
@ -840,10 +836,11 @@ lemma arch_switch_to_thread_globals_equiv_scheduler':
"\<lbrace>invs and globals_equiv_scheduler sta\<rbrace>
set_vm_root t
\<lbrace>\<lambda>_. globals_equiv_scheduler sta\<rbrace>"
including no_pre
apply (rule_tac Q="\<lambda>r s. invs s \<and> globals_equiv_scheduler sta s" in hoare_strengthen_post)
apply wp
apply (rule globals_equiv_scheduler_inv')
apply (wp set_vm_root_globals_equiv)
apply (wp set_vm_root_globals_equiv)+
apply clarsimp+
done
@ -1105,7 +1102,7 @@ lemma switch_to_idle_thread_midstrength_reads_respects_scheduler[wp]: "midstreng
apply (simp add: arch_switch_to_idle_thread_def bind_assoc)
apply (rule bind_ev_general)
apply (rule store_cur_thread_midstrength_reads_respects)
apply wp
apply wp+
apply (clarsimp simp add: scheduler_equiv_def domain_fields_equiv_def globals_equiv_scheduler_def)
done
@ -1119,9 +1116,7 @@ lemma gets_read_queue_reads_respects_scheduler[wp]: "weak_reads_respects_schedul
lemma gets_ready_queue_midstrength_equiv_scheduler[wp]: "equiv_valid_inv (scheduler_equiv aag) (midstrength_scheduler_affects_equiv aag l)
(\<lambda>s. pasDomainAbs aag d \<in> reads_scheduler aag l)
(gets (\<lambda>s. ready_queues s d))"
apply (rule weak_reads_respects_scheduler_to_midstrength)
apply wp
done
by (rule weak_reads_respects_scheduler_to_midstrength; wp)
lemma gets_cur_domain_reads_respects_scheduler[wp]: "equiv_valid (scheduler_equiv aag) A A \<top> (gets cur_domain)"
apply (rule equiv_valid_guard_imp)
@ -1162,7 +1157,7 @@ lemma choose_thread_reads_respects_scheduler_cur_domain: "midstrength_reads_resp
apply (rule if_ev_bind)
apply (rule switch_to_idle_thread_midstrength_reads_respects_scheduler)
apply (rule guarded_switch_to_thread_midstrength_reads_respects_scheduler)
apply wp
apply wp+
apply clarsimp
apply (erule any_valid_thread)
apply (frule(1) tcb_with_domain_at)
@ -1331,7 +1326,7 @@ lemma next_domain_snippit: "reads_respects_scheduler aag l (invs and pas_refined
apply (rule ev_weaken_pre_relation)
apply wp
apply fastforce
apply (wp next_domain_valid_queues)
apply (wp next_domain_valid_queues)+
apply (clarsimp simp: scheduler_equiv_def domain_fields_equiv_def)
done
@ -1437,7 +1432,8 @@ lemma reads_respects_scheduler_invisible_domain_switch: "reads_respects_schedule
apply (simp add: equiv_valid_def2)
apply (rule equiv_valid_rv_bind[where W=dc])
apply (rule equiv_valid_dc)
apply wp[2]
apply wp
apply wp
apply (rule equiv_valid_2_bind_pre[where R'=dc])
apply (rule equiv_valid_2_bind_pre[where R'="op ="])
apply simp
@ -1455,26 +1451,27 @@ lemma reads_respects_scheduler_invisible_domain_switch: "reads_respects_schedule
in equiv_valid_2_unobservable)
apply wp
apply (rule scheduler_equiv_lift)
apply wp
apply wp+
apply simp
apply clarsimp
apply wp
apply (wp tcb_sched_action_unobservable)
apply clarsimp
apply (wp scheduler_equiv_lift)
apply (wp scheduler_equiv_lift)+
apply (wp | simp)+
apply (wp tcb_sched_action_unobservable)
apply (wp tcb_sched_action_unobservable)+
apply simp
apply (fastforce+)[2]
apply wp
apply wp+
apply (force+)[2]
apply (rule equiv_valid_2)
apply (rule ev_gets_const)
apply wp
apply wp+
apply (force+)[2]
apply (rule equiv_valid_dc)
apply wp[2]
apply (wp gts_wp)
apply wp
apply wp
apply (wp gts_wp)+
apply (force+)[2]
apply wp
apply clarsimp
@ -1495,10 +1492,10 @@ lemma schedule_no_domain_switch: "\<lbrace>(\<lambda>s. domain_time s \<noteq> 0
apply (simp add: schedule_def)
apply (wp | wpc)+
apply (rule hoare_pre_cont)
apply wp
apply wp+
apply simp
apply wps
apply (wp gts_wp)
apply (wp gts_wp)+
apply clarsimp
done
@ -1506,10 +1503,10 @@ lemma schedule_no_domain_fields: "\<lbrace>(\<lambda>s. domain_time s \<noteq> 0
apply (simp add: schedule_def)
apply (wp | wpc)+
apply (rule hoare_pre_cont)
apply wp
apply wp+
apply simp
apply wps
apply (wp gts_wp)
apply (wp gts_wp)+
apply clarsimp
done
@ -1537,10 +1534,9 @@ lemma choose_thread_unobservable: "\<lbrace>(\<lambda>s. pasDomainAbs aag (cur_d
apply simp
done
lemma tcb_sched_action_scheduler_equiv[wp]: "\<lbrace>scheduler_equiv aag st\<rbrace> tcb_sched_action f a\<lbrace>\<lambda>_. scheduler_equiv aag st\<rbrace>"
apply (rule scheduler_equiv_lift)
apply wp
done
lemma tcb_sched_action_scheduler_equiv[wp]:
"\<lbrace>scheduler_equiv aag st\<rbrace> tcb_sched_action f a\<lbrace>\<lambda>_. scheduler_equiv aag st\<rbrace>"
by (rule scheduler_equiv_lift; wp)
lemma cur_thread_cur_domain: "st_tcb_at (op = st) (cur_thread s) s \<Longrightarrow> \<not> idle st \<Longrightarrow> invs s \<Longrightarrow>
guarded_pas_domain aag s \<Longrightarrow> pasObjectAbs aag (cur_thread s) = pasDomainAbs aag (cur_domain s)"
@ -1600,11 +1596,11 @@ lemma schedule_reads_respects_scheduler_cur_domain: "reads_respects_scheduler aa
apply (rule ev_weaken_pre_relation)
apply (rule guarded_switch_to_thread_midstrength_reads_respects_scheduler)
apply fastforce
apply (wp when_ev)[2]
apply ((wp when_ev)+)[2]
apply (rule bind_ev)
apply simp
apply (rule next_domain_snippit)
apply (wp_trace when_ev gts_wp get_thread_state_reads_respects_scheduler)
apply (wp_trace when_ev gts_wp get_thread_state_reads_respects_scheduler)+
apply (clarsimp simp: reads_lrefl)
apply (intro impI conjI allI)
apply (simp add: guarded_pas_domain_def)
@ -1956,12 +1952,12 @@ lemma ackInterrupt_reads_respects_scheduler:
apply clarsimp
apply ((wp silc_dom_lift dmo_wp | simp)+)[5]
apply (rule scheduler_affects_equiv_unobservable)
apply (simp add: states_equiv_for_def[abs_def] equiv_for_def equiv_asids_def
equiv_asid_def)
apply (rule hoare_pre)
apply wps
apply (wp dmo_wp | simp add:ackInterrupt_def)+
apply (wp mol_exclusive_state)
apply (simp add: states_equiv_for_def[abs_def] equiv_for_def equiv_asids_def equiv_asid_def)
apply (rule hoare_pre)
apply wps
apply (wp dmo_wp | simp add:ackInterrupt_def)+
apply (wp mol_exclusive_state)
apply assumption
done
@ -2009,14 +2005,7 @@ lemma dmo_distr: "do_machine_op (f >>= g) = ((do_machine_op f) >>= (\<lambda>x.
bind_def get_def return_def)
apply (rule ext)
apply safe
apply clarsimp
apply force
apply clarsimp
apply force
apply clarsimp
apply force
apply clarsimp
apply force
apply ((clarsimp, force)+)[5]
apply (simp add: image_def)
done
@ -2371,8 +2360,6 @@ lemma context_update_cur_thread_snippit: "equiv_valid_2 (scheduler_equiv aag) (s
apply ((fastforce)+)[2]
apply (clarsimp simp: scheduler_equiv_def domain_fields_equiv_def)
done
lemma equiv_valid_2E:

37
proof/infoflow/Syscall_IF.thy
View File

@ -419,7 +419,7 @@ lemma sts_authorised_for_globals_inv: "\<lbrace>authorised_for_globals_inv oper\
apply (rename_tac page_table_invocation)
apply (case_tac page_table_invocation)
apply simp+
apply (wp set_thread_state_arm_global_pd)
apply (wp set_thread_state_arm_global_pd)+
apply simp
apply wp
apply simp
@ -519,7 +519,7 @@ lemma handle_invocation_reads_respects_g:
| intro impI conjI | erule conjE
| rule doesnt_touch_globalsI |
wp syscall_requiv_f_g gts_inv
(wp syscall_requiv_f_g gts_inv
reads_respects_f_g'[OF lookup_extra_caps_reads_respects_g, where Q="\<top>" and st=st]
reads_respects_f_g'[OF lookup_ipc_buffer_reads_respects_g, where Q="\<top>" and st=st]
reads_respects_f_g'[OF cap_fault_on_failure_rev_g, where Q="\<top>" and st=st]
@ -543,7 +543,7 @@ lemma handle_invocation_reads_respects_g:
handle_fault_globals_equiv
set_thread_state_globals_equiv
reply_from_kernel_globals_equiv | (rule hoare_drop_imps)
reply_from_kernel_globals_equiv)+ | (rule hoare_drop_imps)
)+
apply (rule_tac Q'="\<lambda>r s. silc_inv aag st s \<and> invs s \<and> is_subject aag rv \<and> is_subject aag (cur_thread s) \<and> rv \<noteq> idle_thread s" in hoare_post_imp_R)
apply (wp pinv_invs perform_invocation_silc_inv)
@ -551,7 +551,7 @@ lemma handle_invocation_reads_respects_g:
apply(wp reads_respects_f_g'[OF set_thread_state_reads_respects_g, where Q="\<top>" and st=st] | simp)+
apply (simp |
wp set_thread_state_only_timer_irq_inv[where st=st']
(wp set_thread_state_only_timer_irq_inv[where st=st']
set_thread_state_reads_respects_g
set_thread_state_globals_equiv
sts_Restart_invs
@ -569,7 +569,7 @@ lemma handle_invocation_reads_respects_g:
lec_valid_fault
lookup_extra_caps_authorised
lookup_extra_caps_auth
lookup_ipc_buffer_has_read_auth'
lookup_ipc_buffer_has_read_auth')+
| (rule hoare_vcg_conj_liftE_R, rule hoare_drop_impE_R)
)+
apply (rule hoare_pre) (*Weird schematic in precondition necessary*)
@ -590,7 +590,7 @@ lemma handle_invocation_reads_respects_g:
apply (clarsimp simp: requiv_g_cur_thread_eq simp: reads_equiv_f_g_conj)
apply (clarsimp simp: get_register_def invs_sym_refs invs_def valid_state_def valid_arch_state_ko_at_arm valid_pspace_vo valid_pspace_distinct)
apply (rule context_conjI)
apply (simp add: ct_active_not_idle')
apply (simp add: ct_active_not_idle')
apply (clarsimp simp: valid_pspace_def ct_in_state_def)
apply (rule conjI)
apply(fastforce intro: reads_lrefl)
@ -624,11 +624,12 @@ lemma lookup_cap_cap_fault:
"\<lbrace>invs\<rbrace> lookup_cap c b -, \<lbrace>\<lambda>f s. valid_fault (CapFault x y f)\<rbrace>"
apply (simp add: lookup_cap_def)
apply wp
apply (case_tac xa)
apply (simp add: validE_E_def)
apply (wp)
apply (fold validE_E_def)
apply (wp lookup_slot_for_thread_cap_fault)
apply (case_tac xa)
apply (simp add: validE_E_def)
apply (wp)
apply (fold validE_E_def)
apply (wp lookup_slot_for_thread_cap_fault)
apply assumption
done
crunch pas_cur_domain[wp]: delete_caller_cap "pas_cur_domain aag"
@ -752,23 +753,19 @@ lemma handle_recv_reads_respects_f_g:
lemma dmo_return_reads_respects:
"reads_respects aag l \<top> (do_machine_op (return ()))"
apply (rule use_spec_ev)
apply (rule do_machine_op_spec_reads_respects)
apply wp
apply (rule do_machine_op_spec_reads_respects; wp)
done
lemma dmo_return_globals_equiv:
"\<lbrace>globals_equiv st\<rbrace> do_machine_op (return ()) \<lbrace>\<lambda>r .globals_equiv st\<rbrace>"
apply (rule dmo_no_mem_globals_equiv)
apply wp
done
by simp
lemma get_irq_slot_reads_respects':
"reads_respects aag l (K(aag_can_read_label aag (pasIRQAbs aag irq))) (get_irq_slot irq)"
unfolding get_irq_slot_def
apply(rule equiv_valid_guard_imp)
apply(rule gets_ev)
apply(simp add: reads_equiv_def states_equiv_for_def equiv_for_def
affects_equiv_def)
apply(simp add: reads_equiv_def states_equiv_for_def equiv_for_def affects_equiv_def)
done
@ -906,9 +903,9 @@ lemma handle_event_reads_respects_f_g:
apply (simp add: validE_E_def)
apply (rule_tac E="\<lambda>r s. invs s \<and> is_subject aag rv \<and> is_subject aag (cur_thread s) \<and> valid_fault r \<and> pas_refined aag s \<and> pas_cur_domain aag s \<and> silc_inv aag st s \<and> rv \<noteq> idle_thread s" and Q="\<top>\<top>" in hoare_post_impErr)
apply (rule hoare_vcg_E_conj)
apply (wp hv_invs handle_vm_fault_silc_inv)
apply (wp hv_invs handle_vm_fault_silc_inv)+
apply (simp add: invs_imps invs_mdb invs_valid_idle)+
apply wp
apply wp+
apply (clarsimp simp: requiv_g_cur_thread_eq reads_equiv_f_g_conj ct_active_not_idle)
done

59
proof/infoflow/Tcb_IF.thy
View File

@ -60,12 +60,9 @@ crunch globals_equiv[wp]: get_notification "globals_equiv st"
lemma cancel_signal_globals_equiv:
"\<lbrace>globals_equiv st and valid_ko_at_arm\<rbrace> cancel_signal a b \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding cancel_signal_def
apply (wp set_thread_state_globals_equiv get_notification_valid_ko_at_arm
set_notification_globals_equiv set_notification_valid_ko_at_arm | wpc | clarsimp simp: crunch_simps hoare_drop_imps)+
apply (rule hoare_pre)
apply (wp hoare_drop_imps)
apply simp
done
by (wpsimp wp: set_thread_state_globals_equiv get_notification_valid_ko_at_arm
set_notification_globals_equiv set_notification_valid_ko_at_arm hoare_drop_imps
simp: crunch_simps)
crunch globals_equiv[wp]: cancel_ipc "globals_equiv st"
(wp: mapM_x_wp select_inv hoare_drop_imps hoare_vcg_if_lift2 cancel_signal_valid_ko_at_arm
@ -85,18 +82,7 @@ lemma as_user_globals_equiv[wp]:
apply (wp set_object_globals_equiv | simp add: split_def)+
apply (simp add: valid_ko_at_arm_def)
apply (clarsimp simp: get_tcb_def obj_at_def)
done
lemma as_user_valid_ko_at_arm[wp]:
"\<lbrace> valid_ko_at_arm \<rbrace>
as_user thread f
\<lbrace> \<lambda>_. valid_ko_at_arm\<rbrace>"
unfolding as_user_def
apply wp
apply (case_tac x)
apply (simp | wp select_wp)+
apply(fastforce simp: valid_ko_at_arm_def get_tcb_ko_at obj_at_def)
done
done
lemma cap_ne_global_pd : "ex_nonz_cap_to word s \<Longrightarrow> valid_global_refs s \<Longrightarrow> word \<noteq> arm_global_pd (arch_state s)"
unfolding ex_nonz_cap_to_def
@ -107,7 +93,7 @@ lemma cap_ne_global_pd : "ex_nonz_cap_to word s \<Longrightarrow> valid_global_r
apply clarsimp
apply (unfold cap_range_def)
apply blast
done
done
lemma globals_equiv_ioc_update[simp]: "globals_equiv st (is_original_cap_update f s) = globals_equiv st s"
apply (simp add: globals_equiv_def idle_equiv_def)
@ -193,14 +179,14 @@ next
apply (simp only: split_def)
apply (rule hoare_pre_spec_validE)
apply wp
apply (wp set_cap_P set_cap_Q "2.hyps", assumption+)
apply (wp set_cap_P set_cap_Q "2.hyps")+
apply ((wp preemption_point_Q preemption_point_P | simp | wp_once preemption_point_inv)+)[1]
apply (simp(no_asm))
apply (rule spec_strengthen_postE)
apply (rule spec_valid_conj_liftE1, rule valid_validE_R, rule rec_del_invs)
apply (rule spec_valid_conj_liftE1, rule reduce_zombie_cap_to)
apply (rule spec_valid_conj_liftE1, rule rec_del_emptyable)
apply (rule "2.hyps", assumption+)
apply (rule "2.hyps")
apply simp
apply (simp add: conj_comms)
apply (wp set_cap_P set_cap_Q replace_cap_invs
@ -302,24 +288,23 @@ lemma rec_del_globals_equiv:
apply (wp rec_del_preservation2[where Q="valid_ko_at_arm" and R="valid_global_objs and valid_arch_state and pspace_aligned and valid_arch_objs and
valid_global_refs and
valid_vs_lookup"] finalise_cap_globals_equiv)
apply simp
apply (wp set_cap_globals_equiv'')
apply simp
apply (wp set_cap_valid_ko_at_arm empty_slot_globals_equiv)
apply simp
apply (wp empty_slot_valid_ko_at_arm)
apply simp
apply (simp add: invs_valid_ko_at_arm)
apply (simp add: invs_def valid_state_def valid_arch_caps_def valid_pspace_def)
apply (wp preemption_point_inv | simp)+
done
apply simp
apply (wp set_cap_globals_equiv'')
apply simp
apply (wp set_cap_valid_ko_at_arm empty_slot_globals_equiv)+
apply simp
apply (wp empty_slot_valid_ko_at_arm)+
apply simp
apply (simp add: invs_valid_ko_at_arm)
apply (simp add: invs_def valid_state_def valid_arch_caps_def valid_pspace_def)
apply (wp preemption_point_inv | simp)+
done
lemma cap_delete_globals_equiv : "\<lbrace>globals_equiv st and invs and emptyable a\<rbrace> (cap_delete a) \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding cap_delete_def
apply (rule hoare_pre)
apply (wp rec_del_globals_equiv)
apply (wp rec_del_globals_equiv)
apply simp
done
done
lemma no_cap_to_idle_thread': "valid_global_refs s \<Longrightarrow> \<not> ex_nonz_cap_to (idle_thread s) s"
apply (clarsimp simp add: ex_nonz_cap_to_def valid_global_refs_def valid_refs_def)
@ -434,7 +419,7 @@ lemma invoke_tcb_NotificationControl_globals_equiv:
invoke_tcb (NotificationControl t ntfn)
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
apply (case_tac ntfn, simp_all)
apply (wp unbind_notification_globals_equiv bind_notification_globals_equiv)
apply (wp unbind_notification_globals_equiv bind_notification_globals_equiv)+
done
crunch globals_equiv: set_mcpriority "globals_equiv st"
@ -443,6 +428,7 @@ lemma invoke_tcb_globals_equiv:
"\<lbrace> invs and globals_equiv st and Tcb_AI.tcb_inv_wf ti\<rbrace>
invoke_tcb ti
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
including no_pre
apply(case_tac ti)
prefer 4
apply (simp del: invoke_tcb.simps Tcb_AI.tcb_inv_wf.simps)
@ -673,6 +659,7 @@ lemma invoke_tcb_reads_respects_f:
static_imp_wp [wp]
shows
"reads_respects_f aag l (silc_inv aag st and only_timer_irq_inv irq st' and einvs and simple_sched_action and pas_refined aag and pas_cur_domain aag and Tcb_AI.tcb_inv_wf ti and (\<lambda>s. is_subject aag (cur_thread s)) and K (authorised_tcb_inv aag ti \<and> authorised_tcb_inv_extra aag ti)) (invoke_tcb ti)"
including no_pre
apply(case_tac ti)
apply(wp when_ev restart_reads_respects_f as_user_reads_respects_f static_imp_wp | simp)+
apply(auto intro: requiv_cur_thread_eq intro!: det_zipWithM simp: det_setRegister det_getRestartPC det_setNextPC authorised_tcb_inv_def simp: reads_equiv_f_def)[1]

3
proof/invariant-abstract/AInvs.thy
View File

@ -53,7 +53,7 @@ lemma ct_running_machine_op:
"\<lbrace>ct_running\<rbrace> do_machine_op f \<lbrace>\<lambda>_. ct_running\<rbrace>"
apply (simp add: ct_in_state_def pred_tcb_at_def obj_at_def)
apply (rule hoare_lift_Pf [where f=cur_thread])
by wp
by wp+
lemma kernel_entry_invs:
"\<lbrace>invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s)\<rbrace>
@ -104,7 +104,6 @@ lemma user_memory_update[wp]:
valid_def bind_def gets_def return_def get_def select_f_def)
lemma do_user_op_invs:
"\<lbrace>invs and ct_running\<rbrace>
do_user_op f tc

223
proof/invariant-abstract/ARM/ArchAcc_AI.thy
View File

@ -25,6 +25,7 @@ bundle unfold_objects =
obj_at_def[simp]
kernel_object.splits[split]
arch_kernel_obj.splits[split]
get_object_wp [wp]
bundle unfold_objects_asm =
obj_at_def[simp]
@ -58,10 +59,7 @@ lemmas set_asid_pool_typ_ats [wp] = abs_typ_at_lifts [OF set_asid_pool_typ_at]
lemma get_pd_wp [wp]:
"\<lbrace>\<lambda>s. \<forall>pd. ko_at (ArchObj (PageDirectory pd)) p s \<longrightarrow> Q pd s\<rbrace> get_pd p \<lbrace>Q\<rbrace>"
apply (simp add: get_pd_def get_object_def)
apply (wp|wpc)+
apply (clarsimp simp: obj_at_def)
done
unfolding get_pd_def including unfold_objects by wpsimp
lemma get_pde_wp:
@ -73,7 +71,7 @@ lemma get_pde_wp:
lemma get_pde_inv [wp]: "\<lbrace>P\<rbrace> get_pde p \<lbrace>\<lambda>_. P\<rbrace>"
by (wp get_pde_wp) simp
by (wpsimp wp: get_pde_wp)
bundle pagebits =
pd_bits_def[simp] pt_bits_def[simp]
@ -97,8 +95,7 @@ lemma get_master_pde_wp:
lemma store_pde_typ_at [wp]:
"\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> store_pde ptr pde \<lbrace>\<lambda>_ s. P (typ_at T p s)\<rbrace>"
apply (simp add: store_pde_def set_pd_def set_object_def get_object_def)
apply wp
apply (clarsimp simp: obj_at_def a_type_def)
apply (wpsimp simp: obj_at_def a_type_def)
done
@ -108,8 +105,7 @@ lemmas store_pde_typ_ats [wp] = abs_typ_at_lifts [OF store_pde_typ_at]
lemma get_pt_wp [wp]:
"\<lbrace>\<lambda>s. \<forall>pt. ko_at (ArchObj (PageTable pt)) p s \<longrightarrow> Q pt s\<rbrace> get_pt p \<lbrace>Q\<rbrace>"
apply (simp add: get_pt_def get_object_def)
apply (wp|wpc)+
apply (clarsimp simp: obj_at_def)
apply (wpsimp simp: obj_at_def)
done
@ -123,7 +119,7 @@ lemma get_pte_wp:
lemma get_pte_inv [wp]:
"\<lbrace>P\<rbrace> get_pte p \<lbrace>\<lambda>_. P\<rbrace>"
by (wp get_pte_wp) simp
by (wpsimp wp: get_pte_wp)
lemma get_master_pte_wp:
@ -142,8 +138,7 @@ lemma get_master_pte_wp:
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)
apply wp
apply (clarsimp simp: obj_at_def a_type_def)
apply (wpsimp simp: obj_at_def a_type_def)
done
@ -160,8 +155,8 @@ lemma lookup_pt_slot_inv:
lemma lookup_pt_slot_inv_any:
"\<lbrace>\<lambda>s. \<forall>x. Q x s\<rbrace> lookup_pt_slot pd vptr \<lbrace>Q\<rbrace>,-"
"\<lbrace>E\<rbrace> lookup_pt_slot pd vptr -, \<lbrace>\<lambda>ft. E\<rbrace>"
apply (simp_all add: lookup_pt_slot_def)
apply (wp get_pde_wp | simp | wpc)+
apply (simp_all add: lookup_pt_slot_def)
apply (wpsimp wp: get_pde_wp)+
done
crunch cte_wp_at[wp]: set_irq_state "\<lambda>s. P (cte_wp_at P' p s)"
@ -203,27 +198,21 @@ lemma set_asid_pool_cte_wp_at:
lemma set_pt_pred_tcb_at[wp]:
"\<lbrace>pred_tcb_at proj P t\<rbrace> set_pt ptr val \<lbrace>\<lambda>_. pred_tcb_at proj P t\<rbrace>"
apply (simp add: set_pt_def set_object_def)
apply wp
apply (rule hoare_strengthen_post [OF get_object_sp])
apply (clarsimp simp: pred_tcb_at_def obj_at_def)
apply (wpsimp wp: get_object_wp simp: pred_tcb_at_def obj_at_def)
done
lemma set_pd_pred_tcb_at[wp]:
"\<lbrace>pred_tcb_at proj P t\<rbrace> set_pd ptr val \<lbrace>\<lambda>_. pred_tcb_at proj P t\<rbrace>"
apply (simp add: set_pd_def set_object_def)
apply wp
apply (rule hoare_strengthen_post [OF get_object_sp])
apply (clarsimp simp: pred_tcb_at_def obj_at_def)
apply (wpsimp wp: get_object_wp simp: pred_tcb_at_def obj_at_def)
done
lemma set_asid_pool_pred_tcb_at[wp]:
"\<lbrace>pred_tcb_at proj P t\<rbrace> set_asid_pool ptr val \<lbrace>\<lambda>_. pred_tcb_at proj P t\<rbrace>"
apply (simp add: set_asid_pool_def set_object_def)
apply wp
apply (rule hoare_strengthen_post [OF get_object_sp])
apply (clarsimp simp: pred_tcb_at_def obj_at_def)
apply (wpsimp wp: get_object_wp simp: pred_tcb_at_def obj_at_def)
done
@ -273,7 +262,7 @@ lemma arch_derive_cap_valid_cap:
\<lbrace>valid_cap \<circ> cap.ArchObjectCap\<rbrace>, -"
apply(simp add: arch_derive_cap_def)
apply(cases arch_cap, simp_all add: arch_derive_cap_def o_def)
apply(rule hoare_pre, wpc?, wp,
apply(rule hoare_pre, wpc?, wp+;
clarsimp simp add: cap_aligned_def valid_cap_def split: option.splits)+
done
@ -281,7 +270,7 @@ lemma arch_derive_cap_valid_cap:
lemma arch_derive_cap_inv:
"\<lbrace>P\<rbrace> arch_derive_cap arch_cap \<lbrace>\<lambda>rv. P\<rbrace>"
apply(simp add: arch_derive_cap_def, cases arch_cap, simp_all)
apply(rule hoare_pre, wpc?, wp, simp)+
apply(rule hoare_pre, wpc?, wp+; simp)+
done
definition
@ -331,21 +320,18 @@ lemma ucast_ucast_asid_high_bits [simp]:
lemma mask_asid_low_bits_ucast_ucast:
"((asid::word32) && mask asid_low_bits) = ucast (ucast asid :: 10 word)"
apply (rule word_eqI)
apply (simp add: word_size nth_ucast asid_low_bits_def)
done
by (rule word_eqI) (simp add: word_size nth_ucast asid_low_bits_def)
lemma set_asid_pool_cur [wp]:
"\<lbrace>\<lambda>s. P (cur_thread s)\<rbrace> set_asid_pool p a \<lbrace>\<lambda>_ s. P (cur_thread s)\<rbrace>"
unfolding set_asid_pool_def by (wp get_object_wp) simp
unfolding set_asid_pool_def by (wpsimp wp: get_object_wp)
lemma set_asid_pool_cur_tcb [wp]:
"\<lbrace>\<lambda>s. cur_tcb s\<rbrace> set_asid_pool p a \<lbrace>\<lambda>_ s. cur_tcb s\<rbrace>"
unfolding cur_tcb_def
by (rule hoare_lift_Pf [where f=cur_thread]) wp
by (rule hoare_lift_Pf [where f=cur_thread]; wp)
crunch arch [wp]: set_asid_pool "\<lambda>s. P (arch_state s)"
@ -354,7 +340,7 @@ crunch arch [wp]: set_asid_pool "\<lambda>s. P (arch_state s)"
lemma set_asid_pool_valid_arch [wp]:
"\<lbrace>valid_arch_state\<rbrace> set_asid_pool p a \<lbrace>\<lambda>_. valid_arch_state\<rbrace>"
by (rule valid_arch_state_lift) (wp set_asid_pool_typ_at)
by (rule valid_arch_state_lift) (wp set_asid_pool_typ_at)+
lemma set_asid_pool_valid_objs [wp]:
@ -693,10 +679,6 @@ lemma create_mapping_entries_valid [wp]:
apply (cases sz)
apply (rule hoare_pre)
apply (wp|simp add: valid_mapping_entries_def)+
apply (rule hoare_pre)
apply (wp|simp add: valid_mapping_entries_def)+
apply (rule hoare_pre)
apply wp
apply clarsimp
apply (erule (1) page_directory_pde_at_lookupI)
apply (rule hoare_pre)
@ -852,10 +834,7 @@ lemma set_asid_pool_distinct [wp]:
lemma store_pde_arch [wp]:
"\<lbrace>\<lambda>s. P (arch_state s)\<rbrace> store_pde p pde \<lbrace>\<lambda>_ s. P (arch_state s)\<rbrace>"
apply (simp add: store_pde_def set_pd_def get_object_def)
apply (wp|wpc)+
apply clarsimp
done
by (simp add: store_pde_def set_pd_def get_object_def) wpsimp
lemma store_pte_valid_pte [wp]:
@ -871,8 +850,7 @@ lemma store_pde_valid_pde [wp]:
lemma set_pd_typ_at [wp]:
"\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> set_pd ptr pd \<lbrace>\<lambda>_ s. P (typ_at T p s)\<rbrace>"
apply (simp add: set_pd_def set_object_def get_object_def)
apply wp
apply clarsimp
apply wpsimp
apply (erule rsubst [where P=P])
including unfold_objects
by (clarsimp simp: a_type_def)
@ -922,13 +900,8 @@ lemma set_pd_zombies_state_refs:
lemma set_pd_cdt:
"\<lbrace>\<lambda>s. P (cdt s)\<rbrace>
set_pd p pd
\<lbrace>\<lambda>_ s. P (cdt s)\<rbrace>"
apply (clarsimp simp: set_pd_def)
apply (wp get_object_wp)
apply simp
done
"\<lbrace>\<lambda>s. P (cdt s)\<rbrace> set_pd p pd \<lbrace>\<lambda>_ s. P (cdt s)\<rbrace>"
unfolding set_pd_def by (wpsimp wp: get_object_wp)
lemma set_pd_valid_mdb:
@ -936,32 +909,22 @@ lemma set_pd_valid_mdb:
set_pd p pd
\<lbrace>\<lambda>_ s. valid_mdb s\<rbrace>"
apply (rule valid_mdb_lift)
apply (wp set_pd_cdt)
apply (wp set_pd_cdt)+
apply (clarsimp simp: set_pd_def)
apply (wp get_object_wp)
apply simp
apply (wpsimp wp: get_object_wp)
done
lemma set_pd_valid_idle:
"\<lbrace>\<lambda>s. valid_idle s\<rbrace>
set_pd p pd
\<lbrace>\<lambda>_ s. valid_idle s\<rbrace>"
apply (wp valid_idle_lift)
apply (simp add: set_pd_def)
apply (wp get_object_wp)
apply simp
done
"\<lbrace>\<lambda>s. valid_idle s\<rbrace> set_pd p pd \<lbrace>\<lambda>_ s. valid_idle s\<rbrace>"
by (wpsimp wp: valid_idle_lift get_object_wp simp: set_pd_def)
lemma set_pd_ifunsafe:
"\<lbrace>\<lambda>s. if_unsafe_then_cap s\<rbrace>
set_pd p pd
\<lbrace>\<lambda>_ s. if_unsafe_then_cap s\<rbrace>"
apply (simp add: set_pd_def)
apply (wp get_object_wp set_object_ifunsafe)
including unfold_objects
by clarsimp
unfolding set_pd_def including unfold_objects
by (wpsimp wp: get_object_wp set_object_ifunsafe)
lemma set_pd_reply_caps:
@ -1019,7 +982,6 @@ lemma set_pd_cur:
\<lbrace>\<lambda>_ s. cur_tcb s\<rbrace>"
apply (simp add: cur_tcb_def set_pd_def set_object_def)
apply (wp get_object_wp)
apply clarsimp
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
apply (clarsimp simp: obj_at_def is_tcb_def)
done
@ -1046,8 +1008,7 @@ declare graph_of_Some_update[simp]
lemma set_pt_typ_at [wp]:
"\<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> set_pt ptr pt \<lbrace>\<lambda>_ s. P (typ_at T p s)\<rbrace>"
apply (simp add: set_pt_def set_object_def get_object_def)
apply wp
apply clarsimp
apply wpsimp
apply (erule rsubst [where P=P])
including unfold_objects
by (clarsimp simp: a_type_def)
@ -1070,92 +1031,55 @@ lemma set_pt_iflive:
"\<lbrace>\<lambda>s. if_live_then_nonz_cap s\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. if_live_then_nonz_cap s\<rbrace>"
apply (simp add: set_pt_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)
done
unfolding set_pt_def including unfold_objects
by (wpsimp wp: get_object_wp)
lemma set_pt_zombies:
"\<lbrace>\<lambda>s. zombies_final s\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. zombies_final s\<rbrace>"
apply (simp add: set_pt_def)
apply (wp get_object_wp set_object_zombies)
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
apply (clarsimp simp: obj_at_def)
done
unfolding set_pt_def including unfold_objects
by (wpsimp wp: get_object_wp)
lemma set_pt_zombies_state_refs:
"\<lbrace>\<lambda>s. P (state_refs_of s)\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. P (state_refs_of s)\<rbrace>"
apply (clarsimp simp: set_pt_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
unfolding set_pt_def set_object_def including unfold_objects
apply wpsimp
apply (erule rsubst [where P=P])
apply (rule ext)
apply (clarsimp simp: obj_at_def state_refs_of_def split: option.splits)
apply (clarsimp simp: state_refs_of_def split: option.splits)
done
lemma set_pt_cdt:
"\<lbrace>\<lambda>s. P (cdt s)\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. P (cdt s)\<rbrace>"
apply (clarsimp simp: set_pt_def)
apply (wp get_object_wp)
apply simp
done
"\<lbrace>\<lambda>s. P (cdt s)\<rbrace> set_pt p pt \<lbrace>\<lambda>_ s. P (cdt s)\<rbrace>"
unfolding set_pt_def including unfold_objects by wpsimp
lemma set_pt_valid_mdb:
"\<lbrace>\<lambda>s. valid_mdb s\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. valid_mdb s\<rbrace>"
apply (rule valid_mdb_lift)
apply (wp set_pt_cdt)
apply (clarsimp simp: set_pt_def)
apply (wp get_object_wp)
apply simp
done
"\<lbrace>\<lambda>s. valid_mdb s\<rbrace> set_pt p pt \<lbrace>\<lambda>_ s. valid_mdb s\<rbrace>"
including unfold_objects
by (wpsimp wp: set_pt_cdt valid_mdb_lift simp: set_pt_def)
lemma set_pt_valid_idle:
"\<lbrace>\<lambda>s. valid_idle s\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. valid_idle s\<rbrace>"
apply (wp valid_idle_lift)
apply (simp add: set_pt_def)
apply (wp get_object_wp)
apply simp
done
"\<lbrace>\<lambda>s. valid_idle s\<rbrace> set_pt p pt \<lbrace>\<lambda>_ s. valid_idle s\<rbrace>"
including unfold_objects
by (wpsimp wp: valid_idle_lift simp: set_pt_def)
lemma set_pt_ifunsafe:
"\<lbrace>\<lambda>s. if_unsafe_then_cap s\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. if_unsafe_then_cap s\<rbrace>"
apply (simp add: set_pt_def)
apply (wp get_object_wp set_object_ifunsafe)
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
apply (clarsimp simp: obj_at_def)
done
"\<lbrace>\<lambda>s. if_unsafe_then_cap s\<rbrace> set_pt p pt \<lbrace>\<lambda>_ s. if_unsafe_then_cap s\<rbrace>"
including unfold_objects by (wpsimp simp: set_pt_def)
lemma set_pt_reply_caps:
"\<lbrace>\<lambda>s. valid_reply_caps s\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_ s. valid_reply_caps s\<rbrace>"
"\<lbrace>\<lambda>s. valid_reply_caps s\<rbrace> set_pt p pt \<lbrace>\<lambda>_ s. valid_reply_caps s\<rbrace>"
by (wp valid_reply_caps_st_cte_lift)
lemma set_pt_reply_masters:
"\<lbrace>valid_reply_masters\<rbrace>
set_pt p pt
\<lbrace>\<lambda>_. valid_reply_masters\<rbrace>"
"\<lbrace>valid_reply_masters\<rbrace> set_pt p pt \<lbrace>\<lambda>_. valid_reply_masters\<rbrace>"
by (wp valid_reply_masters_cte_lift)
@ -1248,7 +1172,7 @@ lemma set_pt_vs_lookup [wp]:
lemma store_pte_vs_lookup [wp]:
"\<lbrace>\<lambda>s. P (vs_lookup s)\<rbrace> store_pte x pte \<lbrace>\<lambda>_ s. P (vs_lookup s)\<rbrace>"
unfolding store_pte_def by wp simp
unfolding store_pte_def by wpsimp
lemma unique_table_caps_ptD:
@ -1524,7 +1448,7 @@ lemma set_pt_asid_map [wp]:
"\<lbrace>valid_asid_map\<rbrace> set_pt p pt \<lbrace>\<lambda>_. valid_asid_map\<rbrace>"
apply (simp add: valid_asid_map_def vspace_at_asid_def)
apply (rule hoare_lift_Pf2 [where f="arch_state"])
apply wp
apply wp+
done
@ -1862,56 +1786,41 @@ lemma set_asid_pool_cdt [wp]:
"\<lbrace>\<lambda>s. P (cdt s)\<rbrace>
set_asid_pool p ap
\<lbrace>\<lambda>_ s. P (cdt s)\<rbrace>"
apply (clarsimp simp: set_asid_pool_def)
apply (wp get_object_wp)
apply simp
done
unfolding set_asid_pool_def including unfold_objects
by wpsimp
lemma set_asid_pool_caps_of_state [wp]:
"\<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> set_asid_pool p ap \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
apply (simp add: set_asid_pool_def get_object_def bind_assoc set_object_def)
apply wp
apply clarsimp
unfolding set_asid_pool_def set_object_def including unfold_objects
apply wpsimp
apply (subst cte_wp_caps_of_lift)
prefer 2
apply assumption
subgoal for _ y
by (cases y, auto simp: cte_wp_at_cases)
subgoal for _ _ y by (cases y, auto simp: cte_wp_at_cases)
done
lemma set_asid_pool_valid_mdb [wp]:
"\<lbrace>\<lambda>s. valid_mdb s\<rbrace>
set_asid_pool p ap
\<lbrace>\<lambda>_ s. valid_mdb s\<rbrace>"
apply (rule valid_mdb_lift)
apply wp
apply (clarsimp simp: set_asid_pool_def)
apply (wp get_object_wp)
apply simp
done
including unfold_objects
by (wpsimp wp: valid_mdb_lift simp: set_asid_pool_def)
lemma set_asid_pool_valid_idle [wp]:
"\<lbrace>\<lambda>s. valid_idle s\<rbrace>
set_asid_pool p ap
\<lbrace>\<lambda>_ s. valid_idle s\<rbrace>"
apply (wp valid_idle_lift)
apply (simp add: set_asid_pool_def)
apply (wp get_object_wp)
apply simp
done
including unfold_objects
by (wpsimp wp: valid_idle_lift simp: set_asid_pool_def)
lemma set_asid_pool_ifunsafe [wp]:
"\<lbrace>\<lambda>s. if_unsafe_then_cap s\<rbrace>
set_asid_pool p ap
\<lbrace>\<lambda>_ s. if_unsafe_then_cap s\<rbrace>"
apply (simp add: set_asid_pool_def)
apply (wp get_object_wp set_object_ifunsafe)
apply (clarsimp split: kernel_object.splits arch_kernel_obj.splits)
apply (clarsimp simp: obj_at_def)
done
including unfold_objects
by (wpsimp simp: set_asid_pool_def)
lemma set_asid_pool_reply_caps [wp]:
@ -1961,13 +1870,9 @@ 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>"
apply (simp add: set_asid_pool_def)
apply (wp get_object_wp set_object_arch_objs)
apply (clarsimp simp: obj_at_def obj_at_def)
apply (rule conjI)
apply (clarsimp simp: a_type_def split: kernel_object.splits arch_kernel_obj.splits)
apply (clarsimp simp: vs_refs_def)
apply fastforce
unfolding set_asid_pool_def including unfold_objects
apply (wpsimp wp: set_object_arch_objs)
apply (fastforce simp: a_type_def vs_refs_def)
done

18
proof/invariant-abstract/ARM/ArchArch_AI.thy
View File

@ -537,7 +537,7 @@ lemma cap_insert_simple_arch_caps_ap:
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
get_cap_wp static_imp_wp)
get_cap_wp static_imp_wp)+
apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps)
apply (rule conjI)
apply (clarsimp simp: vs_cap_ref_def)
@ -649,12 +649,13 @@ lemma perform_asid_control_invocation_st_tcb_at:
and ct_active and invs and valid_aci aci\<rbrace>
perform_asid_control_invocation aci
\<lbrace>\<lambda>y. st_tcb_at P t\<rbrace>"
including no_pre
apply (clarsimp simp: perform_asid_control_invocation_def split: asid_control_invocation.splits)
apply (rename_tac word1 a b aa ba word2)
apply (wp hoare_vcg_const_imp_lift retype_region_st_tcb_at set_cap_no_overlap|simp)+
apply (strengthen invs_valid_objs invs_psp_aligned)
apply (clarsimp simp:conj_comms)
apply (wp max_index_upd_invs_simple get_cap_wp)
apply (wp max_index_upd_invs_simple get_cap_wp)+
apply (rule hoare_name_pre_state)
apply (subgoal_tac "is_aligned word1 page_bits")
prefer 2
@ -939,6 +940,7 @@ lemma sts_valid_arch_inv:
lemma ensure_safe_mapping_inv [wp]:
"\<lbrace>P\<rbrace> ensure_safe_mapping m \<lbrace>\<lambda>_. P\<rbrace>"
including no_pre
apply (cases m, simp_all)
apply (case_tac a, simp)
apply (case_tac aa, simp_all)[1]
@ -952,9 +954,7 @@ lemma ensure_safe_mapping_inv [wp]:
(* the induct rule matches the wrong parameters first -> crunch blows up *)
lemma create_mapping_entries_inv [wp]:
"\<lbrace>P\<rbrace> create_mapping_entries base vptr vmsz R A pd \<lbrace>\<lambda>_. P\<rbrace>"
apply (induct vmsz)
apply (simp, wp lookup_pt_slot_inv)+
done
by (induct vmsz; wpsimp wp: lookup_pt_slot_inv)
crunch_ignore (add: select_ext)
@ -965,13 +965,7 @@ crunch inv [wp]: arch_decode_invocation "P"
lemma create_mappings_empty [wp]:
"\<lbrace>\<top>\<rbrace> create_mapping_entries base vptr vmsz R A pd \<lbrace>\<lambda>m s. empty_refs m\<rbrace>, -"
apply (cases vmsz, simp_all add: empty_refs_def)
apply (wp|simp)+
apply (rule hoare_pre)
apply (wp|simp add: pde_ref_def)+
apply (rule hoare_pre)
apply (wp|simp add: pde_ref_def)+
done
by (cases vmsz; wpsimp simp: pde_ref_def empty_refs_def)
lemma empty_pde_atI:

22
proof/invariant-abstract/ARM/ArchCNodeInv_AI.thy
View File

@ -23,6 +23,7 @@ lemma set_cap_in_device_frame[wp]:
(* 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>,-"
including no_pre
apply (cases cap, simp_all add: derive_cap_def is_zombie_def)
apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11]
apply (rename_tac arch_cap)
@ -31,21 +32,21 @@ lemma derive_cap_objrefs [CNodeInv_AI_assms]:
apply (rename_tac word option)
apply (case_tac option)
apply simp
apply (rule hoare_pre, wp)
apply (rule hoare_pre, wp+)
apply simp
apply (rule hoare_pre, wp)
apply (rule hoare_pre, wp+)
apply (simp add: aobj_ref_cases)
apply (rename_tac word option)
apply (case_tac option, simp)
apply (rule hoare_pre, wp)
apply (rule hoare_pre, wp+)
apply simp
apply (rule hoare_pre, wp)
apply clarsimp
done
lemma derive_cap_zobjrefs [CNodeInv_AI_assms]:
"\<lbrace>\<lambda>s. P (zobj_refs cap)\<rbrace> derive_cap slot cap \<lbrace>\<lambda>rv s. rv \<noteq> NullCap \<longrightarrow> P (zobj_refs rv)\<rbrace>,-"
including no_pre
apply (cases cap, simp_all add: derive_cap_def is_zombie_def)
apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11]
apply (rename_tac arch_cap)
@ -54,13 +55,13 @@ lemma derive_cap_zobjrefs [CNodeInv_AI_assms]:
apply (rename_tac option)
apply (case_tac option)
apply simp
apply (rule hoare_pre, wp)
apply (rule hoare_pre, wp+)
apply simp
apply (rule hoare_pre, wp)
apply (rule hoare_pre, wp+)
apply (simp add: aobj_ref_cases)
apply (rename_tac option)
apply (case_tac option, simp)
apply (rule hoare_pre, wp)
apply (rule hoare_pre, wp+)
apply simp
apply (rule hoare_pre, wp)
apply clarsimp
@ -611,7 +612,7 @@ next
apply (rule hoare_pre_spec_validE)
apply (wp replace_cap_invs | simp)+
apply (erule finalise_cap_not_reply_master)
apply (wp "2.hyps", assumption+)
apply (wp "2.hyps")
apply (wp preemption_point_Q | simp)+
apply (wp preemption_point_inv, simp+)
apply (wp preemption_point_Q)
@ -625,7 +626,7 @@ next
| wp replace_cap_invs set_cap_sets final_cap_same_objrefs
set_cap_cte_cap_wp_to static_imp_wp
| erule finalise_cap_not_reply_master)+
apply (wp hoare_vcg_const_Ball_lift)
apply (wp hoare_vcg_const_Ball_lift)+
apply (rule hoare_strengthen_post)
apply (rule_tac Q="\<lambda>fin s. Q s \<and> invs s \<and> replaceable s slot (fst fin) rv
\<and> cte_wp_at (op = rv) slot s \<and> s \<turnstile> (fst fin)
@ -851,7 +852,7 @@ next
apply (rule hoare_pre_spec_validE)
apply wp
apply ((wp | simp)+)[1]
apply (wp wp, assumption+)
apply (wp wp)
apply ((wp preemption_point_inv | simp)+)[1]
apply (simp(no_asm))
apply (rule wp, assumption+)
@ -955,6 +956,7 @@ lemma cap_move_invs[wp, CNodeInv_AI_assms]:
and K (\<not> is_master_reply_cap cap)\<rbrace>
cap_move cap ptr ptr'
\<lbrace>\<lambda>rv. invs\<rbrace>"
including no_pre
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

4
proof/invariant-abstract/ARM/ArchCSpace_AI.thy
View File

@ -273,7 +273,7 @@ lemma cap_insert_valid_arch_caps [CSpace_AI_assms]:
apply (erule iffD2[OF caps_of_state_cteD'])
apply (wp set_untyped_cap_as_full_cte_wp_at hoare_vcg_all_lift hoare_vcg_imp_lift
set_untyped_cap_as_full_cte_wp_at_neg hoare_vcg_ex_lift | clarsimp)+
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply (intro conjI allI impI disj_subst)
apply simp
apply clarsimp
@ -514,7 +514,7 @@ lemma cap_insert_simple_arch_caps_no_ap:
set_untyped_cap_as_full_empty_table_at hoare_vcg_ex_lift
set_untyped_cap_as_full_caps_of_state_diff[where dest=dest]
| wps)+
apply (wp get_cap_wp)
apply (wp get_cap_wp)+
apply (clarsimp simp: cte_wp_at_caps_of_state)
apply (intro conjI impI allI)
by (auto simp:is_simple_cap_def[simplified is_simple_cap_arch_def] is_cap_simps)

25
proof/invariant-abstract/ARM/ArchDetSchedAux_AI.thy
View File

@ -79,11 +79,10 @@ lemma invoke_untyped_etcb_at [DetSchedAux_AI_assms]:
apply (cases ui)
apply (simp add: mapM_x_def[symmetric] invoke_untyped_def whenE_def
split del: if_split)
apply (rule hoare_pre)
apply (wp retype_region_etcb_at mapM_x_wp'
create_cap_no_pred_tcb_at typ_at_pred_tcb_at_lift
hoare_convert_imp[OF create_cap_no_pred_tcb_at]
hoare_convert_imp[OF _ init_arch_objects_exst]
apply (wp retype_region_etcb_at mapM_x_wp'
create_cap_no_pred_tcb_at typ_at_pred_tcb_at_lift
hoare_convert_imp[OF create_cap_no_pred_tcb_at]
hoare_convert_imp[OF _ init_arch_objects_exst]
| simp
| (wp_once hoare_drop_impE_E))+
done
@ -123,10 +122,10 @@ lemma perform_asid_control_etcb_at:"\<lbrace>(\<lambda>s. etcb_at P t s) and val
\<lbrace>\<lambda>r s. st_tcb_at (Not \<circ> inactive) t s \<longrightarrow> etcb_at P t s\<rbrace>"
apply (simp add: perform_asid_control_invocation_def)
apply (rule hoare_pre)
apply ( wp | wpc | simp)+
apply (wp | wpc | simp)+
apply (wp hoare_imp_lift_something typ_at_pred_tcb_at_lift)[1]
apply (rule hoare_drop_imps)
apply (wp retype_region_etcb_at)
apply (wp retype_region_etcb_at)+
apply simp
done
@ -150,15 +149,15 @@ lemma perform_asid_control_invocation_valid_sched:
\<lbrace>\<lambda>_. valid_sched\<rbrace>"
apply (rule hoare_pre)
apply (rule_tac I="invs and ct_active and valid_aci aci" in valid_sched_tcb_state_preservation)
apply (wp perform_asid_control_invocation_st_tcb_at)
apply simp
apply (wp perform_asid_control_etcb_at)
apply (rule hoare_strengthen_post, rule aci_invs)
apply (simp add: invs_def valid_state_def)
apply (wp perform_asid_control_invocation_st_tcb_at)
apply simp
apply (wp perform_asid_control_etcb_at)+
apply (rule hoare_strengthen_post, rule aci_invs)
apply (simp add: invs_def valid_state_def)
apply (rule hoare_lift_Pf[where f="\<lambda>s. scheduler_action s"])
apply (rule hoare_lift_Pf[where f="\<lambda>s. cur_domain s"])
apply (rule hoare_lift_Pf[where f="\<lambda>s. idle_thread s"])
apply wp
apply wp+
apply simp
done

3
proof/invariant-abstract/ARM/ArchEmptyFail_AI.thy
View File

@ -99,7 +99,8 @@ lemma arch_decode_invocation_empty_fail[wp]:
apply (find_goal \<open>succeeds \<open>erule arch_decode_ARMASIDControlMakePool_empty_fail\<close>\<close>)
apply (find_goal \<open>succeeds \<open>erule arch_decode_ARMASIDPoolAssign_empty_fail\<close>\<close>)
apply ((simp add: arch_decode_ARMASIDControlMakePool_empty_fail arch_decode_ARMASIDPoolAssign_empty_fail)+)[2]
by ((simp add: arch_decode_invocation_def Let_def split: arch_cap.splits cap.splits option.splits | wp | intro conjI impI allI)+)
including no_pre
by ((simp add: arch_decode_invocation_def Let_def split: arch_cap.splits cap.splits option.splits | (wp+) | intro conjI impI allI)+)
end

33
proof/invariant-abstract/ARM/ArchFinalise_AI.thy
View File

@ -96,7 +96,7 @@ lemma delete_asid_pool_invs[wp]:
apply (rule hoare_vcg_conj_lift,
(rule mapM_invalidate[where ptr=pptr])?,
((wp mapM_wp' | simp add: if_apply_def2)+)[1])+
apply wp
apply wp+
apply (clarsimp simp: is_aligned_mask[symmetric])
apply (rule conjI)
apply (rule vs_lookupI)
@ -112,7 +112,7 @@ lemma delete_asid_invs[wp]:
apply (simp add: delete_asid_def cong: option.case_cong)
apply (wp set_asid_pool_invs_unmap | wpc)+
apply (simp add: invalidate_asid_entry_def invalidate_asid_def invalidate_hw_asid_entry_def)
apply (wp load_hw_asid_wp)
apply (wp load_hw_asid_wp)+
apply (simp add: flush_space_def)
apply (wp load_hw_asid_wp|wpc)+
apply (clarsimp simp del: fun_upd_apply)
@ -148,9 +148,9 @@ lemma delete_asid_pool_unmapped[wp]:
apply (simp add: delete_asid_pool_def)
apply wp
apply (rule hoare_strengthen_post [where Q="\<lambda>_. \<top>"])
apply wp
apply wp+
defer
apply wp
apply wp+
apply (clarsimp simp: vs_lookup_def vs_asid_refs_def
dest!: graph_ofD)
apply (erule rtranclE)
@ -228,7 +228,7 @@ lemma unmap_page_tcb_cap_valid:
apply (rule tcb_cap_valid_typ_st)
apply wp
apply (simp add: pred_tcb_at_def2)
apply (wp unmap_page_tcb_at hoare_vcg_ex_lift hoare_vcg_all_lift)
apply (wp unmap_page_tcb_at hoare_vcg_ex_lift hoare_vcg_all_lift)+
done
global_naming Arch
@ -525,6 +525,7 @@ lemma (* finalise_cap_replaceable *) [Finalise_AI_asms]:
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
@ -898,17 +899,17 @@ lemma delete_asid_empty_table_pd:
\<and> obj_at (empty_table (set (arm_global_pts (arch_state s)))) word s\<rbrace>
delete_asid a word
\<lbrace>\<lambda>_ s. obj_at (empty_table (set (arm_global_pts (arch_state s)))) word s\<rbrace>"
apply (simp add: delete_asid_def)
apply (wp | wpc)+
apply wps
apply wp
apply (simp add: set_asid_pool_def)
apply wp
apply (case_tac "x2 = word")
defer
apply (simp add: delete_asid_def)
apply (wp | wpc)+
apply wps
apply (rule set_object_at_obj)
apply (wp get_object_ret | wps)+
apply wp+
apply (simp add: set_asid_pool_def)
apply wp
apply (case_tac "x2 = word")
defer
apply wps
apply (rule set_object_at_obj)
apply (wp get_object_ret | wps)+
apply (clarsimp simp: obj_at_def empty_table_def)+
done
@ -1655,7 +1656,7 @@ lemma delete_asid_pool_unmapped2:
apply simp
apply (wp mapM_wp')
apply clarsimp
apply wp
apply wp+
apply clarsimp
done

1
proof/invariant-abstract/ARM/ArchInterrupt_AI.thy
View File

@ -121,7 +121,6 @@ lemma invoke_irq_handler_invs'[Interrupt_AI_asms]:
show ?thesis
apply (cases i, simp_all)
apply (wp maskInterrupt_invs_ARCH)
apply simp
apply simp
apply (rename_tac irq cap prod)
apply (rule hoare_pre)

10
proof/invariant-abstract/ARM/ArchInvariants_AI.thy
View File

@ -979,8 +979,8 @@ lemma valid_arch_objs_stateI:
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>"
apply (simp add: valid_arch_cap_def)
apply (case_tac c, simp_all)
unfolding valid_arch_cap_def
apply (case_tac c; simp)
apply (wp P hoare_vcg_ball_lift hoare_vcg_imp_lift hoare_vcg_conj_lift | clarsimp)+
done
@ -992,11 +992,11 @@ lemma valid_arch_obj_typ:
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 P)
apply (wp hoare_vcg_disj_lift P)
apply (wp hoare_vcg_disj_lift P)+
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 P)
apply (wp hoare_vcg_disj_lift P)
apply (wp hoare_vcg_disj_lift P)+
done
@ -1230,7 +1230,7 @@ lemma valid_arch_state_lift:
apply (simp add: valid_arch_state_def valid_asid_table_def
valid_global_pts_def)
apply (rule hoare_lift_Pf[where f="\<lambda>s. arch_state s"])
apply (wp arch typs hoare_vcg_conj_lift hoare_vcg_const_Ball_lift )
apply (wp arch typs hoare_vcg_conj_lift hoare_vcg_const_Ball_lift)+
done
lemma aobj_at_default_arch_cap_valid:

18
proof/invariant-abstract/ARM/ArchIpc_AI.thy
View File

@ -97,7 +97,7 @@ lemma derive_cap_is_derived [Ipc_AI_assms]:
| erule cte_wp_at_weakenE
| simp split: cap.split_asm)+)[11]
apply(wp, simp add: o_def)
apply(rule hoare_pre, wp hoare_drop_imps arch_derive_cap_is_derived)
apply(wp hoare_drop_imps arch_derive_cap_is_derived)
apply(clarify, drule cte_wp_at_eqD, clarify)
apply(frule(1) cte_wp_at_valid_objs_valid_cap)
apply(erule cte_wp_at_weakenE)
@ -184,7 +184,7 @@ lemma arch_derive_cap_objrefs_iszombie [Ipc_AI_assms]:
arch_derive_cap cap
\<lbrace>\<lambda>rv s. P (set_option (aobj_ref rv)) False s\<rbrace>,-"
apply(cases cap, simp_all add: is_zombie_def arch_derive_cap_def)
apply(rule hoare_pre, wpc?, wp, simp)+
apply(rule hoare_pre, wpc?, wp+, simp)+
done
lemma obj_refs_remove_rights[simp, Ipc_AI_assms]:
@ -462,6 +462,7 @@ lemma do_ipc_transfer_respects_device_region[Ipc_AI_cont_assms]:
"\<lbrace>cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\<rbrace>
do_ipc_transfer t ep bg grt r
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
including no_pre
apply (simp add: do_ipc_transfer_def)
apply (wp|wpc)+
apply (simp add: do_normal_transfer_def transfer_caps_def bind_assoc)
@ -472,13 +473,13 @@ lemma do_ipc_transfer_respects_device_region[Ipc_AI_cont_assms]:
apply (subst ball_conj_distrib)
apply (wp get_rs_cte_at2 thread_get_wp static_imp_wp grs_distinct
hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift | simp)+
apply (rule hoare_strengthen_post[where Q = "\<lambda>r s. cap_refs_respects_device_region s
\<and> valid_objs s \<and> valid_mdb s \<and> obj_at (\<lambda>ko. \<exists>tcb. ko = TCB tcb) t s"])
apply (rule hoare_strengthen_post[where Q = "\<lambda>r s. cap_refs_respects_device_region s
\<and> valid_objs s \<and> valid_mdb s \<and> obj_at (\<lambda>ko. \<exists>tcb. ko = TCB tcb) t s"])
apply wp
apply (clarsimp simp: obj_at_def is_tcb_def)
apply (simp split: kernel_object.split_asm)
apply auto
done
apply (clarsimp simp: obj_at_def is_tcb_def)
apply (simp split: kernel_object.split_asm)
apply auto
done
end
@ -487,4 +488,5 @@ interpretation Ipc_AI?: Ipc_AI_cont
interpret Arch .
case 1 show ?case by (unfold_locales;(fact Ipc_AI_cont_assms)?)
qed
end

27
proof/invariant-abstract/ARM/ArchKHeap_AI.thy
View File

@ -265,7 +265,7 @@ lemma valid_vs_lookup_lift:
unfolding valid_vs_lookup_def
apply (rule hoare_lift_Pf [where f=vs_lookup_pages])
apply (rule hoare_lift_Pf [where f="\<lambda>s. (caps_of_state s)"])
apply (wp lookup cap)
apply (wp lookup cap)+
done
@ -277,7 +277,7 @@ lemma valid_table_caps_lift:
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. arm_global_pts (arch_state s)"])
apply (wp cap pts hoare_vcg_all_lift hoare_vcg_const_imp_lift obj)
apply (wp cap pts hoare_vcg_all_lift hoare_vcg_const_imp_lift obj)+
done
lemma valid_arch_caps_lift:
@ -362,7 +362,7 @@ lemma arch_lifts:
subgoal
apply (rule valid_global_objs_lift)
apply (wp arch)
apply (wp arch)+
apply (simp add: valid_ao_at_def)
apply (rule hoare_vcg_ex_lift)
apply (rule hoare_vcg_conj_lift)
@ -405,6 +405,7 @@ lemma arch_lifts:
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 simp
done
done
@ -418,7 +419,7 @@ lemma equal_kernel_mappings_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 arch_obj_pred_arch_obj_l])+
done
lemma valid_machine_state_lift:
@ -430,25 +431,9 @@ lemma valid_machine_state_lift:
apply (rule hoare_vcg_all_lift)
apply (rule hoare_vcg_disj_lift[OF _ hoare_vcg_prop])
apply (rule in_user_frame_lift)
apply (wp aobj_at)
apply simp
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>"

Some files were not shown because too many files have changed in this diff Show More