(* * Copyright 2014, General Dynamics C4 Systems * * SPDX-License-Identifier: GPL-2.0-only *) (* Refinement for handleEvent and syscalls *) theory Syscall_R imports Tcb_R Arch_R Interrupt_R begin context begin interpretation Arch . (*FIXME: arch_split*) (* syscall has 5 sections: m_fault h_fault m_error h_error m_finalise run m_fault (faultable code) \ r_fault failure, i.e. Inr somefault \ \somefault. h_fault; done success, i.e. Inl a \ run \a. m_error a (errable code) \ r_error failure, i.e. Inr someerror \ \someerror. h_error e; done success, i.e. Inl b \ \b. m_finalise b One can clearly see this is simulating some kind of monadic Maybe sequence trying to identify all possible errors before actually performing the syscall. *) lemma syscall_corres: assumes corres: "corres (fr \ r_flt_rel) P P' m_flt m_flt'" "\flt flt'. flt' = fault_map flt \ corres r (P_flt flt) (P'_flt flt') (h_flt flt) (h_flt' flt')" "\rv rv'. r_flt_rel rv rv' \ corres (ser \ r_err_rel rv rv') (P_no_flt rv) (P'_no_flt rv') (m_err rv) (m_err' rv')" "\rv rv' err err'. \r_flt_rel rv rv'; err' = syscall_error_map err \ \ corres r (P_err rv err) (P'_err rv' err') (h_err err) (h_err' err')" "\rvf rvf' rve rve'. \r_flt_rel rvf rvf'; r_err_rel rvf rvf' rve rve'\ \ corres (dc \ r) (P_no_err rvf rve) (P'_no_err rvf' rve') (m_fin rve) (m_fin' rve')" assumes wp: "\rv. \Q_no_flt rv\ m_err rv \P_no_err rv\, \P_err rv\" "\rv'. \Q'_no_flt rv'\ m_err' rv' \P'_no_err rv'\,\P'_err rv'\" "\Q\ m_flt \\rv. P_no_flt rv and Q_no_flt rv\, \P_flt\" "\Q'\ m_flt' \\rv. P'_no_flt rv and Q'_no_flt rv\, \P'_flt\" shows "corres (dc \ r) (P and Q) (P' and Q') (Syscall_A.syscall m_flt h_flt m_err h_err m_fin) (Syscall_H.syscall m_flt' h_flt' m_err' h_err' m_fin')" apply (simp add: Syscall_A.syscall_def Syscall_H.syscall_def liftE_bindE) apply (rule corres_split_bind_case_sum) apply (rule corres_split_bind_case_sum | rule corres | rule wp | simp add: liftE_bindE)+ done lemma syscall_valid': assumes x: "\ft. \P_flt ft\ h_flt ft \Q\" "\err. \P_err err\ h_err err \Q\" "\rv. \P_no_err rv\ m_fin rv \Q\,\E\" "\rv. \P_no_flt rv\ m_err rv \P_no_err\, \P_err\" "\P\ m_flt \P_no_flt\, \P_flt\" shows "\P\ Syscall_H.syscall m_flt h_flt m_err h_err m_fin \Q\, \E\" apply (simp add: Syscall_H.syscall_def liftE_bindE cong: sum.case_cong) apply (rule hoare_split_bind_case_sumE) apply (wp x)[1] apply (rule hoare_split_bind_case_sumE) apply (wp x|simp)+ done text \Completing the relationship between abstract/haskell invocations\ primrec inv_relation :: "Invocations_A.invocation \ Invocations_H.invocation \ bool" where "inv_relation (Invocations_A.InvokeUntyped i) x = (\i'. untypinv_relation i i' \ x = InvokeUntyped i')" | "inv_relation (Invocations_A.InvokeEndpoint w w2 b c) x = (x = InvokeEndpoint w w2 b c)" | "inv_relation (Invocations_A.InvokeNotification w w2) x = (x = InvokeNotification w w2)" | "inv_relation (Invocations_A.InvokeReply w ptr grant) x = (x = InvokeReply w (cte_map ptr) grant)" | "inv_relation (Invocations_A.InvokeTCB i) x = (\i'. tcbinv_relation i i' \ x = InvokeTCB i')" | "inv_relation (Invocations_A.InvokeDomain tptr domain) x = (x = InvokeDomain tptr domain)" | "inv_relation (Invocations_A.InvokeIRQControl i) x = (\i'. irq_control_inv_relation i i' \ x = InvokeIRQControl i')" | "inv_relation (Invocations_A.InvokeIRQHandler i) x = (\i'. irq_handler_inv_relation i i' \ x = InvokeIRQHandler i')" | "inv_relation (Invocations_A.InvokeCNode i) x = (\i'. cnodeinv_relation i i' \ x = InvokeCNode i')" | "inv_relation (Invocations_A.InvokeArchObject i) x = (\i'. archinv_relation i i' \ x = InvokeArchObject i')" (* In order to assert conditions that must hold for the appropriate handleInvocation and handle_invocation calls to succeed, we must have some notion of what a valid invocation is. This function defines that. For example, a InvokeEndpoint requires an endpoint at its first constructor argument. *) primrec valid_invocation' :: "Invocations_H.invocation \ kernel_state \ bool" where "valid_invocation' (Invocations_H.InvokeUntyped i) = valid_untyped_inv' i" | "valid_invocation' (Invocations_H.InvokeEndpoint w w2 b c) = (ep_at' w and ex_nonz_cap_to' w)" | "valid_invocation' (Invocations_H.InvokeNotification w w2) = (ntfn_at' w and ex_nonz_cap_to' w)" | "valid_invocation' (Invocations_H.InvokeTCB i) = tcb_inv_wf' i" | "valid_invocation' (Invocations_H.InvokeDomain thread domain) = (tcb_at' thread and K (domain \ maxDomain))" | "valid_invocation' (Invocations_H.InvokeReply thread slot grant) = (tcb_at' thread and cte_wp_at' (\cte. \gr. cteCap cte = ReplyCap thread False gr) slot)" | "valid_invocation' (Invocations_H.InvokeIRQControl i) = irq_control_inv_valid' i" | "valid_invocation' (Invocations_H.InvokeIRQHandler i) = irq_handler_inv_valid' i" | "valid_invocation' (Invocations_H.InvokeCNode i) = valid_cnode_inv' i" | "valid_invocation' (Invocations_H.InvokeArchObject i) = valid_arch_inv' i" (* FIXME: move *) lemma dec_domain_inv_corres: shows "\ list_all2 cap_relation (map fst cs) (map fst cs'); list_all2 (\p pa. snd pa = cte_map (snd p)) cs cs' \ \ corres (ser \ ((\x. inv_relation x \ uncurry Invocations_H.invocation.InvokeDomain) \ (\(x,y). Invocations_A.invocation.InvokeDomain x y))) \ \ (decode_domain_invocation label args cs) (decodeDomainInvocation label args cs')" apply (simp add: decode_domain_invocation_def decodeDomainInvocation_def) apply (rule whenE_throwError_corres_initial) apply (simp+)[2] apply (case_tac "args", simp_all) apply (rule corres_guard_imp) apply (rule_tac r'="\domain domain'. domain = domain'" and R="\_. \" and R'="\_. \" in corres_splitEE) apply (rule whenE_throwError_corres_initial) apply simp apply (case_tac "cs") apply ((case_tac "cs'", ((simp add: null_def)+)[2])+)[2] apply (subgoal_tac "cap_relation (fst (hd cs)) (fst (hd cs'))") apply (case_tac "fst (hd cs)") apply (case_tac "fst (hd cs')", simp+, rule corres_returnOkTT) apply (simp add: inv_relation_def o_def uncurry_def) apply (case_tac "fst (hd cs')", fastforce+) apply (case_tac "cs") apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2]) apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2]) apply (rule whenE_throwError_corres) apply (simp+)[2] apply (rule corres_returnOkTT) apply (wp | simp)+ done lemma decode_invocation_corres: "\cptr = to_bl cptr'; mi' = message_info_map mi; slot' = cte_map slot; cap_relation cap cap'; args = args'; list_all2 cap_relation (map fst excaps) (map fst excaps'); list_all2 (\p pa. snd pa = cte_map (snd p)) excaps excaps' \ \ corres (ser \ inv_relation) (invs and valid_sched and valid_list and valid_cap cap and cte_at slot and cte_wp_at ((=) cap) slot and (\s. \x\set excaps. s \ fst x \ cte_at (snd x) s) and (\s. length args < 2 ^ word_bits)) (invs' and valid_cap' cap' and cte_at' slot' and (\s. \x\set excaps'. s \' fst x \ cte_at' (snd x) s) and (\s. vs_valid_duplicates' (ksPSpace s))) (decode_invocation (mi_label mi) args cptr slot cap excaps) (RetypeDecls_H.decodeInvocation (mi_label mi) args' cptr' slot' cap' excaps')" apply (rule corres_gen_asm) apply (unfold decode_invocation_def decodeInvocation_def) apply (case_tac cap, simp_all only: cap.simps) \ \dammit, simp_all messes things up, must handle cases manually\ \ \Null\ apply (simp add: isCap_defs) \ \Untyped\ apply (simp add: isCap_defs Let_def o_def split del: if_split) apply (rule corres_guard_imp, rule dec_untyped_inv_corres) apply ((clarsimp simp:cte_wp_at_caps_of_state)+)[3] \ \(Async)Endpoint\ apply (simp add: isCap_defs returnOk_def) apply (simp add: isCap_defs) apply (clarsimp simp: returnOk_def neq_Nil_conv) \ \ReplyCap\ apply (simp add: isCap_defs Let_def returnOk_def) \ \CNodeCap\ apply (rename_tac word nat list) apply (simp add: isCap_defs Let_def CanModify_def split del: if_split cong: if_cong) apply (clarsimp simp add: o_def) apply (rule corres_guard_imp) apply (rule_tac F="length list \ 32" in corres_gen_asm) apply (rule dec_cnode_inv_corres, simp+) apply (simp add: valid_cap_def word_bits_def) apply simp \ \ThreadCap\ apply (simp add: isCap_defs Let_def CanModify_def split del: if_split cong: if_cong) apply (clarsimp simp add: o_def) apply (rule corres_guard_imp) apply (rule decode_tcb_inv_corres, rule refl, simp_all add: valid_cap_def valid_cap'_def)[3] apply (simp add: split_def) apply (rule list_all2_conj) apply (simp add: list_all2_map2 list_all2_map1) apply assumption \ \DomainCap\ apply (simp add: isCap_defs) apply (rule corres_guard_imp) apply (rule dec_domain_inv_corres) apply (simp+)[4] \ \IRQControl\ apply (simp add: isCap_defs o_def) apply (rule corres_guard_imp, rule decode_irq_control_corres, simp+)[1] \ \IRQHandler\ apply (simp add: isCap_defs o_def) apply (rule corres_guard_imp, rule decode_irq_handler_corres, simp+)[1] \ \Zombie\ apply (simp add: isCap_defs) \ \Arch\ apply (clarsimp simp only: cap_relation.simps) apply (clarsimp simp add: isCap_defs Let_def o_def) apply (rule corres_guard_imp [OF dec_arch_inv_corres]) apply (simp_all add: list_all2_map2 list_all2_map1)+ done declare mapME_Nil [simp] lemma hinv_corres_assist: "\ info' = message_info_map info \ \ corres (fr \ (\(p, cap, extracaps, buffer) (p', capa, extracapsa, buffera). p' = cte_map p \ cap_relation cap capa \ buffer = buffera \ list_all2 (\x y. cap_relation (fst x) (fst y) \ snd y = cte_map (snd x)) extracaps extracapsa)) (invs and tcb_at thread and (\_. valid_message_info info)) (invs' and tcb_at' thread) (doE (cap, slot) \ cap_fault_on_failure cptr' False (lookup_cap_and_slot thread (to_bl cptr')); do buffer \ lookup_ipc_buffer False thread; doE extracaps \ lookup_extra_caps thread buffer info; returnOk (slot, cap, extracaps, buffer) odE od odE) (doE (cap, slot) \ capFaultOnFailure cptr' False (lookupCapAndSlot thread cptr'); do buffer \ VSpace_H.lookupIPCBuffer False thread; doE extracaps \ lookupExtraCaps thread buffer info'; returnOk (slot, cap, extracaps, buffer) odE od odE)" apply (clarsimp simp add: split_def) apply (rule corres_guard_imp) apply (rule corres_splitEE [OF _ corres_cap_fault]) prefer 2 \ \switched over to argument of corres_cap_fault\ apply (rule lcs_corres, simp) apply (rule corres_split_deprecated [OF _ lipcb_corres]) apply (rule corres_splitEE [OF _ lec_corres]) apply (rule corres_returnOkTT) apply simp+ apply (wp | simp)+ apply auto done lemma msg_from_syserr_map[simp]: "msgFromSyscallError (syscall_error_map err) = msg_from_syscall_error err" apply (simp add: msgFromSyscallError_def) apply (case_tac err,clarsimp+) done (* FIXME: move *) lemma non_exst_same_timeSlice_upd[simp]: "non_exst_same tcb (tcbDomain_update f tcb)" by (cases tcb, simp add: non_exst_same_def) lemma threadSet_tcbDomain_update_ct_not_inQ: "\ct_not_inQ \ threadSet (tcbDomain_update (\_. domain)) t \\_. ct_not_inQ\" apply (simp add: threadSet_def ct_not_inQ_def) apply (wp) apply (rule hoare_convert_imp [OF setObject_nosch]) apply (rule updateObject_tcb_inv) apply (wps setObject_ct_inv) apply (wp setObject_tcb_strongest getObject_tcb_wp)+ apply (case_tac "t = ksCurThread s") apply (clarsimp simp: obj_at'_def)+ done (* FIXME: move *) lemma setObject_F_ct_activatable': "\\tcb f. tcbState (F f tcb) = tcbState tcb \ \ \ct_in_state' activatable' and obj_at' ((=) tcb) t\ setObject t (F f tcb) \\_. ct_in_state' activatable'\" apply (clarsimp simp: ct_in_state'_def st_tcb_at'_def) apply (rule hoare_pre) apply (wps setObject_ct_inv) apply (wp setObject_tcb_strongest) apply (clarsimp simp: obj_at'_def) done lemmas setObject_tcbDomain_update_ct_activatable'[wp] = setObject_F_ct_activatable'[where F="tcbDomain_update", simplified] (* FIXME: move *) lemma setObject_F_st_tcb_at': "\\tcb f. tcbState (F f tcb) = tcbState tcb \ \ \st_tcb_at' P t' and obj_at' ((=) tcb) t\ setObject t (F f tcb) \\_. st_tcb_at' P t'\" apply (simp add: st_tcb_at'_def) apply (rule hoare_pre) apply (wp setObject_tcb_strongest) apply (clarsimp simp: obj_at'_def) done lemmas setObject_tcbDomain_update_st_tcb_at'[wp] = setObject_F_st_tcb_at'[where F="tcbDomain_update", simplified] lemma threadSet_tcbDomain_update_sch_act_wf[wp]: "\\s. sch_act_wf (ksSchedulerAction s) s \ sch_act_not t s\ threadSet (tcbDomain_update (\_. domain)) t \\_ s. sch_act_wf (ksSchedulerAction s) s\" apply (simp add: sch_act_wf_cases split: scheduler_action.split) apply (wp hoare_vcg_conj_lift) apply (simp add: threadSet_def) apply wp apply (wps setObject_sa_unchanged) apply (wp static_imp_wp getObject_tcb_wp hoare_vcg_all_lift)+ apply (rename_tac word) apply (rule_tac Q="\_ s. ksSchedulerAction s = SwitchToThread word \ st_tcb_at' runnable' word s \ tcb_in_cur_domain' word s \ word \ t" in hoare_strengthen_post) apply (wp hoare_vcg_all_lift hoare_vcg_conj_lift hoare_vcg_imp_lift)+ apply (simp add: threadSet_def) apply (wp getObject_tcb_wp threadSet_tcbDomain_triv')+ apply (auto simp: obj_at'_def) done lemma set_domain_setDomain_corres: "corres dc (valid_etcbs and valid_sched and tcb_at tptr) (invs' and sch_act_simple and tcb_at' tptr and (\s. new_dom \ maxDomain)) (set_domain tptr new_dom) (setDomain tptr new_dom)" apply (rule corres_gen_asm2) apply (simp add: set_domain_def setDomain_def thread_set_domain_def) apply (rule corres_guard_imp) apply (rule corres_split_deprecated[OF _ gct_corres]) apply (rule corres_split_deprecated[OF _ tcbSchedDequeue_corres]) apply (rule corres_split_deprecated[OF _ ethread_set_corres]) apply (rule corres_split_deprecated[OF _ gts_isRunnable_corres]) apply simp apply (rule corres_split_deprecated[OF corres_when[OF refl]]) apply (rule rescheduleRequired_corres) apply clarsimp apply (rule corres_when[OF refl]) apply (rule tcbSchedEnqueue_corres) apply (wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+ apply (clarsimp simp: etcb_relation_def) apply ((wp hoare_vcg_conj_lift hoare_vcg_disj_lift | clarsimp)+)[1] apply clarsimp apply (rule_tac Q="\_. valid_objs' and valid_queues' and valid_queues and (\s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr" in hoare_strengthen_post[rotated]) apply (auto simp: invs'_def valid_state'_def sch_act_wf_weak st_tcb_at'_def o_def)[1] apply (wp threadSet_valid_objs' threadSet_valid_queues'_no_state threadSet_valid_queues_no_state threadSet_pred_tcb_no_state | simp)+ apply (rule_tac Q = "\r s. invs' s \ (\p. tptr \ set (ksReadyQueues s p)) \ sch_act_simple s \ tcb_at' tptr s" in hoare_strengthen_post[rotated]) apply (clarsimp simp:invs'_def valid_state'_def valid_pspace'_def sch_act_simple_def) apply (clarsimp simp:valid_tcb'_def) apply (drule(1) bspec) apply (clarsimp simp:tcb_cte_cases_def) apply fastforce apply (wp hoare_vcg_all_lift Tcb_R.tcbSchedDequeue_not_in_queue)+ apply clarsimp apply (frule tcb_at_is_etcb_at) apply simp+ apply (auto elim: tcb_at_is_etcb_at valid_objs'_maxDomain valid_objs'_maxPriority pred_tcb'_weakenE simp: valid_sched_def valid_sched_action_def) done lemma pinv_corres: "\ inv_relation i i'; call \ block \ \ corres (dc \ (=)) (einvs and valid_invocation i and simple_sched_action and ct_active and (\s. (\w w2 b c. i = Invocations_A.InvokeEndpoint w w2 b c) \ st_tcb_at simple (cur_thread s) s)) (invs' and sch_act_simple and valid_invocation' i' and ct_active' and (\s. vs_valid_duplicates' (ksPSpace s))) (perform_invocation block call i) (performInvocation block call i')" apply (simp add: performInvocation_def) apply (case_tac i) apply (clarsimp simp: o_def liftE_bindE) apply (rule corres_guard_imp) apply (rule corres_split_norE[OF corres_returnOkTT]) apply simp apply (rule corres_rel_imp, rule inv_untyped_corres) apply simp apply (case_tac x, simp_all)[1] apply wp+ apply simp+ apply (rule corres_guard_imp) apply (rule corres_split_deprecated [OF _ gct_corres]) apply simp apply (rule corres_split_deprecated [OF _ send_ipc_corres]) apply (rule corres_trivial) apply simp apply simp apply wp+ apply (clarsimp simp: ct_in_state_def) apply (fastforce elim: st_tcb_ex_cap) apply (clarsimp simp: pred_conj_def invs'_def cur_tcb'_def simple_sane_strg sch_act_simple_def) apply (rule corres_guard_imp) apply (simp add: liftE_bindE) apply (rule corres_split_deprecated [OF _ send_signal_corres]) apply (rule corres_trivial) apply (simp add: returnOk_def) apply wp+ apply (simp+)[2] apply simp apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ gct_corres]) apply (rule corres_split_nor [OF _ do_reply_transfer_corres']) apply (rule corres_trivial, simp) apply wp+ apply (clarsimp simp: tcb_at_invs) apply (clarsimp simp: invs_def valid_state_def valid_pspace_def) apply (erule cte_wp_at_weakenE, fastforce simp: is_reply_cap_to_def) apply (clarsimp simp: tcb_at_invs') apply (fastforce elim!: cte_wp_at_weakenE') apply (clarsimp simp: liftME_def) apply (rule corres_guard_imp) apply (erule tcbinv_corres) apply (simp)+ \ \domain cap\ apply (clarsimp simp: invoke_domain_def) apply (rule corres_guard_imp) apply (rule corres_split_deprecated [OF _ set_domain_setDomain_corres]) apply (rule corres_trivial, simp) apply (wp)+ apply (clarsimp+)[2] \ \CNodes\ apply clarsimp apply (rule corres_guard_imp) apply (rule corres_splitEE [OF _ inv_cnode_corres]) apply (rule corres_trivial, simp add: returnOk_def) apply assumption apply wp+ apply (clarsimp+)[2] apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric]) apply (rule corres_guard_imp, rule invoke_irq_control_corres, simp+) apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric]) apply (rule corres_guard_imp, rule invoke_irq_handler_corres, simp+) apply clarsimp apply (rule corres_guard_imp) apply (rule inv_arch_corres, assumption) apply (clarsimp+)[2] done lemma sendSignal_tcb_at'[wp]: "\tcb_at' t\ sendSignal ntfnptr bdg \\rv. tcb_at' t\" apply (simp add: sendSignal_def cong: list.case_cong Structures_H.notification.case_cong) apply (wp ntfn'_cases_weak_wp list_cases_weak_wp hoare_drop_imps | wpc | simp)+ done lemmas checkCap_inv_typ_at' = checkCap_inv[where P="\s. P (typ_at' T p s)" for P T p] crunches restart, bindNotification, performTransfer for typ_at'[wp]: "\s. P (typ_at' T p s)" lemma invokeTCB_typ_at'[wp]: "\\s. P (typ_at' T p s)\ invokeTCB tinv \\rv s. P (typ_at' T p s)\" apply (cases tinv, simp_all add: invokeTCB_def getThreadBufferSlot_def locateSlot_conv split del: if_split) apply (simp only: cases_simp if_cancel simp_thms conj_comms pred_conj_def Let_def split_def getThreadVSpaceRoot | (simp split del: if_split cong: if_cong) | (wp mapM_x_wp[where S=UNIV, simplified] checkCap_inv_typ_at' case_options_weak_wp)[1] | wpcw)+ done lemmas invokeTCB_typ_ats[wp] = typ_at_lifts [OF invokeTCB_typ_at'] crunch typ_at'[wp]: doReplyTransfer "\s. P (typ_at' T p s)" (wp: hoare_drop_imps) lemmas doReplyTransfer_typ_ats[wp] = typ_at_lifts [OF doReplyTransfer_typ_at'] crunch typ_at'[wp]: "performIRQControl" "\s. P (typ_at' T p s)" lemmas invokeIRQControl_typ_ats[wp] = typ_at_lifts [OF performIRQControl_typ_at'] crunch typ_at'[wp]: InterruptDecls_H.invokeIRQHandler "\s. P (typ_at' T p s)" lemmas invokeIRQHandler_typ_ats[wp] = typ_at_lifts [OF InterruptDecls_H_invokeIRQHandler_typ_at'] crunch tcb_at'[wp]: setDomain "tcb_at' tptr" (simp: crunch_simps) lemma pinv_tcb'[wp]: "\invs' and st_tcb_at' active' tptr and valid_invocation' i and ct_active'\ RetypeDecls_H.performInvocation block call i \\rv. tcb_at' tptr\" apply (simp add: performInvocation_def) apply (case_tac i, simp_all) apply (wp invokeArch_tcb_at' | clarsimp simp: pred_tcb_at')+ done lemma sts_cte_at[wp]: "\cte_at' p\ setThreadState st t \\rv. cte_at' p\" apply (simp add: setThreadState_def) apply (wp|simp)+ done crunch obj_at_ntfn[wp]: setThreadState "obj_at' (\ntfn. P (ntfnBoundTCB ntfn) (ntfnObj ntfn)) ntfnptr" (wp: obj_at_setObject2 crunch_wps simp: crunch_simps updateObject_default_def in_monad) lemma sts_mcpriority_tcb_at'[wp]: "\mcpriority_tcb_at' P t\ setThreadState st t' \\_. mcpriority_tcb_at' P t\" apply (cases "t = t'", simp_all add: setThreadState_def split del: if_split) apply ((wp threadSet_pred_tcb_at_state | simp)+)[1] apply (wp threadSet_obj_at'_really_strongest | simp add: pred_tcb_at'_def)+ done lemma sts_valid_inv'[wp]: "\valid_invocation' i\ setThreadState st t \\rv. valid_invocation' i\" apply (case_tac i, simp_all add: sts_valid_untyped_inv' sts_valid_arch_inv') apply (wp | simp)+ defer apply (rename_tac cnode_invocation) apply (case_tac cnode_invocation, simp_all add: cte_wp_at_ctes_of) apply (wp | simp)+ apply (rename_tac irqcontrol_invocation) apply (case_tac irqcontrol_invocation, simp_all) apply (rename_tac arch_irqhandler_issue) apply (case_tac arch_irqhandler_issue) apply (wp | simp add: irq_issued'_def)+ apply (rename_tac irqhandler_invocation) apply (case_tac irqhandler_invocation, simp_all) apply (wp hoare_vcg_ex_lift ex_cte_cap_to'_pres | simp)+ apply (rename_tac tcbinvocation) apply (case_tac tcbinvocation, simp_all add: setThreadState_tcb', auto intro!: hoare_vcg_conj_lift hoare_vcg_disj_lift simp only: imp_conv_disj simp_thms pred_conj_def, auto intro!: hoare_vcg_prop sts_cap_to' sts_cte_cap_to' setThreadState_typ_ats split: option.splits)[1] apply (wp sts_bound_tcb_at' hoare_vcg_all_lift hoare_vcg_const_imp_lift)+ done (* FIXME: move to TCB *) crunch inv[wp]: decodeDomainInvocation P (wp: crunch_wps simp: crunch_simps) lemma decode_inv_inv'[wp]: "\P\ decodeInvocation label args cap_index slot cap excaps \\rv. P\" apply (simp add: decodeInvocation_def Let_def split del: if_split cong: if_cong) apply (rule hoare_pre) apply (wp decodeTCBInvocation_inv | simp only: o_def | clarsimp split: capability.split_asm simp: isCap_defs)+ done (* FIXME: move to TCB *) lemma dec_dom_inv_wf[wp]: "\invs' and (\s. \x \ set excaps. s \' fst x)\ decodeDomainInvocation label args excaps \\x s. tcb_at' (fst x) s \ snd x \ maxDomain\, -" apply (simp add:decodeDomainInvocation_def) apply (wp whenE_throwError_wp | wpc |simp)+ apply clarsimp apply (drule_tac x = "hd excaps" in bspec) apply (rule hd_in_set) apply (simp add:null_def) apply (simp add:valid_cap'_def) apply (simp add:not_le) apply (simp add:ucast_nat_def[symmetric]) apply (rule word_of_nat_le) apply (simp add:numDomains_def maxDomain_def) done lemma decode_inv_wf'[wp]: "\valid_cap' cap and invs' and sch_act_simple and cte_wp_at' ((=) cap \ cteCap) slot and real_cte_at' slot and (\s. \r\zobj_refs' cap. ex_nonz_cap_to' r s) and (\s. \r\cte_refs' cap (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s) and (\s. \cap \ set excaps. \r\zobj_refs' (fst cap). ex_nonz_cap_to' r s) and (\s. \x \ set excaps. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s) and (\s. \x \ set excaps. s \' fst x) and (\s. \x \ set excaps. real_cte_at' (snd x) s) and (\s. \x \ set excaps. ex_cte_cap_wp_to' isCNodeCap (snd x) s) and (\s. \x \ set excaps. cte_wp_at' (badge_derived' (fst x) \ cteCap) (snd x) s) and (\s. vs_valid_duplicates' (ksPSpace s))\ decodeInvocation label args cap_index slot cap excaps \valid_invocation'\,-" apply (case_tac cap, simp_all add: decodeInvocation_def Let_def isCap_defs uncurry_def split_def split del: if_split cong: if_cong) apply ((rule hoare_pre, ((wpsimp wp: decodeTCBInv_wf simp: o_def)+)[1], clarsimp simp: valid_cap'_def cte_wp_at_ctes_of) | intro exI conjI | simp)+ done lemma ct_active_imp_simple'[elim!]: "ct_active' s \ st_tcb_at' simple' (ksCurThread s) s" by (clarsimp simp: ct_in_state'_def elim!: pred_tcb'_weakenE) lemma ct_running_imp_simple'[elim!]: "ct_running' s \ st_tcb_at' simple' (ksCurThread s) s" by (clarsimp simp: ct_in_state'_def elim!: pred_tcb'_weakenE) lemma active_ex_cap'[elim]: "\ ct_active' s; if_live_then_nonz_cap' s \ \ ex_nonz_cap_to' (ksCurThread s) s" by (fastforce simp: ct_in_state'_def elim!: st_tcb_ex_cap'') crunch it[wp]: handleFaultReply "\s. P (ksIdleThread s)" lemma handleFaultReply_invs[wp]: "\invs' and tcb_at' t\ handleFaultReply x t label msg \\rv. invs'\" apply (simp add: handleFaultReply_def) apply (case_tac x, simp_all) apply (wp | clarsimp simp: handleArchFaultReply_def split: arch_fault.split)+ done crunch sch_act_simple[wp]: handleFaultReply sch_act_simple (wp: crunch_wps) lemma transferCaps_non_null_cte_wp_at': assumes PUC: "\cap. P cap \ \ isUntypedCap cap" shows "\cte_wp_at' (\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap) ptr\ transferCaps info caps ep rcvr rcvBuf \\_. cte_wp_at' (\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap) ptr\" proof - have CTEF: "\P p s. \ cte_wp_at' P p s; \cte. P cte \ False \ \ False" by (erule cte_wp_atE', auto) show ?thesis unfolding transferCaps_def apply (wp | wpc)+ apply (rule transferCapsToSlots_pres2) apply (rule hoare_weaken_pre [OF cteInsert_weak_cte_wp_at3]) apply (rule PUC,simp) apply (clarsimp simp: cte_wp_at_ctes_of) apply (wp hoare_vcg_all_lift static_imp_wp | simp add:ball_conj_distrib)+ done qed crunch cte_wp_at' [wp]: setMessageInfo "cte_wp_at' P p" lemma copyMRs_cte_wp_at'[wp]: "\cte_wp_at' P ptr\ copyMRs sender sendBuf receiver recvBuf n \\_. cte_wp_at' P ptr\" unfolding copyMRs_def apply (wp mapM_wp | wpc | simp add: split_def | rule equalityD1)+ done lemma doNormalTransfer_non_null_cte_wp_at': assumes PUC: "\cap. P cap \ \ isUntypedCap cap" shows "\cte_wp_at' (\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap) ptr\ doNormalTransfer st send_buffer ep b gr rt recv_buffer \\_. cte_wp_at' (\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap) ptr\" unfolding doNormalTransfer_def apply (wp transferCaps_non_null_cte_wp_at' | simp add:PUC)+ done lemma setMRs_cte_wp_at'[wp]: "\cte_wp_at' P ptr\ setMRs thread buffer messageData \\_. cte_wp_at' P ptr\" by (simp add: setMRs_def zipWithM_x_mapM split_def, wp crunch_wps) lemma doFaultTransfer_cte_wp_at'[wp]: "\cte_wp_at' P ptr\ doFaultTransfer badge sender receiver receiverIPCBuffer \\_. cte_wp_at' P ptr\" unfolding doFaultTransfer_def apply (wp | wpc | simp add: split_def)+ done lemma doIPCTransfer_non_null_cte_wp_at': assumes PUC: "\cap. P cap \ \ isUntypedCap cap" shows "\cte_wp_at' (\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap) ptr\ doIPCTransfer sender endpoint badge grant receiver \\_. cte_wp_at' (\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap) ptr\" unfolding doIPCTransfer_def apply (wp doNormalTransfer_non_null_cte_wp_at' hoare_drop_imp hoare_allI | wpc | clarsimp simp:PUC)+ done lemma doIPCTransfer_non_null_cte_wp_at2': fixes P assumes PNN: "\cte. P (cteCap cte) \ cteCap cte \ capability.NullCap" and PUC: "\cap. P cap \ \ isUntypedCap cap" shows "\cte_wp_at' (\cte. P (cteCap cte)) ptr\ doIPCTransfer sender endpoint badge grant receiver \\_. cte_wp_at' (\cte. P (cteCap cte)) ptr\" proof - have PimpQ: "\P Q ptr s. \ cte_wp_at' (\cte. P (cteCap cte)) ptr s; \cte. P (cteCap cte) \ Q (cteCap cte) \ \ cte_wp_at' (\cte. P (cteCap cte) \ Q (cteCap cte)) ptr s" by (erule cte_wp_at_weakenE', clarsimp) show ?thesis apply (rule hoare_chain [OF doIPCTransfer_non_null_cte_wp_at']) apply (erule PUC) apply (erule PimpQ) apply (drule PNN, clarsimp) apply (erule cte_wp_at_weakenE') apply (clarsimp) done qed lemma st_tcb_at'_eqD: "\ st_tcb_at' (\s. s = st) t s; st_tcb_at' (\s. s = st') t s \ \ st = st'" by (clarsimp simp add: pred_tcb_at'_def obj_at'_def) lemma isReply_awaiting_reply': "isReply st = awaiting_reply' st" by (case_tac st, (clarsimp simp add: isReply_def)+) lemma doReply_invs[wp]: "\tcb_at' t and tcb_at' t' and cte_wp_at' (\cte. \grant. cteCap cte = ReplyCap t False grant) slot and invs' and sch_act_simple\ doReplyTransfer t' t slot grant \\rv. invs'\" apply (simp add: doReplyTransfer_def liftM_def) apply (rule hoare_seq_ext [OF _ gts_sp']) apply (rule hoare_seq_ext [OF _ assert_sp]) apply (rule hoare_seq_ext [OF _ getCTE_sp]) apply (wp, wpc) apply (wp) apply (wp (once) sts_invs_minor'') apply (simp) apply (wp (once) sts_st_tcb') apply (wp)[1] apply (rule_tac Q="\rv s. invs' s \ t \ ksIdleThread s \ st_tcb_at' awaiting_reply' t s" in hoare_post_imp) apply (clarsimp) apply (frule_tac t=t in invs'_not_runnable_not_queued) apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+) apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+) apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st) apply (clarsimp | drule(1) obj_at_conj')+ apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def) apply (drule(1) pred_tcb_at_conj') apply (subgoal_tac "st_tcb_at' (\_. False) (ksCurThread s) s") apply (clarsimp) apply (erule_tac P="\st. awaiting_reply' st \ activatable' st" in pred_tcb'_weakenE) apply (case_tac st, clarsimp+) apply (wp cteDeleteOne_reply_pred_tcb_at)+ apply (clarsimp) apply (rule_tac Q="\_. (\s. t \ ksIdleThread s) and cte_wp_at' (\cte. \grant. cteCap cte = capability.ReplyCap t False grant) slot" in hoare_strengthen_post [rotated]) apply (fastforce simp: cte_wp_at'_def) apply (wp) apply (rule hoare_strengthen_post [OF doIPCTransfer_non_null_cte_wp_at']) apply (erule conjE) apply assumption apply (erule cte_wp_at_weakenE') apply (fastforce) apply (wp sts_invs_minor'' sts_st_tcb' static_imp_wp) apply (rule_tac Q="\rv s. invs' s \ sch_act_simple s \ st_tcb_at' awaiting_reply' t s \ t \ ksIdleThread s" in hoare_post_imp) apply (clarsimp) apply (frule_tac t=t in invs'_not_runnable_not_queued) apply (erule pred_tcb'_weakenE, case_tac st, clarsimp+) apply (rule conjI, erule pred_tcb'_weakenE, case_tac st, clarsimp+) apply (rule conjI, rule impI, erule pred_tcb'_weakenE, case_tac st) apply (clarsimp | drule(1) obj_at_conj')+ apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def) apply (drule(1) pred_tcb_at_conj') apply (subgoal_tac "st_tcb_at' (\_. False) (ksCurThread s) s") apply (clarsimp) apply (erule_tac P="\st. awaiting_reply' st \ activatable' st" in pred_tcb'_weakenE) apply (case_tac st, clarsimp+) apply (wp threadSet_invs_trivial threadSet_st_tcb_at2 static_imp_wp | clarsimp simp add: inQ_def)+ apply (rule_tac Q="\_. invs' and tcb_at' t and sch_act_simple and st_tcb_at' awaiting_reply' t" in hoare_strengthen_post [rotated]) apply (clarsimp) apply (rule conjI) apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def) apply (rule conjI) apply clarsimp apply clarsimp apply (drule idle_tcb_at'_split, clarsimp, drule (1) st_tcb_at'_eqD, simp) apply clarsimp apply (rule conjI) apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def) apply (erule pred_tcb'_weakenE, clarsimp) apply (rule conjI) apply (clarsimp simp add: invs'_def valid_state'_def valid_idle'_def pred_tcb_at'_def obj_at'_def) apply (rule conjI) apply clarsimp apply (frule invs'_not_runnable_not_queued) apply (erule pred_tcb'_weakenE, clarsimp) apply (frule (1) not_tcbQueued_not_ksQ) apply simp apply clarsimp apply (wp cteDeleteOne_reply_pred_tcb_at hoare_drop_imp hoare_allI)+ apply (clarsimp simp add: isReply_awaiting_reply' cte_wp_at_ctes_of) apply (auto dest!: st_tcb_idle'[rotated] simp:isCap_simps) done lemma ct_active_runnable' [simp]: "ct_active' s \ ct_in_state' runnable' s" by (fastforce simp: ct_in_state'_def elim!: pred_tcb'_weakenE) lemma valid_irq_node_tcbSchedEnqueue[wp]: "\\s. valid_irq_node' (irq_node' s) s \ tcbSchedEnqueue ptr \\rv s'. valid_irq_node' (irq_node' s') s'\" apply (rule hoare_pre) apply (simp add:valid_irq_node'_def ) apply (wp hoare_unless_wp hoare_vcg_all_lift | wps)+ apply (simp add:tcbSchedEnqueue_def) apply (wp hoare_unless_wp| simp)+ apply (simp add:valid_irq_node'_def) done lemma rescheduleRequired_valid_queues_but_ct_domain: "\\s. Invariants_H.valid_queues s \ valid_objs' s \ (\x. ksSchedulerAction s = SwitchToThread x \ st_tcb_at' runnable' x s) \ rescheduleRequired \\_. Invariants_H.valid_queues\" apply (simp add: rescheduleRequired_def) apply (wp | wpc | simp)+ done lemma rescheduleRequired_valid_queues'_but_ct_domain: "\\s. valid_queues' s \ (\x. ksSchedulerAction s = SwitchToThread x \ st_tcb_at' runnable' x s) \ rescheduleRequired \\_. valid_queues'\" apply (simp add: rescheduleRequired_def) apply (wp | wpc | simp | fastforce simp: valid_queues'_def)+ done lemma tcbSchedEnqueue_valid_action: "\\s. \x. ksSchedulerAction s = SwitchToThread x \ st_tcb_at' runnable' x s\ tcbSchedEnqueue ptr \\rv s. \x. ksSchedulerAction s = SwitchToThread x \ st_tcb_at' runnable' x s\" apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift) apply clarsimp done abbreviation (input) "all_invs_but_sch_extra \ \s. valid_pspace' s \ Invariants_H.valid_queues s \ sym_refs (state_refs_of' s) \ if_live_then_nonz_cap' s \ if_unsafe_then_cap' s \ valid_idle' s \ valid_global_refs' s \ valid_arch_state' s \ valid_irq_node' (irq_node' s) s \ valid_irq_handlers' s \ valid_irq_states' s \ irqs_masked' s \ valid_machine_state' s \ cur_tcb' s \ untyped_ranges_zero' s \ valid_queues' s \ valid_pde_mappings' s \ pspace_domain_valid s \ ksCurDomain s \ maxDomain \ valid_dom_schedule' s \ (\x. ksSchedulerAction s = SwitchToThread x \ st_tcb_at' runnable' x s)" lemma rescheduleRequired_all_invs_but_extra: "\\s. all_invs_but_sch_extra s\ rescheduleRequired \\_. invs'\" apply (simp add: invs'_def valid_state'_def) apply (rule hoare_pre) apply (wp add:rescheduleRequired_ct_not_inQ rescheduleRequired_sch_act' rescheduleRequired_valid_queues_but_ct_domain rescheduleRequired_valid_queues'_but_ct_domain valid_irq_node_lift valid_irq_handlers_lift'' irqs_masked_lift cur_tcb_lift) apply auto done lemma threadSet_all_invs_but_sch_extra: shows "\ tcb_at' t and (\s. (\p. t \ set (ksReadyQueues s p))) and all_invs_but_sch_extra and sch_act_simple and K (ds \ maxDomain) \ threadSet (tcbDomain_update (\_. ds)) t \\rv. all_invs_but_sch_extra \" apply (rule hoare_gen_asm) apply (rule hoare_pre) apply (wp threadSet_valid_pspace'T_P[where P = False and Q = \ and Q' = \]) apply (simp add:tcb_cte_cases_def)+ apply (wp threadSet_valid_pspace'T_P threadSet_state_refs_of'T_P[where f'=id and P'=False and Q=\ and g'=id and Q'=\] threadSet_idle'T threadSet_global_refsT threadSet_cur irqs_masked_lift valid_irq_node_lift valid_irq_handlers_lift'' threadSet_ctes_ofT threadSet_not_inQ threadSet_valid_queues'_no_state threadSet_valid_queues threadSet_valid_dom_schedule' threadSet_iflive'T threadSet_ifunsafe'T untyped_ranges_zero_lift | simp add:tcb_cte_cases_def cteCaps_of_def o_def)+ apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift threadSet_pred_tcb_no_state | simp)+ apply (clarsimp simp:sch_act_simple_def o_def cteCaps_of_def) apply (intro conjI) apply fastforce+ done lemma threadSet_not_curthread_ct_domain: "\\s. ptr \ ksCurThread s \ ct_idle_or_in_cur_domain' s\ threadSet f ptr \\rv. ct_idle_or_in_cur_domain'\" apply (simp add:ct_idle_or_in_cur_domain'_def tcb_in_cur_domain'_def) apply (wp hoare_vcg_imp_lift hoare_vcg_disj_lift | wps)+ apply clarsimp done lemma setDomain_invs': "\invs' and sch_act_simple and ct_active' and (tcb_at' ptr and (\s. sch_act_not ptr s) and (\y. domain \ maxDomain))\ setDomain ptr domain \\y. invs'\" apply (simp add:setDomain_def ) apply (wp add: hoare_when_wp static_imp_wp static_imp_conj_wp rescheduleRequired_all_invs_but_extra tcbSchedEnqueue_valid_action hoare_vcg_if_lift2) apply (rule_tac Q = "\r s. all_invs_but_sch_extra s \ curThread = ksCurThread s \ (ptr \ curThread \ ct_not_inQ s \ sch_act_wf (ksSchedulerAction s) s \ ct_idle_or_in_cur_domain' s)" in hoare_strengthen_post[rotated]) apply (clarsimp simp:invs'_def valid_state'_def st_tcb_at'_def[symmetric] valid_pspace'_def) apply (erule st_tcb_ex_cap'') apply simp apply (case_tac st,simp_all)[1] apply (rule hoare_strengthen_post[OF hoare_vcg_conj_lift]) apply (rule threadSet_all_invs_but_sch_extra) prefer 2 apply clarsimp apply assumption apply (wp static_imp_wp threadSet_pred_tcb_no_state threadSet_not_curthread_ct_domain threadSet_tcbDomain_update_ct_not_inQ | simp)+ apply (rule_tac Q = "\r s. invs' s \ curThread = ksCurThread s \ sch_act_simple s \ domain \ maxDomain \ (ptr \ curThread \ ct_not_inQ s \ sch_act_not ptr s)" in hoare_strengthen_post[rotated]) apply (clarsimp simp:invs'_def valid_state'_def) apply (wp hoare_vcg_imp_lift)+ apply (clarsimp simp:invs'_def valid_pspace'_def valid_state'_def)+ done lemma performInv_invs'[wp]: "\invs' and sch_act_simple and (\s. \p. ksCurThread s \ set (ksReadyQueues s p)) and ct_active' and valid_invocation' i\ RetypeDecls_H.performInvocation block call i \\rv. invs'\" unfolding performInvocation_def apply (cases i) apply ((clarsimp simp: simple_sane_strg sch_act_simple_def ct_not_ksQ sch_act_sane_def | wp tcbinv_invs' arch_performInvocation_invs' setDomain_invs' | rule conjI | erule active_ex_cap')+) done lemma getSlotCap_to_refs[wp]: "\\\ getSlotCap ref \\rv s. \r\zobj_refs' rv. ex_nonz_cap_to' r s\" by (simp add: getSlotCap_def | wp)+ lemma lcs_valid' [wp]: "\invs'\ lookupCapAndSlot t xs \\x s. s \' fst x\, -" unfolding lookupCapAndSlot_def apply (rule hoare_pre) apply (wp|clarsimp simp: split_def)+ done lemma lcs_ex_cap_to' [wp]: "\invs'\ lookupCapAndSlot t xs \\x s. \r\cte_refs' (fst x) (irq_node' s). ex_cte_cap_to' r s\, -" unfolding lookupCapAndSlot_def apply (rule hoare_pre) apply (wp | simp add: split_def)+ done lemma lcs_ex_nonz_cap_to' [wp]: "\invs'\ lookupCapAndSlot t xs \\x s. \r\zobj_refs' (fst x). ex_nonz_cap_to' r s\, -" unfolding lookupCapAndSlot_def apply (rule hoare_pre) apply (wp | simp add: split_def)+ done lemma lcs_cte_at' [wp]: "\valid_objs'\ lookupCapAndSlot t xs \\rv s. cte_at' (snd rv) s\,-" unfolding lookupCapAndSlot_def apply (rule hoare_pre) apply (wp|simp)+ done lemma lec_ex_cap_to' [wp]: "\invs'\ lookupExtraCaps t xa mi \\rv s. (\cap \ set rv. \r\cte_refs' (fst cap) (irq_node' s). ex_cte_cap_to' r s)\, -" unfolding lookupExtraCaps_def apply (cases "msgExtraCaps mi = 0") apply simp apply (wp mapME_set | simp)+ done lemma lec_ex_nonz_cap_to' [wp]: "\invs'\ lookupExtraCaps t xa mi \\rv s. (\cap \ set rv. \r\zobj_refs' (fst cap). ex_nonz_cap_to' r s)\, -" unfolding lookupExtraCaps_def apply (cases "msgExtraCaps mi = 0") apply simp apply (wp mapME_set | simp)+ done (* FIXME: move *) lemma getSlotCap_eq [wp]: "\\\ getSlotCap slot \\cap. cte_wp_at' ((=) cap \ cteCap) slot\" by (wpsimp wp: getCTE_wp' simp: getSlotCap_def cte_wp_at_ctes_of) lemma lcs_eq [wp]: "\\\ lookupCapAndSlot t cptr \\rv. cte_wp_at' ((=) (fst rv) \ cteCap) (snd rv)\,-" by (wpsimp simp: lookupCapAndSlot_def) lemma lec_dimished'[wp]: "\\\ lookupExtraCaps t buffer info \\rv s. (\x\set rv. cte_wp_at' ((=) (fst x) \ cteCap) (snd x) s)\,-" by (wpsimp wp: mapME_set simp: lookupExtraCaps_def) lemma lookupExtras_real_ctes[wp]: "\valid_objs'\ lookupExtraCaps t xs info \\rv s. \x \ set rv. real_cte_at' (snd x) s\,-" apply (simp add: lookupExtraCaps_def Let_def split del: if_split cong: if_cong) apply (rule hoare_pre) apply (wp mapME_set) apply (simp add: lookupCapAndSlot_def split_def) apply (wp case_options_weak_wp mapM_wp' lsft_real_cte | simp)+ done lemma lookupExtras_ctes[wp]: "\valid_objs'\ lookupExtraCaps t xs info \\rv s. \x \ set rv. cte_at' (snd x) s\,-" apply (rule hoare_post_imp_R) apply (rule lookupExtras_real_ctes) apply (simp add: real_cte_at') done lemma lsft_ex_cte_cap_to': "\invs' and K (\cap. isCNodeCap cap \ P cap)\ lookupSlotForThread t cref \\rv s. ex_cte_cap_wp_to' P rv s\,-" apply (simp add: lookupSlotForThread_def split_def) apply (wp rab_cte_cap_to' getSlotCap_cap_to2 | simp)+ done lemma lec_caps_to'[wp]: "\invs' and K (\cap. isCNodeCap cap \ P cap)\ lookupExtraCaps t buffer info \\rv s. (\x\set rv. ex_cte_cap_wp_to' P (snd x) s)\,-" apply (simp add: lookupExtraCaps_def split del: if_split) apply (rule hoare_pre) apply (wp mapME_set) apply (simp add: lookupCapAndSlot_def split_def) apply (wp lsft_ex_cte_cap_to' mapM_wp' | simp | wpc)+ done lemma getSlotCap_badge_derived[wp]: "\\\ getSlotCap p \\cap. cte_wp_at' (badge_derived' cap \ cteCap) p\" apply (simp add: getSlotCap_def) apply (wp getCTE_wp) apply (clarsimp simp: cte_wp_at_ctes_of) done lemma lec_derived'[wp]: "\invs'\ lookupExtraCaps t buffer info \\rv s. (\x\set rv. cte_wp_at' (badge_derived' (fst x) o cteCap) (snd x) s)\,-" apply (simp add: lookupExtraCaps_def split del: if_split) apply (rule hoare_pre) apply (wp mapME_set) apply (simp add: lookupCapAndSlot_def split_def) apply (wp | simp)+ done lemma get_mrs_length_rv[wp]: "\\s. \n. n \ msg_max_length \ P n\ get_mrs thread buf mi \\rv s. P (length rv)\" apply (simp add: get_mrs_def cong: option.case_cong_weak[cong]) apply (rule hoare_pre) apply (wp mapM_length | wpc | simp del: upt.simps)+ apply (clarsimp simp: msgRegisters_unfold msg_max_length_def) done lemma st_tcb_at_idle_thread': "\ st_tcb_at' P (ksIdleThread s) s; valid_idle' s \ \ P IdleThreadState" by (clarsimp simp: valid_idle'_def pred_tcb_at'_def obj_at'_def) crunch tcb_at'[wp]: replyFromKernel "tcb_at' t" lemma invs_weak_sch_act_wf_strg: "invs' s \ weak_sch_act_wf (ksSchedulerAction s) s" by clarsimp (* FIXME: move *) lemma rct_sch_act_simple[simp]: "ksSchedulerAction s = ResumeCurrentThread \ sch_act_simple s" by (simp add: sch_act_simple_def) (* FIXME: move *) lemma rct_sch_act_sane[simp]: "ksSchedulerAction s = ResumeCurrentThread \ sch_act_sane s" by (simp add: sch_act_sane_def) lemma lookupCapAndSlot_real_cte_at'[wp]: "\valid_objs'\ lookupCapAndSlot thread ptr \\rv. real_cte_at' (snd rv)\, -" apply (simp add: lookupCapAndSlot_def lookupSlotForThread_def) apply (wp resolveAddressBits_real_cte_at' | simp add: split_def)+ done lemmas set_thread_state_active_valid_sched = set_thread_state_runnable_valid_sched[simplified runnable_eq_active] lemma setTCB_valid_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ setObject a (tcb::tcb) \\rv s. vs_valid_duplicates' (ksPSpace s)\" apply (clarsimp simp: setObject_def split_def valid_def in_monad projectKOs pspace_aligned'_def ps_clear_upd objBits_def[symmetric] lookupAround2_char1 split: if_split_asm) apply (frule pspace_storable_class.updateObject_type[where v = tcb,simplified]) apply (clarsimp simp:updateObject_default_def assert_def bind_def alignCheck_def in_monad when_def alignError_def magnitudeCheck_def assert_opt_def return_def fail_def typeError_def split:if_splits option.splits Structures_H.kernel_object.splits) apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+ done crunch valid_duplicates'[wp]: threadSet "\s. vs_valid_duplicates' (ksPSpace s)" (wp: setObject_ksInterrupt updateObject_default_inv) crunch valid_duplicates'[wp]: addToBitmap "\s. vs_valid_duplicates' (ksPSpace s)" (wp: setObject_ksInterrupt updateObject_default_inv) lemma tcbSchedEnqueue_valid_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ tcbSchedEnqueue a \\rv s. vs_valid_duplicates' (ksPSpace s)\" by (simp add:tcbSchedEnqueue_def unless_def setQueue_def | wp | wpc)+ crunch valid_duplicates'[wp]: rescheduleRequired "\s. vs_valid_duplicates' (ksPSpace s)" (wp: setObject_ksInterrupt updateObject_default_inv) crunch valid_duplicates'[wp]: setThreadState "\s. vs_valid_duplicates' (ksPSpace s)" (*FIXME: move to NonDetMonadVCG.valid_validE_R *) lemma hinv_corres: "c \ b \ corres (dc \ dc) (einvs and (\s. scheduler_action s = resume_cur_thread) and ct_active) (invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and ct_active') (handle_invocation c b) (handleInvocation c b)" apply (simp add: handle_invocation_def handleInvocation_def liftE_bindE) apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ gct_corres]) apply (rule corres_split_deprecated [OF _ get_mi_corres]) apply clarsimp apply (simp add: liftM_def cap_register_def capRegister_def) apply (rule corres_split_eqr [OF _ user_getreg_corres]) apply (rule syscall_corres) apply (rule hinv_corres_assist, simp) apply (clarsimp simp add: when_def) apply (rule hf_corres) apply simp apply (simp add: split_def) apply (rule corres_split_deprecated [OF _ get_mrs_corres]) apply (rule decode_invocation_corres, simp_all)[1] apply (fastforce simp: list_all2_map2 list_all2_map1 elim: list_all2_mono) apply (fastforce simp: list_all2_map2 list_all2_map1 elim: list_all2_mono) apply wp[1] apply (drule sym[OF conjunct1]) apply simp apply wp[1] apply (clarsimp simp: when_def) apply (rule rfk_corres) apply (rule corres_split_deprecated [OF _ sts_corres]) apply (rule corres_splitEE [OF _ pinv_corres]) apply simp apply (rule corres_split_deprecated [OF _ gts_corres]) apply (rename_tac state state') apply (case_tac state, simp_all)[1] apply (fold dc_def)[1] apply (rule corres_split_deprecated [OF sts_corres]) apply simp apply (rule corres_when [OF refl rfk_corres]) apply (simp add: when_def) apply (rule conjI, rule impI) apply (rule reply_from_kernel_tcb_at) apply (rule impI, wp+) apply (simp)+ apply (wp hoare_drop_imps)+ apply (simp) apply (wp) apply (simp) apply simp apply (rule_tac Q="\rv. einvs and simple_sched_action and valid_invocation rve and (\s. thread = cur_thread s) and st_tcb_at active thread" in hoare_post_imp) apply (clarsimp simp: simple_from_active ct_in_state_def elim!: st_tcb_weakenE) apply (wp sts_st_tcb_at' set_thread_state_simple_sched_action set_thread_state_active_valid_sched) apply (rule_tac Q="\rv. invs' and valid_invocation' rve' and (\s. thread = ksCurThread s) and st_tcb_at' active' thread and (\s. ksSchedulerAction s = ResumeCurrentThread) and (\s. vs_valid_duplicates' (ksPSpace s))" in hoare_post_imp) apply (clarsimp simp: ct_in_state'_def) apply (frule(1) ct_not_ksQ) apply (clarsimp) apply (wp setThreadState_nonqueued_state_update setThreadState_st_tcb setThreadState_rct)[1] apply (wp lec_caps_to lsft_ex_cte_cap_to | simp add: split_def liftE_bindE[symmetric] ct_in_state'_def ball_conj_distrib | rule hoare_vcg_E_elim)+ apply (clarsimp simp: tcb_at_invs invs_valid_objs valid_tcb_state_def ct_in_state_def simple_from_active invs_mdb) apply (clarsimp simp: msg_max_length_def word_bits_def) apply (erule st_tcb_ex_cap, clarsimp+) apply fastforce apply (clarsimp) apply (frule tcb_at_invs') apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def ct_not_inQ_def) apply (frule(1) valid_queues_not_tcbQueued_not_ksQ) apply (frule pred_tcb'_weakenE [where P=active' and P'=simple'], clarsimp) apply (frule(1) st_tcb_ex_cap'', fastforce) apply (clarsimp simp: valid_pspace'_def) apply (frule(1) st_tcb_at_idle_thread') apply (simp) done lemma ts_Restart_case_helper': "(case ts of Structures_H.Restart \ A | _ \ B) = (if ts = Structures_H.Restart then A else B)" by (cases ts, simp_all) lemma gts_imp': "\Q\ getThreadState t \R\ \ \\s. st_tcb_at' P t s \ Q s\ getThreadState t \\rv s. P rv \ R rv s\" apply (simp only: imp_conv_disj) apply (erule hoare_vcg_disj_lift[rotated]) apply (rule hoare_strengthen_post [OF gts_sp']) apply (clarsimp simp: pred_tcb_at'_def obj_at'_def projectKOs) done crunch st_tcb_at'[wp]: replyFromKernel "st_tcb_at' P t" crunch cap_to'[wp]: replyFromKernel "ex_nonz_cap_to' p" crunch it'[wp]: replyFromKernel "\s. P (ksIdleThread s)" crunch sch_act_simple[wp]: replyFromKernel sch_act_simple (rule: sch_act_simple_lift) lemma rfk_ksQ[wp]: "\\s. P (ksReadyQueues s p)\ replyFromKernel t x1 \\_ s. P (ksReadyQueues s p)\" apply (case_tac x1) apply (simp add: replyFromKernel_def) apply (wp) done lemma hinv_invs'[wp]: "\invs' and ct_active' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread)\ handleInvocation calling blocking \\rv. invs'\" apply (simp add: handleInvocation_def split_def ts_Restart_case_helper') apply (wp syscall_valid' setThreadState_nonqueued_state_update rfk_invs' hoare_vcg_all_lift static_imp_wp) apply simp apply (intro conjI impI) apply (wp gts_imp' | simp)+ apply (rule_tac Q'="\rv. invs'" in hoare_post_imp_R[rotated]) apply clarsimp apply (subgoal_tac "thread \ ksIdleThread s", simp_all)[1] apply (fastforce elim!: pred_tcb'_weakenE st_tcb_ex_cap'') apply (clarsimp simp: valid_idle'_def valid_state'_def invs'_def pred_tcb_at'_def obj_at'_def) apply wp+ apply (rule_tac Q="\rv'. invs' and valid_invocation' rv and (\s. ksSchedulerAction s = ResumeCurrentThread) and (\s. ksCurThread s = thread) and st_tcb_at' active' thread" in hoare_post_imp) apply (clarsimp simp: ct_in_state'_def) apply (frule(1) ct_not_ksQ) apply (clarsimp) apply (wp sts_invs_minor' setThreadState_st_tcb setThreadState_rct | simp)+ apply (clarsimp) apply (frule(1) ct_not_ksQ) apply (fastforce simp add: tcb_at_invs' ct_in_state'_def simple_sane_strg sch_act_simple_def elim!: pred_tcb'_weakenE st_tcb_ex_cap'' dest: st_tcb_at_idle_thread')+ done crunch typ_at'[wp]: handleFault "\s. P (typ_at' T p s)" lemmas handleFault_typ_ats[wp] = typ_at_lifts [OF handleFault_typ_at'] lemma hs_corres: "corres (dc \ dc) (einvs and (\s. scheduler_action s = resume_cur_thread) and ct_active) (invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and ct_active') (handle_send blocking) (handleSend blocking)" by (simp add: handle_send_def handleSend_def hinv_corres) lemma hs_invs'[wp]: "\invs' and ct_active' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread)\ handleSend blocking \\r. invs'\" apply (rule validE_valid) apply (simp add: handleSend_def) apply (wp | simp)+ done lemma getThreadCallerSlot_map: "getThreadCallerSlot t = return (cte_map (t, tcb_cnode_index 3))" by (simp add: getThreadCallerSlot_def locateSlot_conv cte_map_def tcb_cnode_index_def tcbCallerSlot_def cte_level_bits_def) lemma tcb_at_cte_at_map: "\ tcb_at' t s; offs \ dom tcb_cap_cases \ \ cte_at' (cte_map (t, offs)) s" apply (clarsimp simp: obj_at'_def projectKOs objBits_simps) apply (drule tcb_cases_related) apply (auto elim: cte_wp_at_tcbI') done lemma delete_caller_cap_corres: "corres dc (einvs and tcb_at t) (invs' and tcb_at' t) (delete_caller_cap t) (deleteCallerCap t)" apply (simp add: delete_caller_cap_def deleteCallerCap_def getThreadCallerSlot_map) apply (rule corres_guard_imp) apply (rule_tac P'="cte_at' (cte_map (t, tcb_cnode_index 3))" in corres_symb_exec_r_conj) apply (rule_tac F="isReplyCap rv \ rv = capability.NullCap" and P="cte_wp_at (\cap. is_reply_cap cap \ cap = cap.NullCap) (t, tcb_cnode_index 3) and einvs" and P'="invs' and cte_wp_at' (\cte. cteCap cte = rv) (cte_map (t, tcb_cnode_index 3))" in corres_req) apply (clarsimp simp: cte_wp_at_caps_of_state state_relation_def) apply (drule caps_of_state_cteD) apply (drule(1) pspace_relation_cte_wp_at, clarsimp+) apply (clarsimp simp: cte_wp_at_ctes_of is_reply_cap_relation cap_relation_NullCapI) apply simp apply (rule corres_guard_imp, rule cap_delete_one_corres) apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps) apply (auto simp: can_fast_finalise_def)[1] apply (clarsimp simp: cte_wp_at_ctes_of) apply ((wp getCTE_wp')+ | simp add: getSlotCap_def)+ apply clarsimp apply (frule tcb_at_cte_at[where ref="tcb_cnode_index 3"]) apply clarsimp apply (clarsimp simp: cte_wp_at_caps_of_state) apply (frule tcb_cap_valid_caps_of_stateD, clarsimp) apply (drule(1) tcb_cnode_index_3_reply_or_null) apply (auto simp: can_fast_finalise_def is_cap_simps intro: tcb_at_cte_at_map tcb_at_cte_at)[1] apply clarsimp apply (frule_tac offs="tcb_cnode_index 3" in tcb_at_cte_at_map) apply (simp add: tcb_cap_cases_def) apply (clarsimp simp: cte_wp_at_ctes_of) done lemma deleteCallerCap_invs[wp]: "\invs'\ deleteCallerCap t \\rv. invs'\" apply (simp add: deleteCallerCap_def getThreadCallerSlot_def locateSlot_conv) apply (wp cteDeleteOne_invs hoare_drop_imps) done lemma deleteCallerCap_simple[wp]: "\st_tcb_at' simple' t\ deleteCallerCap t' \\rv. st_tcb_at' simple' t\" apply (simp add: deleteCallerCap_def getThreadCallerSlot_def locateSlot_conv) apply (wp cteDeleteOne_st_tcb_at hoare_drop_imps | simp)+ done lemma cteDeleteOne_reply_cap_to''[wp]: "\ex_nonz_cap_to' p and cte_wp_at' (\c. isReplyCap (cteCap c) \ isNullCap (cteCap c)) slot\ cteDeleteOne slot \\rv. ex_nonz_cap_to' p\" apply (simp add: cteDeleteOne_def ex_nonz_cap_to'_def unless_def) apply (rule hoare_seq_ext [OF _ getCTE_sp]) apply (rule hoare_assume_pre) apply (subgoal_tac "isReplyCap (cteCap cte) \ isNullCap (cteCap cte)") apply (wp hoare_vcg_ex_lift emptySlot_cte_wp_cap_other isFinalCapability_inv | clarsimp simp: finaliseCap_def isCap_simps | simp | wp (once) hoare_drop_imps)+ apply (fastforce simp: cte_wp_at_ctes_of) apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps) done lemma deleteCallerCap_nonz_cap: "\ex_nonz_cap_to' p and tcb_at' t and valid_objs'\ deleteCallerCap t \\rv. ex_nonz_cap_to' p\" apply (simp add: deleteCallerCap_def getSlotCap_def getThreadCallerSlot_map locateSlot_conv ) apply (rule hoare_pre) apply (wp cteDeleteOne_reply_cap_to'' getCTE_wp') apply clarsimp apply (frule_tac offs="tcb_cnode_index 3" in tcb_at_cte_at_map) apply (clarsimp simp: tcb_cap_cases_def) apply (auto simp: ex_nonz_cap_to'_def isCap_simps cte_wp_at_ctes_of) done crunch sch_act_sane[wp]: cteDeleteOne sch_act_sane (wp: crunch_wps loadObject_default_inv getObject_inv simp: crunch_simps unless_def rule: sch_act_sane_lift) crunch sch_act_sane[wp]: deleteCallerCap sch_act_sane (wp: crunch_wps) lemma delete_caller_cap_valid_ep_cap: "\valid_cap (cap.EndpointCap r a b)\ delete_caller_cap thread \\rv. valid_cap (cap.EndpointCap r a b)\" apply (clarsimp simp: delete_caller_cap_def cap_delete_one_def valid_cap_def) apply (rule hoare_pre) by (wp get_cap_wp fast_finalise_typ_at abs_typ_at_lifts(1) | simp add: unless_def valid_cap_def)+ lemma hw_corres': "corres dc (einvs and ct_in_state active and (\s. ex_nonz_cap_to (cur_thread s) s)) (invs' and ct_in_state' simple' and sch_act_sane and (\s. \p. ksCurThread s \ set (ksReadyQueues s p)) and (\s. ex_nonz_cap_to' (ksCurThread s) s)) (handle_recv isBlocking) (handleRecv isBlocking)" (is "corres dc (?pre1) (?pre2) (handle_recv _) (handleRecv _)") apply (simp add: handle_recv_def handleRecv_def liftM_bind Let_def cap_register_def capRegister_def cong: if_cong cap.case_cong capability.case_cong bool.case_cong) apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ gct_corres]) apply (rule corres_split_eqr [OF _ user_getreg_corres]) apply (rule corres_split_catch) apply (erule hf_corres) apply (rule corres_cap_fault) apply (rule corres_splitEE [OF _ lc_corres]) apply (rule_tac P="?pre1 and tcb_at thread and (\s. (cur_thread s) = thread ) and valid_cap rv" and P'="?pre2 and tcb_at' thread and valid_cap' rv'" in corres_inst) apply (clarsimp split: cap_relation_split_asm arch_cap.split_asm split del: if_split simp: lookup_failure_map_def whenE_def) apply (rule corres_guard_imp) apply (rename_tac rights) apply (case_tac "AllowRead \ rights"; simp) apply (rule corres_split_nor[OF _ delete_caller_cap_corres]) apply (rule receive_ipc_corres) apply (clarsimp)+ apply (wp delete_caller_cap_nonz_cap delete_caller_cap_valid_ep_cap)+ apply (clarsimp)+ apply (clarsimp simp: lookup_failure_map_def)+ apply (clarsimp simp: valid_cap'_def capAligned_def) apply (rule corres_guard_imp) apply (rename_tac rights) apply (case_tac "AllowRead \ rights"; simp) apply (rule_tac r'=ntfn_relation in corres_splitEE) apply (rule corres_if) apply (clarsimp simp: ntfn_relation_def) apply (clarsimp, rule receive_signal_corres) prefer 3 apply (rule corres_trivial) apply (clarsimp simp: lookup_failure_map_def)+ apply (rule get_ntfn_corres) apply (wp get_simple_ko_wp getNotification_wp | wpcw | simp)+ apply (clarsimp simp: lookup_failure_map_def) apply (clarsimp simp: valid_cap_def ct_in_state_def) apply (clarsimp simp: valid_cap'_def capAligned_def) apply (wp get_simple_ko_wp | wpcw | simp)+ apply (rule hoare_vcg_E_elim) apply (simp add: lookup_cap_def lookup_slot_for_thread_def) apply wp apply (simp add: split_def) apply (wp resolve_address_bits_valid_fault2)+ apply (wp getNotification_wp | wpcw | simp add: valid_fault_def whenE_def split del: if_split)+ apply (clarsimp simp add: ct_in_state_def ct_in_state'_def conj_comms invs_valid_tcb_ctable invs_valid_objs tcb_at_invs invs_psp_aligned invs_cur) apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def ct_in_state'_def sch_act_sane_not) done lemma hw_corres: "corres dc (einvs and ct_active) (invs' and ct_active' and sch_act_sane and (\s. \p. ksCurThread s \ set (ksReadyQueues s p))) (handle_recv isBlocking) (handleRecv isBlocking)" apply (rule corres_guard_imp) apply (rule hw_corres') apply (clarsimp simp: ct_in_state_def) apply (fastforce elim!: st_tcb_weakenE st_tcb_ex_cap) apply (clarsimp simp: ct_in_state'_def invs'_def valid_state'_def) apply (frule(1) st_tcb_ex_cap'') apply (auto elim: pred_tcb'_weakenE) done lemma lookupCap_refs[wp]: "\invs'\ lookupCap t ref \\rv s. \r\zobj_refs' rv. ex_nonz_cap_to' r s\,-" by (simp add: lookupCap_def split_def | wp | simp add: o_def)+ lemma deleteCallerCap_ksQ_ct': "\invs' and ct_in_state' simple' and sch_act_sane and (\s. ksCurThread s \ set (ksReadyQueues s p) \ thread = ksCurThread s)\ deleteCallerCap thread \\rv s. thread \ set (ksReadyQueues s p)\" apply (rule_tac Q="\rv s. thread = ksCurThread s \ ksCurThread s \ set (ksReadyQueues s p)" in hoare_strengthen_post) apply (wp deleteCallerCap_ct_not_ksQ) apply auto done lemma hw_invs'[wp]: "\invs' and ct_in_state' simple' and sch_act_sane and (\s. ex_nonz_cap_to' (ksCurThread s) s) and (\s. ksCurThread s \ ksIdleThread s) and (\s. \p. ksCurThread s \ set (ksReadyQueues s p))\ handleRecv isBlocking \\r. invs'\" apply (simp add: handleRecv_def cong: if_cong) apply (rule hoare_pre) apply ((wp getNotification_wp | wpc | simp)+)[1] apply (clarsimp simp: ct_in_state'_def) apply ((wp deleteCallerCap_nonz_cap hoare_vcg_all_lift deleteCallerCap_ksQ_ct' hoare_lift_Pf2[OF deleteCallerCap_simple deleteCallerCap_ct'] | wpc | simp)+)[1] apply simp apply (wp deleteCallerCap_nonz_cap hoare_vcg_all_lift deleteCallerCap_ksQ_ct' hoare_lift_Pf2[OF deleteCallerCap_simple deleteCallerCap_ct'] | wpc | simp add: ct_in_state'_def whenE_def split del: if_split)+ apply (rule validE_validE_R) apply (rule_tac Q="\rv s. invs' s \ sch_act_sane s \ (\p. ksCurThread s \ set (ksReadyQueues s p)) \ thread = ksCurThread s \ ct_in_state' simple' s \ ex_nonz_cap_to' thread s \ thread \ ksIdleThread s \ (\x \ zobj_refs' rv. ex_nonz_cap_to' x s)" and E="\_ _. True" in hoare_post_impErr[rotated]) apply (clarsimp simp: isCap_simps ct_in_state'_def pred_tcb_at' invs_valid_objs' sch_act_sane_not obj_at'_def projectKOs pred_tcb_at'_def) apply (assumption) apply (wp)+ apply (clarsimp) apply (auto elim: st_tcb_ex_cap'' pred_tcb'_weakenE dest!: st_tcb_at_idle_thread' simp: ct_in_state'_def sch_act_sane_def) done lemma setSchedulerAction_obj_at'[wp]: "\obj_at' P p\ setSchedulerAction sa \\rv. obj_at' P p\" unfolding setSchedulerAction_def by (wp, clarsimp elim!: obj_at'_pspaceI) lemma hy_corres: "corres dc einvs (invs' and ct_active' and (\s. ksSchedulerAction s = ResumeCurrentThread)) handle_yield handleYield" apply (clarsimp simp: handle_yield_def handleYield_def) apply (rule corres_guard_imp) apply (rule corres_split_deprecated[OF _ gct_corres]) apply simp apply (rule corres_split_deprecated[OF _ tcbSchedDequeue_corres]) apply (rule corres_split_deprecated[OF _ tcbSchedAppend_corres]) apply (rule rescheduleRequired_corres) apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues | simp add: )+ apply (simp add: invs_def valid_sched_def valid_sched_action_def cur_tcb_def tcb_at_is_etcb_at) apply clarsimp apply (frule ct_active_runnable') apply (clarsimp simp: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak cur_tcb'_def valid_pspace_valid_objs' valid_objs'_maxDomain tcb_in_cur_domain'_def) apply (erule(1) valid_objs_valid_tcbE[OF valid_pspace_valid_objs']) apply (simp add:valid_tcb'_def) done lemma hy_invs': "\invs' and ct_active'\ handleYield \\r. invs' and ct_active'\" apply (simp add: handleYield_def) apply (wp ct_in_state_thread_state_lift' rescheduleRequired_all_invs_but_ct_not_inQ tcbSchedAppend_invs_but_ct_not_inQ' | simp)+ apply (clarsimp simp add: invs'_def valid_state'_def ct_in_state'_def sch_act_wf_weak cur_tcb'_def valid_pspace_valid_objs' valid_objs'_maxDomain tcb_in_cur_domain'_def ) apply (simp add:ct_active_runnable'[unfolded ct_in_state'_def]) done lemma getDFSR_invs'[wp]: "valid invs' (doMachineOp getDFSR) (\_. invs')" by (simp add: getDFSR_def doMachineOp_def split_def select_f_returns | wp)+ lemma getFAR_invs'[wp]: "valid invs' (doMachineOp getFAR) (\_. invs')" by (simp add: getFAR_def doMachineOp_def split_def select_f_returns | wp)+ lemma getIFSR_invs'[wp]: "valid invs' (doMachineOp getIFSR) (\_. invs')" by (simp add: getIFSR_def doMachineOp_def split_def select_f_returns | wp)+ lemma hv_invs'[wp]: "\invs' and tcb_at' t'\ handleVMFault t' vptr \\r. invs'\" apply (simp add: ARM_H.handleVMFault_def cong: vmfault_type.case_cong) apply (rule hoare_pre) apply (wp | wpcw | simp)+ done crunch nosch[wp]: handleVMFault "\s. P (ksSchedulerAction s)" (ignore: getFAR getDFSR getIFSR) lemma hv_inv_ex': "\P\ handleVMFault t vp \\_ _. True\, \\_. P\" apply (simp add: ARM_H.handleVMFault_def cong: vmfault_type.case_cong) apply (rule hoare_pre) apply (wp dmo_inv' getDFSR_inv getFAR_inv getIFSR_inv getRestartPC_inv det_getRestartPC asUser_inv | wpcw)+ apply simp done lemma active_from_running': "ct_running' s' \ ct_active' s'" by (clarsimp elim!: pred_tcb'_weakenE simp: ct_in_state'_def)+ lemma simple_from_running': "ct_running' s' \ ct_in_state' simple' s'" by (clarsimp elim!: pred_tcb'_weakenE simp: ct_in_state'_def)+ lemma hr_corres: "corres dc (einvs and ct_running) (invs' and ct_running') handle_reply handleReply" apply (simp add: handle_reply_def handleReply_def getThreadCallerSlot_map getSlotCap_def) apply (rule corres_guard_imp) apply (rule corres_split_eqr [OF _ gct_corres]) apply (rule corres_split_deprecated [OF _ get_cap_corres]) apply (rule_tac P="einvs and cte_wp_at ((=) caller_cap) (thread, tcb_cnode_index 3) and K (is_reply_cap caller_cap \ caller_cap = cap.NullCap) and tcb_at thread and st_tcb_at active thread and valid_cap caller_cap" and P'="invs' and tcb_at' thread and valid_cap' (cteCap rv') and cte_at' (cte_map (thread, tcb_cnode_index 3))" in corres_inst) apply (auto split: cap_relation_split_asm arch_cap.split_asm bool.split intro!: corres_guard_imp [OF delete_caller_cap_corres] corres_guard_imp [OF do_reply_transfer_corres] corres_fail simp: valid_cap_def valid_cap'_def is_cap_simps assert_def is_reply_cap_to_def)[1] apply (fastforce simp: invs_def valid_state_def cte_wp_at_caps_of_state st_tcb_def2 dest: valid_reply_caps_of_stateD) apply (wp get_cap_cte_wp_at get_cap_wp | simp add: cte_wp_at_eq_simp)+ apply (intro conjI impI allI, (fastforce simp: invs_def valid_state_def intro: tcb_at_cte_at)+) apply (clarsimp, frule tcb_at_invs) apply (fastforce dest: tcb_caller_cap simp: cte_wp_at_def) apply clarsimp apply (clarsimp simp: ct_in_state_def elim!: st_tcb_weakenE) apply (fastforce intro: cte_wp_valid_cap elim: cte_wp_at_weakenE) apply (fastforce intro: tcb_at_cte_at_map) done lemma hr_invs'[wp]: "\invs' and sch_act_simple\ handleReply \\rv. invs'\" apply (simp add: handleReply_def getSlotCap_def getThreadCallerSlot_map getCurThread_def) apply (wp getCTE_wp | wpc | simp)+ apply (clarsimp simp: cte_wp_at_ctes_of) apply (drule ctes_of_valid', clarsimp+) apply (simp add: valid_cap'_def) apply (simp add: invs'_def cur_tcb'_def) done crunch ksCurThread[wp]: handleReply "\s. P (ksCurThread s)" (wp: crunch_wps transferCapsToSlots_pres1 setObject_ep_ct setObject_ntfn_ct simp: unless_def crunch_simps ignore: transferCapsToSlots) lemmas cteDeleteOne_st_tcb_at_simple'[wp] = cteDeleteOne_st_tcb_at[where P=simple', simplified] crunch st_tcb_at_simple'[wp]: handleReply "st_tcb_at' simple' t'" (wp: hoare_post_taut crunch_wps sts_st_tcb_at'_cases threadSet_pred_tcb_no_state ignore: setThreadState) lemmas handleReply_ct_in_state_simple[wp] = ct_in_state_thread_state_lift' [OF handleReply_ksCurThread handleReply_st_tcb_at_simple'] (* FIXME: move *) lemma doReplyTransfer_st_tcb_at_active: "\st_tcb_at' active' t and tcb_at' t' and K (t \ t') and cte_wp_at' (\cte. cteCap cte = (capability.ReplyCap t' False g)) sl\ doReplyTransfer t t' sl g \\rv. st_tcb_at' active' t\" apply (simp add: doReplyTransfer_def liftM_def) apply (wp setThreadState_st_tcb sts_pred_tcb_neq' cteDeleteOne_reply_pred_tcb_at hoare_drop_imps threadSet_pred_tcb_no_state hoare_exI doIPCTransfer_non_null_cte_wp_at2' | wpc | clarsimp simp:isCap_simps)+ apply (fastforce) done lemma hr_ct_active'[wp]: "\invs' and ct_active'\ handleReply \\rv. ct_active'\" apply (simp add: handleReply_def getSlotCap_def getCurThread_def getThreadCallerSlot_def locateSlot_conv) apply (rule hoare_seq_ext) apply (rule_tac t=thread in ct_in_state'_decomp) apply ((wp hoare_drop_imps | wpc | simp)+)[1] apply (subst haskell_assert_def) apply (wp hoare_vcg_all_lift getCTE_wp doReplyTransfer_st_tcb_at_active | wpc | simp)+ apply (fastforce simp: ct_in_state'_def cte_wp_at_ctes_of valid_cap'_def dest: ctes_of_valid') done lemma hc_corres: "corres (dc \ dc) (einvs and (\s. scheduler_action s = resume_cur_thread) and ct_active) (invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and ct_active') handle_call handleCall" by (simp add: handle_call_def handleCall_def liftE_bindE hinv_corres) lemma hc_invs'[wp]: "\invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread) and ct_active'\ handleCall \\rv. invs'\" apply (simp add: handleCall_def) apply (wp) apply (clarsimp) done lemma sch_act_sane_ksMachineState [iff]: "sch_act_sane (s\ksMachineState := b\) = sch_act_sane s" by (simp add: sch_act_sane_def) lemma cteInsert_sane[wp]: "\sch_act_sane\ cteInsert newCap srcSlot destSlot \\_. sch_act_sane\" apply (simp add: sch_act_sane_def) apply (wp hoare_vcg_all_lift hoare_convert_imp [OF cteInsert_nosch cteInsert_ct]) done crunch sane [wp]: setExtraBadge sch_act_sane crunch sane [wp]: transferCaps "sch_act_sane" (wp: transferCapsToSlots_pres1 crunch_wps simp: crunch_simps ignore: transferCapsToSlots) lemma possibleSwitchTo_sane: "\\s. sch_act_sane s \ t \ ksCurThread s\ possibleSwitchTo t \\_. sch_act_sane\" apply (simp add: possibleSwitchTo_def setSchedulerAction_def curDomain_def cong: if_cong) apply (wp hoare_drop_imps | wpc)+ apply (simp add: sch_act_sane_def) done crunch sane [wp]: handleFaultReply sch_act_sane ( wp: threadGet_inv hoare_drop_imps crunch_wps simp: crunch_simps ignore: setSchedulerAction) crunch sane [wp]: doIPCTransfer sch_act_sane ( wp: threadGet_inv hoare_drop_imps crunch_wps simp: crunch_simps ignore: setSchedulerAction) lemma doReplyTransfer_sane: "\\s. sch_act_sane s \ t' \ ksCurThread s\ doReplyTransfer t t' callerSlot g \\rv. sch_act_sane\" apply (simp add: doReplyTransfer_def liftM_def) apply (wp possibleSwitchTo_sane hoare_drop_imps hoare_vcg_all_lift|wpc)+ apply simp done lemma handleReply_sane: "\sch_act_sane\ handleReply \\rv. sch_act_sane\" apply (simp add: handleReply_def getSlotCap_def getThreadCallerSlot_def locateSlot_conv) apply (rule hoare_pre) apply (wp haskell_assert_wp doReplyTransfer_sane getCTE_wp'| wpc)+ apply (clarsimp simp: cte_wp_at_ctes_of) done lemma handleReply_nonz_cap_to_ct: "\ct_active' and invs' and sch_act_simple\ handleReply \\rv s. ex_nonz_cap_to' (ksCurThread s) s\" apply (rule_tac Q="\rv. ct_active' and invs'" in hoare_post_imp) apply (auto simp: ct_in_state'_def elim: st_tcb_ex_cap'')[1] apply (wp | simp)+ done crunch ksQ[wp]: handleFaultReply "\s. P (ksReadyQueues s p)" lemma doReplyTransfer_ct_not_ksQ: "\ invs' and sch_act_simple and tcb_at' thread and tcb_at' word and ct_in_state' simple' and (\s. ksCurThread s \ word) and (\s. \p. ksCurThread s \ set(ksReadyQueues s p))\ doReplyTransfer thread word callerSlot g \\rv s. \p. ksCurThread s \ set(ksReadyQueues s p)\" proof - have astct: "\t p. \(\s. ksCurThread s \ set(ksReadyQueues s p) \ sch_act_sane s) and (\s. ksCurThread s \ t)\ possibleSwitchTo t \\rv s. ksCurThread s \ set(ksReadyQueues s p)\" apply (rule hoare_weaken_pre) apply (wps possibleSwitchTo_ct') apply (wp possibleSwitchTo_ksQ') apply (clarsimp simp: sch_act_sane_def) done have stsct: "\t st p. \(\s. ksCurThread s \ set(ksReadyQueues s p)) and sch_act_simple\ setThreadState st t \\rv s. ksCurThread s \ set(ksReadyQueues s p)\" apply (rule hoare_weaken_pre) apply (wps setThreadState_ct') apply (wp hoare_vcg_all_lift sts_ksQ) apply (clarsimp) done show ?thesis apply (simp add: doReplyTransfer_def) apply (wp, wpc) apply (wp astct stsct hoare_vcg_all_lift cteDeleteOne_ct_not_ksQ hoare_drop_imp hoare_lift_Pf2 [OF cteDeleteOne_sch_act_not cteDeleteOne_ct'] hoare_lift_Pf2 [OF doIPCTransfer_pred_tcb_at' doIPCTransfer_ct'] hoare_lift_Pf2 [OF doIPCTransfer_ksQ doIPCTransfer_ct'] hoare_lift_Pf2 [OF threadSet_ksQ threadSet_ct] hoare_lift_Pf2 [OF handleFaultReply_ksQ handleFaultReply_ct'] | simp add: ct_in_state'_def)+ apply (fastforce simp: sch_act_simple_def sch_act_sane_def ct_in_state'_def)+ done qed lemma handleReply_ct_not_ksQ: "\invs' and sch_act_simple and ct_in_state' simple' and (\s. \p. ksCurThread s \ set (ksReadyQueues s p))\ handleReply \\rv s. \p. ksCurThread s \ set (ksReadyQueues s p)\" apply (simp add: handleReply_def del: split_paired_All) apply (subst haskell_assert_def) apply (wp | wpc)+ apply (wp doReplyTransfer_ct_not_ksQ getThreadCallerSlot_inv)+ apply (rule_tac Q="\cap. (\s. \p. ksCurThread s \ set(ksReadyQueues s p)) and invs' and sch_act_simple and (\s. thread = ksCurThread s) and tcb_at' thread and ct_in_state' simple' and cte_wp_at' (\c. cteCap c = cap) callerSlot" in hoare_post_imp) apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def cte_wp_at_ctes_of valid_cap'_def dest!: ctes_of_valid') apply (wp getSlotCap_cte_wp_at getThreadCallerSlot_inv)+ apply (clarsimp) done crunches possible_switch_to, handle_recv for valid_etcbs[wp]: "valid_etcbs" (wp: crunch_wps simp: crunch_simps) lemma hrw_corres: "corres dc (einvs and ct_running) (invs' and ct_running' and (\s. ksSchedulerAction s = ResumeCurrentThread)) (do x \ handle_reply; handle_recv True od) (do x \ handleReply; handleRecv True od)" apply (rule corres_guard_imp) apply (rule corres_split_nor [OF _ hr_corres]) apply (rule hw_corres') apply (wp handle_reply_nonz_cap_to_ct handleReply_sane handleReply_nonz_cap_to_ct handleReply_ct_not_ksQ handle_reply_valid_sched)+ apply (fastforce simp: ct_in_state_def ct_in_state'_def simple_sane_strg elim!: st_tcb_weakenE st_tcb_ex_cap') apply (clarsimp simp: ct_in_state'_def) apply (frule(1) ct_not_ksQ) apply (fastforce elim: pred_tcb'_weakenE) done lemma hh_corres: "corres dc (einvs and st_tcb_at active thread and ex_nonz_cap_to thread and (%_. valid_fault f)) (invs' and sch_act_not thread and (\s. \p. thread \ set(ksReadyQueues s p)) and st_tcb_at' simple' thread and ex_nonz_cap_to' thread) (handle_hypervisor_fault w fault) (handleHypervisorFault w fault)" apply (cases fault; clarsimp simp add: handleHypervisorFault_def returnOk_def2) done (* FIXME: move *) lemma he_corres: "corres (dc \ dc) (einvs and (\s. event \ Interrupt \ ct_running s) and (\s. scheduler_action s = resume_cur_thread)) (invs' and (\s. event \ Interrupt \ ct_running' s) and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread)) (handle_event event) (handleEvent event)" (is "?he_corres") proof - have hw: "\isBlocking. corres dc (einvs and ct_running and (\s. scheduler_action s = resume_cur_thread)) (invs' and ct_running' and (\s. ksSchedulerAction s = ResumeCurrentThread)) (handle_recv isBlocking) (handleRecv isBlocking)" apply (rule corres_guard_imp [OF hw_corres]) apply (clarsimp simp: ct_in_state_def ct_in_state'_def elim!: st_tcb_weakenE pred_tcb'_weakenE dest!: ct_not_ksQ)+ done show ?thesis apply (case_tac event) apply (simp_all add: handleEvent_def) apply (rename_tac syscall) apply (case_tac syscall) apply (auto intro: corres_guard_imp[OF hs_corres] corres_guard_imp[OF hw] corres_guard_imp [OF hr_corres] corres_guard_imp[OF hrw_corres] corres_guard_imp[OF hc_corres] corres_guard_imp[OF hy_corres] active_from_running active_from_running' simp: simple_sane_strg)[8] apply (rule corres_split') apply (rule corres_guard_imp[OF gct_corres], simp+) apply (rule hf_corres) apply simp apply (simp add: valid_fault_def) apply wp apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def) apply wp apply (clarsimp) apply (frule(1) ct_not_ksQ) apply (auto simp: ct_in_state'_def sch_act_simple_def sch_act_sane_def elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1] apply (rule corres_split') apply (rule corres_guard_imp, rule gct_corres, simp+) apply (rule hf_corres) apply (simp add: valid_fault_def) apply wp apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def valid_fault_def) apply wp apply clarsimp apply (frule(1) ct_not_ksQ) apply (auto simp: ct_in_state'_def sch_act_simple_def sch_act_sane_def elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1] apply (rule corres_guard_imp) apply (rule corres_split_eqr[where R="\rv. einvs" and R'="\rv s. \x. rv = Some x \ R'' x s" for R'']) apply (case_tac rv, simp_all add: doMachineOp_return)[1] apply (rule handle_interrupt_corres) apply (rule corres_machine_op) apply (rule corres_Id, simp+) apply (wp hoare_vcg_all_lift doMachineOp_getActiveIRQ_IRQ_active' | simp | simp add: imp_conjR | wp (once) hoare_drop_imps)+ apply force apply simp apply (simp add: invs'_def valid_state'_def) apply (rule_tac corres_split') apply (rule corres_guard_imp, rule gct_corres, simp+) apply (rule corres_split_catch) apply (erule hf_corres) apply (rule hv_corres) apply (rule hoare_elim_pred_conjE2) apply (rule hoare_vcg_E_conj, rule valid_validE_E, wp) apply (wp handle_vm_fault_valid_fault) apply (rule hv_inv_ex') apply wp apply (clarsimp simp: simple_from_running tcb_at_invs) apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def) apply wp apply (clarsimp) apply (frule(1) ct_not_ksQ) apply (fastforce simp: simple_sane_strg sch_act_simple_def ct_in_state'_def elim: st_tcb_ex_cap'' pred_tcb'_weakenE) apply (rule corres_split') apply (rule corres_guard_imp[OF gct_corres], simp+) apply (rule hh_corres) apply (simp add: valid_fault_def) apply wp apply (fastforce elim!: st_tcb_ex_cap st_tcb_weakenE simp: ct_in_state_def) apply wp apply (clarsimp) apply (frule(1) ct_not_ksQ) apply (auto simp: ct_in_state'_def sch_act_simple_def sch_act_sane_def elim: pred_tcb'_weakenE st_tcb_ex_cap'')[1] done qed crunches handleVMFault,handleHypervisorFault for st_tcb_at'[wp]: "st_tcb_at' P t" and cap_to'[wp]: "ex_nonz_cap_to' t" and ksit[wp]: "\s. P (ksIdleThread s)" (ignore: getFAR getDFSR getIFSR) lemma hv_inv': "\P\ handleVMFault p t \\_. P\" apply (simp add: ARM_H.handleVMFault_def) apply (rule hoare_pre) apply (wp dmo_inv' getDFSR_inv getFAR_inv getIFSR_inv getRestartPC_inv det_getRestartPC asUser_inv |wpc|simp)+ done lemma hh_inv': "\P\ handleHypervisorFault p t \\_. P\" apply (simp add: ARM_H.handleHypervisorFault_def) apply (cases t; clarsimp) done lemma ct_not_idle': fixes s assumes vi: "valid_idle' s" and cts: "ct_in_state' (\tcb. \idle' tcb) s" shows "ksCurThread s \ ksIdleThread s" proof assume "ksCurThread s = ksIdleThread s" with vi have "ct_in_state' idle' s" unfolding ct_in_state'_def valid_idle'_def by (clarsimp simp: pred_tcb_at'_def obj_at'_def) with cts show False unfolding ct_in_state'_def by (fastforce dest: pred_tcb_at_conj') qed lemma ct_running_not_idle'[simp]: "\invs' s; ct_running' s\ \ ksCurThread s \ ksIdleThread s" apply (rule ct_not_idle') apply (fastforce simp: invs'_def valid_state'_def ct_in_state'_def elim: pred_tcb'_weakenE)+ done lemma ct_active_not_idle'[simp]: "\invs' s; ct_active' s\ \ ksCurThread s \ ksIdleThread s" apply (rule ct_not_idle') apply (fastforce simp: invs'_def valid_state'_def ct_in_state'_def elim: pred_tcb'_weakenE)+ done crunches handleFault, receiveSignal, receiveIPC, asUser for ksCurThread[wp]: "\s. P (ksCurThread s)" (wp: hoare_drop_imps crunch_wps simp: crunch_simps) lemma he_invs'[wp]: "\invs' and (\s. event \ Interrupt \ ct_running' s) and (\s. vs_valid_duplicates' (ksPSpace s)) and (\s. ksSchedulerAction s = ResumeCurrentThread)\ handleEvent event \\rv. invs'\" proof - have nidle: "\s. invs' s \ ct_active' s \ ksCurThread s \ ksIdleThread s" by (clarsimp) show ?thesis apply (case_tac event, simp_all add: handleEvent_def) apply (rename_tac syscall) apply (case_tac syscall, (wp handleReply_sane handleReply_nonz_cap_to_ct handleReply_ksCurThread handleReply_ct_not_ksQ | clarsimp simp: active_from_running' simple_from_running' simple_sane_strg simp del: split_paired_All | rule conjI active_ex_cap' | drule ct_not_ksQ[rotated] | strengthen nidle)+) apply (rule hoare_strengthen_post, rule hoare_weaken_pre, rule hy_invs') apply (simp add: active_from_running') apply simp apply (wp hv_inv' hh_inv' | rule conjI | erule pred_tcb'_weakenE st_tcb_ex_cap'' | clarsimp simp: tcb_at_invs ct_in_state'_def simple_sane_strg sch_act_simple_def | drule st_tcb_at_idle_thread' | drule ct_not_ksQ[rotated] | wpc | wp (once) hoare_drop_imps)+ done qed lemma inv_irq_IRQInactive: "\\\ performIRQControl irqcontrol_invocation -, \\rv s. intStateIRQTable (ksInterruptState s) rv \ irqstate.IRQInactive\" apply (simp add: performIRQControl_def) apply (rule hoare_pre) apply (wpc|wp|simp add: ARM_H.performIRQControl_def)+ done lemma inv_arch_IRQInactive: "\\\ Arch.performInvocation invocation -, \\rv s. intStateIRQTable (ksInterruptState s) rv \ irqstate.IRQInactive\" apply (simp add: ARM_H.performInvocation_def performARMMMUInvocation_def) apply wp done lemma retype_pi_IRQInactive: "\valid_irq_states'\ RetypeDecls_H.performInvocation blocking call v -, \\rv s. intStateIRQTable (ksInterruptState s) rv \ irqstate.IRQInactive\" apply (simp add: Retype_H.performInvocation_def) apply (rule hoare_pre) apply (wpc | wp inv_tcb_IRQInactive inv_cnode_IRQInactive inv_irq_IRQInactive inv_untyped_IRQInactive inv_arch_IRQInactive | simp)+ done end end