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

arm: update for simple_ko getter/setter

This commit is contained in:
Miki Tanaka 2017-11-27 15:59:58 +11:00
parent b37bc04463
commit 2a1beffac1
25 changed files with 410 additions and 500 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -666,10 +666,9 @@ lemma set_endpoinintegrity:
and K (\<exists>auth. aag_has_auth_to aag auth epptr \<and> auth \<in> {Receive, SyncSend, Reset})\<rbrace>
set_endpoint epptr ep'
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: set_endpoint_def set_object_def)
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp simp: obj_at_def)
apply (case_tac koa, simp_all)
apply (clarsimp simp: obj_at_def partial_inv_def a_type_def)
apply (erule integrity_trans)
apply (clarsimp simp: integrity_def tro_ep)
done
@ -733,85 +732,45 @@ lemma set_thread_state_pas_refined:
split: if_split_asm)
done
lemma set_ep_vrefs[wp]:
"\<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace> set_endpoint ptr val \<lbrace>\<lambda>rv s. P (state_vrefs s)\<rbrace>"
apply (simp add: set_endpoint_def set_object_def)
apply (wp get_object_wp)
lemma set_simple_ko_vrefs[wp]:
"\<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace> set_simple_ko f ptr val \<lbrace>\<lambda>rv s. P (state_vrefs s)\<rbrace>"
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp; clarsimp; rule conjI)
apply (clarsimp simp: state_vrefs_def vs_refs_no_global_pts_def obj_at_def
partial_inv_def a_type_def
elim!: rsubst[where P=P, OF _ ext]
split: Structures_A.kernel_object.split_asm)
split: Structures_A.kernel_object.split_asm)+
done
lemma set_ep_thread_states[wp]:
"\<lbrace>\<lambda>s. P (thread_states s)\<rbrace> set_endpoint ptr val \<lbrace>\<lambda>rv s. P (thread_states s)\<rbrace>"
apply (simp add: set_endpoint_def set_object_def)
apply (wp get_object_wp)
lemma set_simple_ko_thread_states[wp]:
"\<lbrace>\<lambda>s. P (thread_states s)\<rbrace> set_simple_ko f ptr val \<lbrace>\<lambda>rv s. P (thread_states s)\<rbrace>"
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp; clarsimp; rule conjI)
apply (clarsimp simp: thread_states_def obj_at_def get_tcb_def tcb_states_of_state_def
partial_inv_def a_type_def
elim!: rsubst[where P=P, OF _ ext]
split: Structures_A.kernel_object.split_asm option.split)
split: Structures_A.kernel_object.split_asm option.split)+
done
lemma set_ep_thread_bound_ntfns[wp]:
"\<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace> set_endpoint ptr val \<lbrace>\<lambda>rv s. P (thread_bound_ntfns s)\<rbrace>"
apply (simp add: set_endpoint_def set_object_def)
apply (wp get_object_wp)
lemma set_simple_ko_thread_bound_ntfns[wp]:
"\<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace> set_simple_ko f ptr val \<lbrace>\<lambda>rv s. P (thread_bound_ntfns s)\<rbrace>"
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp; clarsimp; rule conjI)
apply (clarsimp simp: thread_bound_ntfns_def obj_at_def get_tcb_def tcb_states_of_state_def
partial_inv_def a_type_def
elim!: rsubst[where P=P, OF _ ext]
split: Structures_A.kernel_object.split_asm option.split)
split: Structures_A.kernel_object.split_asm option.split)+
done
(* FIXME move to AInvs *)
lemma set_endpoint_ekheap[wp]:
"\<lbrace>\<lambda>s. P (ekheap s)\<rbrace> set_endpoint ptr ep \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
apply (simp add: set_endpoint_def)
lemma set_simple_ko_ekheap[wp]:
"\<lbrace>\<lambda>s. P (ekheap s)\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
apply (simp add: set_simple_ko_def)
apply (wp get_object_wp | simp)+
done
lemma set_endpoint_pas_refined[wp]:
"\<lbrace>pas_refined aag\<rbrace> set_endpoint ptr ep \<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: pas_refined_def state_objs_to_policy_def)
apply (rule hoare_pre)
apply (wp tcb_domain_map_wellformed_lift | wps)+
apply simp
done
lemma set_ntfn_vrefs[wp]:
"\<lbrace>\<lambda>s. P (state_vrefs s)\<rbrace> set_notification ptr val \<lbrace>\<lambda>rv s. P (state_vrefs s)\<rbrace>"
apply (simp add: set_notification_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp simp: state_vrefs_def vs_refs_no_global_pts_def obj_at_def
elim!: rsubst[where P=P, OF _ ext]
split: Structures_A.kernel_object.split_asm)
done
lemma set_ntfn_thread_states[wp]:
"\<lbrace>\<lambda>s. P (thread_states s)\<rbrace> set_notification ptr val \<lbrace>\<lambda>rv s. P (thread_states s)\<rbrace>"
apply (simp add: set_notification_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp simp: thread_states_def obj_at_def get_tcb_def tcb_states_of_state_def
elim!: rsubst[where P=P, OF _ ext]
split: Structures_A.kernel_object.split_asm option.split)
done
lemma set_ntfn_thread_bound_ntfns[wp]:
"\<lbrace>\<lambda>s. P (thread_bound_ntfns s)\<rbrace> set_notification ptr val \<lbrace>\<lambda>rv s. P (thread_bound_ntfns s)\<rbrace>"
apply (simp add: set_notification_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp simp: thread_bound_ntfns_def obj_at_def get_tcb_def tcb_states_of_state_def
elim!: rsubst[where P=P, OF _ ext]
split: Structures_A.kernel_object.split_asm option.split)
done
(* FIXME move to AInvs *)
lemma set_notification_ekheap[wp]:
"\<lbrace>\<lambda>s. P (ekheap s)\<rbrace> set_notification ptr ntfn \<lbrace>\<lambda>rv s. P (ekheap s)\<rbrace>"
apply (simp add: set_notification_def)
apply (wp get_object_wp)
apply simp
done
lemma set_notification_pas_refined:
"\<lbrace>pas_refined aag\<rbrace> set_notification ptr ntfn \<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
lemma set_simple_ko_pas_refined[wp]:
"\<lbrace>pas_refined aag\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: pas_refined_def state_objs_to_policy_def)
apply (rule hoare_pre)
apply (wp tcb_domain_map_wellformed_lift | wps)+
@ -1106,10 +1065,9 @@ lemma set_ntfn_respects:
and K (\<exists>auth. aag_has_auth_to aag auth epptr \<and> auth \<in> {Receive, Notify, Reset})\<rbrace>
set_notification epptr ep'
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: set_notification_def set_object_def)
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp simp: obj_at_def)
apply (case_tac ko, simp_all)
apply (clarsimp simp: obj_at_def partial_inv_def a_type_def)
apply (erule integrity_trans)
apply (clarsimp simp: integrity_def tro_ntfn)
done

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

@ -10,7 +10,7 @@
theory DomainSepInv
imports
"Ipc_AC" (* for transfer_caps_loop_pres_dest lec_valid_cap' set_endpoint_get_tcb thread_set_tcb_fault_update_valid_mdb *)
"Ipc_AC" (* for transfer_caps_loop_pres_dest lec_valid_cap' set_simple_ko_get_tcb thread_set_tcb_fault_update_valid_mdb *)
"../../lib/Monad_WP/wp/WPBang"
begin
@ -325,30 +325,18 @@ lemma empty_slot_domain_sep_inv:
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>"
apply(simp add: set_endpoint_def)
apply(wp set_object_wp get_object_wp | simp)+
lemma set_simple_ko_neg_cte_wp_at[wp]:
"\<lbrace>\<lambda>s. \<not> cte_wp_at P slot s\<rbrace> set_simple_ko f a b \<lbrace>\<lambda>_ s. \<not> cte_wp_at P slot s\<rbrace>"
apply(simp add: set_simple_ko_def)
apply(wp set_object_wp get_object_wp
| simp add: partial_inv_def a_type_def split: kernel_object.splits)+
apply(case_tac "a = fst slot")
apply(clarsimp split: kernel_object.splits)
apply(fastforce elim: cte_wp_atE simp: obj_at_def)
apply(fastforce elim: cte_wp_atE intro: cte_wp_at_cteI cte_wp_at_tcbI)
done
lemma set_notification_neg_cte_wp_at[wp]:
"\<lbrace>\<lambda>s. \<not> cte_wp_at P slot s\<rbrace> set_notification a b \<lbrace>\<lambda>_ s. \<not> cte_wp_at P slot s\<rbrace>"
apply(simp add: set_notification_def)
apply(wp set_object_wp get_object_wp | simp)+
apply(case_tac "a = fst slot")
apply(clarsimp split: kernel_object.splits)
apply(fastforce elim: cte_wp_atE simp: obj_at_def)
apply(fastforce elim: cte_wp_atE intro: cte_wp_at_cteI cte_wp_at_tcbI)
done
crunch domain_sep_inv[wp]: set_endpoint "domain_sep_inv irqs st"
(wp: domain_sep_inv_triv)
crunch domain_sep_inv[wp]: set_notification "domain_sep_inv irqs st"
crunch domain_sep_inv[wp]: set_simple_ko "domain_sep_inv irqs st"
(wp: domain_sep_inv_triv)
lemma set_thread_state_neg_cte_wp_at[wp]:
@ -1010,10 +998,10 @@ lemma send_ipc_domain_sep_inv:
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 get_simple_ko_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
valid_simple_obj_def a_type_def ep_redux_simps neq_Nil_conv valid_ep_def case_list_cons_cong
elim: ep_queued_st_tcb_at)
done
@ -1042,8 +1030,8 @@ lemma receive_ipc_base_domain_sep_inv:
| wpc | simp split del: if_split)+
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 hoare_vcg_all_lift | wpc | simp)+
apply(wp hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1] hoare_vcg_all_lift get_endpoint_wp
| wpc | simp add: do_nbrecv_failed_transfer_def)+
apply(wp hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1] hoare_vcg_all_lift get_simple_ko_wp
| wpc | simp add: valid_simple_obj_def a_type_def do_nbrecv_failed_transfer_def)+
apply (clarsimp simp: conj_comms)
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def
ep_redux_simps neq_Nil_conv valid_ep_def case_list_cons_cong)
@ -1056,10 +1044,10 @@ lemma receive_ipc_domain_sep_inv:
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
unfolding receive_ipc_def
apply (simp add: receive_ipc_def split: cap.splits, clarsimp)
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_seq_ext[OF _ gbn_sp])
apply (case_tac ntfnptr, simp)
apply (wp receive_ipc_base_domain_sep_inv get_ntfn_wp | simp split: if_split option.splits)+
apply (wp receive_ipc_base_domain_sep_inv get_simple_ko_wp | simp split: if_split option.splits)+
done
lemma send_fault_ipc_domain_sep_inv:
@ -1333,7 +1321,7 @@ lemma handle_recv_domain_sep_inv:
apply (simp add: handle_recv_def Let_def lookup_cap_def split_def)
apply (wp hoare_vcg_all_lift lookup_slot_for_thread_cap_fault
receive_ipc_domain_sep_inv delete_caller_cap_domain_sep_inv
get_cap_wp get_ntfn_wp
get_cap_wp get_simple_ko_wp
| wpc | simp
| rule_tac Q="\<lambda>rv. invs and (\<lambda>s. cur_thread s = thread)" in hoare_strengthen_post, wp,
clarsimp simp: invs_valid_objs invs_sym_refs)+

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

