(* * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230) * * SPDX-License-Identifier: GPL-2.0-only *) theory ArchIpc_IF imports Ipc_IF begin context Arch begin global_naming ARM named_theorems Ipc_IF_assms lemma lookup_ipc_buffer_reads_respects[Ipc_IF_assms]: "reads_respects aag l (K (aag_can_read aag thread \ aag_can_affect aag l thread)) (lookup_ipc_buffer is_receiver thread)" unfolding lookup_ipc_buffer_def by (wp thread_get_reads_respects get_cap_reads_respects | wpc | simp)+ lemma as_user_equiv_but_for_labels[Ipc_IF_assms]: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag thread \ L)\ as_user thread f \\_. equiv_but_for_labels aag L st\" unfolding as_user_def apply (wp set_object_equiv_but_for_labels | simp add: split_def)+ apply (blast dest: get_tcb_not_asid_pool_at) done lemma storeWord_equiv_but_for_labels[Ipc_IF_assms]: "\\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\)\" unfolding storeWord_def apply (wp modify_wp) apply (clarsimp simp: equiv_but_for_labels_def) apply (rule states_equiv_forI) apply (fastforce intro!: equiv_forI elim!: states_equiv_forE dest: equiv_forD) apply (simp add: states_equiv_for_def) apply (rule conjI) apply (rule equiv_forI) apply clarsimp apply (drule_tac f=underlying_memory in equiv_forD,fastforce) apply (fastforce intro: is_aligned_no_wrap' word_plus_mono_right simp: is_aligned_mask for_each_byte_of_word_def word_size_def) apply (rule equiv_forI) apply clarsimp apply (drule_tac f=device_state in equiv_forD,fastforce) apply clarsimp 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 equiv_asid_def elim: states_equiv_forE) apply (fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=ready_queues]) done lemma set_thread_state_runnable_equiv_but_for_labels[Ipc_IF_assms]: "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\" unfolding set_thread_state_def apply (wpsimp wp: set_object_equiv_but_for_labels[THEN hoare_set_object_weaken_pre] set_thread_state_ext_runnable_equiv_but_for_labels) apply (wpsimp wp: set_object_wp)+ apply (fastforce dest: get_tcb_not_asid_pool_at simp: st_tcb_at_def obj_at_def) done lemma set_endpoint_equiv_but_for_labels[Ipc_IF_assms]: "\equiv_but_for_labels aag L st and K (pasObjectAbs aag epptr \ L)\ set_endpoint epptr ep \\_. equiv_but_for_labels aag L st\" unfolding set_simple_ko_def apply (wp set_object_equiv_but_for_labels get_object_wp) apply (clarsimp simp: asid_pool_at_kheap partial_inv_def obj_at_def split: kernel_object.splits) done (* FIXME move *) lemma conj_imp: "\ Q \ R; P \ Q; P' \ Q \ \ (P \ R) \ (P' \ R)" by fastforce (* basically clagged directly from lookup_ipc_buffer_has_auth *) lemma lookup_ipc_buffer_has_read_auth[Ipc_IF_assms]: "\pas_refined aag and valid_objs\ lookup_ipc_buffer is_receiver thread \\rv s. ipc_buffer_has_read_auth aag (pasObjectAbs aag thread) rv\" apply (rule hoare_pre) apply (simp add: lookup_ipc_buffer_def) apply (wp get_cap_wp thread_get_wp' | wpc)+ apply (clarsimp simp: cte_wp_at_caps_of_state ipc_buffer_has_read_auth_def get_tcb_ko_at[symmetric]) apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"]) apply (simp add: dom_tcb_cap_cases) apply (frule (1) caps_of_state_valid_cap) apply (clarsimp simp: vm_read_only_def vm_read_write_def) apply (rule_tac Q="AllowRead \ xc" in conj_imp) apply (clarsimp simp: valid_cap_simps cap_aligned_def) apply (rule conjI) apply (erule aligned_add_aligned) apply (rule is_aligned_andI1) apply (drule (1) valid_tcb_objs) apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def split: if_splits) apply (rule order_trans [OF _ pbfs_atleast_pageBits]) apply (simp add: msg_align_bits pageBits_def) apply (drule (1) cap_auth_caps_of_state) apply (clarsimp simp: aag_cap_auth_def cap_auth_conferred_def arch_cap_auth_conferred_def vspace_cap_rights_to_auth_def vm_read_only_def) apply (drule bspec) apply (erule (3) ipcframe_subset_page) apply (clarsimp split: if_split_asm simp: vspace_cap_rights_to_auth_def is_page_cap_def) apply (simp_all) done lemma cptrs_in_ipc_buffer[Ipc_IF_assms]: "\ n \ set [buffer_cptr_index ..< buffer_cptr_index + unat (mi_extra_caps mi)]; is_aligned (p :: obj_ref) 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" apply (rule ptr_range_subset) apply assumption apply (simp add: msg_align_bits') apply (simp add: msg_align_bits' word_size_bits_def word_bits_def) apply (simp add: word_size_def) apply (subst upto_enum_step_shift_red[where us=2, simplified]) apply (simp add: msg_align_bits' word_bits_def word_size_bits_def)+ done lemma msg_in_ipc_buffer[Ipc_IF_assms]: "\ 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 :: obj_ref) msg_align_bits" apply (rule ptr_range_subset) apply assumption apply (simp add: msg_align_bits') apply (simp add: msg_align_bits word_bits_def) apply (simp add: word_size_def) apply (subst upto_enum_step_shift_red[where us=2, simplified]) apply (simp add: msg_align_bits word_bits_def)+ apply (simp add: image_def) apply (rule_tac x=n in bexI) apply (rule refl) apply (auto simp: msg_max_length_def) done lemma arch_derive_cap_reads_respects[Ipc_IF_assms]: "reads_respects aag l \ (arch_derive_cap cap)" unfolding arch_derive_cap_def apply (rule equiv_valid_guard_imp) apply (wp | wpc)+ apply (simp) done lemma arch_derive_cap_rev[Ipc_IF_assms]: "reads_equiv_valid_inv aag l \ (arch_derive_cap cap)" unfolding arch_derive_cap_def apply (rule equiv_valid_guard_imp) apply (wp | wpc)+ apply (simp) done lemma captransfer_in_ipc_buffer[Ipc_IF_assms]: "\ is_aligned (buf :: obj_ref) msg_align_bits; n \ {0..2} \ \ ptr_range (buf + (2 + (of_nat msg_max_length + of_nat msg_max_extra_caps)) * word_size + n * word_size) word_size_bits \ ptr_range buf msg_align_bits" apply (rule ptr_range_subset) apply assumption apply (simp add: msg_align_bits') apply (simp add: msg_align_bits word_bits_def) apply (simp add: word_size_def) apply (subst upto_enum_step_shift_red[where us=2, simplified]) apply (simp add: msg_align_bits word_bits_def)+ apply (simp add: image_def msg_max_length_def msg_max_extra_caps_def) apply (rule_tac x="(125::nat) + unat n" in bexI) apply simp+ apply (fastforce intro: unat_less_helper word_leq_minus_one_le) done lemma mrs_in_ipc_buffer[Ipc_IF_assms]: "\ n \ set [length msg_registers + 1 ..< Suc n']; is_aligned (buf :: obj_ref) 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" apply (rule ptr_range_subset) apply assumption apply (simp add: msg_align_bits') apply (simp add: msg_align_bits word_bits_def) apply (simp add: word_size_def) apply (subst upto_enum_step_shift_red[where us=2, simplified]) apply (simp add: msg_align_bits word_bits_def word_size_bits_def)+ apply (simp add: image_def) apply (rule_tac x=n in bexI) apply (rule refl) apply (fastforce split: if_split_asm) done lemma dmo_loadWord_reads_respects[Ipc_IF_assms]: "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))" apply (rule gen_asm_ev) apply (rule use_spec_ev) apply (rule spec_equiv_valid_hoist_guard) apply (rule do_machine_op_spec_reads_respects) apply (simp add: loadWord_def equiv_valid_def2 spec_equiv_valid_def) apply (rule_tac R'="\rv rv'. for_each_byte_of_word (\y. rv y = rv' y) p" and Q="\\" and Q'="\\" and P="\" and P'="\" in equiv_valid_2_bind_pre) apply (rule_tac R'="(=)" and Q="\ r s. p && mask 2 = 0" and Q'="\ r s. p && mask 2 = 0" and P="\" and P'="\" in equiv_valid_2_bind_pre) apply (rule return_ev2) apply (rule_tac f="word_rcat" in arg_cong) apply (fastforce intro: is_aligned_no_wrap' word_plus_mono_right simp: is_aligned_mask for_each_byte_of_word_def word_size_def) (* slow *) apply (rule assert_ev2[OF refl]) apply (rule assert_wp)+ apply simp+ apply (clarsimp simp: equiv_valid_2_def in_monad for_each_byte_of_word_def) apply (fastforce elim: equiv_forD orthD1 simp: ptr_range_def add.commute) apply (wp wp_post_taut loadWord_inv | simp)+ done lemma complete_signal_reads_respects[Ipc_IF_assms]: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag l (K (aag_can_read aag ntfnptr \ aag_can_affect aag l ntfnptr)) (complete_signal ntfnptr receiver)" unfolding complete_signal_def by (wp set_simple_ko_reads_respects get_simple_ko_reads_respects as_user_set_register_reads_respects' | wpc | simp)+ lemma handle_arch_fault_reply_reads_respects[Ipc_IF_assms, wp]: "reads_respects aag l (K (aag_can_read aag thread)) (handle_arch_fault_reply afault thread x y)" by (simp add: handle_arch_fault_reply_def, wp) lemma arch_get_sanitise_register_info_reads_respects[Ipc_IF_assms, wp]: "reads_respects aag l \ (arch_get_sanitise_register_info t)" by wpsimp declare arch_get_sanitise_register_info_inv[Ipc_IF_assms] lemma lookup_ipc_buffer_ptr_range'[Ipc_IF_assms]: "\valid_objs\ lookup_ipc_buffer True thread \\rv s. rv = Some buf' \ auth_ipc_buffers s thread = ptr_range buf' msg_align_bits\" unfolding lookup_ipc_buffer_def apply (rule hoare_pre) apply (wp get_cap_wp thread_get_wp' | wpc)+ apply (clarsimp simp: cte_wp_at_caps_of_state ipc_buffer_has_auth_def get_tcb_ko_at [symmetric]) apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"]) apply (simp add: dom_tcb_cap_cases) apply (clarsimp simp: auth_ipc_buffers_def get_tcb_ko_at [symmetric]) apply (drule(1) valid_tcb_objs) apply (drule get_tcb_SomeD)+ apply (simp add: vm_read_write_def valid_tcb_def valid_ipc_buffer_cap_def split: bool.splits) done lemma lookup_ipc_buffer_aligned'[Ipc_IF_assms]: "\valid_objs\ lookup_ipc_buffer True thread \\rv s. rv = Some buf' \ is_aligned buf' msg_align_bits\" apply (insert lookup_ipc_buffer_aligned) apply (fastforce simp: valid_def) done lemma handle_arch_fault_reply_globals_equiv[Ipc_IF_assms]: "\globals_equiv st and valid_arch_state and (\s. thread \ idle_thread s)\ handle_arch_fault_reply vmf thread x y \\_. globals_equiv st\" by (wpsimp simp: handle_arch_fault_reply_def)+ crunches arch_get_sanitise_register_info, handle_arch_fault_reply for valid_global_objs[Ipc_IF_assms, wp]: "valid_global_objs" end global_interpretation Ipc_IF_1?: Ipc_IF_1 proof goal_cases interpret Arch . case 1 show ?case by (unfold_locales; (fact Ipc_IF_assms)?) qed context Arch begin global_naming ARM lemma copy_mrs_reads_respects[Ipc_IF_assms]: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (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)" unfolding copy_mrs_def fun_app_def apply (rule gen_asm_ev) apply (wp mapM_ev'' store_word_offs_reads_respects load_word_offs_reads_respects as_user_set_register_reads_respects' as_user_reads_respects | wpc | simp add: det_setRegister det_getRegister split del: if_split)+ apply clarsimp apply (rename_tac n') apply (subgoal_tac "ptr_range (x + of_nat n' * of_nat word_size) word_size_bits \ ptr_range x msg_align_bits") apply (simp add: for_each_byte_of_word_def2) apply (simp add: aag_can_read_or_affect_ipc_buffer_def) apply (erule conjE) apply (rule ballI) apply (erule bspec) apply (erule (1) subsetD[rotated]) apply (rule ptr_range_subset) apply (simp add: aag_can_read_or_affect_ipc_buffer_def) apply (simp add: msg_align_bits') apply (simp add: msg_align_bits word_bits_def) apply (simp add: word_size_def word_size_bits_def) apply (subst upto_enum_step_shift_red[where us=2, simplified]) apply (simp add: msg_align_bits word_bits_def aag_can_read_or_affect_ipc_buffer_def )+ apply (fastforce simp: image_def) done lemma get_message_info_reads_respects[Ipc_IF_assms]: "reads_respects aag (l :: 'a subject_label) (K (aag_can_read_or_affect aag l ptr)) (get_message_info ptr)" apply (simp add: get_message_info_def) apply (wp as_user_reads_respects | clarsimp simp: getRegister_def)+ done lemma do_normal_transfer_reads_respects[Ipc_IF_assms]: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (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)" apply (cases grant) apply (rule gen_asm_ev) apply (simp add: do_normal_transfer_def) apply (wp copy_mrs_pas_refined get_message_info_rev lookup_extra_caps_rev as_user_set_register_reads_respects' set_message_info_reads_respects transfer_caps_reads_respects copy_mrs_reads_respects lookup_extra_caps_rev lookup_extra_caps_authorised lookup_extra_caps_auth get_message_info_rev get_mi_length' get_mi_length validE_E_wp_post_taut copy_mrs_cte_wp_at hoare_vcg_ball_lift lec_valid_cap' lookup_extra_caps_srcs[simplified ball_conj_distrib,THEN hoare_conjDR1] lookup_extra_caps_srcs[simplified ball_conj_distrib,THEN hoare_conjDR2] | wpc | simp add: det_setRegister ball_conj_distrib)+ apply (fastforce intro: aag_has_read_auth_can_read_or_affect_ipc_buffer) apply (rule gen_asm_ev) apply (simp add: do_normal_transfer_def transfer_caps_def) apply (wp ev_irrelevant_bind[where f="get_receive_slots receiver rbuf"] as_user_set_register_reads_respects' set_message_info_reads_respects copy_mrs_reads_respects get_message_info_reads_respects get_mi_length | wpc | simp)+ apply (auto simp: ipc_buffer_has_read_auth_def aag_can_read_or_affect_ipc_buffer_def dest: reads_read_thread_read_pages split: option.splits) done lemma make_arch_fault_msg_reads_respects[Ipc_IF_assms]: "reads_respects aag (l :: 'a subject_label) (\y. aag_can_read_or_affect aag l sender) (make_arch_fault_msg x4 sender)" apply (case_tac x4) apply (wp as_user_reads_respects | simp add: det_getRegister det_getRestartPC)+ done lemma set_mrs_equiv_but_for_labels[Ipc_IF_assms]: "\equiv_but_for_labels (aag :: 'a subject_label PAS) 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\" unfolding set_mrs_def apply (wp | wpc)+ apply (subst zipWithM_x_mapM_x) apply (rule_tac Q="\_. 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))" in hoare_strengthen_post) apply (wp mapM_x_wp' store_word_offs_equiv_but_for_labels | simp add: split_def)+ apply (case_tac xa, clarsimp split: if_split_asm elim!: in_set_zipE) apply (clarsimp simp: for_each_byte_of_word_def) apply (erule bspec) apply (clarsimp simp: ptr_range_def) apply (rule conjI) apply (erule order_trans[rotated]) apply (erule is_aligned_no_wrap') apply (rule mul_word_size_lt_msg_align_bits_ofnat) apply (fastforce simp: msg_max_length_def msg_align_bits') apply (erule order_trans) apply (subst p_assoc_help) apply (simp add: add.assoc) apply (rule word_plus_mono_right) apply (rule word_less_sub_1) apply (rule_tac y="of_nat msg_max_length * of_nat word_size + (word_size - 1)" in le_less_trans) apply (rule word_plus_mono_left) apply (rule word_mult_le_mono1) apply (erule disjE) apply (rule word_of_nat_le) apply (simp add: msg_max_length_def) apply clarsimp apply (rule word_of_nat_le) apply (simp add: msg_max_length_def) apply (simp add: word_size_def) apply (simp add: msg_max_length_def word_size_def) apply (simp add: msg_max_length_def word_size_def) apply (rule mul_add_word_size_lt_msg_align_bits_ofnat) apply (simp add: msg_max_length_def msg_align_bits') apply (simp add: word_size_def) apply (erule is_aligned_no_overflow') apply simp apply (wp set_object_equiv_but_for_labels hoare_vcg_all_lift hoare_weak_lift_imp | simp)+ apply (fastforce dest: get_tcb_not_asid_pool_at)+ done lemma set_mrs_reads_respects'[Ipc_IF_assms]: assumes domains_distinct[wp]: "pas_domains_distinct aag" shows "reads_respects aag (l :: 'a subject_label) (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)" apply (case_tac "aag_can_read_or_affect aag l thread") apply ((wp equiv_valid_guard_imp[OF set_mrs_reads_respects] | simp)+)[1] apply (rule gen_asm_ev) apply (simp add: equiv_valid_def2) apply (rule equiv_valid_rv_guard_imp) apply (case_tac buf) apply (rule_tac Q="\" and P="\" and L="{pasObjectAbs aag thread}" in ev_invisible[OF domains_distinct]) apply (clarsimp simp: labels_are_invisible_def) apply (rule modifies_at_mostI) apply (simp add: set_mrs_def) apply ((wp set_object_equiv_but_for_labels | simp | auto dest: get_tcb_not_asid_pool_at)+)[1] apply (simp) apply (rule set_mrs_ret_eq) apply (rename_tac buf') apply (rule_tac Q="\" and L="{pasObjectAbs aag thread} \ (pasObjectAbs aag) ` (ptr_range buf' msg_align_bits)" in ev_invisible[OF domains_distinct]) apply (auto simp: labels_are_invisible_def ipc_buffer_has_auth_def dest: reads_read_page_read_thread simp: aag_can_affect_label_def)[1] apply (rule modifies_at_mostI) apply (wp set_mrs_equiv_but_for_labels | simp)+ apply (rule set_mrs_ret_eq) by simp end global_interpretation Ipc_IF_2?: Ipc_IF_2 proof goal_cases interpret Arch . case 1 show ?case by (unfold_locales; (fact Ipc_IF_assms)?) qed end