(* * Copyright 2022, Proofcraft Pty Ltd * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230) * * SPDX-License-Identifier: GPL-2.0-only *) theory Ipc_IF imports ArchFinalise_IF begin section "reads_respects" subsection "Notifications" definition ipc_buffer_has_read_auth :: "'a PAS \ 'a \ obj_ref option \ bool" where "ipc_buffer_has_read_auth aag l \ case_option True (\buf'. is_aligned buf' msg_align_bits \ (\x \ ptr_range buf' msg_align_bits. (l,Read,pasObjectAbs aag x) \ (pasPolicy aag)))" abbreviation aag_can_read_or_affect where "aag_can_read_or_affect aag l x \ aag_can_read aag x \ aag_can_affect aag l x" lemma get_cap_reads_respects: "reads_respects aag l (K (aag_can_read aag (fst slot) \ aag_can_affect aag l (fst slot))) (get_cap slot)" apply (simp add: get_cap_def split_def) apply (wp get_object_reads_respects | wpc | simp)+ done lemma set_thread_state_ext_runnable_equiv_but_for_labels: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag thread \ L) and st_tcb_at runnable thread\ set_thread_state_ext thread \\_. equiv_but_for_labels aag L st\" apply (simp add: set_thread_state_ext_def) apply (wp gts_wp | rule hoare_pre_cont)+ apply (force simp: st_tcb_at_def obj_at_def) done definition all_to_which_has_auth where "all_to_which_has_auth aag auth source \ {t. (source,auth,t) \ pasPolicy aag}" definition all_with_auth_to where "all_with_auth_to aag auth target \ {x. (x, auth, target) \ pasPolicy aag}" lemma valid_ntfn_WaitingNtfn_tl: "\ ntfn_obj ntfn = (WaitingNtfn list); valid_ntfn ntfn s; tl list \ []; ntfn' = ntfn\ntfn_obj := (WaitingNtfn (tl list))\ \ \ valid_ntfn ntfn' s" apply (case_tac list, simp_all) apply (rename_tac a lista) apply (case_tac lista, simp_all) apply (clarsimp simp: valid_ntfn_def split: option.splits) done lemma tcb_sched_action_equiv_but_for_labels: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag thread \ L) and pas_refined aag\ tcb_sched_action action thread \\_. equiv_but_for_labels aag L st\" apply (simp add: tcb_sched_action_def, wp) apply (clarsimp simp: etcb_at_def equiv_but_for_labels_def split: option.splits) apply (rule states_equiv_forI) apply (fastforce intro!: equiv_forI elim!: states_equiv_forE dest: equiv_forD[where f=kheap]) apply (simp add: states_equiv_for_def) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=cdt]) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=ekheap]) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=cdt_list]) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=is_original_cap]) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=interrupt_states]) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=interrupt_irq_node]) apply (fastforce simp: equiv_asids_def elim: states_equiv_forE) apply (clarsimp simp: pas_refined_def tcb_domain_map_wellformed_aux_def split: option.splits) apply (rule equiv_forI) apply (erule_tac x="(thread, tcb_domain (the (ekheap s thread)))" in ballE) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=ready_queues]) apply (force intro: domtcbs) done lemma possible_switch_to_equiv_but_for_labels: "\equiv_but_for_labels aag L st and (\s. etcb_at (\etcb. tcb_domain etcb \ cur_domain s) target s) and K (pasObjectAbs aag target \ L) and pas_refined aag\ possible_switch_to target \\_. equiv_but_for_labels aag L st\" apply (simp add: possible_switch_to_def) apply (wp tcb_sched_action_equiv_but_for_labels) (* possible_switch_to does not modify scheduler action if target is in different domain *) apply (rule hoare_pre_cont) apply (wp tcb_sched_action_equiv_but_for_labels) apply (rule hoare_pre_cont) apply (wp tcb_sched_action_equiv_but_for_labels)+ apply (clarsimp simp: etcb_at_def split: option.splits) done crunches set_thread_state_ext, set_thread_state, set_simple_ko for etcb_at_cdom[wp]: "\s. etcb_at (P (cur_domain s)) t s" (wp: crunch_wps) locale Ipc_IF_1 = fixes aag :: "'a subject_label PAS" assumes lookup_ipc_buffer_reads_respects: "reads_respects aag l (K (aag_can_read aag thread \ aag_can_affect aag l thread)) (lookup_ipc_buffer is_receiver thread)" and as_user_equiv_but_for_labels: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag thread \ L)\ as_user thread (f :: unit user_monad) \\_. equiv_but_for_labels aag L st\" and storeWord_equiv_but_for_labels: "\\ms. equiv_but_for_labels aag L st (s\machine_state := ms\) \ for_each_byte_of_word (\x. pasObjectAbs aag x \ L) p\ storeWord p v \\_ ms. equiv_but_for_labels aag L st (s\machine_state := ms\)\" and set_thread_state_runnable_equiv_but_for_labels: "runnable tst \ \equiv_but_for_labels aag L st and K (pasObjectAbs aag thread \ L)\ set_thread_state thread tst \\_. equiv_but_for_labels aag L st\" and set_endpoint_equiv_but_for_labels: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag epptr \ L)\ set_endpoint epptr ep \\_. equiv_but_for_labels aag L st\" and lookup_ipc_buffer_has_read_auth: "\pas_refined aag and valid_objs\ lookup_ipc_buffer is_receiver thread \\rv _. ipc_buffer_has_read_auth aag (pasObjectAbs aag thread) rv\" and dmo_loadWord_reads_respects: "reads_respects aag l (K (for_each_byte_of_word (\ x. aag_can_read_or_affect aag l x) p)) (do_machine_op (loadWord p))" and arch_derive_cap_reads_respects: "reads_respects aag l \ (arch_derive_cap acap)" and arch_derive_cap_rev: "reads_equiv_valid_inv A aag \ (arch_derive_cap acap)" and cptrs_in_ipc_buffer: "\ n \ set [buffer_cptr_index ..< buffer_cptr_index + unat (mi_extra_caps mi)]; is_aligned p msg_align_bits; buffer_cptr_index + unat (mi_extra_caps mi) < 2 ^ (msg_align_bits - word_size_bits) \ \ ptr_range (p + of_nat n * of_nat word_size) word_size_bits \ ptr_range p msg_align_bits" and msg_in_ipc_buffer: "\ n = msg_max_length \ n < msg_max_length; is_aligned p msg_align_bits; unat (mi_length mi) < 2 ^ (msg_align_bits - word_size_bits) \ \ ptr_range (p + of_nat n * of_nat word_size) word_size_bits \ ptr_range p msg_align_bits" and captransfer_in_ipc_buffer: "\ is_aligned (buf :: obj_ref) msg_align_bits; p \ {0..2} \ \ ptr_range (buf + (2 + (of_nat msg_max_length + of_nat msg_max_extra_caps)) * word_size + p * word_size) word_size_bits \ ptr_range buf msg_align_bits" and mrs_in_ipc_buffer: "\ n \ set [length msg_registers + 1 ..< Suc n']; is_aligned buf msg_align_bits; n' < 2 ^ (msg_align_bits - word_size_bits) \ \ ptr_range (buf + of_nat n * of_nat word_size) word_size_bits \ ptr_range buf msg_align_bits" and complete_signal_reads_respects: "pas_domains_distinct aag \ reads_respects aag l (K (aag_can_read aag nptr \ aag_can_affect aag l nptr)) (complete_signal nptr receiver)" and handle_arch_fault_reply_reads_respects: "reads_respects aag l (K (aag_can_read aag thread)) (handle_arch_fault_reply afault thread x y)" and arch_get_sanitise_register_info_reads_respects[wp]: "reads_respects aag l \ (arch_get_sanitise_register_info t)" and arch_get_sanitise_register_info_valid_global_objs[wp]: "arch_get_sanitise_register_info t \\s :: det_state. valid_global_objs s\" and handle_arch_fault_reply_valid_global_objs[wp]: "handle_arch_fault_reply vmf thread x y \\s :: det_state. valid_global_objs s\" and lookup_ipc_buffer_ptr_range': "\valid_objs\ lookup_ipc_buffer True t \\rv s :: det_state. rv = Some buf' \ auth_ipc_buffers s t = ptr_range buf' msg_align_bits\" and lookup_ipc_buffer_aligned': "\valid_objs\ lookup_ipc_buffer True t \\rv s :: det_state. rv = Some buf' \ is_aligned buf' msg_align_bits\" and handle_arch_fault_reply_globals_equiv: "\globals_equiv st and valid_arch_state and (\s. thread \ idle_thread s)\ handle_arch_fault_reply vmf thread x y \\_. globals_equiv st\" begin lemma store_word_offs_equiv_but_for_labels: "\equiv_but_for_labels aag L st and K (for_each_byte_of_word (\x. pasObjectAbs aag x \ L) (ptr + of_nat offs * of_nat word_size))\ store_word_offs ptr offs v \\_. equiv_but_for_labels aag L st\" unfolding store_word_offs_def apply (wp modify_wp | simp add: do_machine_op_def split_def)+ apply clarsimp apply (erule use_valid[OF _ storeWord_equiv_but_for_labels]) apply simp done (* FIXME: many redundant conditions *) lemma update_waiting_ntfn_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag l (pspace_aligned and valid_vspace_objs and valid_arch_state and valid_objs and sym_refs \ state_refs_of and pas_refined aag and pas_cur_domain aag and ko_at (Notification ntfn) nptr and (\s. is_subject aag (cur_thread s)) and K (ntfn_obj ntfn = WaitingNtfn queue)) (update_waiting_ntfn nptr queue bound_tcb badge)" 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)+ by (wp as_user_set_register_reads_respects' set_thread_state_reads_respects 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)+ lemma update_waiting_ntfn_equiv_but_for_labels: "\equiv_but_for_labels aag L st and pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_objs and ko_at (Notification ntfn) nptr and sym_refs \ state_refs_of and (\s. \t\ set list. etcb_at (\etcb. tcb_domain etcb \ cur_domain s) t s) and K (ntfn_obj ntfn = WaitingNtfn list \ pasObjectAbs aag nptr \ L \ all_with_auth_to aag Receive (pasObjectAbs aag nptr) \ L \ \ (all_to_which_has_auth aag Write ` all_with_auth_to aag Receive (pasObjectAbs aag nptr)) \ L)\ update_waiting_ntfn nptr list boundtcb badge \\_. equiv_but_for_labels aag L st\" 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_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 apply (frule_tac P="receive_blocked_on nptr" and t="hd list" in ntfn_queued_st_tcb_at') apply (fastforce) apply assumption apply assumption apply simp apply (subgoal_tac "pasObjectAbs aag (hd list) \ all_with_auth_to aag Receive (pasObjectAbs aag nptr)") apply (fastforce) apply (clarsimp simp: all_with_auth_to_def) apply (erule pas_refined_mem[rotated]) apply (rule sta_ts) apply (clarsimp simp: thread_st_auth_def tcb_states_of_state_def st_tcb_def2) apply (case_tac "tcb_state tcb", simp_all) done end lemma invisible_ntfn_invisible_receivers_and_ipcbuffers: "\ labels_are_invisible aag l {pasObjectAbs aag nptr}; (pasSubject aag, Notify, pasObjectAbs aag nptr) \ pasPolicy aag\ \ labels_are_invisible aag l ({pasObjectAbs aag nptr} \ all_with_auth_to aag Receive (pasObjectAbs aag nptr) \ \(all_to_which_has_auth aag Write ` all_with_auth_to aag Receive (pasObjectAbs aag nptr)))" by (auto simp: labels_are_invisible_def aag_can_affect_label_def all_to_which_has_auth_def all_with_auth_to_def dest: reads_read_page_read_thread reads_read_queued_thread_read_ep) lemma invisible_ntfn_invisible_receivers_and_receivers[rotated 1]: "\ auth \ {Notify,Receive,SyncSend}; labels_are_invisible aag l {pasObjectAbs aag nptr}; (pasSubject aag, auth, pasObjectAbs aag nptr) \ pasPolicy aag \ \ labels_are_invisible aag l ({pasObjectAbs aag nptr} \ all_with_auth_to aag Receive (pasObjectAbs aag nptr) \ (\(all_to_which_has_auth aag Receive ` all_with_auth_to aag Receive (pasObjectAbs aag nptr))) \ (\(all_to_which_has_auth aag Write ` all_with_auth_to aag Receive (pasObjectAbs aag nptr))))" by (auto simp: labels_are_invisible_def aag_can_affect_label_def all_to_which_has_auth_def all_with_auth_to_def dest: read_sync_ep_read_senders read_sync_ep_read_receivers reads_read_queued_thread_read_ep reads_read_page_read_thread reads_ep) lemma read_queued_thread_reads_ntfn: "\ ko_at (Notification ntfn) ntfnptr s; t \ set queue; aag_can_read aag t; valid_objs s; sym_refs (state_refs_of s); pas_refined aag s; ntfn_obj ntfn = WaitingNtfn queue; (pasSubject aag, Notify, pasObjectAbs aag ntfnptr) \ pasPolicy aag \ \ aag_can_read aag ntfnptr" apply (frule_tac P="receive_blocked_on ntfnptr" and t=t in ntfn_queued_st_tcb_at') apply (fastforce) apply assumption apply assumption apply simp apply (rule_tac t="pasObjectAbs aag t" and auth="Receive" and auth'="Notify" in reads_read_queued_thread_read_ep) apply assumption apply simp apply (erule pas_refined_mem[rotated]) apply (rule sta_ts) apply (clarsimp simp: thread_st_auth_def tcb_states_of_state_def st_tcb_def2) apply (case_tac "tcb_state tcb", simp_all)[1] apply simp apply simp done lemma not_etcb_at_not_cdom_can_read: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "\ \ etcb_at (\etcb. tcb_domain etcb \ cur_domain s) t s; tcb_at t s; valid_etcbs s; pas_refined aag s; pas_cur_domain aag s \ \ aag_can_read aag t" apply (clarsimp simp: valid_etcbs_def tcb_at_st_tcb_at etcb_at_def is_etcb_at_def pas_refined_def tcb_domain_map_wellformed_aux_def) apply (erule_tac x="(t, cur_domain s)" in ballE) apply (force dest: domains_distinct[THEN pas_domains_distinct_inj]) apply (force intro: domtcbs) done lemma tcb_at_ntfn_queue: "\ valid_objs s; t \ set q; ko_at (Notification ntfn) nptr s; ntfn_obj ntfn = WaitingNtfn q \ \ tcb_at t s" by (fastforce simp: obj_at_def valid_obj_def valid_ntfn_def) lemma invisible_ep_invisible_receiver: "\ labels_are_invisible aag l {pasObjectAbs aag epptr}; (pasObjectAbs aag tcb, Receive, pasObjectAbs aag epptr) \ pasPolicy aag; (pasObjectAbs aag tcb, Reset, pasObjectAbs aag epptr) \ pasPolicy aag \ \ labels_are_invisible aag l ({pasObjectAbs aag epptr} \ {pasObjectAbs aag tcb})" by (auto simp: labels_are_invisible_def aag_can_affect_label_def all_with_auth_to_def dest: reads_ep reads_read_queued_thread_read_ep) lemma no_fail_gts: "no_fail (tcb_at tcb) (get_thread_state tcb)" apply (clarsimp simp: get_thread_state_def thread_get_def) apply (rule no_fail_pre) apply wp by (clarsimp simp: get_tcb_def tcb_at_def) lemma sts_noop: "monadic_rewrite True True (tcb_at tcb and (\s. tcb \ cur_thread s)) (set_thread_state_ext tcb) (return ())" unfolding set_thread_state_ext_def when_def apply (monadic_rewrite_l monadic_rewrite_if_l_False \wpsimp wp: gts_wp\) apply (monadic_rewrite_symb_exec_l_drop)+ apply (rule monadic_rewrite_refl) by (auto simp: pred_tcb_at_def obj_at_def is_tcb_def get_tcb_def) lemma sts_to_modify': "monadic_rewrite True True (tcb_at tcb and (\s :: det_state. tcb \ cur_thread s)) (set_thread_state tcb st) (modify (\s. s\kheap := kheap s(tcb \ TCB (the (get_tcb tcb s)\tcb_state := st\))\))" apply (clarsimp simp: set_thread_state_def set_object_def) apply (monadic_rewrite_l sts_noop \wpsimp wp: get_object_wp\) apply (simp add: bind_assoc) apply monadic_rewrite_symb_exec_l+ apply (rule_tac P="\s'. s' = s \ tcba = the (get_tcb tcb s)" in monadic_rewrite_pre_imp_eq) apply (clarsimp simp: put_def modify_def get_def bind_def) apply (wpsimp wp: get_object_wp)+ by (clarsimp simp: get_tcb_def tcb_at_def) lemma sts_no_fail: "no_fail (\s :: det_state. tcb_at tcb s) (set_thread_state tcb st)" apply (simp add: set_thread_state_def set_object_def) apply (simp add: set_thread_state_ext_def get_thread_state_def thread_get_def set_scheduler_action_def) apply (rule no_fail_pre) apply (wpsimp wp: get_object_wp)+ apply (clarsimp simp: get_tcb_def tcb_at_def obj_at_def a_type_def is_tcb_def split: kernel_object.splits option.splits) by (metis kernel_object.exhaust option.inject) lemmas sts_to_modify = monadic_rewrite_weaken_failure[OF sts_to_modify' sts_no_fail no_fail_modify,simplified] definition "blocked_cancel_ipc_nosts tcb \ do state <- get_thread_state tcb; epptr \ get_blocking_object state; ep \ get_endpoint epptr; queue \ get_ep_queue ep; queue' \ return $ remove1 tcb queue; ep' \ return (case queue' of [] \ IdleEP | a # list \ update_ep_queue ep queue'); set_endpoint epptr ep'; set_thread_state tcb Running od" lemma cancel_ipc_to_blocked_nosts: "monadic_rewrite False False (\s :: det_state. st_tcb_at receive_blocked tcb s \ cur_thread s \ tcb) (blocked_cancel_ipc_nosts tcb) (cancel_ipc tcb >>= (\_. set_thread_state tcb Running))" apply (simp add: cancel_ipc_def bind_assoc blocked_cancel_ipc_nosts_def) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_transverse) apply (rename_tac state) apply (rule_tac P="\_. \xa pl. state = BlockedOnReceive xa pl" in monadic_rewrite_bind_head) apply (rule monadic_rewrite_gen_asm[where Q=\,simplified]) apply clarsimp apply (rule monadic_rewrite_refl) apply (simp add: blocked_cancel_ipc_def blocked_cancel_ipc_nosts_def bind_assoc) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_bind_tail) apply (rule monadic_rewrite_trans) apply (rule sts_to_modify) apply (rule monadic_rewrite_transverse) apply (rule monadic_rewrite_bind) apply (rule sts_to_modify) apply (rule sts_to_modify) apply (rule hoare_modifyE_var[where P="tcb_at tcb and (\s. tcb \ cur_thread s)"]) apply (clarsimp simp: tcb_at_def get_tcb_def) apply (simp add: modify_modify) apply (rule monadic_rewrite_is_refl) apply (fastforce simp add: simpler_modify_def o_def get_tcb_def) apply (wp gts_wp)+ apply (simp add: set_thread_state_def bind_assoc gets_the_def) apply (clarsimp simp: pred_tcb_at_def receive_blocked_def obj_at_def is_tcb_def) by (case_tac "tcb_state tcba"; fastforce) lemma gts_reads_respects: "reads_respects aag l (K (aag_can_read aag t \ aag_can_affect aag l t)) (get_thread_state t)" unfolding get_thread_state_def by (wp thread_get_reads_respects) lemma ev2_invisible_simple: assumes domains_distinct: "pas_domains_distinct aag" shows "\ labels_are_invisible aag l L; modifies_at_most aag L Q f \ \ reads_respects aag l Q (f :: (det_state, unit) nondet_monad)" apply (simp add: equiv_valid_def2) apply (rule equiv_valid_2_guard_imp) apply (rule ev2_invisible[OF domains_distinct]) by fastforce+ crunch silc_inv[wp]: blocked_cancel_ipc_nosts "silc_inv aag st" context Ipc_IF_1 begin lemma blocked_cancel_ipc_nosts_equiv_but_for_labels: "\pas_refined aag and st_tcb_at (\st. st = BlockedOnReceive x pl) t and bound_tcb_at ((=) (Some ntfnptr)) t and equiv_but_for_labels aag L st and K (pasObjectAbs aag x \ L) and K (pasObjectAbs aag t \ L)\ blocked_cancel_ipc_nosts t \\_. equiv_but_for_labels aag L st\" unfolding blocked_cancel_ipc_nosts_def get_blocking_object_def apply (wp set_endpoint_equiv_but_for_labels get_object_wp gts_wp set_thread_state_runnable_equiv_but_for_labels | wpc | simp)+ by (clarsimp simp: pred_tcb_at_def obj_at_def) lemma blocked_cancel_ipc_nosts_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag l (pas_refined aag and st_tcb_at (\st. \xa. st = (BlockedOnReceive x pl)) t and bound_tcb_at ((=) (Some ntfnptr)) t and (\s. is_subject aag (cur_thread s)) and K ((pasObjectAbs aag t, Receive, pasObjectAbs aag ntfnptr) \ pasPolicy aag \ (pasSubject aag, Notify, pasObjectAbs aag ntfnptr) \ pasPolicy aag \ (pasObjectAbs aag t, Receive, pasObjectAbs aag x) \ pasPolicy aag)) (blocked_cancel_ipc_nosts t)" unfolding blocked_cancel_ipc_nosts_def apply (simp only:bind_assoc[symmetric]) apply (rule bind_ev[where P''=\,simplified]) apply (wp set_thread_state_runnable_reads_respects,simp) subgoal proof (cases "aag_can_read_label aag (pasObjectAbs aag x) \ aag_can_affect aag l x") case True thus ?thesis \ \boring case, can read or affect ep\ unfolding blocked_cancel_ipc_nosts_def get_blocking_object_def apply clarsimp apply (rule pre_ev) apply (wpsimp 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 simp: get_blocking_object_def get_thread_state_rev)+ apply (clarsimp simp: pred_tcb_at_def obj_at_def) by (fastforce dest:read_sync_ep_read_receivers ) next case False thus ?thesis apply - \ \can't read or affect ep\ apply (rule gen_asm_ev) apply (drule label_is_invisible[THEN iffD2]) apply clarsimp apply (rule ev2_invisible_simple[OF domains_distinct],assumption) apply (simp add: get_blocking_object_def) apply (rule modifies_at_mostI) apply (rule hoare_pre) apply (wpsimp wp: set_thread_state_runnable_equiv_but_for_labels set_endpoint_equiv_but_for_labels get_object_wp gts_wp set_thread_state_runnable_equiv_but_for_labels)+ by (fastforce simp: pred_tcb_at_def obj_at_def) qed by wp lemmas blocked_cancel_ipc_nosts_reads_respects_f = reads_respects_f[where Q=\, simplified, OF blocked_cancel_ipc_nosts_reads_respects blocked_cancel_ipc_nosts_silc_inv, simplified] end lemma monadic_rewrite_reads_respects: "\ monadic_rewrite False False P f f'; reads_respects aag l P' (do x <- f; g x od) \ \ reads_respects aag l (P and P') (do x <- f'; g x od)" apply (clarsimp simp: monadic_rewrite_def spec_equiv_valid_def equiv_valid_def equiv_valid_2_def bind_def) apply (frule_tac x=st in spec) apply (drule_tac x=t in spec) by fastforce lemmas cancel_ipc_reads_respects_rewrite = monadic_rewrite_reads_respects[OF cancel_ipc_to_blocked_nosts, simplified bind_assoc] lemmas cancel_ipc_valid_rewrite = monadic_rewrite_is_valid[OF cancel_ipc_to_blocked_nosts, simplified bind_assoc] crunch etcb_at[wp]: blocked_cancel_ipc_nosts "etcb_at P t" crunch cur_domain[wp]: blocked_cancel_ipc_nosts "\s. P (cur_domain s)" crunch pas_refined[wp]: blocked_cancel_ipc_nosts "pas_refined aag" crunch cur_thread[wp]: blocked_cancel_ipc_nosts "\s. P (cur_thread s)" lemma BlockedOnReceive_inj: "x = (case (BlockedOnReceive x pl) of BlockedOnReceive x pl \ x)" "pl = (case (BlockedOnReceive x pl) of BlockedOnReceive x pl \ pl)" by auto lemma receive_blockedD: "receive_blocked st \ \epptr pl. st = BlockedOnReceive epptr pl" by (cases st; simp add: receive_blocked_def) crunches blocked_cancel_ipc_nosts for pspace_aligned[wp]: pspace_aligned and valid_vspace_objs[wp]: valid_vspace_objs and valid_arch_state[wp]: valid_arch_state context Ipc_IF_1 begin lemma send_signal_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" notes set_thread_state_owned_reads_respects[wp del] cancel_ipc_pas_refined[wp del] shows "reads_respects aag l (pas_refined aag and pas_cur_domain aag and pspace_aligned and valid_vspace_objs and valid_arch_state and (\s. is_subject aag (cur_thread s)) and valid_etcbs and ct_active and (\s. sym_refs (state_refs_of s)) and valid_objs and K ((pasSubject aag, Notify, pasObjectAbs aag ntfnptr) \ pasPolicy aag)) (send_signal ntfnptr badge)" unfolding send_signal_def fun_app_def subgoal proof (cases "aag_can_read aag ntfnptr \ aag_can_affect aag l ntfnptr") case True note visible = this show ?thesis apply (rule pre_ev) apply (simp split del: if_split | rule_tac ntfnptr=ntfnptr in blocked_cancel_ipc_nosts_reads_respects | rule cancel_ipc_reads_respects_rewrite | wp (once) set_simple_ko_reads_respects possible_switch_to_reads_respects as_user_set_register_reads_respects' set_thread_state_pas_refined set_simple_ko_reads_respects cancel_ipc_receive_blocked_pas_refined gts_reads_respects gts_wp hoare_vcg_imp_lift get_simple_ko_wp get_simple_ko_reads_respects update_waiting_ntfn_reads_respects | wpc | simp )+ apply (insert visible) apply clarsimp apply (rule conjI[rotated]) apply fastforce apply (rule disjI2) apply (intro impI allI) apply (simp add: obj_at_def) apply (rule conjI) apply (frule (3) ntfn_bound_tcb_at[where P="(=) (Some ntfnptr)",OF _ _ _ _ refl]) apply (frule (1) bound_tcb_at_implies_receive) apply (elim disjE) apply (rule disjI1) apply (fastforce dest:read_sync_ep_read_receivers) apply (rule disjI2) apply (fastforce dest:read_sync_ep_read_receivers) apply (clarsimp) apply (frule (1) ntfn_bound_tcb_at[where P="(=) (Some ntfnptr)",OF _ _ _ _ refl]) apply (fastforce simp: obj_at_def) apply assumption apply (rule conjI) apply (fastforce simp: pred_tcb_at_def receive_blocked_def obj_at_def) apply (rule conjI[rotated]) apply (frule (1) bound_tcb_at_implies_receive) apply (frule (1) bound_tcb_at_implies_reset) apply (clarsimp simp: pred_tcb_at_def get_tcb_def obj_at_def) apply (rule context_conjI) apply (fastforce dest!: receive_blockedD intro: BlockedOnReceive_inj) apply (frule_tac t=x and tcb=tcb and ep = "case (tcb_state tcb) of BlockedOnReceive a pl \ a" in get_tcb_recv_blocked_implies_receive) apply (fastforce simp: pred_tcb_at_def get_tcb_def obj_at_def) apply (fastforce simp: receive_blocked_def split:thread_state.splits) apply (fastforce simp: receive_blocked_def intro!: BlockedOnReceive_inj) by (fastforce simp: pred_tcb_at_def get_tcb_def obj_at_def receive_blocked_def ct_in_state_def) next case False note invisible = this show ?thesis apply (insert label_is_invisible[THEN iffD2, OF invisible]) apply (rule gen_asm_ev) apply (drule (1) invisible_ntfn_invisible_receivers_and_receivers) apply simp apply (rule ev2_invisible_simple[OF domains_distinct],assumption) apply (rule modifies_at_mostI) apply (simp split del: if_split | rule cancel_ipc_valid_rewrite | wp (once) set_thread_state_pas_refined set_notification_equiv_but_for_labels possible_switch_to_equiv_but_for_labels as_user_equiv_but_for_labels set_thread_state_runnable_equiv_but_for_labels get_simple_ko_wp gts_wp update_waiting_ntfn_equiv_but_for_labels blocked_cancel_ipc_nosts_equiv_but_for_labels | wpc | wps)+ apply (elim conjE) apply (match premises in "ntfn_bound_tcb _ = _" \ \fail\ \ _ \ \rule allI impI conjI\)+ prefer 2 apply (intro conjI allI impI; fastforce?) subgoal waiting_ntfn apply clarsimp apply (rule ccontr) apply (frule (3) not_etcb_at_not_cdom_can_read[OF domains_distinct, rotated 2]) apply (rule tcb_at_ntfn_queue;assumption) apply (frule (7) read_queued_thread_reads_ntfn) using invisible by (fastforce simp add: all_with_auth_to_def all_to_which_has_auth_def) apply (frule (1) ntfn_bound_tcb_at[where P="(=) (Some ntfnptr)", OF _ _ _ _ refl]) apply (fastforce simp: obj_at_def) apply assumption apply (intro allI conjI impI) apply (fastforce simp: pred_tcb_at_def receive_blocked_def obj_at_def split: thread_state.splits intro!: BlockedOnReceive_inj) apply assumption apply distinct_subgoals apply (fold_subgoals (prefix)) apply (frule st_tcb_at_tcb_at) subgoal bound_ntfn premises prems for st s ntfn x sta prefer 2 apply (rule disjI2) apply (rule disjI1) subgoal bound_tcb_can_receive using prems apply (clarsimp simp: all_with_auth_to_def obj_at_def) by (rule bound_tcb_at_implies_receive;assumption) apply (rule disjI2) apply (rule disjI2) apply (rule disjI1) subgoal bound_ep_can_receive apply (rule bexI[OF _ bound_tcb_can_receive]) apply (simp add: all_with_auth_to_def all_to_which_has_auth_def) using prems apply (case_tac sta; (clarsimp simp: pred_tcb_at_def obj_at_def receive_blocked_def)) apply (rule get_tcb_recv_blocked_implies_receive, assumption) apply (fastforce simp: get_tcb_def) by (fastforce split: thread_state.splits) apply (rule ccontr) apply (insert prems) apply (frule (4) not_etcb_at_not_cdom_can_read[OF domains_distinct]) using bound_tcb_can_receive apply (fastforce simp: labels_are_invisible_def all_with_auth_to_def all_to_which_has_auth_def) apply (fastforce simp: pred_tcb_at_def receive_blocked_def obj_at_def) apply (rule ccontr) apply clarsimp using invisible bound_tcb_can_receive reads_ep by (fastforce simp add: all_with_auth_to_def all_to_which_has_auth_def) done qed done end lemma receive_signal_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (valid_objs and pas_refined aag and (\s. is_subject aag (cur_thread s)) and K ((\ntfnptr \ obj_refs_ac cap. (pasSubject aag, Receive, pasObjectAbs aag ntfnptr) \ pasPolicy aag \ is_subject aag thread))) (receive_signal thread cap is_blocking)" unfolding receive_signal_def fun_app_def do_nbrecv_failed_transfer_def by (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 | force dest: reads_ep)+ subsection "Sync IPC" definition aag_can_read_or_affect_ipc_buffer :: "'a PAS \ 'a \ obj_ref option \ bool" where "aag_can_read_or_affect_ipc_buffer aag l \ case_option True (\buf'. is_aligned buf' msg_align_bits \ (\x \ ptr_range buf' msg_align_bits. aag_can_read aag x \ aag_can_affect aag l x))" lemma for_each_byte_of_word_def2: "for_each_byte_of_word P ptr \ (\x\ptr_range ptr word_size_bits. P x)" by (simp add: for_each_byte_of_word_def ptr_range_def word_size_size_bits_word add_diff_eq) context Ipc_IF_1 begin lemma lookup_ipc_buffer_aag_can_read_or_affect: "\pas_refined aag and valid_objs and K (aag_can_read aag thread \ aag_can_affect aag l thread)\ lookup_ipc_buffer is_receiver thread \\rv s. aag_can_read_or_affect_ipc_buffer aag l rv\" apply (rule hoare_gen_asm) apply (rule hoare_strengthen_post[OF lookup_ipc_buffer_has_read_auth]) apply (auto simp: ipc_buffer_has_read_auth_def aag_can_read_or_affect_ipc_buffer_def intro: reads_read_thread_read_pages simp: aag_can_affect_label_def split: option.splits) done lemma aag_has_auth_to_read_cptrs: "\ x \ set [buffer_cptr_index ..< buffer_cptr_index + unat (mi_extra_caps mi)]; ipc_buffer_has_read_auth aag (pasSubject aag) (Some a); buffer_cptr_index + unat (mi_extra_caps mi) < 2 ^ (msg_align_bits - word_size_bits) \ \ for_each_byte_of_word (\ y. aag_can_read aag y) (a + of_nat x * of_nat word_size)" apply (simp add: for_each_byte_of_word_def2 ipc_buffer_has_read_auth_def) apply (rule ballI) apply (rule reads_read) apply (clarify) apply (erule bspec) apply (rule subsetD[OF cptrs_in_ipc_buffer]) apply fastforce apply assumption apply assumption apply assumption done lemma get_extra_cptrs_rev: "reads_equiv_valid_inv A aag (K (ipc_buffer_has_read_auth aag (pasSubject aag) buffer \ (buffer_cptr_index + unat (mi_extra_caps mi) < 2 ^ (msg_align_bits - word_size_bits)))) (get_extra_cptrs buffer mi)" unfolding get_extra_cptrs_def apply (rule gen_asm_ev) apply clarsimp apply (case_tac buffer, simp_all add: return_ev_pre) apply (wp mapM_ev equiv_valid_guard_imp[OF load_word_offs_rev] | erule (2) aag_has_auth_to_read_cptrs)+ done lemma lookup_extra_caps_rev: "reads_equiv_valid_inv A aag (pas_refined aag and (K (is_subject aag thread)) and (\s. ipc_buffer_has_read_auth aag (pasSubject aag) buffer \ buffer_cptr_index + unat (mi_extra_caps mi) < 2 ^ (msg_align_bits - word_size_bits))) (lookup_extra_caps thread buffer mi)" unfolding lookup_extra_caps_def fun_app_def by (wpsimp wp: mapME_ev cap_fault_on_failure_rev lookup_cap_and_slot_rev get_extra_cptrs_rev) lemmas lookup_extra_caps_reads_respects_g = reads_respects_g_from_inv[OF lookup_extra_caps_rev lookup_extra_caps_inv] lemma aag_has_auth_to_read_msg: "\ n = msg_max_length \ n < msg_max_length; ipc_buffer_has_read_auth aag (pasSubject aag) (Some p); unat (mi_length mi) < 2 ^ (msg_align_bits - word_size_bits) \ \ for_each_byte_of_word (aag_can_read aag) (p + of_nat n * of_nat word_size)" apply (simp add: for_each_byte_of_word_def2 ipc_buffer_has_read_auth_def) apply (rule ballI) apply (rule reads_read) apply (clarify) apply (erule bspec) apply (rule subsetD[OF msg_in_ipc_buffer[where n=n]]) apply assumption apply assumption apply assumption apply assumption done (* only called within do_reply_transfer for which access assumes sender and receiver in same domain *) lemma get_mrs_rev: "reads_equiv_valid_inv A aag (K (is_subject aag thread \ ipc_buffer_has_read_auth aag (pasSubject aag) buf \ unat (mi_length mi) < 2 ^ (msg_align_bits - word_size_bits))) (get_mrs thread buf mi)" unfolding get_mrs_def apply (rule gen_asm_ev) apply (wp mapM_ev'' load_word_offs_rev thread_get_rev | wpc | rule aag_has_auth_to_read_msg[where mi=mi] | clarsimp split: if_split_asm)+ done lemmas get_mrs_reads_respects_g = reads_respects_g_from_inv[OF get_mrs_rev get_mrs_inv] end lemma setup_caller_cap_reads_respects: "reads_respects aag l (K (aag_can_read aag sender \ aag_can_read aag receiver)) (setup_caller_cap sender receiver grant)" unfolding setup_caller_cap_def by (wp cap_insert_reads_respects set_thread_state_owned_reads_respects | simp)+ lemma const_on_failure_ev: "equiv_valid_inv I A P m \ equiv_valid_inv I A P (const_on_failure c m)" unfolding const_on_failure_def catch_def by (wp | wpc | simp)+ lemma set_extra_badge_reads_respects: "reads_respects aag l \ (set_extra_badge buffer badge n)" unfolding set_extra_badge_def by (rule store_word_offs_reads_respects) lemma reads_equiv_cdt_has_children0: "\ pas_refined aag s; pas_refined aag s'; aag_can_read aag (fst slot); equiv_for (aag_can_read aag \ fst) cdt s s' \ \ (cdt s) c = Some slot \ (cdt s') c = Some slot" apply (rule iffI) apply (drule equiv_forD) apply (erule(1) all_children_subjectReads[THEN all_childrenD];fastforce) apply fastforce apply (drule equiv_forD) apply (erule(1) all_children_subjectReads[THEN all_childrenD];fastforce) apply fastforce done lemma reads_equiv_cdt_has_children: "\ pas_refined aag s; pas_refined aag s'; is_subject aag (fst slot); equiv_for (aag_can_read aag \ fst) cdt s s' \ \ (\c. (cdt s) c = Some slot) = (\c. (cdt s') c = Some slot)" apply (rule iff_exI) by (erule reads_equiv_cdt_has_children0; force) lemma ensure_no_children_rev: "reads_equiv_valid_inv A aag (pas_refined aag and K (is_subject aag (fst slot))) (ensure_no_children slot)" unfolding ensure_no_children_def fun_app_def equiv_valid_def2 apply (rule equiv_valid_rv_guard_imp) apply (rule_tac Q="\ rv s. pas_refined aag s \ is_subject aag (fst slot) \ rv = cdt s" in equiv_valid_rv_liftE_bindE[OF equiv_valid_rv_guard_imp[OF gets_cdt_revrv']]) apply (rule TrueI) apply (clarsimp simp: equiv_valid_2_def) apply (drule reads_equiv_cdt_has_children) apply assumption apply assumption apply (fastforce elim: reads_equivE) apply (fastforce simp: in_whenE in_throwError) apply (wp, simp) done (* FIXME MOVE *) lemma ball_subsetE: "\ \x \ S. P x; S' \ S; \x. P x \ Q x \ \ \x \ S'. Q x" by blast context Ipc_IF_1 begin lemma derive_cap_rev': "reads_equiv_valid_inv A aag (\s. (\x xa xb d. cap = cap.UntypedCap d x xa xb) \ pas_refined aag s \ is_subject aag (fst slot)) (derive_cap slot cap)" unfolding derive_cap_def apply (rule equiv_valid_guard_imp) apply (wp ensure_no_children_rev arch_derive_cap_rev | wpc | simp)+ done lemma derive_cap_rev: "reads_equiv_valid_inv A aag (\s. pas_refined aag s \ is_subject aag (fst slot)) (derive_cap slot cap)" by (blast intro: equiv_valid_guard_imp[OF derive_cap_rev']) lemma transfer_caps_loop_reads_respects': "reads_respects aag l (pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and valid_objs and (\s. (\cap\set caps. valid_cap (fst cap) s \ is_subject aag (fst (snd cap)) \ pas_cap_cur_auth aag (fst cap) \ cte_wp_at (\cp. fst cap \ NullCap \ cp \ fst cap \ cp = masked_as_full (fst cap) (fst cap)) (snd cap) s) \ (\slot\set slots. is_subject aag (fst slot) \ cte_wp_at ((=) NullCap) slot s \ real_cte_at slot s) \ distinct slots)) (transfer_caps_loop ep rcv_buffer n caps slots mi)" apply (induct caps arbitrary: slots n mi) apply simp apply (rule return_ev_pre) apply (case_tac a, rename_tac cap obj ind) apply (simp split del: if_split) apply (rule equiv_valid_guard_imp) apply (wp const_on_failure_ev | simp | intro conjI impI)+ apply fast apply (wp set_extra_badge_reads_respects hoare_vcg_ball_lift | simp)+ apply fast apply (wp cap_insert_reads_respects cap_insert_pas_refined whenE_throwError_wp derive_cap_rev derive_cap_cap_cur_auth derive_cap_is_derived hoare_vcg_ball_lift cap_insert_cte_wp_at | simp split del: if_split)+ apply (rule_tac Q'="\capd s. (capd \ NullCap \ cte_wp_at (is_derived (cdt s) (obj,ind) capd) (obj, ind) s) \ (capd \ NullCap \ QM s capd)" for QM in hoare_post_imp_R) prefer 2 apply (clarsimp simp: cte_wp_at_caps_of_state split del: if_split) apply (strengthen is_derived_is_transferable[mk_strg I' O], assumption, solves\simp\) apply (rule hoare_vcg_conj_liftE_R) apply (rule derive_cap_is_derived) apply (wp derive_cap_is_derived_foo') apply wp apply (clarsimp simp: remove_rights_cur_auth cte_wp_at_caps_of_state split del: if_split) apply (rename_tac actual_cap) apply (strengthen real_cte_tcb_valid) apply (clarsimp) apply (intro conjI) subgoal by (fastforce simp: masked_as_full_def is_cap_simps cap_master_cap_simps split: if_splits) apply clarsimp apply (intro conjI) apply (fastforce dest: auth_derived_pas_cur_auth) apply fastforce subgoal apply (erule ball_subsetE, fastforce) by (fastforce simp: cte_wp_at_caps_of_state masked_as_full_def is_cap_simps split: if_splits) subgoal by (fastforce simp: neq_Nil_conv cte_wp_at_caps_of_state) by (rule distinct_tl) lemma transfer_caps_loop_reads_respects: "reads_respects aag l (pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and valid_objs and (\s. (\cap\set caps. valid_cap (fst cap) s \ is_subject aag (fst (snd cap)) \ pas_cap_cur_auth aag (fst cap) \ cte_wp_at (\cp. fst cap \ NullCap \ cp = fst cap) (snd cap) s) \ (\slot\set slots. is_subject aag (fst slot) \ cte_wp_at ((=) NullCap) slot s \ real_cte_at slot s) \ distinct slots)) (transfer_caps_loop ep rcv_buffer n caps slots mi)" apply (rule equiv_valid_guard_imp, rule transfer_caps_loop_reads_respects') by (fastforce elim: cte_wp_at_weakenE) end lemma empty_on_failure_ev: "equiv_valid_inv I A P m \ equiv_valid_inv I A P (empty_on_failure m)" unfolding empty_on_failure_def catch_def by (wp | wpc | simp)+ lemma unify_failure_ev: "equiv_valid_inv I A P m \ equiv_valid_inv I A P (unify_failure m)" unfolding unify_failure_def handleE'_def by (wp | wpc | simp)+ lemma lookup_slot_for_cnode_op_rev: "reads_equiv_valid_inv A aag (\s. (depth \ 0 \ depth \ word_bits) \ (pas_refined aag s \ (is_cnode_cap croot \ is_subject aag (obj_ref_of croot)))) (lookup_slot_for_cnode_op is_source croot ptr depth)" unfolding lookup_slot_for_cnode_op_def apply (clarsimp split del: if_split) apply (wp resolve_address_bits_rev lookup_error_on_failure_rev whenE_throwError_wp | wpc | rule hoare_post_imp_R[OF hoare_True_E_R[where P="\"]] | simp add: split_def split del: if_split)+ done lemma lookup_slot_for_cnode_op_reads_respects: "reads_respects aag l (pas_refined aag and K (is_subject aag (obj_ref_of croot))) (lookup_slot_for_cnode_op is_source croot ptr depth)" apply (rule equiv_valid_guard_imp[OF lookup_slot_for_cnode_op_rev]) by simp lemma lookup_cap_rev: "reads_equiv_valid_inv A aag (pas_refined aag and K (is_subject aag thread)) (lookup_cap thread ref)" unfolding lookup_cap_def split_def fun_app_def apply (wp lookup_slot_for_thread_rev get_cap_rev | simp | strengthen aag_can_read_self)+ apply (rule lookup_slot_for_thread_authorised) apply simp done lemma word_plus_power_2_offset_le: "\ is_aligned (p :: 'l :: len word) n; is_aligned q m; p < q; n \ m; n < len_of TYPE('l) \ \ p + 2^n \ q" apply (drule is_aligned_weaken, assumption) apply (clarsimp simp: is_aligned_def) apply (elim dvdE) apply (rename_tac k ka) apply (rule_tac ua=0 and n="int k" and n'="int ka" in udvd_incr') apply assumption apply (clarsimp simp: uint_nat)+ done context Ipc_IF_1 begin lemma aag_has_auth_to_read_captransfer: "\ ipc_buffer_has_read_auth aag (pasSubject aag) (Some buffer); x \ {0..2} \ \ for_each_byte_of_word (aag_can_read aag) (buffer + (2 + (of_nat msg_max_length + of_nat msg_max_extra_caps)) * word_size + x * word_size)" apply (simp add: for_each_byte_of_word_def2 ipc_buffer_has_read_auth_def) apply (rule ballI) apply (rule reads_read) apply (clarify) apply (erule bspec) apply (rule subsetD[OF captransfer_in_ipc_buffer]) apply fastforce+ done lemma load_cap_transfer_rev: "reads_equiv_valid_inv A aag (K (ipc_buffer_has_read_auth aag (pasSubject aag) (Some buffer))) (load_cap_transfer buffer)" unfolding load_cap_transfer_def fun_app_def captransfer_from_words_def apply (wp dmo_loadWord_rev | simp)+ apply safe apply (erule aag_has_auth_to_read_captransfer[where x=0, simplified]) apply (erule aag_has_auth_to_read_captransfer[where x=1, simplified]) apply (erule aag_has_auth_to_read_captransfer[where x=2, simplified]) done end lemma get_endpoint_rev: "reads_equiv_valid_inv A aag (K (is_subject aag ptr)) (get_endpoint ptr)" unfolding get_simple_ko_def by (wp get_object_rev | wpc | simp)+ lemma send_endpoint_threads_blocked: "\ valid_objs s; (sym_refs \ state_refs_of) s; ko_at (Endpoint (SendEP list)) ep s; x \ set list \ \ st_tcb_at (send_blocked_on ep) x s" apply (rule ep_queued_st_tcb_at'') apply simp+ done lemma send_blocked_threads_have_SyncSend_auth: "\ pas_refined aag s; valid_objs s; sym_refs (state_refs_of s); st_tcb_at (send_blocked_on ep) x s \ \ (pasObjectAbs aag x, SyncSend, pasObjectAbs aag ep) \ pasPolicy aag" apply (drule_tac auth="SyncSend" and x=x in pas_refined_mem[rotated]) apply (rule sta_ts) apply (clarsimp simp: thread_st_auth_def split: option.split simp: tcb_states_of_state_def st_tcb_def2) apply (case_tac "tcb_state tcb", simp_all) done lemma get_thread_state_reads_respects: "reads_respects aag l (\s. aag_can_read aag t \ aag_can_affect aag l t) (get_thread_state t)" unfolding get_thread_state_def apply (rule equiv_valid_guard_imp) apply (wp thread_get_reads_respects | simp)+ done lemma send_endpoint_reads_affects_queued: "\ (pasSubject aag, auth, pasObjectAbs aag epptr) \ pasPolicy aag; auth \ {Receive,Reset}; aag_can_read aag epptr \ aag_can_affect aag l epptr; pas_refined aag s; valid_objs s; sym_refs (state_refs_of s); ko_at (Endpoint (SendEP list)) epptr s; ep = SendEP list; x \ set list \ \ aag_can_read aag x \ aag_can_affect aag l x" apply (frule send_endpoint_threads_blocked, (simp | assumption)+) apply (drule send_blocked_threads_have_SyncSend_auth, (simp | assumption)+) apply (auto dest: read_sync_ep_read_senders) done lemma mapM_ev''': assumes reads_res: "\x. x \ set lst \ equiv_valid_inv D A (Q and P x) (m x)" assumes inv: "\x. x \ set lst \ m x \\s. Q s \ (\x \ set lst. P x s)\" shows "equiv_valid_inv D A (\s. Q s \ (\x \ set lst. P x s)) (mapM m lst)" apply (rule mapM_ev) apply (rule equiv_valid_guard_imp[OF reads_res], simp+) apply (wpsimp wp: inv) done lemma cancel_badged_sends_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" notes gts_st_tcb_at[wp del] shows "reads_respects aag (l :: 'a subject_label) (pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_objs and (sym_refs \ state_refs_of) and (\s. is_subject aag (cur_thread s)) and K (is_subject aag epptr)) (cancel_badged_sends epptr badge)" apply (rule gen_asm_ev)+ apply (simp add: cancel_badged_sends_def) apply wp apply ((wp mapM_ev'' 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 mapM_wp | 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) by (rule send_endpoint_reads_affects_queued[where epptr = epptr]; (assumption | force simp: pas_refined_def policy_wellformed_def)) lemma get_cap_ret_is_subject': "\pas_refined aag and K (is_subject aag (fst ptr))\ get_cap ptr \\rv s. is_cnode_cap rv \ (\x\obj_refs_ac rv. is_subject aag x)\" apply (rule hoare_strengthen_post[OF get_cap_ret_is_subject]) apply (clarsimp simp: is_cap_simps) done context Ipc_IF_1 begin lemma get_receive_slots_rev: "reads_equiv_valid_inv A aag (pas_refined aag and (K (is_subject aag thread \ ipc_buffer_has_read_auth aag (pasSubject aag) buf))) (get_receive_slots thread buf)" apply (case_tac buf) apply (fastforce intro: return_ev_pre) apply (simp add: lookup_cap_def split_def | wp empty_on_failure_ev unify_failure_ev lookup_slot_for_cnode_op_rev get_cap_rev lookup_slot_for_thread_rev lookup_slot_for_thread_authorised get_cap_ret_is_subject get_cap_ret_is_subject' load_cap_transfer_rev | wp (once) hoare_drop_imps | strengthen aag_can_read_self)+ done lemma transfer_caps_reads_respects: "reads_respects aag l (pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and valid_objs and (\s. (\cap\set caps. s \ fst cap \ is_subject aag (fst (snd cap)) \ pas_cap_cur_auth aag (fst cap) \ cte_wp_at (\cp. fst cap \ NullCap \ cp = fst cap) (snd cap) s)) and K (is_subject aag receiver \ ipc_buffer_has_read_auth aag (pasSubject aag) receive_buffer)) (transfer_caps mi caps endpoint receiver receive_buffer)" unfolding transfer_caps_def fun_app_def by (wp transfer_caps_loop_reads_respects get_receive_slots_rev get_receive_slots_authorised hoare_vcg_all_lift static_imp_wp | wpc | simp add: ball_conj_distrib)+ lemma aag_has_auth_to_read_mrs: "\ aag_can_read_or_affect_ipc_buffer aag l (Some buf); n \ set [length msg_registers + 1.. \ for_each_byte_of_word (\x. aag_can_read_label aag (pasObjectAbs aag x) \ aag_can_affect aag l x) (buf + of_nat n * of_nat word_size)" apply (simp add: for_each_byte_of_word_def2 aag_can_read_or_affect_ipc_buffer_def) apply (rule ballI) apply (erule conjE) apply (erule bspec) apply (rule subsetD[OF mrs_in_ipc_buffer[where n=n and n'=n']]) apply (clarsimp split: if_splits) apply assumption apply assumption apply assumption done lemma load_word_offs_reads_respects: "reads_respects aag l (\s. for_each_byte_of_word (\x. aag_can_read_or_affect aag l x) (a + of_nat x * of_nat word_size)) (load_word_offs a x)" unfolding load_word_offs_def fun_app_def apply (rule equiv_valid_guard_imp[OF dmo_loadWord_reads_respects]) apply (clarsimp) done end lemma as_user_reads_respects: "reads_respects aag l (K (det f \ aag_can_read_or_affect aag l thread)) (as_user thread f)" apply (simp add: as_user_def split_def) apply (rule gen_asm_ev) apply (wp set_object_reads_respects select_f_ev gets_the_ev) apply (auto intro: reads_affects_equiv_get_tcb_eq[where aag=aag]) done lemma get_mi_length': "\\\ get_message_info sender \\rv s. buffer_cptr_index + unat (mi_extra_caps rv) < 2 ^ (msg_align_bits - word_size_bits)\" apply (rule hoare_post_imp[OF _ get_mi_valid']) apply (clarsimp simp: valid_message_info_def msg_align_bits' msg_max_length_def word_le_nat_alt buffer_cptr_index_def msg_max_extra_caps_def) done lemma validE_E_wp_post_taut: "\P\ f -, \\\\" by (auto simp: validE_E_def validE_def valid_def) lemma aag_has_read_auth_can_read_or_affect_ipc_buffer: "ipc_buffer_has_read_auth aag (pasSubject aag) buf \ aag_can_read_or_affect_ipc_buffer aag l buf" apply (clarsimp simp: ipc_buffer_has_read_auth_def aag_can_read_or_affect_ipc_buffer_def split: option.splits) apply (rule reads_read) apply blast done lemma ev_irrelevant_bind: assumes inv: "\P. \P\ f \\_. P\" assumes ev: "equiv_valid I A A P g" shows "equiv_valid I A A P (do y \ f; g od)" apply (simp add: equiv_valid_def2) apply (rule equiv_valid_rv_guard_imp) apply (rule equiv_valid_2_bind) apply (rule ev[simplified equiv_valid_def2]) apply (wp equiv_valid_rv_trivial[OF inv] inv | simp)+ done lemma set_mrs_returns_a_constant: "\x. \\\ set_mrs thread buf msgs \\rv s. rv = x\" apply (case_tac buf) apply (rule exI) apply ((simp add: set_mrs_def | wp | rule impI)+)[1] apply (rule exI) apply (simp add: set_mrs_def split del: if_split | wp | rule impI)+ done lemma set_mrs_ret_eq: "\(s::'s::state_ext state) (t::'s::state_ext state). \(rva, s') \ fst (set_mrs thread buf msgs s). \(rvb, t') \ fst (set_mrs thread buf msgs t). rva = rvb" apply (clarsimp) apply (cut_tac thread=thread and buf=buf and msgs=msgs in set_mrs_returns_a_constant) apply (erule exE) apply (subgoal_tac "a = x \ aa = x") apply simp apply (rule conjI) apply (erule (1) use_valid | simp)+ done lemma tl_tl_in_set: "tl xs = (x # xs') \ set xs' \ set xs" by (case_tac xs, auto) (* GENERALIZE the following is possible *) lemma ptr_in_obj_range: "\valid_objs s; pspace_aligned s; kheap s ptr = Some obj\ \ ptr + (a && mask (obj_bits obj)) \ obj_range ptr obj" apply (simp add: obj_range_def) apply (rule context_conjI) apply (frule(1) pspace_alignedD) apply (erule is_aligned_no_wrap') apply (rule and_mask_less') apply (drule valid_obj_sizes) apply fastforce apply (simp add: word_bits_def) apply (simp add: p_assoc_help) apply (rule word_plus_mono_right) apply (rule word_less_sub_1) apply (drule valid_obj_sizes) apply fastforce apply (simp add: word_bits_def and_mask_less') apply (rule is_aligned_no_overflow') apply (erule(1) pspace_alignedD) done lemma ko_at_eq: "ko_at obj pos s \ kheap s pos = Some obj" by (force simp:obj_at_def) locale Ipc_IF_2 = Ipc_IF_1 + assumes copy_mrs_reads_respects: "pas_domains_distinct aag \ reads_respects aag l (K (aag_can_read_or_affect aag l sender \ aag_can_read_or_affect_ipc_buffer aag l sbuf \ unat n < 2 ^ (msg_align_bits - word_size_bits))) (copy_mrs sender sbuf receiver rbuf n)" and get_message_info_reads_respects: "reads_respects aag l (K (aag_can_read_or_affect aag l ptr)) (get_message_info ptr)" and do_normal_transfer_reads_respects: "pas_domains_distinct aag \ reads_respects aag l (pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_mdb and valid_objs and K (aag_can_read_or_affect aag l sender \ ipc_buffer_has_read_auth aag (pasObjectAbs aag sender) sbuf \ ipc_buffer_has_read_auth aag (pasObjectAbs aag receiver) rbuf \ (grant \ (is_subject aag sender \ is_subject aag receiver)))) (do_normal_transfer sender sbuf endpoint badge grant receiver rbuf)" and make_arch_fault_msg_reads_respects: "reads_respects aag l (\y. aag_can_read_or_affect aag l sender) (make_arch_fault_msg x4 sender)" and set_mrs_equiv_but_for_labels: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag thread \ L \ (case buf of (Some buf') \ is_aligned buf' msg_align_bits \ (\x \ ptr_range buf' msg_align_bits. pasObjectAbs aag x \ L) | _ \ True))\ set_mrs thread buf msgs \\_. equiv_but_for_labels aag L st\" and set_mrs_reads_respects': "pas_domains_distinct aag \ reads_respects aag l (K (ipc_buffer_has_auth aag thread buf \ (case buf of (Some buf') \ is_aligned buf' msg_align_bits | _ \ True))) (set_mrs thread buf msgs)" begin lemma make_fault_msg_reads_respects: "reads_respects aag l (K (aag_can_read_or_affect aag l sender)) (make_fault_msg rva sender)" apply (case_tac rva) by (wp as_user_reads_respects make_arch_fault_msg_reads_respects | simp split del: if_split add: det_getRegister det_getRestartPC | rule det_mapM | rule subset_refl)+ lemma do_fault_transfer_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag l (K (aag_can_read_or_affect aag l sender \ ipc_buffer_has_auth aag receiver buf \ (case buf of None \ True | Some buf' \ is_aligned buf' msg_align_bits))) (do_fault_transfer badge sender receiver buf)" unfolding do_fault_transfer_def by (wp as_user_set_register_reads_respects' as_user_reads_respects set_message_info_reads_respects set_mrs_reads_respects' make_fault_msg_reads_respects thread_get_reads_respects | wpc | simp add: split_def det_setRegister | wp (once) hoare_drop_imps)+ lemma do_ipc_transfer_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag l (pspace_aligned and valid_vspace_objs and valid_arch_state and valid_objs and valid_mdb and pas_refined aag and K ((grant \ (is_subject aag sender \ is_subject aag receiver)) \ aag_can_read_or_affect aag l sender \ aag_can_read_or_affect aag l receiver )) (do_ipc_transfer sender ep badge grant receiver)" unfolding do_ipc_transfer_def apply (wp do_normal_transfer_reads_respects lookup_ipc_buffer_reads_respects lookup_ipc_buffer_has_read_auth do_fault_transfer_reads_respects thread_get_reads_respects lookup_ipc_buffer_has_auth lookup_ipc_buffer_aligned | wpc | simp | wp (once) hoare_drop_imps | fastforce)+ done lemma receive_ipc_base_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" notes do_nbrecv_failed_transfer_def[simp] shows "reads_respects aag (l :: 'a subject_label) (invs and pas_refined aag and pas_cur_domain aag and ko_at (Endpoint ep) epptr and is_subject aag \ cur_thread and K (is_subject aag receiver \ aag_has_auth_to aag Receive epptr \ (\auth \ cap_rights_to_auth rights True . aag_has_auth_to aag auth epptr))) (receive_ipc_base aag receiver ep epptr rights is_blocking)" apply (rule gen_asm_ev) apply (simp add: thread_get_def split: endpoint.split) apply (intro conjI impI) prefer 2 defer 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_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 set_simple_ko_reads_respects hoare_vcg_all_lift hoare_vcg_imp_lift[OF set_simple_ko_get_tcb, unfolded disj_not1] 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:neq_Nil_conv) subgoal for s sender queue apply (frule(1) receive_ipc_valid_ep_helper) apply (frule(1) sym_ref_endpoint_sendD[OF invs_sym_refs,where t= "sender"], force) apply (clarsimp simp:st_tcb_at_def elim!:obj_atE dest!:sym[where t = "tcb_state _"]) apply (subgoal_tac "aag_can_read aag sender") apply (fastforce simp: get_tcb_def elim: receive_ipc_sender_can_grant_helper intro: requiv_get_tcb_eq') apply (frule(2) receive_ipc_sender_helper) apply (solves \auto intro:reads_ep read_sync_ep_read_senders\) done done lemma receive_ipc_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (invs and pas_refined aag and pas_cur_domain aag and valid_cap cap and is_subject aag \ cur_thread and K (is_subject aag receiver \ pas_cap_cur_auth aag cap \ AllowRead \ cap_rights cap)) (receive_ipc receiver cap is_blocking)" apply (rule gen_asm_ev) apply (simp add: receive_ipc_def thread_get_def split: cap.split) apply (clarsimp simp: fail_ev_pre) apply (rename_tac epptr badge rights) apply (wp receive_ipc_base_reads_respects complete_signal_reads_respects static_imp_wp set_simple_ko_reads_respects set_thread_state_reads_respects setup_caller_cap_reads_respects complete_signal_reads_respects thread_get_reads_respects get_thread_state_reads_respects possible_switch_to_reads_respects gets_cur_thread_ev set_thread_state_pas_refined do_ipc_transfer_reads_respects do_ipc_transfer_pas_refined hoare_vcg_all_lift get_bound_notification_reads_respects' gbn_wp get_simple_ko_reads_respects get_simple_ko_wp | wpc | simp)+ by (fastforce simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def dest: bound_tcb_at_implies_receive reads_ep) end lemma receive_endpoint_threads_blocked: "\valid_objs s; (sym_refs \ state_refs_of) s; ko_at (Endpoint (RecvEP list)) ep s; x\set list\ \ st_tcb_at (receive_blocked_on ep) x s" apply (rule ep_queued_st_tcb_at'') apply simp+ done lemma receive_blocked_threads_have_Receive_auth: "\pas_refined aag s; valid_objs s; sym_refs (state_refs_of s); st_tcb_at (receive_blocked_on ep) x s\ \ (pasObjectAbs aag x,Receive,pasObjectAbs aag ep) \ pasPolicy aag" apply (drule_tac auth="Receive" and x=x in pas_refined_mem[rotated]) apply (rule sta_ts) apply (clarsimp simp: thread_st_auth_def split: option.split simp: tcb_states_of_state_def st_tcb_def2) apply (case_tac "tcb_state tcb", simp_all) done lemma receive_endpoint_reads_affects_queued: "\(pasSubject aag, SyncSend, pasObjectAbs aag epptr) \ pasPolicy aag; aag_can_read_label aag (pasObjectAbs aag epptr) \ aag_can_affect aag l epptr; pas_refined aag s; valid_objs s; sym_refs (state_refs_of s); ko_at (Endpoint (RecvEP list)) epptr s; ep = RecvEP list; x \ set list\ \ aag_can_read_label aag (pasObjectAbs aag x) \ aag_can_affect aag l x" apply (frule receive_endpoint_threads_blocked, (simp | assumption)+) apply (drule receive_blocked_threads_have_Receive_auth, (simp | assumption)+) apply (auto dest: read_sync_ep_read_receivers) done context Ipc_IF_2 begin lemma send_ipc_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (pas_refined aag and invs and pas_cur_domain aag and is_subject aag \ cur_thread and K (can_grant \ (aag_has_auth_to aag Grant epptr)) and K (is_subject aag thread \ aag_has_auth_to aag SyncSend epptr)) (send_ipc block call badge can_grant can_grant_reply thread epptr)" apply (rule gen_asm_ev) apply (subgoal_tac "aag_can_read aag epptr") prefer 2 apply (fastforce intro: reads_ep) apply (simp add: send_ipc_def) apply (wp set_simple_ko_reads_respects set_thread_state_reads_respects when_ev setup_caller_cap_reads_respects thread_get_reads_respects set_thread_state_reads_respects do_ipc_transfer_reads_respects 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 | wpc | simp add: get_thread_state_def thread_get_def split del: if_split)+ apply clarsimp apply (rename_tac receiver queue) apply (subgoal_tac "aag_can_read aag receiver \ (can_grant \ is_subject aag receiver)") prefer 2 apply (frule(2) pas_refined_ep_recv, rule head_in_set) apply (rule conjI) subgoal by (rule read_sync_ep_read_receivers) apply (fastforce dest: aag_wellformed_grant_Control_to_recv[OF _ _ pas_refined_wellformed] simp: aag_has_Control_iff_owns) by (fastforce elim: send_ipc_valid_ep_helper reads_equivE equiv_forD intro: kheap_get_tcb_eq) subsection "Faults" lemma send_fault_ipc_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (invs and pas_refined aag and pas_cur_domain aag and is_subject aag \ cur_thread and K (is_subject aag thread \ valid_fault fault)) (send_fault_ipc thread fault)" apply (rule gen_asm_ev) apply (simp add: send_fault_ipc_def Let_def lookup_cap_def split_def) apply (wp send_ipc_reads_respects thread_set_reads_respects thread_set_refs_trivial thread_set_obj_at_impossible thread_set_valid_objs'' hoare_vcg_conj_lift hoare_vcg_ex_lift hoare_vcg_all_lift thread_set_pas_refined cap_fault_on_failure_rev lookup_slot_for_thread_rev lookup_slot_for_thread_authorised hoare_vcg_all_lift_R thread_get_reads_respects get_cap_auth_wp[where aag=aag] get_cap_rev thread_set_tcb_fault_set_invs | wpc | simp add: split_def add: tcb_cap_cases_def | strengthen aag_can_read_self)+ (* clagged from Ipc_AC *) apply (rule_tac Q'="\rv s. pas_refined aag s \ is_subject aag (cur_thread s) \ invs s \ pas_cur_domain aag s \ valid_fault fault \ is_subject aag (fst (fst rv))" in hoare_post_imp_R[rotated]) apply (fastforce simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def) apply (wp get_cap_auth_wp[where aag=aag] lookup_slot_for_thread_authorised thread_get_reads_respects | simp add: add: lookup_cap_def split_def)+ done lemma handle_fault_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (invs and pas_refined aag and pas_cur_domain aag and is_subject aag \ cur_thread and K (is_subject aag thread \ valid_fault fault)) (handle_fault thread fault)" unfolding handle_fault_def catch_def fun_app_def handle_double_fault_def apply (wp (once) hoare_drop_imps | wp set_thread_state_reads_respects send_fault_ipc_reads_respects | wpc | simp)+ apply (fastforce intro: reads_affects_equiv_get_tcb_eq) done end subsection "Replies" context Ipc_IF_1 begin lemma handle_fault_reply_reads_respects: "reads_respects aag l (K (aag_can_read aag thread)) (handle_fault_reply fault thread x y)" apply (case_tac fault) apply (wp as_user_reads_respects thread_get_reads_respects thread_get_wp' handle_arch_fault_reply_reads_respects[simplified K_def] | simp add: det_zipWithM_x det_setRegister)+ done lemma lookup_ipc_buffer_has_read_auth': "\pas_refined aag and valid_objs and K (is_subject aag thread)\ lookup_ipc_buffer is_receiver thread \\rv s. ipc_buffer_has_read_auth aag (pasSubject aag) rv\" apply (rule hoare_gen_asm) apply (rule hoare_strengthen_post[OF lookup_ipc_buffer_has_read_auth]) apply (drule sym, simp) done end context Ipc_IF_2 begin lemma do_reply_transfer_reads_respects_f: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects_f aag l (silc_inv aag st and invs and pas_refined aag and pas_cur_domain aag and tcb_at receiver and tcb_at sender and emptyable slot and is_subject aag \ cur_thread and K (grant \ is_subject aag receiver) and K (is_subject aag sender \ aag_can_read aag receiver \ is_subject aag (fst slot))) (do_reply_transfer sender receiver slot grant)" unfolding do_reply_transfer_def apply (rule gen_asm_ev)+ apply (wp gets_cur_thread_ev[THEN reads_respects_f[where aag=aag and st=st and Q=\]] set_thread_state_reads_respects cap_delete_one_reads_respects_f do_ipc_transfer_reads_respects do_ipc_transfer_pas_refined thread_set_reads_respects handle_fault_reply_reads_respects get_mrs_rev lookup_ipc_buffer_reads_respects lookup_ipc_buffer_has_read_auth' get_message_info_rev get_mi_length cap_delete_one_silc_inv do_ipc_transfer_silc_inv set_thread_state_pas_refined thread_set_fault_pas_refined' possible_switch_to_reads_respects[THEN reads_respects_f[where aag=aag and st=st and Q=\]] when_ev | wpc | simp split del: if_split | wp (once) reads_respects_f[where aag=aag and st=st] | elim conjE | wp (once) hoare_drop_imps)+ apply (rule_tac Q="\ rv s. pas_refined aag s \ pas_cur_domain aag s \ invs s \ is_subject aag (cur_thread s) \ silc_inv aag st s" in hoare_strengthen_post[rotated]) apply ((wp (once) hoare_drop_imps | wp cap_delete_one_invs hoare_vcg_all_lift cap_delete_one_silc_inv reads_respects_f[OF thread_get_reads_respects] reads_respects_f[OF get_thread_state_rev] | simp add: invs_valid_objs invs_psp_aligned invs_valid_global_refs invs_distinct invs_arch_state invs_psp_aligned invs_vspace_objs invs_arch_state | rule conjI | elim conjE | assumption)+)[8] by (fastforce dest: silc_inv_not_subject) lemma handle_reply_reads_respects_f: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects_f aag l (silc_inv aag st and invs and pas_refined aag and pas_cur_domain aag and is_subject aag \ cur_thread) handle_reply" unfolding handle_reply_def apply (wp do_reply_transfer_reads_respects_f hoare_vcg_all_lift get_cap_wp reads_respects_f[OF get_cap_reads_respects, where Q="\" and st=st] | wpc | blast)+ apply (rule conjI) apply (fastforce simp: reads_equiv_f_def) apply clarsimp apply (rule conjI) apply assumption apply (rule conjI) apply (drule cte_wp_valid_cap) apply (erule invs_valid_objs) apply (simp add: valid_cap_simps) apply (rule conjI, fastforce simp: tcb_at_invs) apply (rule conjI) apply (erule emptyable_cte_wp_atD) apply (erule invs_valid_objs) apply (simp add: is_master_reply_cap_def) apply (frule_tac p="(cur_thread s, tcb_cnode_index 3)" in cap_cur_auth_caps_of_state[rotated]) apply simp apply (simp add: cte_wp_at_caps_of_state) apply (fastforce intro: read_reply_thread_read_thread_rev simp: aag_cap_auth_def cap_auth_conferred_def reply_cap_rights_to_auth_def dest: aag_Control_into_owns) done lemma reply_from_kernel_reads_respects: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag l (K (is_subject aag thread)) (reply_from_kernel thread x)" unfolding reply_from_kernel_def fun_app_def by (wp set_message_info_reads_respects set_mrs_reads_respects as_user_reads_respects lookup_ipc_buffer_reads_respects | simp add: split_def det_setRegister)+ end (* FIXME in whole section replace preconditions with 10 differents invariants by invs *) section "globals_equiv" subsection "Sync IPC" lemma setup_caller_cap_globals_equiv: "\globals_equiv s and valid_arch_state and valid_global_objs\ setup_caller_cap sender receiver grant \\_. globals_equiv s\" unfolding setup_caller_cap_def apply (wp cap_insert_globals_equiv'' set_thread_state_globals_equiv) apply (simp_all) done lemma set_extra_badge_globals_equiv: "set_extra_badge buffer badge n \globals_equiv s\" unfolding set_extra_badge_def by (wp store_word_offs_globals_equiv) lemma transfer_caps_loop_globals_equiv: "\globals_equiv st and valid_arch_state and valid_global_objs\ transfer_caps_loop ep rcv_buffer n caps slots mi \\_. globals_equiv st\" proof (induct caps arbitrary: slots n mi) case Nil thus ?case by (simp, wp, simp) next case (Cons c caps') show ?case apply (cases c) apply (simp split del: if_split cong: if_cong) apply (rule hoare_pre) apply (wp) apply (erule conjE, erule subst, rule Cons.hyps) apply (clarsimp) apply (wp set_extra_badge_globals_equiv)+ apply (rule Cons.hyps) apply (simp) apply (wp cap_insert_globals_equiv'') apply (rule_tac Q="\_. globals_equiv st and valid_arch_state and valid_global_objs" and E="\_. globals_equiv st and valid_arch_state and valid_global_objs" in hoare_post_impErr) apply (simp add: whenE_def, rule conjI) apply (rule impI, wp)+ apply (simp)+ apply wp+ apply (fastforce) done qed lemma transfer_caps_globals_equiv: "\globals_equiv st and valid_arch_state and valid_global_objs\ transfer_caps info caps endpoint receiver recv_buffer \\_. globals_equiv st\" unfolding transfer_caps_def by (wp transfer_caps_loop_globals_equiv | wpc | simp)+ lemma copy_mrs_globals_equiv: "\globals_equiv s and valid_arch_state and (\s. receiver \ idle_thread s)\ copy_mrs sender sbuf receiver rbuf n \\_. globals_equiv s\" unfolding copy_mrs_def including no_pre apply (wp | wpc)+ apply (rule_tac Q="\_. globals_equiv s" in hoare_strengthen_post) apply (wp mapM_wp' | wpc)+ apply (wp store_word_offs_globals_equiv)+ apply fastforce apply simp apply (rule_tac Q="\_. globals_equiv s and valid_arch_state and (\sa. receiver \ idle_thread sa)" in hoare_strengthen_post) apply (wp mapM_wp' as_user_globals_equiv) apply (simp) apply (fastforce) apply simp done (* FIXME: move *) lemma validE_to_valid: "\P\ f \\rv s. \v. rv = Inr v \ Q v s\ \ \P\ f \\v. Q v\, -" apply (rule validE_validE_R) apply (simp add: validE_def valid_def) done lemma do_normal_transfer_globals_equiv: "\globals_equiv st and valid_arch_state and valid_global_objs and (\sa. receiver \ idle_thread sa)\ do_normal_transfer sender sbuf endpoint badge grant receiver rbuf \\_. globals_equiv st\" unfolding do_normal_transfer_def apply (wp as_user_globals_equiv set_message_info_globals_equiv transfer_caps_globals_equiv) apply (wp copy_mrs_globals_equiv) apply (subst K_def) apply (wp | rule impI)+ apply (clarsimp) done lemma do_fault_transfer_globals_equiv: "\globals_equiv s and valid_arch_state and (\sa. receiver \ idle_thread sa)\ do_fault_transfer badge sender receiver buf \\_. globals_equiv s\" unfolding do_fault_transfer_def apply (wp) apply (simp add: split_def) apply (wp as_user_globals_equiv set_message_info_globals_equiv set_mrs_globals_equiv | wpc)+ apply (clarsimp) apply (rule hoare_drop_imps) apply (wp thread_get_inv, simp) done lemma set_collection: "a = {x. x\a}" by simp lemma valid_ep_send_enqueue: "\ ko_at (Endpoint (SendEP (t # ts))) a s; valid_objs s \ \ valid_ep (case ts of [] \ IdleEP | b # bs \ SendEP (b # bs)) s" unfolding valid_objs_def valid_obj_def valid_ep_def obj_at_def apply (drule bspec) apply (auto split: list.splits) done crunch globals_equiv[wp]: complete_signal "globals_equiv st" lemma case_list_cons_cong: "(case xxs of [] \ f | x # xs \ g xxs) = (case xxs of [] \ f | x # xs \ g (x # xs))" by (simp split: list.split) context Ipc_IF_1 begin lemma do_ipc_transfer_globals_equiv: "\globals_equiv st and valid_arch_state and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned and valid_global_objs and (\s. receiver \ idle_thread s)\ do_ipc_transfer sender ep badge grant receiver \\_. globals_equiv st\" unfolding do_ipc_transfer_def apply (wp do_normal_transfer_globals_equiv do_fault_transfer_globals_equiv | wpc)+ apply (rule_tac Q="\_. globals_equiv st and valid_arch_state and valid_global_objs and (\sa. receiver \ idle_thread sa) and (\sa. (\rb. recv_buffer = Some rb \ auth_ipc_buffers sa receiver = ptr_range rb msg_align_bits) \ (\rb. recv_buffer = Some rb \ is_aligned rb msg_align_bits))" in hoare_strengthen_post) apply (wp) apply (clarsimp | rule conjI)+ apply (wp hoare_vcg_all_lift lookup_ipc_buffer_ptr_range' lookup_ipc_buffer_aligned' | fastforce)+ done lemma send_ipc_globals_equiv: "\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 valid_idle and (\s. sym_refs (state_refs_of s))\ send_ipc block call badge can_grant can_grant_reply thread epptr \\_. globals_equiv st\" unfolding send_ipc_def apply (wp set_simple_ko_globals_equiv set_thread_state_globals_equiv setup_caller_cap_globals_equiv | wpc)+ apply (rule_tac Q="\_. globals_equiv st and valid_arch_state and valid_global_objs" in hoare_strengthen_post[rotated]) apply (fastforce) apply (wp set_thread_state_globals_equiv dxo_wp_weak | simp)+ apply wpc apply (wp do_ipc_transfer_globals_equiv)+ apply (clarsimp) apply (rule hoare_drop_imps) apply (wp set_simple_ko_globals_equiv)+ apply (rule_tac Q="\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 (\s. sym_refs (state_refs_of s)) and valid_idle" in hoare_strengthen_post) apply (wp get_simple_ko_sp) apply (clarsimp)+ apply (rule context_conjI) apply (rule valid_ep_recv_dequeue') apply (simp)+ apply (frule_tac x=xa in receive_endpoint_threads_blocked,simp+) by (clarsimp simp add: valid_idle_def pred_tcb_at_def obj_at_def)+ lemma receive_ipc_globals_equiv: notes do_nbrecv_failed_transfer_def[simp] shows "\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 (\s. thread \ idle_thread s)\ receive_ipc thread cap is_blocking \\_. globals_equiv st\" unfolding receive_ipc_def thread_get_def including no_pre apply (wp) apply (simp add: split_def) 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= "\_. globals_equiv st and valid_arch_state and valid_global_objs"]) apply (wp do_ipc_transfer_globals_equiv as_user_globals_equiv) apply clarsimp apply (wp gts_wp get_simple_ko_sp | wpc)+ apply (wp hoare_vcg_all_lift hoare_drop_imps)[1] apply (wp set_simple_ko_globals_equiv | wpc)+ apply (wp set_thread_state_globals_equiv) 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)+ by (auto intro: valid_ep_send_enqueue simp: neq_Nil_conv cong: case_list_cons_cong) end subsection "Notifications" lemma valid_ntfn_dequeue: "\ ko_at (Notification ntfn) ntfnptr s; ntfn_obj ntfn = (WaitingNtfn (t # ts)); valid_objs s; ts \ [] \ \ valid_ntfn ntfn s" unfolding valid_objs_def valid_obj_def valid_ntfn_def obj_at_def apply (drule bspec) apply (auto split: list.splits) done (* FIXME: NTFN OBJECT CHANGED *) lemma update_waiting_ntfn_globals_equiv: "\globals_equiv s and valid_objs and valid_arch_state and valid_global_refs and ko_at (Notification ntfn) ntfnptr and pspace_distinct and sym_refs \ state_refs_of and (\s. idle_thread s \ set queue) and K (ntfn_obj ntfn = WaitingNtfn queue)\ update_waiting_ntfn ntfnptr queue bound_tcb badge \\_. globals_equiv s\" unfolding update_waiting_ntfn_def supply possible_switch_to_extended.dxo_eq[simp del] apply (wpsimp wp: set_thread_state_globals_equiv as_user_globals_equiv set_notification_globals_equiv dxo_wp_weak) by (auto simp: neq_Nil_conv) lemma cancel_ipc_blocked_globals_equiv: "\globals_equiv st and valid_arch_state and st_tcb_at receive_blocked a\ cancel_ipc a \\_. globals_equiv st\" unfolding cancel_ipc_def apply (rule hoare_seq_ext[OF _ gts_sp]) apply (rule hoare_pre) apply (wpc; (simp,rule blocked_cancel_ipc_globals_equiv)?) apply (rule hoare_pre_cont)+ apply clarsimp apply (case_tac state;(clarsimp simp: pred_tcb_at_def obj_at_def receive_blocked_def)) by (simp add: eq_commute) crunch globals_equiv[wp]: possible_switch_to "globals_equiv st" (wp: tcb_sched_action_extended.globals_equiv reschedule_required_ext_extended.globals_equiv ignore_del: possible_switch_to) lemma send_signal_globals_equiv: "\globals_equiv s and valid_objs and valid_arch_state and valid_global_refs and sym_refs \ state_refs_of and pspace_distinct and valid_idle\ send_signal ntfnptr badge \\_. globals_equiv s\" unfolding send_signal_def apply (wp set_notification_globals_equiv possible_switch_to_globals_equiv set_thread_state_globals_equiv as_user_globals_equiv cancel_ipc_blocked_globals_equiv update_waiting_ntfn_globals_equiv get_simple_ko_wp gts_wp | wpc | simp)+ apply clarsimp apply (frule (1) sym_refs_ko_atD) apply (intro allI impI conjI) prefer 4 apply clarsimp apply (frule_tac t="idle_thread sa" and P="\ref. \ idle ref" in ntfn_queued_st_tcb_at') by (auto simp: pred_tcb_at_def obj_at_def valid_idle_def receive_blocked_def) (* FIXME: belongs in Arch_IF *) lemma receive_signal_globals_equiv: "\globals_equiv s and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and (\s. thread \ idle_thread s)\ receive_signal thread cap is_blocking \\_. globals_equiv s\" unfolding receive_signal_def fun_app_def do_nbrecv_failed_transfer_def apply (rule hoare_pre) apply (wpsimp wp: set_notification_globals_equiv set_thread_state_globals_equiv as_user_globals_equiv get_simple_ko_wp)+ done lemma handle_double_fault_globals_equiv: "\globals_equiv s and valid_arch_state\ handle_double_fault tptr ex1 ex2 \\_. globals_equiv s\" unfolding handle_double_fault_def by (wp set_thread_state_globals_equiv) lemma send_ipc_valid_global_objs: "\valid_global_objs\ send_ipc block call badge can_grant can_grant_reply thread epptr \\_. valid_global_objs\" unfolding send_ipc_def by (wp dxo_wp_weak hoare_drop_imps hoare_vcg_all_lift | simp | wpc | intro conjI impI)+ lemma send_fault_ipc_valid_global_objs: "send_fault_ipc tptr fault \valid_global_objs\" unfolding send_fault_ipc_def apply (wp) apply (simp add: Let_def) apply (wp send_ipc_valid_global_objs | wpc)+ apply (rule_tac Q'="\_. valid_global_objs" in hoare_post_imp_R) apply (wp | simp)+ done context Ipc_IF_1 begin lemma send_fault_ipc_globals_equiv: "\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 valid_idle and (\s. sym_refs (state_refs_of s)) and K (valid_fault fault)\ send_fault_ipc tptr fault \\_. globals_equiv st\" unfolding send_fault_ipc_def apply (wp) apply (simp add: Let_def) apply (wp send_ipc_globals_equiv thread_set_globals_equiv thread_set_valid_objs'' thread_set_fault_valid_global_refs thread_set_valid_idle_trivial thread_set_refs_trivial | wpc | simp)+ apply (rule_tac Q'="\_. 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 K (valid_fault fault) and valid_idle and (\s. sym_refs (state_refs_of s))" in hoare_post_imp_R) apply (wp | simp)+ apply (clarsimp) apply (rule valid_tcb_fault_update) apply (wp | simp)+ done crunches send_fault_ipc for valid_arch_state[wp]: valid_arch_state (wp: dxo_wp_weak hoare_drop_imps simp: crunch_simps) lemma handle_fault_globals_equiv: "\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 valid_idle and (\s. sym_refs (state_refs_of s)) and K (valid_fault ex)\ handle_fault thread ex \\_. globals_equiv st\" unfolding handle_fault_def apply (wp handle_double_fault_globals_equiv) apply (rule_tac Q="\_. globals_equiv st and valid_arch_state" and E="\_. globals_equiv st and valid_arch_state" in hoare_post_impErr) apply (wp send_fault_ipc_globals_equiv | simp)+ done lemma handle_fault_reply_globals_equiv: "\globals_equiv st and valid_arch_state and (\s. thread \ idle_thread s)\ handle_fault_reply fault thread x y \\_. globals_equiv st\" by (cases fault; wpsimp wp: as_user_globals_equiv handle_arch_fault_reply_globals_equiv) crunch valid_global_objs: handle_fault_reply "\s :: det_state. valid_global_objs s" lemma do_reply_transfer_globals_equiv: "\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 valid_idle\ do_reply_transfer sender receiver slot grant \\_. globals_equiv st\" unfolding do_reply_transfer_def apply (wp set_thread_state_globals_equiv cap_delete_one_globals_equiv do_ipc_transfer_globals_equiv thread_set_globals_equiv handle_fault_reply_globals_equiv dxo_wp_weak | wpc | simp split del: if_split)+ apply (rule_tac Q="\_. globals_equiv st and valid_arch_state and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned and valid_global_objs and (\s. receiver \ idle_thread s) and valid_idle" in hoare_strengthen_post) apply (wp gts_wp | fastforce simp: pred_tcb_at_def obj_at_def valid_idle_def)+ done lemma handle_reply_globals_equiv: "\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 valid_idle\ handle_reply \\_. globals_equiv st\" unfolding handle_reply_def apply (wp do_reply_transfer_globals_equiv | wpc)+ apply (rule_tac Q="\_. 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 valid_idle" in hoare_strengthen_post) apply (wp | simp)+ done end lemma reply_from_kernel_globals_equiv: "\globals_equiv s and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned and (\s. thread \ idle_thread s)\ reply_from_kernel thread x \\_. globals_equiv s\" unfolding reply_from_kernel_def by (wpsimp wp: set_message_info_globals_equiv set_mrs_globals_equiv as_user_globals_equiv) section "reads_respects_g" subsection "Notifications" context Ipc_IF_1 begin lemma send_signal_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag l (pas_refined aag and pas_cur_domain aag and valid_etcbs and pspace_aligned and valid_vspace_objs and valid_arch_state and valid_objs and valid_global_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_idle and ct_active and sym_refs \ state_refs_of and is_subject aag \ cur_thread and K ((pasSubject aag, Notify, pasObjectAbs aag ntfnptr) \ pasPolicy aag)) (send_signal ntfnptr badge)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule send_signal_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp send_signal_globals_equiv | simp)+ done end lemma receive_signal_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag (l :: 'a subject_label) (valid_global_objs and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and pas_refined aag and (\s. thread \ idle_thread s) and is_subject aag \ cur_thread and K (\nptr\obj_refs_ac cap. (pasSubject aag, Receive, pasObjectAbs aag nptr) \ pasPolicy aag \ is_subject aag thread)) (receive_signal thread cap is_blocking)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule receive_signal_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp receive_signal_globals_equiv | simp)+ done context Ipc_IF_2 begin subsection "Sync IPC" lemma send_ipc_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag l (pas_refined aag and pas_cur_domain aag and invs and is_subject aag \ cur_thread and (\s. (can_grant \ aag_has_auth_to aag Grant epptr)) and K (is_subject aag thread \ aag_has_auth_to aag SyncSend epptr)) (send_ipc block call badge can_grant can_grant_reply thread epptr)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule send_ipc_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp send_ipc_globals_equiv | simp)+ by fastforce lemma receive_ipc_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag l (invs and (\s. receiver \ idle_thread s) and pas_refined aag and pas_cur_domain aag and valid_cap cap and is_subject aag \ cur_thread and K (is_subject aag receiver \ pas_cap_cur_auth aag cap \ AllowRead \ cap_rights cap)) (receive_ipc receiver cap is_blocking)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule receive_ipc_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp receive_ipc_globals_equiv | simp)+ by fastforce subsection "Faults" lemma send_fault_ipc_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag l (invs and pas_refined aag and pas_cur_domain aag and is_subject aag \ cur_thread and K (is_subject aag thread \ valid_fault fault)) (send_fault_ipc thread fault)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule send_fault_ipc_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp send_fault_ipc_globals_equiv | simp)+ by fastforce lemma handle_fault_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag l (invs and pas_refined aag and pas_cur_domain aag and is_subject aag \ cur_thread and K (is_subject aag thread \ valid_fault fault)) (handle_fault thread fault)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule handle_fault_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp handle_fault_globals_equiv | simp)+ by fastforce subsection "Replies" lemma handle_fault_reply_reads_respects_g: "reads_respects_g aag l (valid_arch_state and (\s. thread \ idle_thread s) and K (is_subject aag thread)) (handle_fault_reply fault thread x y)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule handle_fault_reply_reads_respects) apply (rule doesnt_touch_globalsI) apply (wp handle_fault_reply_globals_equiv | simp)+ done lemma do_reply_transfer_reads_respects_f_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_f_g aag l (silc_inv aag st and invs and pas_refined aag and pas_cur_domain aag and tcb_at receiver and tcb_at sender and emptyable slot and is_subject aag \ cur_thread and K (grant \ is_subject aag receiver) and K (is_subject aag sender \ aag_can_read aag receiver \ is_subject aag (fst slot))) (do_reply_transfer sender receiver slot grant)" apply (rule equiv_valid_guard_imp[OF reads_respects_f_g]) apply (rule do_reply_transfer_reads_respects_f[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp do_reply_transfer_globals_equiv | simp)+ apply (simp add: invs_def valid_state_def valid_pspace_def | blast)+ done lemma handle_reply_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_f_g aag l (silc_inv aag st and invs and pas_refined aag and pas_cur_domain aag and is_subject aag \ cur_thread) (handle_reply)" apply (rule equiv_valid_guard_imp[OF reads_respects_f_g]) apply (rule handle_reply_reads_respects_f[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp handle_reply_globals_equiv | simp)+ apply (simp add: invs_def valid_state_def valid_pspace_def | blast)+ done lemma reply_from_kernel_reads_respects_g: assumes domains_distinct: "pas_domains_distinct aag" shows "reads_respects_g aag l (valid_global_objs and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned and (\s. thread \ idle_thread s) and K (is_subject aag thread)) (reply_from_kernel thread x)" apply (rule equiv_valid_guard_imp[OF reads_respects_g]) apply (rule reply_from_kernel_reads_respects[OF domains_distinct]) apply (rule doesnt_touch_globalsI) apply (wp reply_from_kernel_globals_equiv | simp)+ done lemmas lookup_ipc_buffer_reads_respects_g = reads_respects_g_from_inv[OF lookup_ipc_buffer_reads_respects lookup_ipc_buffer_inv] end end