@ -87,7 +87,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_simple_ko_wp)+
apply clarsimp
apply (frule(1) sym_refs_ko_atD)
apply (frule ko_at_state_refs_ofD)
@ -107,12 +107,13 @@ lemma cancel_all_ipc_respects [wp]:
apply (clarsimp simp add: cancel_all_ipc_def get_ep_queue_def cong: Structures_A.endpoint.case_cong)
apply (wp mapM_x_inv_wp2 [where I = "integrity aag X st" and V = "\<lambda>q s. distinct q \<and> (\<forall>x \<in> set q. st_tcb_at (blocked_on epptr) x s)"]
sts_respects_restart_ep sts_st_tcb_at_neq hoare_vcg_ball_lift set_endpoinintegrity
get_endpoint_wp
get_simple_ko_wp
| wpc
| clarsimp
| blast)+
apply (frule ko_at_state_refs_ofD)
apply (rule obj_at_valid_objsE, assumption, assumption)
apply (rename_tac ep ko)
apply (subgoal_tac "\<forall>x \<in> ep_q_refs_of ep. st_tcb_at (blocked_on epptr) (fst x) s")
apply (fastforce simp: valid_obj_def valid_ep_def obj_at_def is_ep_def split: Structures_A.endpoint.splits)
apply clarsimp
@ -181,13 +182,13 @@ lemma sbn_pas_refined[wp]:
lemma unbind_notification_pas_refined[wp]:
"\<lbrace>pas_refined aag\<rbrace> unbind_notification t \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
apply (clarsimp simp: unbind_notification_def)
apply (wp set_notification_pas_refined | wpc | simp)+
apply (wp set_simple_ko_pas_refined | wpc | simp)+
done
lemma unbind_maybe_notification_pas_refined[wp]:
"\<lbrace>pas_refined aag\<rbrace> unbind_maybe_notification a \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
apply (clarsimp simp: unbind_maybe_notification_def)
apply (wp set_notification_pas_refined | wpc | simp)+
apply (wp set_simple_ko_pas_refined | wpc | simp)+
done
crunch pas_refined[wp]: cap_delete_one "pas_refined aag"
@ -236,7 +237,7 @@ lemma cancel_all_signals_respects [wp]:
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (rule hoare_gen_asm)
apply (clarsimp simp add: cancel_all_signals_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp], rule hoare_pre)
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp], rule hoare_pre)
apply (wp mapM_x_inv_wp2 [where I = "integrity aag X st" and V = "\<lambda>q s. distinct q \<and> (\<forall>x \<in> set q. st_tcb_at (blocked_on epptr) x s)"]
sts_respects_restart_ep sts_st_tcb_at_neq hoare_vcg_ball_lift set_ntfn_respects
| wpc
@ -287,7 +288,7 @@ lemma unbind_notification_bound_respects:
"\<lbrace>integrity aag X st and pas_refined aag and (\<lambda>s. bound_tcb_at (\<lambda>a. a = Some ntfn) t s \<and>
(pasSubject aag, Reset, pasObjectAbs aag ntfn) \<in> pasPolicy aag)\<rbrace> unbind_notification t \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
apply (clarsimp simp: unbind_notification_def)
apply (wp_trace set_ntfn_respects hoare_vcg_imp_lift hoare_vcg_ex_lift gbn_wp | wpc | simp del: set_bound_notification_def)+
apply (wp set_ntfn_respects hoare_vcg_imp_lift hoare_vcg_ex_lift gbn_wp | wpc | simp del: set_bound_notification_def)+
apply clarsimp
apply (fastforce simp: pred_tcb_at_def obj_at_def)+
done
@ -316,7 +317,7 @@ lemma unbind_maybe_notification_respects:
unbind_maybe_notification a \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
apply (clarsimp simp: unbind_maybe_notification_def)
apply (rule hoare_pre)
apply (wp set_ntfn_respects get_ntfn_wp hoare_vcg_ex_lift gbn_wp | wpc | simp)+
apply (wp set_ntfn_respects get_simple_ko_wp hoare_vcg_ex_lift gbn_wp | wpc | simp)+
apply clarsimp
apply (frule_tac P="\<lambda>ntfn. ntfn = Some a" in ntfn_bound_tcb_at[OF invs_sym_refs invs_valid_objs], (simp add: obj_at_def)+)
apply (auto simp: pred_tcb_at_def obj_at_def split: option.splits)
@ -327,7 +328,7 @@ lemma fast_finalise_respects[wp]:
fast_finalise cap fin
\<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
apply (cases cap, simp_all)
apply (wp unbind_maybe_notification_valid_objs get_ntfn_wp unbind_maybe_notification_respects
apply (wp unbind_maybe_notification_valid_objs get_simple_ko_wp unbind_maybe_notification_respects
| wpc
| simp add: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def when_def
split: if_split_asm
@ -373,7 +374,7 @@ lemma cancel_signal_respects[wp]:
cancel_signal t ntfnptr
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: cancel_signal_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wp set_thread_state_integrity_autarch set_ntfn_respects
| wpc | fastforce)+
@ -386,7 +387,7 @@ lemma cancel_ipc_respects[wp]:
apply (simp add: cancel_ipc_def)
apply (rule hoare_seq_ext[OF _ gts_sp])
apply (rule hoare_pre)
apply (wp set_thread_state_integrity_autarch set_endpoinintegrity get_endpoint_wp
apply (wp set_thread_state_integrity_autarch set_endpoinintegrity get_simple_ko_wp
| wpc
| simp(no_asm) add: blocked_cancel_ipc_def get_ep_queue_def
get_blocking_object_def)+
@ -449,7 +450,7 @@ lemma finalise_cap_respects[wp]:
apply (wp |clarsimp simp: invs_valid_objs invs_sym_refs cap_auth_conferred_def
cap_rights_to_auth_def aag_cap_auth_def)+
(*NTFN Cap*)
apply ((wp unbind_maybe_notification_valid_objs get_ntfn_wp
apply ((wp unbind_maybe_notification_valid_objs get_simple_ko_wp
unbind_maybe_notification_respects
| wpc
| simp add: cap_auth_conferred_def cap_rights_to_auth_def aag_cap_auth_def split: if_split_asm

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

@ -36,7 +36,7 @@ lemma cancel_ipc_receive_blocked_caps_of_state:
lemma send_signal_caps_of_state[wp]:
"\<lbrace>\<lambda>s :: det_ext state. P (caps_of_state s) \<rbrace> send_signal ntfnptr badge \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
apply (clarsimp simp: send_signal_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wp dxo_wp_weak cancel_ipc_receive_blocked_caps_of_state gts_wp static_imp_wp | wpc | simp add: update_waiting_ntfn_def)+
apply (clarsimp simp: fun_upd_def[symmetric] st_tcb_def2)
@ -60,7 +60,7 @@ lemma cancel_ipc_receive_blocked_mdb:
lemma send_signal_mdb[wp]:
"\<lbrace>\<lambda>s. P (cdt (s :: det_ext state))\<rbrace> send_signal ntfnptr badge \<lbrace>\<lambda>rv s. P (cdt s)\<rbrace>"
apply (clarsimp simp: send_signal_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wp dxo_wp_weak gts_wp cancel_ipc_receive_blocked_mdb | wpc | simp)+
apply (clarsimp simp: st_tcb_def2)
@ -74,7 +74,7 @@ lemma update_waiting_ntfn_pas_refined:
update_waiting_ntfn ntfnptr queue badge val
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: update_waiting_ntfn_def)
apply (wp set_thread_state_pas_refined set_notification_pas_refined | simp)+
apply (wp set_thread_state_pas_refined set_simple_ko_pas_refined | simp)+
done
@ -90,9 +90,9 @@ lemma cancel_ipc_receive_blocked_pas_refined:
lemma send_signal_pas_refined:
"\<lbrace>\<lambda>s. pas_refined aag s\<rbrace> send_signal ntfnptr badge \<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: send_signal_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wp set_notification_pas_refined update_waiting_ntfn_pas_refined gts_wp set_thread_state_pas_refined
apply (wp set_simple_ko_pas_refined update_waiting_ntfn_pas_refined gts_wp set_thread_state_pas_refined
cancel_ipc_receive_blocked_pas_refined
| wpc
| simp)+
@ -106,9 +106,9 @@ lemma receive_signal_pas_refined:
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: receive_signal_def)
apply (cases cap, simp_all)
apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
apply (rule hoare_seq_ext [OF _ get_simple_ko_sp])
apply (rule hoare_pre)
by (wp set_notification_pas_refined set_thread_state_pas_refined
by (wp set_simple_ko_pas_refined set_thread_state_pas_refined
| wpc | simp add: do_nbrecv_failed_transfer_def)+
@ -271,10 +271,9 @@ lemma set_notification_respects:
"\<lbrace>integrity aag X st and K (aag_has_auth_to aag auth epptr \<and> auth \<in> {Receive, Notify, Reset})\<rbrace>
set_notification epptr ntfn'
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: set_notification_def set_object_def)
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp simp: obj_at_def)
apply (case_tac ko, simp_all)
apply (clarsimp simp: obj_at_def partial_inv_def a_type_def)
apply (erule integrity_trans)
apply (clarsimp simp: integrity_def tro_ntfn)
done
@ -287,7 +286,7 @@ lemma receive_signal_integrity_autarch:
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: receive_signal_def)
apply (cases cap, simp_all)
apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
apply (rule hoare_seq_ext [OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wp set_notification_respects[where auth=Receive] set_thread_state_integrity_autarch as_user_integrity_autarch
| wpc
@ -410,17 +409,18 @@ lemma set_notification_obj_at:
"\<lbrace>obj_at P ptr and K (ptr \<noteq> ntfnptr)\<rbrace>
set_notification ntfnptr queue
\<lbrace>\<lambda>rv. obj_at P ptr\<rbrace>"
apply (simp add: set_notification_def set_object_def)
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp)
apply (auto simp: obj_at_def)
done
lemma set_ntfn_valid_objs_at:
"\<lbrace>valid_objs and (\<lambda>s. ntfn_at p s \<longrightarrow> valid_ntfn ntfn s)\<rbrace> set_notification p ntfn \<lbrace>\<lambda>rv. valid_objs\<rbrace>"
unfolding set_notification_def
unfolding set_simple_ko_def
apply (rule hoare_pre)
apply (wp set_object_valid_objs get_object_wp)
apply (clarsimp simp: valid_obj_def obj_at_def is_ntfn split: Structures_A.kernel_object.splits)
apply (clarsimp simp: valid_obj_def obj_at_def is_ntfn partial_inv_def
split: Structures_A.kernel_object.splits)
done
lemma drop_Suc0_iff:
@ -490,11 +490,11 @@ lemma cancel_ipc_receive_blocked_respects:
apply (rule hoare_seq_ext[OF _ gts_sp])
apply (rule hoare_name_pre_state)
apply (subgoal_tac "case state of BlockedOnReceive x \<Rightarrow> True | _ \<Rightarrow> False")
apply (simp add: blocked_cancel_ipc_def bind_assoc set_endpoint_def set_object_def
apply (simp add: blocked_cancel_ipc_def bind_assoc set_simple_ko_def set_object_def
get_ep_queue_def get_blocking_object_def
split: thread_state.splits)
apply (rule hoare_pre)
apply (wp set_thread_state_integrity_once_ts_upd get_object_wp get_endpoint_wp
apply (wp set_thread_state_integrity_once_ts_upd get_object_wp get_simple_ko_wp
| wpc)+
apply (clarsimp simp: st_tcb_at_def2 obj_at_def)
apply (drule_tac t="tcb_state tcb" in sym)
@ -518,7 +518,7 @@ lemma cancel_ipc_receive_blocked_respects:
apply (rule disjI2)
apply (clarsimp simp: indirect_send_def pred_tcb_at_def obj_at_def)
apply (clarsimp simp: pred_tcb_at_def obj_at_def)
apply (clarsimp simp: pred_tcb_at_def obj_at_def receive_blocked_def)
apply (clarsimp simp: pred_tcb_at_def obj_at_def receive_blocked_def)+
done
lemma set_thread_state_integrity':
@ -585,7 +585,7 @@ lemma send_signal_respects:
send_signal ntfnptr badge
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: send_signal_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_name_pre_state)
apply (case_tac "ntfn_obj ntfn = IdleNtfn \<and> ntfn_bound_tcb ntfn \<noteq> None")
-- "ntfn-binding case"
@ -617,7 +617,7 @@ lemma send_signal_respects:
apply clarsimp
apply (wpc, clarsimp)
apply (wp set_notification_respects[where auth=Notify] sts_st_tcb_at' as_user_set_register_respects
set_thread_state_pas_refined set_notification_pas_refined
set_thread_state_pas_refined set_simple_ko_pas_refined
set_thread_state_respects_in_signalling [where ntfnptr = ntfnptr]
set_notification_respects[where auth=Send]
set_ntfn_valid_objs_at hoare_vcg_disj_lift static_imp_wp
@ -1002,7 +1002,7 @@ lemma send_ipc_pas_refined:
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (rule hoare_gen_asm)
apply (simp add: send_ipc_def)
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wpc | wp set_thread_state_pas_refined)+
apply (simp add: hoare_if_r_and split del:if_split)
@ -1018,7 +1018,7 @@ lemma send_ipc_pas_refined:
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
| simp add: hoare_if_r_and valid_simple_obj_def a_type_def
| rule hoare_drop_imps)+
apply clarsimp
apply (rule obj_at_valid_objsE, assumption+)
@ -1026,11 +1026,12 @@ lemma send_ipc_pas_refined:
apply (auto dest: ep_queued_st_tcb_at [where P = \<top>] simp: tcb_at_st_tcb_at valid_ep_def valid_obj_def obj_at_def split: list.split)
done
lemma set_endpoint_get_tcb:
"\<lbrace>\<lambda>s. P (get_tcb p s)\<rbrace> set_endpoint ep epptr \<lbrace>\<lambda>_ s. P (get_tcb p s) \<rbrace>"
unfolding set_endpoint_def set_object_def
lemma set_simple_ko_get_tcb:
"\<lbrace>\<lambda>s. P (get_tcb p s)\<rbrace> set_simple_ko f ep epptr \<lbrace>\<lambda>_ s. P (get_tcb p s) \<rbrace>"
unfolding set_simple_ko_def set_object_def
apply (wp get_object_wp)
apply (clarsimp simp: get_tcb_def obj_at_def split: Structures_A.kernel_object.splits option.splits)
apply (auto simp: partial_inv_def a_type_def get_tcb_def obj_at_def the_equality
split: Structures_A.kernel_object.splits option.splits)
done
lemma get_tcb_is_Some_iff_typ_at:
@ -1049,7 +1050,7 @@ lemma complete_signal_integrity:
complete_signal ntfnptr thread
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: complete_signal_def)
apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
apply (rule hoare_seq_ext [OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply ((wp set_notification_respects[where auth=Receive] set_thread_state_integrity_autarch as_user_integrity_autarch
| wpc
@ -1101,19 +1102,19 @@ lemma receive_ipc_base_pas_refined:
apply (rule hoare_gen_asm)
apply (clarsimp simp: thread_get_def cong: endpoint.case_cong)
apply (rule hoare_pre)
apply (wp static_imp_wp set_thread_state_pas_refined get_endpoint_wp
apply (wp static_imp_wp set_thread_state_pas_refined get_simple_ko_wp
| wpc | simp add: thread_get_def do_nbrecv_failed_transfer_def split del: if_split)+
apply (simp add:aag_cap_auth_def clas_no_asid cli_no_irqs)
apply (rename_tac list sss data)
apply (rule_tac Q="\<lambda>rv s. pas_refined aag s \<and> (sender_can_grant data \<longrightarrow> is_subject aag (hd list))"
in hoare_strengthen_post[rotated])
apply (clarsimp simp: cap_auth_conferred_def pas_refined_all_auth_is_owns pas_refined_refl)
apply (wp static_imp_wp do_ipc_transfer_pas_refined set_endpoint_pas_refined set_thread_state_pas_refined get_endpoint_wp
hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
apply (wp static_imp_wp do_ipc_transfer_pas_refined set_simple_ko_pas_refined set_thread_state_pas_refined get_simple_ko_wp
hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
| wpc
| simp add: thread_get_def get_thread_state_def)
apply (wp static_imp_wp do_ipc_transfer_pas_refined set_endpoint_pas_refined set_thread_state_pas_refined get_endpoint_wp
hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
apply (wp static_imp_wp do_ipc_transfer_pas_refined set_simple_ko_pas_refined set_thread_state_pas_refined get_simple_ko_wp
hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
| wpc
| simp add: thread_get_def get_thread_state_def do_nbrecv_failed_transfer_def)+
apply (clarsimp simp: tcb_at_def [symmetric] conj_ac tcb_at_st_tcb_at)
@ -1130,7 +1131,7 @@ lemma receive_ipc_base_pas_refined:
apply (drule (1) bspec [OF _ hd_in_set])
apply (clarsimp simp: obj_at_def tcb_bound_refs_def dest!: get_tcb_SomeD split: option.splits)
apply assumption+
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def valid_simple_obj_def a_type_def
ep_redux_simps neq_Nil_conv valid_ep_def case_list_cons_cong)
done
@ -1139,9 +1140,9 @@ lemma complete_signal_pas_refined:
complete_signal ntfnptr thread
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
apply (simp add: complete_signal_def)
apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
apply (rule hoare_seq_ext [OF _ get_simple_ko_sp])
apply (rule hoare_pre)
apply (wp set_notification_pas_refined set_thread_state_pas_refined
apply (wp set_simple_ko_pas_refined set_thread_state_pas_refined
| wpc)+
apply clarsimp
done
@ -1156,7 +1157,7 @@ lemma receive_ipc_pas_refined:
apply (rule hoare_gen_asm)
apply (simp add: receive_ipc_def thread_get_def split: cap.split)
apply clarsimp
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_seq_ext[OF _ gbn_sp])
apply (case_tac ntfnptr, simp_all)
(* old receive_ipc stuff *)
@ -1165,7 +1166,7 @@ lemma receive_ipc_pas_refined:
apply clarsimp
(* ntfn-binding case *)
apply clarsimp
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (case_tac "isActive ntfn", simp_all)
apply (wp complete_signal_pas_refined, clarsimp)
(* regular case again *)
@ -1330,11 +1331,11 @@ lemma set_thread_state_running_respects:
done
(* FIXME move *)
lemma set_endpoint_obj_at:
lemma set_simple_ko_obj_at:
"\<lbrace>obj_at P ptr and K (ptr \<noteq> epptr)\<rbrace>
set_endpoint epptr ep
set_simple_ko f epptr ep
\<lbrace>\<lambda>rv. obj_at P ptr\<rbrace>"
apply (simp add: set_endpoint_def set_object_def)
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp)
apply (auto simp: obj_at_def)
done
@ -1388,9 +1389,9 @@ lemma receive_ipc_base_integrity:
\<and> st_tcb_at (\<lambda>st. send_is_call st = sender_is_call data) (hd list) s"
in hoare_strengthen_post[rotated])
apply (fastforce simp: st_tcb_at_def obj_at_def dest: get_tcb_SomeD)
apply (wp do_ipc_transfer_integrity_autarch do_ipc_transfer_pred_tcb set_endpoinintegrity get_endpoint_wp
apply (wp do_ipc_transfer_integrity_autarch do_ipc_transfer_pred_tcb set_endpoinintegrity get_simple_ko_wp
set_thread_state_integrity_autarch[where param_a=receiver]
hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
as_user_integrity_autarch
| wpc | simp)+
apply clarsimp
@ -1399,7 +1400,7 @@ lemma receive_ipc_base_integrity:
apply (fastforce simp: obj_at_def is_ep)
apply simp
apply (thin_tac "ep_at epptr s \<and> (\<exists>auth. aag_has_auth_to aag auth epptr \<and> (auth = Receive \<or> auth = SyncSend \<or> auth = Reset))")
apply (clarsimp simp: st_tcb_def2)
apply (clarsimp simp: st_tcb_def2 valid_simple_obj_def a_type_def)
(* (update the) clag from _pas_refined *)
apply safe
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def
@ -1433,12 +1434,12 @@ lemma receive_ipc_integrity_autarch:
apply (rule hoare_gen_asm)
apply (simp add: receive_ipc_def split: cap.splits)
apply clarsimp
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_seq_ext[OF _ gbn_sp])
apply (case_tac ntfnptr, simp_all)
(* old receive case, not bound *)
apply (rule hoare_pre, wp receive_ipc_base_integrity, clarsimp)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (case_tac "isActive ntfn", simp_all)
(* new ntfn-binding case *)
apply (rule hoare_pre, wp complete_signal_integrity, clarsimp)
@ -1948,10 +1949,11 @@ lemma set_endpoinintegrity_in_ipc:
and K (aag_has_auth_to aag SyncSend epptr)\<rbrace>
set_endpoint epptr ep'
\<lbrace>\<lambda>rv. integrity_tcb_in_ipc aag X receiver epptr TRContext st\<rbrace>"
apply (simp add: set_endpoint_def set_object_def)
apply (simp add: set_simple_ko_def set_object_def)
apply (wp get_object_wp)
apply (clarsimp split: Structures_A.kernel_object.splits
simp: obj_at_def is_tcb is_ep integrity_tcb_in_ipc_def)
simp: obj_at_def is_tcb is_ep integrity_tcb_in_ipc_def
partial_inv_def a_type_def)
apply (intro impI conjI)
apply (erule integrity_trans)
apply (clarsimp simp: integrity_def)
@ -2005,7 +2007,7 @@ lemma send_ipc_integrity_autarch:
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (rule hoare_gen_asm)
apply (simp add: send_ipc_def)
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (case_tac ep)
apply simp
apply (rule hoare_pre)
@ -2032,11 +2034,11 @@ lemma send_ipc_integrity_autarch:
hoare_vcg_all_lift hoare_drop_imps set_endpoinintegrity
| wpc | simp add: get_thread_state_def split del: if_split
del: hoare_post_taut hoare_True_E_R)+
apply clarsimp
apply (clarsimp simp: a_type_def valid_simple_obj_def)
apply (intro conjI)
apply (fastforce simp: obj_at_def is_ep)
apply blast
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def
apply (fastforce simp: valid_objs_def valid_obj_def obj_at_def valid_simple_obj_def
ep_redux_simps neq_Nil_conv valid_ep_def case_list_cons_cong)
-- "we don't own head of queue"
apply clarsimp
@ -2051,7 +2053,7 @@ lemma send_ipc_integrity_autarch:
| wpc)+
apply (rule_tac Q="\<lambda>rv sa. integrity aag X s sa \<and> (can_grant \<longrightarrow> is_subject aag (hd list))" in hoare_strengthen_post[rotated])
apply simp+
apply (wp thread_get_inv put_wp get_object_wp get_endpoint_wp thread_get_wp'
apply (wp thread_get_inv put_wp get_object_wp get_simple_ko_wp thread_get_wp'
set_thread_state_running_respects_in_ipc[where epptr=epptr]
do_ipc_transfer_respects_in_ipc set_endpoinintegrity
set_thread_state_integrity_autarch
@ -2059,7 +2061,7 @@ lemma send_ipc_integrity_autarch:
hoare_vcg_all_lift hoare_vcg_const_imp_lift
| wpc
| rule hoare_drop_imps
| simp add: get_thread_state_def)+
| simp add: get_thread_state_def valid_simple_obj_def a_type_def)+
apply (clarsimp simp: conj_comms)
apply (subgoal_tac "st_tcb_at (receive_blocked_on epptr) x s")

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

@ -370,7 +370,7 @@ lemma handle_recv_pas_refined:
apply (wp handle_fault_pas_refined receive_ipc_pas_refined receive_signal_pas_refined
get_cap_auth_wp [where aag=aag] lookup_slot_for_cnode_op_authorised
lookup_slot_for_thread_authorised lookup_slot_for_thread_cap_fault
hoare_vcg_all_lift_R get_ntfn_wp
hoare_vcg_all_lift_R get_simple_ko_wp
| wpc | simp
| rename_tac word1 word2 word3, rule_tac Q="\<lambda>rv s. invs s \<and> is_subject aag thread
\<and> (pasSubject aag, Receive, pasObjectAbs aag word1) \<in> pasPolicy aag"
@ -394,7 +394,7 @@ lemma handle_recv_integrity:
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (simp add: handle_recv_def Let_def lookup_cap_def lookup_cap_def split_def)
apply (wp handle_fault_integrity_autarch receive_ipc_integrity_autarch receive_signal_integrity_autarch lookup_slot_for_thread_authorised lookup_slot_for_thread_cap_fault
get_cap_auth_wp [where aag=aag] get_ntfn_wp
get_cap_auth_wp [where aag=aag] get_simple_ko_wp
| wpc | simp
| rule_tac Q="\<lambda>rv s. invs s \<and> is_subject aag thread
\<and> (pasSubject aag, Receive, pasObjectAbs aag x31) \<in> pasPolicy aag"
@ -1099,16 +1099,18 @@ lemma set_thread_state_current_ipc_buffer_register[wp]:
apply (auto simp: current_ipc_buffer_register_def get_tcb_def)
done
lemma set_notification_current_ipc_buffer_register[wp]:
"\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> set_notification t b \<lbrace>\<lambda>r s. P (current_ipc_buffer_register s)\<rbrace>"
apply (clarsimp simp: set_notification_def)
apply (wp dxo_wp_weak)
apply (clarsimp simp: get_object_def set_object_def valid_def put_def
gets_def assert_def bind_def get_def return_def fail_def
split: option.splits kernel_object.splits)
apply simp
apply (wp get_object_wp)+
apply (auto simp: current_ipc_buffer_register_def obj_at_def get_tcb_def split: kernel_object.split_asm)
lemma set_simple_ko_current_ipc_buffer_register[wp]:
"\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> set_simple_ko f t ep \<lbrace>\<lambda>r s. P (current_ipc_buffer_register s)\<rbrace>"
apply (clarsimp simp: set_simple_ko_def )
apply (wp dxo_wp_weak | wpc)+
apply (clarsimp simp: set_thread_state_def get_object_def set_object_def valid_def put_def
gets_def assert_def bind_def get_def return_def fail_def gets_the_def
assert_opt_def
split: option.splits kernel_object.splits)
apply simp
apply (wp get_object_wp | simp add: get_simple_ko_def | wpc)+
apply (auto simp: a_type_def partial_inv_def obj_at_def current_ipc_buffer_register_def get_tcb_def
split: kernel_object.split_asm)
done
crunch current_ipc_buffer_register [wp]: "set_cap" "\<lambda>s. P (current_ipc_buffer_register s)"
@ -1133,20 +1135,7 @@ lemma unbind_maybe_notification_current_ipc_buffer_register[wp]:
apply (erule update_tcb_current_ipc_buffer_register)
apply assumption
apply simp
apply (wp get_object_wp | simp add: get_notification_def | wpc)+
done
lemma set_endpoint_current_ipc_buffer_register[wp]:
"\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> set_endpoint t ep \<lbrace>\<lambda>r s. P (current_ipc_buffer_register s)\<rbrace>"
apply (clarsimp simp: set_endpoint_def )
apply (wp dxo_wp_weak | wpc)+
apply (clarsimp simp: set_thread_state_def get_object_def set_object_def valid_def put_def
gets_def assert_def bind_def get_def return_def fail_def gets_the_def
assert_opt_def
split: option.splits kernel_object.splits)
apply simp
apply (wp get_object_wp | simp add: get_notification_def | wpc)+
apply (auto simp: obj_at_def current_ipc_buffer_register_def get_tcb_def split: kernel_object.split_asm)
apply (wp get_object_wp | simp add: get_simple_ko_def | wpc)+
done
lemma set_bounded_notification_current_ipc_buffer_register[wp]:
@ -1158,7 +1147,7 @@ lemma set_bounded_notification_current_ipc_buffer_register[wp]:
assert_opt_def
split: option.splits kernel_object.splits)
apply simp
apply (wp get_object_wp | simp add: get_notification_def | wpc)+
apply (wp get_object_wp | simp add: get_simple_ko_def | wpc)+
apply (auto simp: obj_at_def current_ipc_buffer_register_def get_tcb_def split: kernel_object.split_asm)
done
@ -1171,7 +1160,7 @@ lemma set_pd_current_ipc_buffer_register[wp]:
assert_opt_def
split: option.splits kernel_object.splits)
apply simp
apply (wp get_object_wp | simp add: get_notification_def | wpc)+
apply (wp get_object_wp | simp add: get_simple_ko_def | wpc)+
apply (auto simp: obj_at_def current_ipc_buffer_register_def get_tcb_def split: kernel_object.split_asm)
done
@ -1184,7 +1173,7 @@ lemma set_pt_current_ipc_buffer_register[wp]:
assert_opt_def
split: option.splits kernel_object.splits)
apply simp
apply (wp get_object_wp | simp add: get_notification_def | wpc)+
apply (wp get_object_wp | simp add: get_simple_ko_def | wpc)+
apply (auto simp: obj_at_def current_ipc_buffer_register_def get_tcb_def split: kernel_object.split_asm)
done
@ -1265,7 +1254,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 (clarsimp simp: cancel_signal_def get_simple_ko_def)
apply (wp | wpc)+
apply (clarsimp simp: get_object_def set_object_def valid_def put_def
gets_def assert_def bind_def get_def return_def fail_def gets_the_def
@ -1509,14 +1498,6 @@ lemma cap_swap_ct_active[wp]:
\<lbrace>\<lambda>_. ct_active \<rbrace>"
by (wp | simp add: cap_swap_def | wps)+
lemma set_ep_ct_active[wp]:
"\<lbrace>ct_active\<rbrace>
set_endpoint a b
\<lbrace>\<lambda>_. ct_active \<rbrace>"
apply (wp set_object_wp get_object_wp| simp add: set_endpoint_def)+
apply (auto simp: ct_in_state_def st_tcb_at_def obj_at_def)
done
lemma unbind_maybe_notification_ct_active[wp]:
"\<lbrace>ct_active\<rbrace>
unbind_maybe_notification ptr
@ -1543,11 +1524,11 @@ lemma cancel_all_ipc_ct_active[wp]:
"\<lbrace>ct_active\<rbrace>
cancel_all_ipc ptr
\<lbrace>\<lambda>_. ct_active \<rbrace>"
apply (wp mapM_x_wp | wps | simp add: cancel_all_ipc_def | wpc)+
apply (wp mapM_x_wp set_simple_ko_ct_active | wps | simp add: cancel_all_ipc_def | wpc)+
apply force
apply (wp mapM_x_wp)+
apply (wp mapM_x_wp set_simple_ko_ct_active)+
apply force
apply (wp hoare_drop_imps hoare_vcg_conj_lift hoare_vcg_all_lift)+
apply (wp set_simple_ko_ct_active hoare_drop_imps hoare_vcg_conj_lift hoare_vcg_all_lift)+
apply simp
done

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

@ -275,7 +275,7 @@ lemma invoke_tcb_tc_respects_aag:
thread_set_ipc_tcb_cap_valid
cap_delete_pas_refined[THEN valid_validE_E])+
| simp add: ran_tcb_cap_cases dom_tcb_cap_cases[simplified]
emptyable_def
emptyable_def a_type_def partial_inv_def
del: hoare_post_taut hoare_True_E_R
| wpc
| strengthen use_no_cap_to_obj_asid_strg
@ -326,7 +326,7 @@ lemma bind_notification_respects:
"\<lbrace>integrity aag X st and pas_refined aag and bound_tcb_at (op = None) t and K (is_subject aag t \<and> (pasSubject aag, Receive, pasObjectAbs aag ntfnptr) \<in> pasPolicy aag)\<rbrace> bind_notification t ntfnptr \<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
apply (rule hoare_gen_asm)
apply (clarsimp simp: bind_notification_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (wp set_ntfn_respects hoare_vcg_imp_lift sbn_bind_respects | wpc | clarsimp)+
apply fastforce
done
@ -381,7 +381,7 @@ lemma hoare_st_refl: "(\<And>st. \<lbrace>P st\<rbrace> f \<lbrace>Q st\<rbrace>
lemma bind_notification_pas_refined[wp]:
"\<lbrace>pas_refined aag and K (\<forall>auth \<in> {Receive, Reset}. (pasObjectAbs aag t, auth, pasObjectAbs aag ntfnptr) \<in> pasPolicy aag)\<rbrace> bind_notification t ntfnptr \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
apply (clarsimp simp: bind_notification_def)
apply (wp set_notification_pas_refined | wpc | simp)+
apply (wp set_simple_ko_pas_refined | wpc | simp)+
done
lemma invoke_tcb_ntfn_control_pas_refined[wp]:
@ -534,7 +534,7 @@ lemma decode_bind_notification_authorised:
\<lbrace>\<lambda>rv s. authorised_tcb_inv aag rv\<rbrace>, -"
unfolding decode_bind_notification_def authorised_tcb_inv_def
apply clarsimp
apply (wp gbn_wp get_ntfn_wp whenE_throwError_wp | wpc | simp add:)+
apply (wp gbn_wp get_simple_ko_wp whenE_throwError_wp | wpc | simp add:)+
apply (clarsimp dest!: hd_in_set)
apply (drule_tac x="hd excaps" in bspec, simp)+
apply (auto simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def AllowRecv_def)

6
proof/bisim/Syscall_S.thy
View File

@ -614,7 +614,7 @@ lemma handle_recv_bisim:
apply (case_tac rc, simp_all)[1]
apply (wp get_cap_wp' lsft_sep | simp add: lookup_cap_def split_def del: hoare_True_E_R)+
apply (rule handle_fault_bisim)
apply (wp get_ntfn_wp | wpc | simp)+
apply (wp get_simple_ko_wp | wpc | simp)+
apply (rule_tac Q' = "\<lambda>_. separate_state and valid_objs and tcb_at r" in hoare_post_imp_R)
prefer 2
apply simp
@ -746,7 +746,7 @@ lemma send_signal_separate_state [wp]:
unfolding send_signal_def cancel_ipc_def
apply (rule separate_state_pres)
apply (rule hoare_pre)
apply (wp gts_wp get_ntfn_wp hoare_pre_cont[where a = "reply_cancel_ipc x" for x]
apply (wp gts_wp get_simple_ko_wp hoare_pre_cont[where a = "reply_cancel_ipc x" for x]
| wpc | wps
| simp add: update_waiting_ntfn_def)+
apply (clarsimp)
@ -779,7 +779,7 @@ lemma separate_state_machine_state:
crunch separate_state [wp]: set_thread_state "separate_state"
(wp: separate_state_pres' crunch_wps simp: crunch_simps)
crunch separate_state [wp]: set_notification "separate_state"
crunch separate_state [wp]: set_simple_ko "separate_state"
(wp: separate_state_pres' crunch_wps simp: crunch_simps)
crunch separate_state [wp]: "Syscall_SA.handle_event" "separate_state"

4
proof/drefine/CNode_DR.thy
View File

@ -1060,7 +1060,9 @@ lemma dcorres_ep_cancel_badge_sends:
apply (clarsimp simp:get_tcb_ep_badge_def tcb_slot_defs tcb_pending_op_slot_def
split: option.splits cdl_cap.splits)
apply clarsimp+
apply (wp get_endpoint_sp valid_ep_get_ep2 | clarsimp simp:valid_state_def)+
apply (wpsimp wp: get_simple_ko_sp get_simple_ko_ko_at
get_simple_ko_valid[where f=Endpoint, simplified valid_ep_def2[symmetric]]
simp:valid_state_def)+
done
lemma neq_CPSR:

14
proof/drefine/Finalise_DR.thy
View File

@ -402,9 +402,10 @@ lemma finalise_cancel_ipc:
apply (rule corres_split [OF _ dcorres_revoke_cap_unnecessary])
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 (wp sts_only_idle sts_st_tcb_at' valid_ep_queue_subset
| clarsimp simp:not_idle_thread_def valid_simple_obj_def a_type_def)+
apply (simp add:get_blocking_object_def | wp)+
apply (clarsimp dest!:get_tcb_rev simp:invs_def )
apply (clarsimp dest!:get_tcb_rev simp:invs_def ep_at_def2[symmetric, simplified])
apply (frule(1) valid_tcb_if_valid_state)
apply (clarsimp simp:valid_tcb_def valid_tcb_state_def
valid_state_def valid_pspace_def infer_tcb_pending_op_def
@ -423,9 +424,9 @@ lemma finalise_cancel_ipc:
unfolding K_bind_def
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)+
| clarsimp simp:not_idle_thread_def valid_simple_obj_def a_type_def)+
apply (simp add:get_blocking_object_def | wp)+
apply (clarsimp dest!:get_tcb_rev simp:invs_def)
apply (clarsimp dest!:get_tcb_rev simp:invs_def ep_at_def2[symmetric, simplified])
apply (frule(1) valid_tcb_if_valid_state)
apply (clarsimp simp:valid_tcb_def valid_tcb_state_def
valid_state_def valid_pspace_def infer_tcb_pending_op_def
@ -454,9 +455,10 @@ lemma finalise_cancel_ipc:
unfolding K_bind_def
apply (rule set_thread_state_corres)
including no_pre
apply (wpsimp wp: set_ntfn_valid_objs simp:not_idle_thread_def)+
apply (wpsimp wp: set_simple_ko_valid_objs
simp: valid_simple_obj_def not_idle_thread_def a_type_def)+
apply (clarsimp simp:valid_def fail_def return_def split:Structures_A.ntfn.splits)+
apply (clarsimp simp:invs_def)
apply (clarsimp simp:invs_def ntfn_at_def2[symmetric, simplified])
apply (frule(1) valid_tcb_if_valid_state)
apply (clarsimp simp:valid_tcb_def tcb_at_cte_at_2
valid_tcb_state_def invs_def valid_state_def valid_pspace_def

72
proof/drefine/Ipc_DR.thy
View File

@ -17,7 +17,7 @@ context begin interpretation Arch . (*FIXME: arch_split*)
abbreviation
"thread_is_running y s \<equiv> st_tcb_at (op=Structures_A.thread_state.Running) y s"
lemmas [wp] = abs_typ_at_lifts[OF set_notification_typ_at]
lemmas [wp] = abs_typ_at_lifts[OF set_simple_ko_typ_at]
lemma set_object_cur_thread_idle_thread:
"\<lbrace>\<lambda>s. P (cur_thread s) (idle_thread s)\<rbrace> KHeap_A.set_object word x
@ -542,8 +542,8 @@ lemma corres_update_waiting_ntfn_do_notification_transfer:
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 (wp set_simple_ko_aligned set_ep_mdb set_simple_ko_valid_objs sts_typ_ats)
apply (simp_all add:not_idle_thread_def valid_simple_obj_def a_type_def ntfn_at_def2[symmetric, simplified])+
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)
@ -646,7 +646,7 @@ lemma recv_signal_corres:
apply (rule corres_split[OF corres_dummy_set_notification set_register_corres])
apply (wp |clarsimp)+
apply (rule_tac Q="\<lambda>r. ko_at (kernel_object.Notification r) word1 and valid_state" in hoare_strengthen_post)
apply (wp get_ntfn_ko | clarsimp)+
apply (wp get_simple_ko_ko_at | clarsimp)+
apply (rule valid_objs_valid_ntfn_simp)
apply (clarsimp simp:valid_objs_valid_ntfn_simp valid_state_def valid_pspace_def)
apply (simp add:obj_at_def)
@ -729,12 +729,12 @@ lemma not_idle_after_blocked_cancel_ipc:
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:obj_at_def is_ep_def2)
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 simp:obj_at_def is_ep_def2)
apply (clarsimp)+
done
@ -778,7 +778,7 @@ lemma valid_idle_cancel_all_ipc:
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 (wp simple_obj_set_prop_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)
@ -795,8 +795,8 @@ lemma valid_idle_cancel_all_ipc:
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 (wp simple_obj_set_prop_at | clarsimp simp :get_ep_queue_def not_idle_thread_def)+
apply (rule hoare_strengthen_post[OF get_simple_ko_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)
@ -811,15 +811,6 @@ lemma valid_idle_cancel_all_ipc:
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>"
apply (simp add:set_notification_def)
apply (wp obj_set_prop_at)
apply (simp add:get_object_def)
apply wp
apply clarsimp
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
@ -840,9 +831,9 @@ lemma valid_idle_cancel_all_signals:
apply (clarsimp simp:)+
apply (rule hoare_vcg_conj_lift)
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 (wp set_simple_ko_tcb| clarsimp simp : not_idle_thread_def)+
apply (wp simple_obj_set_prop_at)+
apply (rule hoare_strengthen_post[OF get_simple_ko_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)
@ -883,7 +874,7 @@ lemma not_idle_thread_cancel_signal:
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])
apply (rule hoare_strengthen_post[OF get_simple_ko_sp])
apply (clarsimp simp:not_idle_thread_def obj_at_def is_ntfn_def)
done
@ -908,9 +899,11 @@ lemma send_signal_corres:
(Ipc_A.send_signal epptr badge)"
apply (unfold Endpoint_D.send_signal_def Ipc_A.send_signal_def invs_def)
apply (rule dcorres_expand_pfx)
apply (clarsimp simp:get_notification_def get_object_def gets_def bind_assoc split: if_split)
apply (clarsimp simp:get_simple_ko_def get_object_def gets_def bind_assoc split: if_split)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp:assert_def corres_free_fail split:Structures_A.kernel_object.splits if_split )
apply (clarsimp simp:assert_def corres_free_fail partial_inv_def a_type_def the_equality
split:Structures_A.kernel_object.splits if_split)
apply (rule conjI, clarsimp+)
apply (rename_tac ntfn_ext)
apply (case_tac "ntfn_obj ntfn_ext", clarsimp)
apply (case_tac "ntfn_bound_tcb ntfn_ext", clarsimp)
@ -951,7 +944,7 @@ lemma send_signal_corres:
apply (rule corres_split[OF dcorres_dat set_thread_state_corres])
apply (wp cancel_ipc_valid_idle
| simp add: not_idle_thread_def invs_def valid_state_def get_blocking_object_def)+
apply (clarsimp dest!:get_tcb_rev simp:invs_def )
apply (clarsimp dest!:get_tcb_rev simp:invs_def ep_at_def2[symmetric, simplified])
apply (frule valid_tcb_if_valid_state[rotated], clarsimp simp: valid_state_def)
apply (fastforce dest!: get_tcb_SomeD
simp: receive_blocked_def valid_idle_def pred_tcb_at_def obj_at_def
@ -2364,7 +2357,7 @@ lemma set_endpoint_valid_irq_node[wp]:
apply (clarsimp simp:valid_irq_node_def)
apply wp
apply simp_all
apply (simp add:set_endpoint_def)
apply (simp add:set_simple_ko_def)
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)
@ -2520,8 +2513,9 @@ lemma dcorres_receive_sync:
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)
apply (clarsimp simp:valid_state_def valid_pspace_def)+
apply (clarsimp simp:valid_ep_def valid_simple_obj_def a_type_def
split:Structures_A.endpoint.splits list.splits)
apply (clarsimp simp:valid_state_def valid_pspace_def valid_simple_obj_def a_type_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)
@ -2551,9 +2545,11 @@ lemma dcorres_receive_sync:
lemma dcorres_complete_signal:
"dcorres dc \<top> (valid_idle and not_idle_thread thread and valid_etcbs) (corrupt_tcb_intent thread)
(complete_signal aa thread)"
apply (clarsimp simp: complete_signal_def get_notification_def get_object_def gets_def bind_assoc)
apply (clarsimp simp: complete_signal_def get_simple_ko_def get_object_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp: assert_def corres_free_fail split: Structures_A.kernel_object.splits Structures_A.ntfn.splits)
apply (clarsimp split: option.splits)
apply (clarsimp simp: assert_def corres_free_fail partial_inv_def a_type_def
split: Structures_A.kernel_object.splits Structures_A.ntfn.splits)
apply (rule corres_guard_imp)
apply (rule corres_dummy_return_l)
apply (rule corres_split[OF corres_dummy_set_notification set_register_corres])
@ -2580,20 +2576,22 @@ lemma recv_sync_ipc_corres:
-- "not bound"
apply (rule corres_alternate2)
apply (rule dcorres_receive_sync, simp_all)[1]
apply (simp add: get_notification_def gets_def get_object_def bind_assoc)
apply (simp add: get_simple_ko_def gets_def get_object_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (frule get_tcb_SomeD)
apply (clarsimp simp add: valid_state_def valid_pspace_def)
apply (clarsimp simp add: valid_state_def valid_pspace_def
split: kernel_object.splits if_splits)
apply (rule valid_objsE, assumption, simp)
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_bound_ntfn_def)
apply (clarsimp simp: assert_def corres_free_fail obj_at_def split: Structures_A.kernel_object.splits)
apply (clarsimp simp: assert_def corres_free_fail obj_at_def partial_inv_def
split: Structures_A.kernel_object.splits)
apply safe[1]
apply (rule corres_alternate1)
apply (rule corres_guard_imp)
apply (rule dcorres_complete_signal, simp+)
apply (rule corres_alternate2)
apply (rule dcorres_receive_sync, simp_all add: obj_at_def valid_state_def valid_pspace_def)[1]
apply (wp | clarsimp)+
apply (wp get_simple_ko_ko_at | clarsimp)+
done
lemma option_select_not_empty:
@ -2660,7 +2658,7 @@ lemma send_sync_ipc_corres:
apply (rule dcorres_absorb_get_l)
apply (clarsimp split del:if_splits)
apply (rule_tac Q' = "\<lambda>r. op = s' and ko_at (kernel_object.Endpoint r) epptr" in corres_symb_exec_r[rotated])
apply (wp|simp split del:if_splits)+
apply (wp get_simple_ko_ko_at |simp split del:if_splits)+
apply (rule dcorres_expand_pfx)
apply (clarsimp split del:if_splits)
apply (frule_tac get_endpoint_pick)
@ -2746,8 +2744,8 @@ lemma send_sync_ipc_corres:
apply (rule dcorres_to_wp[where Q=\<top> ,simplified])
apply (rule corres_dummy_set_sync_ep)
apply simp
apply (clarsimp simp:valid_state_def not_idle_thread_def
valid_pspace_def st_tcb_at_def obj_at_def is_ep_def)
apply (clarsimp simp:valid_state_def not_idle_thread_def a_type_def
valid_pspace_def st_tcb_at_def obj_at_def is_ep_def valid_simple_obj_def)
apply (drule(1) valid_objs_valid_ep_simp)
apply (clarsimp simp:valid_ep_def tcb_at_def
valid_idle_def pred_tcb_at_def obj_at_def

84
proof/drefine/KHeap_DR.thy
View File

@ -545,9 +545,9 @@ lemma set_original_dummy_corres:
lemma corres_dummy_set_notification:
"dcorres dc \<top> \<top> (return a) (set_notification epptr b)"
apply (simp add: set_notification_def get_object_def bind_assoc gets_def)
apply (simp add: set_simple_ko_def get_object_def bind_assoc gets_def)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp: corres_free_fail assert_def
apply (clarsimp simp: corres_free_fail assert_def a_type_def
split: option.splits Structures_A.kernel_object.splits)
apply (rule corres_free_set_object)
apply (clarsimp simp:transform_def transform_current_thread_def)
@ -557,9 +557,9 @@ lemma corres_dummy_set_notification:
lemma corres_dummy_set_sync_ep:
"dcorres dc \<top> \<top> (return a) (set_endpoint epptr b)"
apply (simp add: set_endpoint_def get_object_def bind_assoc gets_def)
apply (simp add: set_simple_ko_def get_object_def bind_assoc gets_def)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp: corres_free_fail assert_def
apply (clarsimp simp: corres_free_fail assert_def a_type_def partial_inv_def
split: option.splits Structures_A.kernel_object.splits)
apply (rule corres_free_set_object)
apply (clarsimp simp:transform_def transform_current_thread_def)
@ -1936,7 +1936,7 @@ lemma tcb_type_set_obj_ep:
lemma tcb_type_at_set_ep:
"\<lbrace>op = s'a\<rbrace> set_endpoint word1 Structures_A.endpoint.IdleEP \<lbrace>\<lambda>r s. \<forall>x. tcb_at x s \<longrightarrow> tcb_at x s'a\<rbrace>"
apply (clarsimp simp:set_endpoint_def)
apply (clarsimp simp:set_simple_ko_def)
apply (wp tcb_type_set_obj_ep)
apply (clarsimp simp:get_object_def)
apply wp
@ -1956,29 +1956,15 @@ lemma is_thread_blocked_on_sth:
apply (clarsimp simp:is_thread_blocked_on_endpoint_def)+
done
lemma set_ep_exec_wp:
lemma set_ep_exec_wp: (* generalise? *)
"\<lbrace>op = s\<rbrace> set_endpoint epptr ep \<lbrace>\<lambda>r s'. s' = update_kheap ((kheap s)(epptr \<mapsto> Endpoint ep)) s\<rbrace> "
apply (simp add:set_endpoint_def)
apply wp
apply (clarsimp simp:set_object_def put_def get_def bind_def return_def valid_def)
apply simp
apply (wp)
apply (simp add:get_object_def)
apply wp
apply (clarsimp split:Structures_A.kernel_object.splits)
done
by (wpsimp simp: set_simple_ko_def set_object_def get_object_def a_type_def fun_upd_def
split: option.splits Structures_A.kernel_object.splits)
lemma set_ntfn_exec_wp:
"\<lbrace>op = s\<rbrace> set_notification epptr ep \<lbrace>\<lambda>r s'. s' = update_kheap ((kheap s)(epptr \<mapsto> Notification ep)) s\<rbrace> "
apply (simp add:set_notification_def)
apply wp
apply (clarsimp simp:set_object_def put_def get_def bind_def return_def valid_def)
apply simp
apply wp
apply (simp add:get_object_def)
apply wp
apply (clarsimp split:Structures_A.kernel_object.splits)
done
by (wpsimp simp: set_simple_ko_def set_object_def get_object_def a_type_def fun_upd_def
split: option.splits Structures_A.kernel_object.splits)
lemma pending_thread_in_recv_not_idle:
"\<lbrakk>valid_state s'; valid_idle s';
@ -2382,11 +2368,13 @@ lemma fast_finalise_wait_ntfn:
lemma dcorres_cancel_all_ipc:
"dcorres dc \<top> (valid_state and valid_idle and valid_etcbs) (PageTableUnmap_D.cancel_all_ipc oid)
(IpcCancel_A.cancel_all_ipc oid)"
apply (simp add:IpcCancel_A.cancel_all_ipc_def IpcCancel_A.cancel_all_signals_def PageTableUnmap_D.fast_finalise_def)
apply (clarsimp simp:get_endpoint_def get_object_def bind_assoc gets_def)
apply (simp add:IpcCancel_A.cancel_all_ipc_def IpcCancel_A.cancel_all_signals_def
PageTableUnmap_D.fast_finalise_def partial_inv_def)
apply (clarsimp simp:get_simple_ko_def get_object_def bind_assoc gets_def)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp:assert_def corres_free_fail split:Structures_A.kernel_object.splits)
apply (rename_tac endpoint)
apply (clarsimp simp:assert_def corres_free_fail partial_inv_def a_type_def
split:Structures_A.kernel_object.splits, safe)
apply (rename_tac endpoint y)
apply (case_tac endpoint)
apply (clarsimp simp:cancel_all_ipc_def_alt1)
apply (rule dcorres_absorb_get_l)
@ -2411,10 +2399,11 @@ lemma dcorres_cancel_all_ipc:
lemma dcorres_cancel_all_signals:
"dcorres dc \<top> (valid_state and valid_idle and valid_etcbs) (PageTableUnmap_D.cancel_all_ipc oid)
(cancel_all_signals oid)"
apply (clarsimp simp: cancel_all_signals_def get_notification_def get_object_def bind_assoc gets_def)
apply (clarsimp simp: cancel_all_signals_def get_simple_ko_def get_object_def bind_assoc gets_def)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp:assert_def corres_free_fail split:Structures_A.kernel_object.splits)
apply (rename_tac ntfn_ext)
apply (clarsimp simp:assert_def corres_free_fail partial_inv_def a_type_def
split:Structures_A.kernel_object.splits, safe)
apply (rename_tac ntfn_ext y)
apply (case_tac "ntfn_obj ntfn_ext")
apply (clarsimp simp:cancel_all_ipc_def_alt1)
apply (rule dcorres_absorb_get_l)
@ -2501,9 +2490,10 @@ lemma dcorres_unbind_notification:
apply (clarsimp simp: opt_object_tcb transform_tcb_def not_idle_thread_def)
apply (frule (1) valid_etcbs_get_tcb_get_etcb)
apply (clarsimp simp: opt_cap_tcb tcb_slots infer_tcb_bound_notification_def split: option.splits)
apply (clarsimp simp: get_notification_def get_object_def gets_def bind_assoc)
apply (clarsimp simp: get_simple_ko_def get_object_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp: assert_def corres_free_fail split: Structures_A.kernel_object.splits)
apply (clarsimp simp: assert_def corres_free_fail partial_inv_def a_type_def
split: Structures_A.kernel_object.splits, safe)
apply (rule corres_dummy_return_pl[where b="()"])
apply (rule corres_underlying_split[where r'=dc and P="\<lambda>_. \<top>", OF _ _ set_ntfn_exec_wp])
apply (rule corres_dummy_set_notification[THEN corres_guard_imp],simp+)
@ -2524,10 +2514,12 @@ lemma dcorres_ntfn_bound_tcb:
"dcorres (\<lambda>rv rv'. rv = set_option (ntfn_bound_tcb rv')) \<top> (valid_state and valid_etcbs)
(gets $ get_bound_notification_threads ntfn)
(get_notification ntfn)"
apply (clarsimp simp: gets_def get_notification_def get_object_def bind_assoc)
apply (clarsimp simp: gets_def get_simple_ko_def
get_object_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (rule dcorres_absorb_get_l)
apply (clarsimp simp: assert_def corres_free_fail split: Structures_A.kernel_object.splits )
apply (clarsimp simp: assert_def corres_free_fail a_type_def partial_inv_def
split: Structures_A.kernel_object.splits, rule conjI, clarsimp+)
apply (frule get_notification_pick, simp)
apply (clarsimp simp: valid_ntfn_abstract_def ntfn_bound_set_lift valid_state_def option_select_def split del: if_split)
done
@ -2578,7 +2570,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_simple_ko_wp)+
apply (clarsimp split: option.splits)
apply (clarsimp simp: valid_state_def valid_pspace_def split: option.splits)
apply (simp add: obj_at_def)
@ -2594,13 +2586,13 @@ lemma unbind_notification_valid_state[wp]:
apply (rule hoare_seq_ext [OF _ gbn_sp])
apply (case_tac ntfnptr, clarsimp, wp, simp)
apply clarsimp
apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
apply (wp valid_irq_node_typ set_ntfn_valid_objs
apply (rule hoare_seq_ext [OF _ get_simple_ko_sp])
apply (wp valid_irq_node_typ set_simple_ko_valid_objs
| clarsimp)+
defer 4
apply (auto elim!: obj_at_weakenE obj_at_valid_objsE if_live_then_nonz_capD2
simp: valid_ntfn_set_bound_None is_ntfn valid_obj_def
live_def hyp_live_def)[8]
simp: valid_ntfn_set_bound_None is_ntfn valid_obj_def valid_simple_obj_def
live_def hyp_live_def a_type_def)[8]
apply (clarsimp simp: if_split)
apply (rule delta_sym_refs, assumption)
apply (fastforce simp: obj_at_def is_tcb
@ -2624,14 +2616,14 @@ 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 (rule hoare_seq_ext [OF _ get_simple_ko_sp])
apply (case_tac "ntfn_bound_tcb ntfn", clarsimp, wp, simp+)
apply (wp valid_irq_node_typ set_ntfn_valid_objs
apply (wp valid_irq_node_typ set_simple_ko_valid_objs
| clarsimp)+
defer 4
apply (auto elim!: obj_at_weakenE obj_at_valid_objsE if_live_then_nonz_capD2
simp: valid_ntfn_set_bound_None is_ntfn valid_obj_def
live_def hyp_live_def)[8]
simp: valid_ntfn_set_bound_None is_ntfn valid_obj_def valid_simple_obj_def
live_def hyp_live_def a_type_def)[8]
apply (clarsimp simp: if_split)
apply (rule delta_sym_refs, assumption)
apply (fastforce simp: obj_at_def is_tcb
@ -2659,7 +2651,7 @@ lemma unbind_notification_valid_idle[wp]:
apply (rule hoare_seq_ext[OF _ gbn_sp])
apply (case_tac ntfnptr, clarsimp, wp, simp)
apply clarsimp
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (wp | clarsimp)+
apply (auto simp: obj_at_def is_ntfn_def)
done
@ -2667,7 +2659,7 @@ lemma unbind_notification_valid_idle[wp]:
lemma unbind_maybe_notification_valid_idle[wp]:
"\<lbrace>valid_idle\<rbrace> IpcCancel_A.unbind_maybe_notification a \<lbrace>\<lambda>rv. valid_idle\<rbrace>"
apply (simp add: unbind_maybe_notification_def)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (case_tac "ntfn_bound_tcb ntfn", clarsimp, wp, simp)
apply clarsimp
apply (wp | clarsimp)+

11
proof/drefine/Syscall_DR.thy
View File

@ -1414,9 +1414,9 @@ lemma receive_ipc_cur_thread:
apply (rule_tac Q="\<lambda>r s. P (cur_thread s) \<and> tcb_at (hd list) s" in hoare_strengthen_post)
apply wp
apply (clarsimp simp:st_tcb_at_def tcb_at_def)
apply (wp get_ntfn_wp gbn_wp | wpc | simp add: Ipc_A.isActive_def)+
apply (wp get_simple_ko_wp[where f=Notification] gbn_wp | wpc | simp add: Ipc_A.isActive_def)+
apply (rule_tac Q="\<lambda>r s. valid_ep r s \<and> P (cur_thread s)" in hoare_strengthen_post)
apply (wp valid_ep_get_ep2)
apply (wp get_simple_ko_valid[where f=Endpoint, simplified valid_ep_def2[symmetric]])
apply (clarsimp simp:valid_ep_def)
apply auto[1]
apply (rule hoare_pre)
@ -1483,7 +1483,7 @@ lemma handle_recv_corres:
apply (clarsimp simp: valid_cap_def)
apply wp+
apply (simp add:injection_handler_def)
apply (wp get_ntfn_wp |wpc)+
apply (wp get_simple_ko_wp |wpc)+
apply (simp only: conj_ac)
apply wp
apply (rule hoare_vcg_E_elim)
@ -1511,9 +1511,10 @@ lemma handle_recv_corres:
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)
apply (clarsimp simp: liftE_bindE get_simple_ko_def get_object_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp: assert_def corres_free_fail split: Structures_A.kernel_object.splits)
apply (clarsimp simp: assert_def corres_free_fail partial_inv_def a_type_def
split: Structures_A.kernel_object.splits)
apply safe[1]
apply (rule corres_alternate1, clarsimp, rule corres_guard_imp[OF recv_signal_corres], (clarsimp simp: transform_cap_def)+)+
apply (rule corres_alternate2)

8
proof/drefine/Tcb_DR.thy
View File

@ -403,7 +403,7 @@ lemma decode_tcb_corres:
apply (rename_tac rva word)
apply ((case_tac "excaps' ! 0",clarsimp, rule corres_alternate1[OF dcorres_returnOk], simp add: translate_tcb_invocation_def hd_conv_nth)
| clarsimp simp: throw_on_none_def get_index_def dcorres_alternative_throw split del: if_split
| wp get_ntfn_wp
| wp get_simple_ko_wp
| (case_tac "excaps' ! 0", rule dcorres_alternative_throw)
| (case_tac "AllowRead \<in> rights", simp))+
@ -1687,9 +1687,11 @@ lemma dcorres_bind_notification:
"dcorres dc (\<lambda>_. True) (valid_etcbs and not_idle_thread t)
(Tcb_D.bind_notification t a) (Tcb_A.bind_notification t a)"
apply (clarsimp simp: Tcb_D.bind_notification_def Tcb_A.bind_notification_def
get_notification_def get_object_def gets_def bind_assoc)
get_simple_ko_def get_object_def gets_def bind_assoc)
apply (rule dcorres_absorb_get_r)
apply (clarsimp simp: assert_def corres_free_fail split: Structures_A.kernel_object.splits)
apply (simp split: option.splits)
apply (clarsimp simp: assert_def corres_free_fail partial_inv_def a_type_def
split: Structures_A.kernel_object.splits)
apply (rule corres_dummy_return_pl)
apply (rule corres_guard_imp)
apply (rule corres_split[OF _ corres_dummy_set_notification], simp)

16
proof/infoflow/Arch_IF.thy
View File

@ -1427,17 +1427,19 @@ lemma delete_asid_reads_respects:
subsection "globals_equiv"
lemma set_endpoint_globals_equiv:
"\<lbrace>globals_equiv s and valid_ko_at_arm\<rbrace> set_endpoint ptr ep \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
unfolding set_endpoint_def
apply(wp set_object_globals_equiv get_object_wp | simp)+
lemma set_simple_ko_globals_equiv:
"\<lbrace>globals_equiv s and valid_ko_at_arm\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
unfolding set_simple_ko_def
apply(wpsimp wp: set_object_globals_equiv get_object_wp
simp: partial_inv_def)+
apply(fastforce simp: obj_at_def valid_ko_at_arm_def)
done
lemma set_endpoint_valid_ko_at_arm[wp]:
"\<lbrace>valid_ko_at_arm\<rbrace> set_endpoint ptr ep \<lbrace>\<lambda>_. valid_ko_at_arm\<rbrace>"
unfolding set_endpoint_def set_object_def
apply(wp get_object_wp | clarsimp simp: obj_at_def valid_ko_at_arm_def)+
"\<lbrace>valid_ko_at_arm\<rbrace> set_simple_ko f ptr ep \<lbrace>\<lambda>_. valid_ko_at_arm\<rbrace>"
unfolding set_simple_ko_def set_object_def
apply(wpsimp wp: get_object_wp
simp: partial_inv_def a_type_def obj_at_def valid_ko_at_arm_def)+
done
lemma set_thread_state_globals_equiv:

2
proof/infoflow/Decode_IF.thy
View File

@ -238,7 +238,7 @@ lemma decode_tcb_invocation_reads_respects_f:
check_valid_ipc_buffer_inv
respects_f[OF decode_set_priority_rev]
respects_f[OF decode_set_mcpriority_rev]
respects_f[OF get_notification_reads_respects]
respects_f[OF get_simple_ko_reads_respects]
respects_f[OF get_bound_notification_reads_respects']
| wp_once whenE_throwError_wp
| wp_once hoare_drop_imps

41
proof/infoflow/FinalCaps.thy
View File

@ -981,11 +981,11 @@ lemma cte_wp_at_eq:
apply(simp add: cte_wp_at_def)
done
lemma set_endpoint_silc_inv[wp]:
lemma set_simple_ko_silc_inv[wp]:
"\<lbrace> silc_inv aag st \<rbrace>
set_endpoint ptr ep
set_simple_ko f ptr ep
\<lbrace> \<lambda> _. silc_inv aag st \<rbrace>"
unfolding set_endpoint_def
unfolding set_simple_ko_def
apply(rule silc_inv_pres)
apply(wp set_object_wp get_object_wp)
apply (simp split: kernel_object.splits)
@ -993,24 +993,7 @@ lemma set_endpoint_silc_inv[wp]:
apply(fastforce simp: silc_inv_def obj_at_def is_cap_table_def)
apply(wp set_object_wp get_object_wp | simp)+
apply(case_tac "ptr = fst slot")
apply(clarsimp split: kernel_object.splits)
apply(fastforce elim: cte_wp_atE simp: obj_at_def)
apply(fastforce elim: cte_wp_atE intro: cte_wp_at_cteI cte_wp_at_tcbI)
done
lemma set_notification_silc_inv[wp]:
"\<lbrace> silc_inv aag st \<rbrace>
set_notification ptr ntfn
\<lbrace> \<lambda> _. silc_inv aag st \<rbrace>"
unfolding set_notification_def
apply(rule silc_inv_pres)
apply(wp set_object_wp get_object_wp)
apply (simp split: kernel_object.splits)
apply(rule impI | simp)+
apply(fastforce simp: silc_inv_def obj_at_def is_cap_table_def)
apply(wp set_object_wp get_object_wp | simp)+
apply(case_tac "ptr = fst slot")
apply(clarsimp split: kernel_object.splits)
apply(clarsimp simp: a_type_def partial_inv_def split: kernel_object.splits)
apply(fastforce elim: cte_wp_atE simp: obj_at_def)
apply(fastforce elim: cte_wp_atE intro: cte_wp_at_cteI cte_wp_at_tcbI)
done
@ -1190,7 +1173,7 @@ lemma cancel_ipc_silc_inv:
cancel_ipc t
\<lbrace> \<lambda>_. silc_inv aag st \<rbrace>"
unfolding cancel_ipc_def
apply(wp get_endpoint_wp reply_cancel_ipc_silc_inv get_thread_state_inv hoare_vcg_all_lift
apply(wp get_simple_ko_wp reply_cancel_ipc_silc_inv get_thread_state_inv hoare_vcg_all_lift
| wpc
| simp(no_asm) add: blocked_cancel_ipc_def get_ep_queue_def
get_blocking_object_def
@ -2294,7 +2277,7 @@ crunch silc_inv[wp]: update_waiting_ntfn, set_message_info, invalidate_tlb_by_as
lemma send_signal_silc_inv[wp]:
"\<lbrace>silc_inv aag st\<rbrace> send_signal param_a param_b \<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
unfolding send_signal_def
apply (wp get_ntfn_wp gts_wp cancel_ipc_indirect_silc_inv | wpc | simp)+
apply (wp get_simple_ko_wp gts_wp cancel_ipc_indirect_silc_inv | wpc | simp)+
apply (clarsimp simp: receive_blocked_def pred_tcb_at_def obj_at_def)
done
@ -2696,7 +2679,7 @@ lemma send_ipc_silc_inv:
apply simp
apply(wp do_ipc_transfer_silc_inv | wpc | simp)+
apply(wp_once hoare_drop_imps)
apply (wp get_endpoint_wp)+
apply (wp get_simple_ko_wp)+
apply clarsimp
apply(rule conjI)
apply(fastforce simp: obj_at_def ep_q_refs_of_def)
@ -2717,8 +2700,8 @@ lemma receive_ipc_base_silc_inv:
apply (rename_tac list tcb data)
apply(rule_tac Q="\<lambda> r s. (sender_can_grant data \<longrightarrow> is_subject aag receiver \<and> is_subject aag (hd list)) \<and> silc_inv aag st s" in hoare_strengthen_post)
apply(wp do_ipc_transfer_silc_inv hoare_vcg_all_lift | wpc | simp)+
apply(wp hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1]
hoare_vcg_all_lift get_endpoint_wp
apply(wp hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1]
hoare_vcg_all_lift get_simple_ko_wp
| wpc)+
apply (clarsimp simp: conj_comms)
apply(rule conjI)
@ -2763,12 +2746,12 @@ lemma receive_ipc_silc_inv:
apply (rule hoare_gen_asm)
apply (simp del: AllowSend_def split: cap.splits)
apply clarsimp
apply (rule hoare_seq_ext[OF _ get_endpoint_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (rule hoare_seq_ext[OF _ gbn_sp])
apply (case_tac ntfnptr, simp_all)
(* old receive case, not bound *)
apply (rule hoare_pre, wp receive_ipc_base_silc_inv, clarsimp)
apply (rule hoare_seq_ext[OF _ get_ntfn_sp])
apply (rule hoare_seq_ext[OF _ get_simple_ko_sp])
apply (case_tac "isActive ntfn", simp_all)
(* new ntfn-binding case *)
apply (rule hoare_pre, wp, clarsimp)
@ -3033,7 +3016,7 @@ lemma handle_recv_silc_inv:
handle_recv is_blocking
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
apply (simp add: handle_recv_def Let_def lookup_cap_def split_def)
apply (wp hoare_vcg_all_lift get_ntfn_wp delete_caller_cap_silc_inv
apply (wp hoare_vcg_all_lift get_simple_ko_wp delete_caller_cap_silc_inv
receive_ipc_silc_inv
lookup_slot_for_thread_authorised
lookup_slot_for_thread_cap_fault

150
proof/infoflow/Finalise_IF.thy
View File

@ -259,22 +259,26 @@ lemma get_object_revrv:
apply wp
done
lemma set_endpoint_reads_respects:
"reads_respects aag l \<top> (set_endpoint ptr ep)"
unfolding set_endpoint_def
lemma set_simple_ko_reads_respects:
"reads_respects aag l \<top> (set_simple_ko f ptr ep)"
unfolding set_simple_ko_def
apply(simp add: equiv_valid_def2)
apply(rule equiv_valid_rv_bind)
apply(rule equiv_valid_rv_guard_imp)
apply(rule get_object_revrv)
apply(simp, simp)
apply(rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
apply(subst equiv_valid_def2[symmetric])
apply(rule set_object_reads_respects)
apply(rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
apply(subst equiv_valid_def2[symmetric])
apply(rule set_object_reads_respects)
apply(rule assert_ev2)
apply(simp)
apply(rule assert_inv)+
apply(rule assert_ev2)
apply(simp)
apply(rule assert_wp)+
apply(rule assert_inv)+
apply(simp)
apply(rule get_object_inv)
apply(wp get_object_inv)
done
lemma get_ep_queue_reads_respects:
@ -293,9 +297,10 @@ lemma get_object_reads_respects:
apply (fastforce elim: reads_equivE affects_equivE equiv_forE)
done
lemma get_endpoint_reads_respects:
"reads_respects aag l (K (aag_can_read aag ptr \<or> aag_can_affect aag l ptr)) (get_endpoint ptr)"
unfolding get_endpoint_def
lemma get_simple_ko_reads_respects:
"reads_respects aag l (K (aag_can_read aag ptr \<or> aag_can_affect aag l ptr))
(get_simple_ko f ptr)"
unfolding get_simple_ko_def
apply(wp get_object_reads_respects | wpc | simp)+
done
@ -457,26 +462,35 @@ lemma ep_queues_are_invisible_or_eps_are_equal:
apply (assumption | erule reads_equiv_sym | erule affects_equiv_sym)+
done
lemma get_simple_ko_revrv:
"inj C \<Longrightarrow> reads_equiv_valid_rv_inv R aag
(\<lambda>obj obj'. \<exists>s t. reads_equiv aag s t
\<and> R s t \<and> P s \<and> P t \<and> ko_at (C obj) ptr s
\<and> ko_at (C obj') ptr t)
P
(get_simple_ko C ptr)"
apply (simp add: get_simple_ko_def)
apply(rule_tac Q="\<lambda> rv. ko_at rv ptr and P" in equiv_valid_rv_bind)
apply(rule equiv_valid_rv_guard_imp[OF equiv_valid_rv_trivial])
apply wpsimp+
apply (clarsimp simp add: assert_def fail_ev2_l fail_ev2_r
simp del: imp_disjL split: option.split)
apply (rule return_ev2)
apply (auto simp: proj_inj)[1]
apply (rule hoare_strengthen_post[OF get_object_sp])
apply simp
done
lemma get_endpoint_revrv:
"reads_equiv_valid_rv_inv (affects_equiv aag l) aag
(\<lambda>ep ep'. (\<not> ep_queue_invisible aag l ep \<or> \<not> ep_queue_invisible aag l ep') \<longrightarrow> ep = ep')
(pas_refined aag and valid_objs and sym_refs \<circ> state_refs_of and
K ((pasSubject aag, Reset, pasObjectAbs aag epptr) \<in> pasPolicy aag))
(get_endpoint epptr)"
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 wpsimp+
apply(case_tac "\<exists> ep. rv = Endpoint ep")
apply(case_tac "\<exists> ep. rv' = Endpoint ep")
apply (clarsimp split: kernel_object.splits)
apply (rule return_ev2)
apply (rule ep_queues_are_invisible_or_eps_are_equal[simplified])
apply fastforce+
apply(clarsimp split: kernel_object.splits simp: fail_ev2_l fail_ev2_r)
apply(clarsimp split: kernel_object.splits simp: fail_ev2_l fail_ev2_r)
apply (rule hoare_strengthen_post[OF get_object_sp])
by simp
apply (rule equiv_valid_2_rvrel_imp, rule get_simple_ko_revrv)
apply (simp add: inj_Endpoint)
apply (auto elim: ep_queues_are_invisible_or_eps_are_equal[rule_format])
done
lemma gen_asm_ev2_r:
"\<lbrakk>P' \<Longrightarrow> equiv_valid_2 I A B R P \<top> f f'\<rbrakk> \<Longrightarrow>
@ -604,9 +618,9 @@ lemma set_endpoint_equiv_but_for_labels:
"\<lbrace>equiv_but_for_labels aag L st and K (pasObjectAbs aag epptr \<in> L)\<rbrace>
set_endpoint epptr ep
\<lbrace>\<lambda>_. equiv_but_for_labels aag L st\<rbrace>"
unfolding set_endpoint_def
unfolding set_simple_ko_def
apply (wp set_object_equiv_but_for_labels get_object_wp)
apply (clarsimp simp: asid_pool_at_kheap split: kernel_object.splits simp: obj_at_def)
apply (clarsimp simp: asid_pool_at_kheap partial_inv_def split: kernel_object.splits simp: obj_at_def)
done
@ -770,18 +784,17 @@ lemma possible_switch_to_reads_respects:
apply simp
done
crunch sched_act[wp]: set_endpoint "\<lambda>s. P (scheduler_action s)"
crunch sched_act[wp]: set_simple_ko "\<lambda>s. P (scheduler_action s)"
(wp: crunch_wps)
lemma set_endpoint_valid_sched_action[wp]:
"\<lbrace>valid_sched_action\<rbrace> set_endpoint ptr ep \<lbrace>\<lambda>_. valid_sched_action\<rbrace>"
by (wp valid_sched_action_lift)
lemma cancel_all_ipc_reads_respects:
"reads_respects aag l (pas_refined aag and K (is_subject aag epptr)) (cancel_all_ipc epptr)"
unfolding cancel_all_ipc_def fun_app_def
apply (wp mapM_x_ev'' tcb_sched_action_reads_respects set_thread_state_runnable_reads_respects set_thread_state_pas_refined hoare_vcg_ball_lift mapM_x_wp set_thread_state_runnable_valid_sched_action set_endpoint_reads_respects get_ep_queue_reads_respects get_epq_SendEP_ret get_epq_RecvEP_ret get_endpoint_reads_respects get_endpoint_wp | wpc | clarsimp simp: ball_conj_distrib | rule subset_refl | wp_once hoare_drop_imps | assumption)+
apply (wp mapM_x_ev'' tcb_sched_action_reads_respects set_thread_state_runnable_reads_respects
set_thread_state_pas_refined hoare_vcg_ball_lift mapM_x_wp set_thread_state_runnable_valid_sched_action
set_simple_ko_reads_respects get_ep_queue_reads_respects get_epq_SendEP_ret get_epq_RecvEP_ret
get_simple_ko_reads_respects get_simple_ko_wp | wpc
| clarsimp simp: ball_conj_distrib | rule subset_refl | wp_once hoare_drop_imps | assumption)+
done
(*
lemma cancel_all_ipc_reads_respects:
@ -922,31 +935,6 @@ lemma cancel_all_ipc_reads_respects:
done
*)
lemma set_notification_reads_respects:
"reads_respects aag l \<top> (set_notification ptr ntfn)"
unfolding set_notification_def
apply(simp add: equiv_valid_def2)
apply(rule equiv_valid_rv_bind)
apply(rule equiv_valid_rv_guard_imp)
apply(rule get_object_revrv)
apply(simp, simp)
apply(rule equiv_valid_2_bind)
apply(subst equiv_valid_def2[symmetric])
apply(rule set_object_reads_respects)
apply(rule assert_ev2)
apply(simp)
apply(rule assert_wp)+
apply(simp)
apply (rule get_object_inv)
done
lemma get_notification_reads_respects:
"reads_respects aag l (K (aag_can_read aag ptr \<or> aag_can_affect aag l ptr)) (get_notification ptr)"
unfolding get_notification_def
apply(wp get_object_reads_respects hoare_vcg_all_lift | wpc | simp)+
done
fun ntfn_queue_invisible where
"ntfn_queue_invisible aag l (WaitingNtfn list) = labels_are_invisible aag l ((pasObjectAbs aag) ` (set list))" |
"ntfn_queue_invisible aag l _ = True"
@ -1002,21 +990,25 @@ lemma set_notification_equiv_but_for_labels:
"\<lbrace>equiv_but_for_labels aag L st and K (pasObjectAbs aag ntfnptr \<in> L)\<rbrace>
set_notification ntfnptr ntfn
\<lbrace>\<lambda>_. equiv_but_for_labels aag L st\<rbrace>"
unfolding set_notification_def
unfolding set_simple_ko_def
apply (wp set_object_equiv_but_for_labels get_object_wp)
apply (clarsimp simp: asid_pool_at_kheap split: kernel_object.splits simp: obj_at_def)
apply (clarsimp simp: asid_pool_at_kheap partial_inv_def split: kernel_object.splits simp: obj_at_def)
done
lemma cancel_all_signals_reads_respects:
"reads_respects aag l (pas_refined aag and K (is_subject aag ntfnptr)) (cancel_all_signals ntfnptr)"
unfolding cancel_all_signals_def
apply ((wp mapM_x_ev'' tcb_sched_action_reads_respects set_thread_state_runnable_reads_respects set_thread_state_pas_refined hoare_vcg_ball_lift mapM_x_wp set_thread_state_runnable_valid_sched_action set_notification_reads_respects get_ep_queue_reads_respects get_epq_SendEP_ret get_epq_RecvEP_ret get_notification_reads_respects get_endpoint_wp set_notification_pas_refined hoare_vcg_all_lift | wpc | clarsimp simp: ball_conj_distrib | rule subset_refl | wp_once hoare_drop_imps | simp)+)[1]
apply ((wp mapM_x_ev'' tcb_sched_action_reads_respects set_thread_state_runnable_reads_respects
set_thread_state_pas_refined hoare_vcg_ball_lift mapM_x_wp set_thread_state_runnable_valid_sched_action
set_simple_ko_reads_respects get_epq_SendEP_ret get_epq_RecvEP_ret
get_simple_ko_reads_respects get_simple_ko_wp
| wpc | clarsimp simp: ball_conj_distrib | rule subset_refl | wp_once hoare_drop_imps | simp)+)[1]
done
(*
apply (wp hoare_vcg_all_lift)
apply(case_tac "aag_can_read aag ntfnptr \<or> aag_can_affect aag l ntfnptr")
apply((wp mapM_x_ev' set_thread_state_reads_respects set_notification_reads_respects
get_notification_reads_respects hoare_vcg_all_lift
apply((wp mapM_x_ev' set_thread_state_reads_respects set_simple_ko_reads_respects
get_simple_ko_reads_respects hoare_vcg_all_lift
| wpc | simp)+)[1]
apply (wp hoare_drop_imps)
@ -1029,8 +1021,8 @@ lemma cancel_all_signals_reads_respects:
apply(clarsimp)
apply(fold equiv_valid_def2)
apply(rule equiv_valid_guard_imp)
apply((wp mapM_x_ev' set_thread_state_reads_respects set_notification_reads_respects
get_notification_reads_respects hoare_vcg_all_lift
apply((wp mapM_x_ev' set_thread_state_reads_respects set_simple_ko_reads_respects
get_simple_ko_reads_respects hoare_vcg_all_lift
| wpc | simp)+)[1]
apply clarsimp+
apply force
@ -1169,8 +1161,8 @@ apply wp
apply (clarsimp, wp)[1]
-- "interesting case, ntfn is bound"
apply (clarsimp)
apply ((wp set_bound_notification_none_reads_respects set_notification_reads_respects
get_notification_reads_respects
apply ((wp set_bound_notification_none_reads_respects set_simple_ko_reads_respects
get_simple_ko_reads_respects
| wpc
| simp)+)
done
@ -1179,8 +1171,8 @@ lemma unbind_notification_is_subj_reads_respects:
"reads_respects aag l (pas_refined aag and invs and K (is_subject aag t))
(unbind_notification t)"
apply (clarsimp simp: unbind_notification_def)
apply (wp set_bound_notification_owned_reads_respects set_notification_reads_respects
get_notification_reads_respects get_bound_notification_reads_respects
apply (wp set_bound_notification_owned_reads_respects set_simple_ko_reads_respects
get_simple_ko_reads_respects get_bound_notification_reads_respects
gbn_wp[unfolded get_bound_notification_def, simplified]
| wpc
| simp add: get_bound_notification_def)+
@ -1199,7 +1191,7 @@ lemma fast_finalise_reads_respects:
equiv_valid_guard_imp[OF cancel_all_signals_reads_respects]
unbind_notification_is_subj_reads_respects
unbind_maybe_notification_reads_respects
get_notification_reads_respects get_ntfn_wp
get_simple_ko_reads_respects get_simple_ko_wp
| simp add: when_def
| wpc
| intro conjI impI
@ -1275,7 +1267,9 @@ lemma blocked_cancel_ipc_reads_respects:
"reads_respects aag l (pas_refined aag and invs and st_tcb_at (op = state) tptr and (\<lambda>_. (is_subject aag tptr)))
(blocked_cancel_ipc state tptr)"
unfolding blocked_cancel_ipc_def
apply(wp set_thread_state_owned_reads_respects set_endpoint_reads_respects get_ep_queue_reads_respects get_endpoint_reads_respects get_blocking_object_reads_respects | simp add: get_blocking_object_def | wpc)+
apply(wp set_thread_state_owned_reads_respects set_simple_ko_reads_respects get_ep_queue_reads_respects
get_simple_ko_reads_respects get_blocking_object_reads_respects
| simp add: get_blocking_object_def | wpc)+
apply(fastforce intro: aag_can_read_self owns_thread_blocked_reads_endpoint simp: st_tcb_at_sym)
done
@ -1368,14 +1362,14 @@ lemma cancel_signal_reads_respects:
"reads_respects aag l ((\<lambda>s. is_subject aag (cur_thread s)) and K (aag_can_read_label aag (pasObjectAbs aag ntfnptr) \<or>
aag_can_affect aag l ntfnptr)) (cancel_signal threadptr ntfnptr)"
unfolding cancel_signal_def
apply(wp set_thread_state_reads_respects set_notification_reads_respects get_notification_reads_respects hoare_drop_imps | wpc | simp)+
apply(wp set_thread_state_reads_respects set_simple_ko_reads_respects get_simple_ko_reads_respects hoare_drop_imps | wpc | simp)+
done
lemma cancel_signal_owned_reads_respects:
"reads_respects aag l (K (is_subject aag threadptr) and K (aag_can_read_label aag (pasObjectAbs aag ntfnptr) \<or>
aag_can_affect aag l ntfnptr)) (cancel_signal threadptr ntfnptr)"
unfolding cancel_signal_def
apply(wp set_thread_state_owned_reads_respects set_notification_reads_respects get_notification_reads_respects hoare_drop_imps | wpc | simp)+
apply(wp set_thread_state_owned_reads_respects set_simple_ko_reads_respects get_simple_ko_reads_respects hoare_drop_imps | wpc | simp)+
done
lemma cancel_ipc_reads_respects_f:
@ -1793,7 +1787,7 @@ lemma cancel_all_ipc_globals_equiv':
\<lbrace> \<lambda>_. globals_equiv st and valid_ko_at_arm \<rbrace>"
unfolding cancel_all_ipc_def
apply(wp mapM_x_wp[OF _ subset_refl] set_thread_state_globals_equiv
set_endpoint_globals_equiv hoare_vcg_all_lift get_object_inv
set_simple_ko_globals_equiv hoare_vcg_all_lift get_object_inv
dxo_wp_weak | wpc | simp
| wp_once hoare_drop_imps)+
done
@ -1809,14 +1803,14 @@ lemma set_notification_globals_equiv:
"\<lbrace> globals_equiv st and valid_ko_at_arm \<rbrace>
set_notification ptr ntfn
\<lbrace> \<lambda>_. globals_equiv st \<rbrace>"
unfolding set_notification_def
unfolding set_simple_ko_def
apply(wp set_object_globals_equiv get_object_wp | simp)+
apply(fastforce simp: valid_ko_at_arm_def obj_at_def)+
done
lemma set_notification_valid_ko_at_arm:
"\<lbrace> valid_ko_at_arm \<rbrace> set_notification ptr ntfn \<lbrace>\<lambda>_. valid_ko_at_arm\<rbrace>"
unfolding set_notification_def
unfolding set_simple_ko_def
apply (wp get_object_wp)
apply(fastforce simp: valid_ko_at_arm_def get_tcb_ko_at obj_at_def)
done
@ -1865,7 +1859,7 @@ lemma unbind_maybe_notification_globals_equiv:
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding unbind_maybe_notification_def
by (wp gbn_wp set_bound_notification_globals_equiv set_notification_valid_ko_at_arm
set_notification_globals_equiv get_ntfn_wp
set_notification_globals_equiv get_simple_ko_wp
| wpc
| simp)+
@ -1875,7 +1869,7 @@ lemma unbind_maybe_notification_valid_ko_at_arm[wp]:
\<lbrace>\<lambda>_. valid_ko_at_arm\<rbrace>"
unfolding unbind_maybe_notification_def
by (wp gbn_wp set_bound_notification_valid_ko_at_arm set_notification_valid_ko_at_arm
get_ntfn_wp
get_simple_ko_wp
| wpc
| simp)+

101
proof/infoflow/Ipc_IF.thy
View File

@ -211,8 +211,8 @@ lemma update_waiting_ntfn_reads_respects:
unfolding update_waiting_ntfn_def fun_app_def
apply (wp assert_sp possible_switch_to_reads_respects gets_cur_thread_ev | simp add: split_def)+
apply (wp as_user_set_register_reads_respects' set_thread_state_reads_respects
set_notification_reads_respects set_thread_state_pas_refined
set_ntfn_valid_objs hoare_vcg_disj_lift set_notification_pas_refined
set_simple_ko_reads_respects set_thread_state_pas_refined
set_simple_ko_valid_objs hoare_vcg_disj_lift set_simple_ko_pas_refined
| simp add: split_def reads_lrefl)+
done
@ -274,7 +274,7 @@ lemma possible_switch_to_equiv_but_for_labels:
apply (clarsimp simp: etcb_at_def split: option.splits)
done
crunch etcb_at_cdom[wp]: set_thread_state_ext, set_thread_state, set_notification
crunch etcb_at_cdom[wp]: set_thread_state_ext, set_thread_state, set_simple_ko
"\<lambda>s. etcb_at (P (cur_domain s)) t s"
(wp: crunch_wps)
@ -292,8 +292,8 @@ lemma update_waiting_ntfn_equiv_but_for_labels:
\<lbrace> \<lambda>_. equiv_but_for_labels aag L st \<rbrace>"
unfolding update_waiting_ntfn_def
apply (wp static_imp_wp as_user_equiv_but_for_labels set_thread_state_runnable_equiv_but_for_labels
set_thread_state_pas_refined set_notification_equiv_but_for_labels set_ntfn_valid_objs_at
set_notification_pred_tcb_at set_notification_cte_wp_at set_notification_pas_refined
set_thread_state_pas_refined set_notification_equiv_but_for_labels
set_simple_ko_pred_tcb_at set_simple_ko_pas_refined
hoare_vcg_disj_lift possible_switch_to_equiv_but_for_labels
| wpc | simp add: split_def)+
apply (clarsimp simp: conj_ac)
@ -586,9 +586,9 @@ lemma blocked_cancel_ipc_nosts_reads_respects:
unfolding blocked_cancel_ipc_nosts_def get_blocking_object_def
apply clarsimp
apply (rule pre_ev)
apply ((wp set_thread_state_reads_respects set_endpoint_reads_respects get_ep_queue_reads_respects
get_endpoint_reads_respects get_blocking_object_reads_respects
gts_reads_respects
apply ((wp set_thread_state_reads_respects get_ep_queue_reads_respects
get_simple_ko_reads_respects get_blocking_object_reads_respects
gts_reads_respects set_simple_ko_reads_respects
gts_wp
| wpc
| simp add: get_blocking_object_def get_thread_state_rev)+)[2]
@ -674,19 +674,19 @@ lemma send_signal_reads_respects:
| rule_tac ntfnptr=ntfnptr in blocked_cancel_ipc_nosts_reads_respects
| rule cancel_ipc_reads_respects_rewrite
| wp_once
set_notification_reads_respects
set_simple_ko_reads_respects
possible_switch_to_reads_respects
as_user_set_register_reads_respects'
set_thread_state_pas_refined
set_thread_state_pas_refined
set_notification_reads_respects
set_simple_ko_reads_respects
gts_reads_respects
cancel_ipc_receive_blocked_pas_refined
gts_wp
hoare_vcg_imp_lift
update_waiting_ntfn_reads_respects
get_ntfn_wp
get_notification_reads_respects
get_simple_ko_wp
get_simple_ko_reads_respects
| wpc
| simp )+
apply (insert visible)
@ -745,7 +745,7 @@ lemma send_signal_reads_respects:
blocked_cancel_ipc_nosts_equiv_but_for_labels
gts_wp
update_waiting_ntfn_equiv_but_for_labels
get_ntfn_wp
get_simple_ko_wp
| wpc
| wps
)+
@ -816,8 +816,8 @@ lemma receive_signal_reads_respects:
\<in> pasPolicy aag \<and> is_subject aag thread)))
(receive_signal thread cap is_blocking)"
unfolding receive_signal_def fun_app_def do_nbrecv_failed_transfer_def
apply(wp set_notification_reads_respects set_thread_state_reads_respects
as_user_set_register_reads_respects' get_notification_reads_respects hoare_vcg_all_lift
apply(wp set_simple_ko_reads_respects set_thread_state_reads_respects
as_user_set_register_reads_respects' get_simple_ko_reads_respects hoare_vcg_all_lift
| wpc
| wp_once hoare_drop_imps)+
apply(force dest: reads_ep)
@ -1221,7 +1221,7 @@ lemma load_cap_transfer_rev:
lemma get_endpoint_rev:
"reads_equiv_valid_inv A aag (K (is_subject aag ptr)) (get_endpoint ptr)"
unfolding get_endpoint_def
unfolding get_simple_ko_def
apply(wp get_object_rev | wpc | simp)+
done
@ -1295,7 +1295,7 @@ lemma cancel_badged_sends_equiv_but_for_labels:
apply(wp mapM_wp' set_thread_state_equiv_but_for_labels gts_wp | simp add: filterM_mapM)+
apply(fastforce simp: all_with_auth_to_def)
apply simp
apply(wp set_endpoint_equiv_but_for_labels get_endpoint_wp | simp)+
apply(wp set_endpoint_equiv_but_for_labels get_simple_ko_wp | simp)+
apply clarsimp
apply(frule send_endpoint_threads_blocked, (simp | assumption)+)
apply(drule send_blocked_threads_have_SyncSend_auth, (simp | assumption)+)
@ -1313,8 +1313,8 @@ lemma cancel_badged_sends_reads_respects:
apply (rule_tac Q="\<lambda>s.
(case rv of SendEP list \<Rightarrow> \<forall>x\<in>set list. aag_can_read aag x \<or> aag_can_affect aag l x | _ \<Rightarrow> True)" in equiv_valid_guard_imp)
apply (case_tac rv)
apply ((wp mapM_ev'' get_thread_state_reads_respects set_thread_state_reads_respects set_endpoint_reads_respects get_endpoint_reads_respects hoare_vcg_ball_lift | wpc | simp add: filterM_mapM tcb_at_st_tcb_at[symmetric])+)
apply (wp get_endpoint_wp)
apply ((wp mapM_ev'' get_thread_state_reads_respects set_thread_state_reads_respects set_simple_ko_reads_respects get_simple_ko_reads_respects hoare_vcg_ball_lift | wpc | simp add: filterM_mapM tcb_at_st_tcb_at[symmetric])+)
apply (wp get_simple_ko_wp)
apply (intro impI allI conjI)
apply simp
apply (case_tac ep,simp_all)
@ -1345,9 +1345,12 @@ lemma cancel_badged_sends_reads_respects:
apply (rule gen_asm_ev)+
apply(simp add: cancel_badged_sends_def fun_app_def)
apply wp
apply ((wp mapM_ev'' mapM_wp get_thread_state_reads_respects set_thread_state_runnable_reads_respects set_endpoint_reads_respects get_endpoint_reads_respects hoare_vcg_ball_lift tcb_sched_action_reads_respects set_thread_state_pas_refined | wpc | simp add: filterM_mapM tcb_at_st_tcb_at[symmetric] | wp_once hoare_drop_imps | rule subset_refl | force)+)[1]
apply (wp get_endpoint_reads_respects)
apply (wp get_endpoint_wp)
apply ((wp mapM_ev'' mapM_wp get_thread_state_reads_respects set_thread_state_runnable_reads_respects
set_simple_ko_reads_respects get_simple_ko_reads_respects hoare_vcg_ball_lift
tcb_sched_action_reads_respects set_thread_state_pas_refined
| wpc | simp add: filterM_mapM tcb_at_st_tcb_at[symmetric] | wp_once hoare_drop_imps | rule subset_refl | force)+)[1]
apply (wp get_simple_ko_reads_respects)
apply (wp get_simple_ko_wp)
apply simp
apply (intro conjI allI impI ballI, elim conjE)
apply (rule send_endpoint_reads_affects_queued[where epptr = epptr])
@ -1701,8 +1704,8 @@ lemma complete_signal_reads_respects:
"reads_respects aag l ( K(aag_can_read aag ntfnptr \<or> aag_can_affect aag l ntfnptr))
(complete_signal ntfnptr receiver)"
unfolding complete_signal_def
apply (wp set_notification_reads_respects
get_notification_reads_respects
apply (wp set_simple_ko_reads_respects
get_simple_ko_reads_respects
as_user_set_register_reads_respects'
| wpc
| simp)+
@ -1726,11 +1729,11 @@ lemma receive_ipc_base_reads_respects:
apply (simp add: thread_get_def split: endpoint.split)
apply (intro conjI impI)
prefer 2 defer
apply ((wp set_thread_state_reads_respects set_endpoint_reads_respects
apply ((wp set_thread_state_reads_respects set_simple_ko_reads_respects
as_user_set_register_reads_respects'
| simp | intro allI impI | rule pre_ev, wpc)+)[2]
apply (intro allI impI)
apply (wp static_imp_wp set_endpoint_reads_respects set_thread_state_reads_respects
apply (wp static_imp_wp set_simple_ko_reads_respects set_thread_state_reads_respects
setup_caller_cap_reads_respects do_ipc_transfer_reads_respects
possible_switch_to_reads_respects
gets_cur_thread_ev set_thread_state_pas_refined
@ -1740,11 +1743,11 @@ lemma receive_ipc_base_reads_respects:
apply (rule_tac Q="\<lambda>rv s. pas_refined aag s \<and> pas_cur_domain aag s \<and> is_subject aag (cur_thread s) \<and>
(sender_can_grant rvd \<longrightarrow> is_subject aag (hd list))"
in hoare_strengthen_post)
apply(wp set_endpoint_reads_respects
hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1]
apply(wp set_simple_ko_reads_respects
hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1]
hoare_vcg_all_lift
set_thread_state_reads_respects get_endpoint_reads_respects
get_endpoint_wp do_ipc_transfer_pas_refined
set_thread_state_reads_respects get_simple_ko_reads_respects
get_simple_ko_wp do_ipc_transfer_pas_refined
| wpc | simp add: get_thread_state_def thread_get_def)+
apply (clarsimp simp: conj_comms)
apply (rename_tac x s)
@ -1804,7 +1807,7 @@ lemma receive_ipc_reads_respects:
apply (wp receive_ipc_base_reads_respects[simplified AllowSend_def]
complete_signal_reads_respects
| simp)+
apply (wp static_imp_wp set_endpoint_reads_respects set_thread_state_reads_respects
apply (wp static_imp_wp set_simple_ko_reads_respects set_thread_state_reads_respects
setup_caller_cap_reads_respects do_ipc_transfer_reads_respects
complete_signal_reads_respects thread_get_reads_respects
get_thread_state_reads_respects
@ -1812,12 +1815,12 @@ lemma receive_ipc_reads_respects:
gets_cur_thread_ev set_thread_state_pas_refined
do_ipc_transfer_pas_refined
hoare_vcg_all_lift
get_notification_reads_respects
get_simple_ko_reads_respects
get_bound_notification_reads_respects'
gbn_wp
get_endpoint_reads_respects
get_ntfn_wp
get_endpoint_wp
get_simple_ko_reads_respects
get_simple_ko_wp
get_simple_ko_wp
| wpc
| simp)+
apply (clarsimp)
@ -1877,7 +1880,7 @@ lemma send_ipc_reads_respects:
\<and> aag_has_auth_to aag Grant epptr))) and K (is_subject aag thread \<and> (pasSubject aag, SyncSend, pasObjectAbs aag epptr) \<in> pasPolicy aag)) (send_ipc block call badge can_grant thread epptr)"
apply(rule gen_asm_ev)
apply(simp add: send_ipc_def)
apply (wp set_endpoint_reads_respects set_thread_state_reads_respects
apply (wp set_simple_ko_reads_respects set_thread_state_reads_respects
when_ev setup_caller_cap_reads_respects thread_get_reads_respects
| wpc | simp split del: if_split)+
apply(rename_tac list word list' rvb)
@ -1886,9 +1889,9 @@ lemma send_ipc_reads_respects:
in hoare_strengthen_post)
apply(wp set_thread_state_reads_respects
do_ipc_transfer_reads_respects
set_endpoint_reads_respects
hoare_vcg_imp_lift [OF set_endpoint_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
get_endpoint_reads_respects get_endpoint_wp
set_simple_ko_reads_respects
hoare_vcg_imp_lift [OF set_simple_ko_get_tcb, unfolded disj_not1] hoare_vcg_all_lift
get_simple_ko_reads_respects get_simple_ko_wp
possible_switch_to_reads_respects
gets_cur_thread_ev set_thread_state_pas_refined
do_ipc_transfer_pas_refined
@ -2246,7 +2249,7 @@ lemma send_ipc_globals_equiv:
send_ipc block call badge can_grant thread epptr
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding send_ipc_def
apply(wp set_endpoint_globals_equiv set_thread_state_globals_equiv
apply(wp set_simple_ko_globals_equiv set_thread_state_globals_equiv
setup_caller_cap_globals_equiv | wpc)+
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_ko_at_arm and valid_global_objs"
in hoare_strengthen_post)
@ -2257,12 +2260,12 @@ lemma send_ipc_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_simple_ko_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"
in hoare_strengthen_post)
apply(wp get_endpoint_sp)
apply(wp get_simple_ko_sp)
apply(clarsimp simp: valid_arch_state_ko_at_arm)+
apply (rule context_conjI)
apply(rule valid_ep_recv_dequeue')
@ -2290,18 +2293,18 @@ lemma receive_ipc_globals_equiv:
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
apply(wp set_simple_ko_globals_equiv set_thread_state_globals_equiv
setup_caller_cap_globals_equiv dxo_wp_weak as_user_globals_equiv
| wpc
| simp split del: if_split)+
apply (rule hoare_strengthen_post[where Q= "\<lambda>_. globals_equiv st and valid_ko_at_arm and valid_global_objs"])
apply (wp do_ipc_transfer_globals_equiv as_user_globals_equiv)
apply clarsimp
apply (wp gts_wp get_endpoint_sp | wpc)+
apply (wp gts_wp get_simple_ko_sp | wpc)+
apply (wp hoare_vcg_all_lift hoare_drop_imps)[1]
apply(wp set_endpoint_globals_equiv | wpc)+
apply(wp set_simple_ko_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 get_simple_ko_wp gbn_wp get_simple_ko_wp as_user_globals_equiv | wpc | simp)+
apply (rule hoare_pre)
apply(wpc)
apply(rule fail_wp | rule return_wp)+
@ -2339,7 +2342,7 @@ lemma
blocked_cancel_ipc_globals_equiv[wp]:
"\<lbrace>globals_equiv st and valid_ko_at_arm\<rbrace> blocked_cancel_ipc a b \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
unfolding blocked_cancel_ipc_def
by (wp set_thread_state_globals_equiv set_endpoint_globals_equiv | wpc | simp)+
by (wp set_thread_state_globals_equiv set_simple_ko_globals_equiv | wpc | simp)+
@ -2373,7 +2376,7 @@ lemma send_signal_globals_equiv:
as_user_globals_equiv
cancel_ipc_blocked_globals_equiv
update_waiting_ntfn_globals_equiv
get_ntfn_wp
get_simple_ko_wp
gts_wp
| wpc
| simp)+
@ -2396,7 +2399,7 @@ lemma receive_signal_globals_equiv:
unfolding receive_signal_def fun_app_def do_nbrecv_failed_transfer_def
apply (rule hoare_pre)
apply(wp set_notification_globals_equiv set_thread_state_globals_equiv
as_user_globals_equiv get_ntfn_wp
as_user_globals_equiv get_simple_ko_wp
| wpc)+
apply(simp add: valid_arch_state_ko_at_arm)
done

8
proof/infoflow/Syscall_IF.thy
View File

@ -669,9 +669,9 @@ lemma handle_recv_reads_respects_f:
reads_respects_f[OF lookup_slot_for_thread_rev, where st=st and Q=\<top>]
reads_respects_f_inv[OF get_cap_rev get_cap_silc_inv, where st=st]
get_cap_auth_wp[where aag=aag]
reads_respects_f[OF get_notification_reads_respects, where st=st and Q=\<top>]
reads_respects_f[OF get_simple_ko_reads_respects, where st=st and Q=\<top>]
lookup_slot_for_thread_authorised
get_ntfn_wp
get_simple_ko_wp
shows
"reads_respects_f aag l (silc_inv aag st and einvs and ct_active and
pas_refined aag and pas_cur_domain aag and is_subject aag \<circ> cur_thread) (handle_recv is_blocking)"
@ -704,7 +704,7 @@ lemma handle_recv_reads_respects_f:
apply(rule reads_ep[where auth=Receive])
apply(fastforce simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def)+
apply(wp reads_respects_f[OF handle_fault_reads_respects,where st=st])
apply (wpsimp wp: get_ntfn_wp get_cap_wp)+
apply (wpsimp wp: get_simple_ko_wp get_cap_wp)+
apply(rule VSpaceEntries_AI.hoare_vcg_all_liftE)
apply (rule_tac Q="\<lambda>r s. silc_inv aag st s \<and> einvs s \<and> pas_refined aag s \<and>
tcb_at rv s \<and> pas_cur_domain aag s \<and>
@ -722,7 +722,7 @@ lemma handle_recv_reads_respects_f:
lemma handle_recv_globals_equiv:
"\<lbrace>globals_equiv (st :: det_state) and invs and ct_active\<rbrace> handle_recv is_blocking \<lbrace>\<lambda>r. globals_equiv st\<rbrace>"
unfolding handle_recv_def
apply (wp handle_fault_globals_equiv get_ntfn_wp
apply (wp handle_fault_globals_equiv get_simple_ko_wp
| wpc | simp add: Let_def)+
apply (rule_tac Q="\<lambda>r s. invs s \<and> globals_equiv st s" and
E = "\<lambda>r s. valid_fault (CapFault (of_bl ep_cptr) True r)" in hoare_post_impErr)

6
proof/infoflow/Tcb_IF.thy
View File

@ -60,7 +60,7 @@ 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
by (wpsimp wp: set_thread_state_globals_equiv get_notification_valid_ko_at_arm
by (wpsimp wp: set_thread_state_globals_equiv get_simple_ko_valid_ko_at_arm
set_notification_globals_equiv set_notification_valid_ko_at_arm hoare_drop_imps
simp: crunch_simps)
@ -614,8 +614,8 @@ lemma bind_notification_reads_respects:
"reads_respects aag l (pas_refined aag and invs and K (is_subject aag t \<and> (\<forall>auth\<in>{Receive, Reset}. (pasSubject aag, auth, pasObjectAbs aag ntfnptr) \<in> pasPolicy aag)))
(bind_notification t ntfnptr)"
apply (clarsimp simp: bind_notification_def)
apply (wp set_bound_notification_owned_reads_respects set_notification_reads_respects
get_notification_reads_respects get_bound_notification_reads_respects
apply (wp set_bound_notification_owned_reads_respects set_simple_ko_reads_respects
get_simple_ko_reads_respects get_bound_notification_reads_respects
gbn_wp[unfolded get_bound_notification_def, simplified]
| wpc
| simp add: get_bound_notification_def)+

2
proof/refine/ARM/Finalise_R.thy
View File

@ -3592,7 +3592,7 @@ lemma unbind_maybe_notification_corres:
apply (rule corres_split[OF _ set_ntfn_corres])
apply (rule sbn_corres)
apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
apply (wp get_ntfn_wp getNotification_wp)+
apply (wp get_simple_ko_wp getNotification_wp)+
apply (clarsimp elim!: obj_at_valid_objsE
dest!: bound_tcb_at_state_refs_ofD invs_valid_objs
simp: valid_obj_def is_tcb tcb_ntfn_is_bound_def

6
proof/refine/ARM/IpcCancel_R.thy
View File

@ -2056,7 +2056,7 @@ proof -
show ?thesis
apply (simp add: cancel_all_ipc_def cancelAllIPC_def)
apply (rule corres_split' [OF _ _ get_endpoint_sp get_ep_sp'])
apply (rule corres_split' [OF _ _ get_simple_ko_sp get_ep_sp'])
apply (rule corres_guard_imp [OF get_ep_corres], simp+)
apply (case_tac epa, simp_all add: ep_relation_def
get_ep_queue_def)
@ -2083,7 +2083,7 @@ lemma ntfn_cancel_corres:
"corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
(cancel_all_signals ntfn) (cancelAllSignals ntfn)"
apply (simp add: cancel_all_signals_def cancelAllSignals_def)
apply (rule corres_split' [OF _ _ get_ntfn_sp get_ntfn_sp'])
apply (rule corres_split' [OF _ _ get_simple_ko_sp get_ntfn_sp'])
apply (rule corres_guard_imp [OF get_ntfn_corres])
apply simp+
apply (case_tac "ntfn_obj ntfna", simp_all add: ntfn_relation_def)
@ -2698,7 +2698,7 @@ lemma cancel_badged_sends_corres:
(cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
apply (simp add: cancel_badged_sends_def cancelBadgedSends_def)
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ get_ep_corres get_endpoint_sp get_ep_sp',
apply (rule corres_split [OF _ get_ep_corres get_simple_ko_sp get_ep_sp',
where Q="invs and valid_sched" and Q'=invs'])
apply simp_all
apply (case_tac ep, simp_all add: ep_relation_def)

23
proof/refine/ARM/Ipc_R.thy
View File

@ -2739,13 +2739,14 @@ proof -
apply (simp)
apply (wp weak_sch_act_wf_lift_linear set_ep_valid_objs' setEndpoint_valid_mdb')+
apply (clarsimp simp add: invs_def valid_state_def valid_pspace_def ep_redux_simps
ep_redux_simps' st_tcb_at_tcb_at valid_ep_def cong: list.case_cong)
ep_redux_simps' st_tcb_at_tcb_at valid_ep_def
cong: list.case_cong)
apply (drule(1) sym_refs_obj_atD[where P="\<lambda>ob. ob = e" for e])
apply (clarsimp simp: st_tcb_at_refs_of_rev st_tcb_at_reply_cap_valid st_tcb_at_caller_cap_null)
apply (fastforce simp: st_tcb_def2 valid_sched_def valid_sched_action_def)
subgoal by (auto simp: valid_ep'_def invs'_def valid_state'_def split: list.split)
apply wp+
apply (clarsimp)+
apply (clarsimp simp: ep_at_def2)+
apply (rule corres_guard_imp)
apply (rule corres_split [OF _ get_ep_corres,
where
@ -2831,7 +2832,7 @@ proof -
split: list.split;
clarsimp simp: invs'_def valid_state'_def)
apply wp+
apply (clarsimp)+
apply (clarsimp simp: ep_at_def2)+
done
qed
@ -2876,7 +2877,7 @@ lemma send_signal_corres:
R' = "\<lambda>rv'. invs' and ntfn_at' ep and
valid_ntfn' rv' and ko_at' rv' ep"])
defer
apply (wp get_ntfn_ko get_ntfn_ko')+
apply (wp get_simple_ko_ko_at get_ntfn_ko')+
apply (simp add: invs_valid_objs)+
apply (case_tac "ntfn_obj ntfn")
-- "IdleNtfn"
@ -2943,7 +2944,7 @@ lemma send_signal_corres:
setThreadState_st_tcb
| simp)+
apply (simp add: ntfn_relation_def)
apply (wp set_ntfn_valid_objs set_ntfn_aligned' set_ntfn_valid_objs'
apply (wp set_simple_ko_valid_objs set_ntfn_aligned' set_ntfn_valid_objs'
hoare_vcg_disj_lift weak_sch_act_wf_lift_linear
| simp add: valid_tcb_state_def valid_tcb_state'_def)+
apply (clarsimp simp: invs_def valid_state_def valid_ntfn_def
@ -2968,7 +2969,7 @@ lemma send_signal_corres:
setThreadState_st_tcb
| simp)+
apply (simp add: ntfn_relation_def split:list.splits)
apply (wp set_ntfn_aligned' set_ntfn_valid_objs set_ntfn_valid_objs'
apply (wp set_ntfn_aligned' set_simple_ko_valid_objs set_ntfn_valid_objs'
hoare_vcg_disj_lift weak_sch_act_wf_lift_linear
| simp add: valid_tcb_state_def valid_tcb_state'_def)+
apply (clarsimp simp: invs_def valid_state_def valid_ntfn_def
@ -3454,7 +3455,7 @@ lemma complete_signal_corres:
apply (simp add: badgeRegister_def badge_register_def)
apply (rule corres_split[OF set_ntfn_corres user_setreg_corres])
apply (clarsimp simp: ntfn_relation_def)
apply (wp set_ntfn_valid_objs get_ntfn_wp getNotification_wp | clarsimp simp: valid_ntfn'_def)+
apply (wp set_simple_ko_valid_objs get_simple_ko_wp getNotification_wp | clarsimp simp: valid_ntfn'_def)+
apply (clarsimp simp: valid_pspace'_def)
apply (frule_tac P="(\<lambda>k. k = ntfn)" in obj_at_valid_objs', assumption)
apply (clarsimp simp: projectKOs valid_obj'_def valid_ntfn'_def obj_at'_def)
@ -3602,9 +3603,9 @@ lemma receive_ipc_corres:
apply clarsimp
apply (rule corres_trivial, simp add: ntfn_relation_def default_notification_def
default_ntfn_def)
apply (wp get_ntfn_wp getNotification_wp gbn_wp gbn_wp' hoare_vcg_all_lift hoare_vcg_imp_lift
hoare_vcg_if_lift
| wpc | simp | clarsimp)+
apply (wp get_simple_ko_wp[where f=Notification] getNotification_wp gbn_wp gbn_wp'
hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_if_lift
| wpc | simp add: ep_at_def2[symmetric, simplified] | clarsimp)+
apply (clarsimp simp: valid_cap_def invs_psp_aligned invs_valid_objs pred_tcb_at_def
valid_obj_def valid_tcb_def valid_bound_ntfn_def
dest!: invs_valid_objs
@ -3667,7 +3668,7 @@ lemma receive_signal_corres:
elim!: st_tcb_weakenE)
apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
apply wp+
apply (clarsimp simp add: valid_cap_def st_tcb_at_tcb_at)
apply (clarsimp simp add: ntfn_at_def2 valid_cap_def st_tcb_at_tcb_at)
apply (clarsimp simp add: valid_cap'_def)
done

18
proof/refine/ARM/KHeap_R.thy
View File

@ -897,10 +897,10 @@ lemma get_ep_corres [corres]:
(get_endpoint ptr) (getEndpoint ptr)"
apply (rule corres_no_failI)
apply wp
apply (simp add: get_endpoint_def getEndpoint_def get_object_def
getObject_def bind_assoc)
apply (simp add: get_simple_ko_def getEndpoint_def get_object_def
getObject_def bind_assoc ep_at_def2)
apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def)
apply (clarsimp simp add: assert_def fail_def obj_at_def return_def is_ep)
apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_ep partial_inv_def)
apply (clarsimp simp: loadObject_default_def in_monad projectKOs
in_magnitude_check objBits_simps')
apply (clarsimp simp add: state_relation_def pspace_relation_def)
@ -1086,19 +1086,19 @@ lemma set_ep_corres [corres]:
"ep_relation e e' \<Longrightarrow>
corres dc (ep_at ptr) (ep_at' ptr)
(set_endpoint ptr e) (setEndpoint ptr e')"
apply (simp add: set_endpoint_def setEndpoint_def is_ep_def[symmetric])
apply (simp add: set_simple_ko_def setEndpoint_def is_ep_def[symmetric])
apply (corres_search search: set_other_obj_corres[where P="\<lambda>_. True"])
apply (corressimp wp: get_object_ret get_object_wp)+
by (clarsimp simp: is_ep obj_at_simps objBits_defs)
by (fastforce simp: is_ep obj_at_simps objBits_defs partial_inv_def)
lemma set_ntfn_corres [corres]:
"ntfn_relation ae ae' \<Longrightarrow>
corres dc (ntfn_at ptr) (ntfn_at' ptr)
(set_notification ptr ae) (setNotification ptr ae')"
apply (simp add: set_notification_def setNotification_def is_ntfn_def[symmetric])
apply (simp add: set_simple_ko_def setNotification_def is_ntfn_def[symmetric])
apply (corres_search search: set_other_obj_corres[where P="\<lambda>_. True"])
apply (corressimp wp: get_object_ret get_object_wp)+
by (clarsimp simp: is_ntfn obj_at_simps objBits_defs)
by (fastforce simp: is_ntfn obj_at_simps objBits_defs partial_inv_def)
lemma no_fail_getNotification [wp]:
"no_fail (ntfn_at' ptr) (getNotification ptr)"
@ -1121,10 +1121,10 @@ lemma get_ntfn_corres:
(get_notification ptr) (getNotification ptr)"
apply (rule corres_no_failI)
apply wp
apply (simp add: get_notification_def getNotification_def get_object_def
apply (simp add: get_simple_ko_def getNotification_def get_object_def
getObject_def bind_assoc)
apply (clarsimp simp: in_monad split_def bind_def gets_def get_def return_def)
apply (clarsimp simp add: assert_def fail_def obj_at_def return_def is_ntfn)
apply (clarsimp simp: assert_def fail_def obj_at_def return_def is_ntfn partial_inv_def)
apply (clarsimp simp: loadObject_default_def in_monad projectKOs
in_magnitude_check objBits_simps')
apply (clarsimp simp add: state_relation_def pspace_relation_def)

4
proof/refine/ARM/Syscall_R.thy
View File

@ -1726,11 +1726,11 @@ lemma hw_corres':
apply (rule corres_trivial)
apply (clarsimp simp: lookup_failure_map_def)+
apply (rule get_ntfn_corres)
apply (wp get_ntfn_wp getNotification_wp | wpcw | simp)+
apply (wp get_simple_ko_wp getNotification_wp | wpcw | simp)+
apply (clarsimp simp: lookup_failure_map_def)
apply (clarsimp simp: valid_cap_def ct_in_state_def)
apply (clarsimp simp: valid_cap'_def capAligned_def)
apply (wp get_ntfn_wp | wpcw | simp)+
apply (wp get_simple_ko_wp | wpcw | simp)+
apply (rule hoare_vcg_E_elim)
apply (simp add: lookup_cap_def lookup_slot_for_thread_def)
apply wp