(* * Copyright 2014, General Dynamics C4 Systems * * SPDX-License-Identifier: GPL-2.0-only *) theory Tcb_C imports Delete_C Ipc_C begin lemma asUser_obj_at' : "\ K(t\t') and obj_at' P t' \ asUser t f \ \_. obj_at' (P::Structures_H.tcb \ bool) t' \" including no_pre apply (simp add: asUser_def) apply wp apply (case_tac "t=t'"; clarsimp) apply (rule hoare_drop_imps) apply wp done lemma getObject_sched: "(x::tcb, s') \ fst (getObject t s) \ (x,s'\ksSchedulerAction := ChooseNewThread\) \ fst (getObject t (s\ksSchedulerAction := ChooseNewThread\))" apply (clarsimp simp: in_monad getObject_def split_def loadObject_default_def magnitudeCheck_def projectKOs split: option.splits) done lemma threadGet_sched: "(x, s') \ fst (threadGet t f s) \ (x,s'\ksSchedulerAction := ChooseNewThread\) \ fst (threadGet t f (s\ksSchedulerAction := ChooseNewThread\))" apply (clarsimp simp: in_monad threadGet_def liftM_def) apply (drule getObject_sched) apply fastforce done lemma setObject_sched: "(x, s') \ fst (setObject t (v::tcb) s) \ (x, s'\ksSchedulerAction := ChooseNewThread\) \ fst (setObject t v (s\ksSchedulerAction := ChooseNewThread\))" apply (clarsimp simp: in_monad setObject_def split_def updateObject_default_def magnitudeCheck_def projectKOs split: option.splits) done lemma threadSet_sched: "(x, s') \ fst (threadSet f t s) \ (x,s'\ksSchedulerAction := ChooseNewThread\) \ fst (threadSet f t (s\ksSchedulerAction := ChooseNewThread\))" apply (clarsimp simp: in_monad threadSet_def) apply (drule getObject_sched) apply (drule setObject_sched) apply fastforce done lemma asUser_sched: "(rv,s') \ fst (asUser t f s) \ (rv,s'\ksSchedulerAction := ChooseNewThread\) \ fst (asUser t f (s\ksSchedulerAction := ChooseNewThread\))" apply (clarsimp simp: asUser_def split_def in_monad select_f_def) apply (drule threadGet_sched) apply (drule threadSet_sched) apply fastforce done lemma doMachineOp_sched: "(rv,s') \ fst (doMachineOp f s) \ (rv,s'\ksSchedulerAction := ChooseNewThread\) \ fst (doMachineOp f (s\ksSchedulerAction := ChooseNewThread\))" apply (clarsimp simp: doMachineOp_def split_def in_monad select_f_def) apply fastforce done context begin interpretation Arch . (*FIXME: arch_split*) crunch queues[wp]: setupReplyMaster "valid_queues" (simp: crunch_simps wp: crunch_wps) crunch curThread [wp]: restart "\s. P (ksCurThread s)" (wp: crunch_wps simp: crunch_simps) end context kernel_m begin lemma getObject_state: " \(x, s') \ fst (getObject t' s); ko_at' ko t s\ \ (if t = t' then tcbState_update (\_. st) x else x, s'\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\) \ fst (getObject t' (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\))" apply (simp split: if_split) apply (rule conjI) apply clarsimp apply (clarsimp simp: getObject_def split_def loadObject_default_def in_monad Corres_C.in_magnitude_check' projectKOs objBits_simps') apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs objBits_simps) apply (simp add: magnitudeCheck_def in_monad split: option.splits) apply clarsimp apply (simp add: lookupAround2_char2) apply (clarsimp split: if_split_asm) apply (erule_tac x=x2 in allE) apply (clarsimp simp: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE) apply simp apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow, simp add: word_bits_def) apply clarsimp apply (clarsimp simp: getObject_def split_def loadObject_default_def in_monad Corres_C.in_magnitude_check' projectKOs objBits_simps') apply (simp add: magnitudeCheck_def in_monad split: option.splits) apply clarsimp apply (simp add: lookupAround2_char2) apply (clarsimp split: if_split_asm) apply (erule_tac x=t in allE) apply simp apply (clarsimp simp: obj_at'_real_def projectKOs ko_wp_at'_def objBits_simps) apply (simp add: ps_clear_def) apply (drule_tac x=t in orthD2) apply fastforce apply clarsimp apply (erule impE) apply simp apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (erule_tac x=x2 in allE) apply (clarsimp simp: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE) apply (rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply fastforce done lemma threadGet_state: "\ (uc, s') \ fst (threadGet (atcbContextGet o tcbArch) t' s); ko_at' ko t s \ \ (uc, s'\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\) \ fst (threadGet (atcbContextGet o tcbArch) t' (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\))" apply (clarsimp simp: threadGet_def liftM_def in_monad) apply (drule (1) getObject_state [where st=st]) apply (rule exI) apply (erule conjI) apply (simp split: if_splits) done lemma asUser_state: "\(x,s) \ fst (asUser t' f s); ko_at' ko t s; \s. \(=) s\ f \\_. (=) s\ \ \ (x,s\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\) \ fst (asUser t' f (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\))" apply (clarsimp simp: asUser_def in_monad select_f_def) apply (frule use_valid, rule threadGet_inv [where P="(=) s"], rule refl) apply (frule use_valid, assumption, rule refl) apply clarsimp apply (frule (1) threadGet_state) apply (intro exI) apply (erule conjI) apply (rule exI, erule conjI) apply (clarsimp simp: threadSet_def in_monad) apply (frule use_valid, rule getObject_inv [where P="(=) s"]) apply (simp add: loadObject_default_def) apply wp apply simp apply (rule refl) apply clarsimp apply (frule (1) getObject_state) apply (intro exI) apply (erule conjI) apply (clarsimp simp: setObject_def split_def updateObject_default_def threadGet_def in_magnitude_check' getObject_def loadObject_default_def liftM_def objBits_simps' projectKOs in_monad) apply (simp split: if_split) apply (rule conjI) apply (clarsimp simp: obj_at'_def projectKOs objBits_simps) apply (clarsimp simp: magnitudeCheck_def in_monad split: option.splits) apply (rule conjI) apply clarsimp apply (cases s, simp) apply (rule ext) apply (clarsimp split: if_split) apply (cases ko) apply clarsimp apply clarsimp apply (rule conjI) apply (clarsimp simp add: lookupAround2_char2 split: if_split_asm) apply (erule_tac x=x2 in allE) apply simp apply (simp add: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE, simp) apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (rule exI) apply (rule conjI, fastforce) apply clarsimp apply (cases s, clarsimp) apply (rule ext, clarsimp split: if_split) apply (cases ko, clarsimp) apply (clarsimp simp: magnitudeCheck_def in_monad split: option.splits) apply (rule conjI) apply clarsimp apply (cases s, clarsimp) apply (rule ext, clarsimp split: if_split) apply (case_tac tcb, clarsimp) apply clarsimp apply (rule conjI) apply (clarsimp simp add: lookupAround2_char2 split: if_split_asm) apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs objBits_simps) apply (erule_tac x=t in allE) apply simp apply (simp add: ps_clear_def) apply (drule_tac x=t in orthD2) apply fastforce apply clarsimp apply (erule impE, simp) apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (erule_tac x=x2 in allE) apply simp apply (simp add: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE) apply (rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (erule impE, simp) apply simp apply (rule exI) apply (rule conjI, fastforce) apply clarsimp apply (cases s, clarsimp) apply (rule ext, clarsimp split: if_split) apply (case_tac tcb, clarsimp) done lemma doMachineOp_state: "(rv,s') \ fst (doMachineOp f s) \ (rv,s'\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\) \ fst (doMachineOp f (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\))" apply (clarsimp simp: doMachineOp_def split_def in_monad select_f_def) apply fastforce done lemma mapM_upd_inv: assumes f: "\x rv. (rv,s) \ fst (f x s) \ x \ set xs \ (rv, g s) \ fst (f x (g s))" assumes inv: "\x. \(=) s\ f x \\_. (=) s\" shows "(rv,s) \ fst (mapM f xs s) \ (rv, g s) \ fst (mapM f xs (g s))" using f inv proof (induct xs arbitrary: rv s) case Nil thus ?case by (simp add: mapM_Nil return_def) next case (Cons z zs) from Cons.prems show ?case apply (clarsimp simp: mapM_Cons in_monad) apply (frule use_valid, assumption, rule refl) apply clarsimp apply (drule Cons.prems, simp) apply (rule exI, erule conjI) apply (drule Cons.hyps) apply simp apply assumption apply simp done qed lemma getMRs_rel_state: "\getMRs_rel args buffer s; (cur_tcb' and case_option \ valid_ipc_buffer_ptr' buffer) s; ko_at' ko t s \ \ getMRs_rel args buffer (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbState_update (\_. st) ko))\)" apply (clarsimp simp: getMRs_rel_def) apply (rule exI, erule conjI) apply (subst (asm) det_wp_use, rule det_wp_getMRs) apply (simp add: cur_tcb'_def) apply (subst det_wp_use, rule det_wp_getMRs) apply (simp add: cur_tcb'_def) apply (rule conjI) apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs objBits_simps ps_clear_def split: if_split) apply (clarsimp simp: valid_ipc_buffer_ptr'_def split: option.splits) apply (clarsimp simp: typ_at'_def ko_wp_at'_def projectKOs obj_at'_real_def objBits_simps ps_clear_def split: if_split) apply (clarsimp simp: getMRs_def in_monad) apply (frule use_valid, rule asUser_inv [where P="(=) s"]) apply (wp mapM_wp' getRegister_inv)[1] apply simp apply clarsimp apply (drule (1) asUser_state) apply (wp mapM_wp' getRegister_inv)[1] apply (intro exI) apply (erule conjI) apply (cases buffer) apply (clarsimp simp: return_def) apply clarsimp apply (drule mapM_upd_inv [rotated -1]) prefer 3 apply fastforce prefer 2 apply wp apply (clarsimp simp: loadWordUser_def in_monad stateAssert_def word_size simp del: fun_upd_apply) apply (rule conjI) apply (clarsimp simp: pointerInUserData_def typ_at'_def ko_wp_at'_def projectKOs ps_clear_def obj_at'_real_def split: if_split) apply (erule doMachineOp_state) done lemma setThreadState_getMRs_rel: "\getMRs_rel args buffer and cur_tcb' and case_option \ valid_ipc_buffer_ptr' buffer and (\_. runnable' st)\ setThreadState st t \\_. getMRs_rel args buffer\" apply (rule hoare_gen_asm') apply (simp add: setThreadState_runnable_simp) apply (simp add: threadSet_def) apply wp apply (simp add: setObject_def split_def updateObject_default_def) apply wp apply (simp del: fun_upd_apply) apply (wp getObject_tcb_wp) apply (clarsimp simp del: fun_upd_apply) apply (drule obj_at_ko_at')+ apply (clarsimp simp del: fun_upd_apply) apply (rule exI, rule conjI, assumption) apply (clarsimp split: if_split simp del: fun_upd_apply) apply (simp add: getMRs_rel_state) done lemma setThreadState_sysargs_rel: "\sysargs_rel args buffer and (\_. runnable' st)\ setThreadState st t \\_. sysargs_rel args buffer\" apply (cases buffer, simp_all add: sysargs_rel_def) apply (rule hoare_pre) apply (wp setThreadState_getMRs_rel hoare_valid_ipc_buffer_ptr_typ_at'|simp)+ done lemma ccorres_abstract_known: "\ \rv' t t'. ceqv \ xf' rv' t t' g (g' rv'); ccorres rvr xf P P' hs f (g' val) \ \ ccorres rvr xf P (P' \ {s. xf' s = val}) hs f g" apply (rule ccorres_guard_imp2) apply (rule_tac xf'=xf' in ccorres_abstract) apply assumption apply (rule_tac P="rv' = val" in ccorres_gen_asm2) apply simp apply simp done lemma setPriority_ccorres: "ccorres dc xfdc (\s. tcb_at' t s \ Invariants_H.valid_queues s \ ksCurDomain s \ maxDomain \ valid_queues' s \ valid_objs' s \ weak_sch_act_wf (ksSchedulerAction s) s \ (priority \ maxPriority)) (UNIV \ {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \ {s. prio_' s = ucast priority}) [] (setPriority t priority) (Call setPriority_'proc)" apply (cinit lift: tptr_' prio_') apply (ctac(no_vcg) add: tcbSchedDequeue_ccorres) apply (rule ccorres_move_c_guard_tcb) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule threadSet_ccorres_lemma2[where P=\]) apply vcg apply clarsimp apply (erule(1) rf_sr_tcb_update_no_queue2, (simp add: typ_heap_simps')+, simp_all?)[1] apply (rule ball_tcb_cte_casesI, simp+) apply (simp add: ctcb_relation_def) apply (ctac(no_vcg) add: isRunnable_ccorres) apply (simp add: when_def to_bool_def del: Collect_const) apply (rule ccorres_cond2[where R=\], simp add: Collect_const_mem) apply (rule ccorres_pre_getCurThread) apply (rule_tac R = "\s. rv = ksCurThread s" in ccorres_cond2) apply (clarsimp simp: rf_sr_ksCurThread) apply (ctac add: rescheduleRequired_ccorres[unfolded dc_def]) apply (ctac add: possibleSwitchTo_ccorres[unfolded dc_def]) apply (rule ccorres_return_Skip') apply (wp isRunnable_wp) apply (wpsimp wp: hoare_drop_imps threadSet_valid_queues threadSet_valid_objs' weak_sch_act_wf_lift_linear threadSet_pred_tcb_at_state threadSet_tcbDomain_triv simp: st_tcb_at'_def o_def split: if_splits) apply (simp add: guard_is_UNIV_def) apply (rule hoare_strengthen_post[ where Q="\rv s. obj_at' (\_. True) t s \ priority \ maxPriority \ Invariants_H.valid_queues s \ ksCurDomain s \ maxDomain \ valid_objs' s \ valid_queues' s \ weak_sch_act_wf (ksSchedulerAction s) s \ (\d p. \ t \ set (ksReadyQueues s (d, p)))"]) apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_valid_queues tcbSchedDequeue_nonq) apply (clarsimp simp: valid_tcb'_tcbPriority_update) apply clarsimp apply (frule (1) valid_objs'_maxDomain[where t=t]) apply (frule (1) valid_objs'_maxPriority[where t=t]) apply simp done lemma setMCPriority_ccorres: "ccorres dc xfdc (invs' and tcb_at' t and (\s. priority \ maxPriority)) (UNIV \ {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \ {s. mcp_' s = ucast priority}) [] (setMCPriority t priority) (Call setMCPriority_'proc)" apply (rule ccorres_gen_asm) apply (cinit lift: tptr_' mcp_') apply (rule ccorres_move_c_guard_tcb) apply (rule threadSet_ccorres_lemma2[where P=\]) apply vcg apply clarsimp apply (erule(1) rf_sr_tcb_update_no_queue2, (simp add: typ_heap_simps')+)[1] apply (rule ball_tcb_cte_casesI, simp+) apply (simp add: ctcb_relation_def cast_simps) apply (clarsimp simp: down_cast_same [symmetric] ucast_up_ucast is_up is_down) done lemma ccorres_subgoal_tailE: "\ ccorres rvr xf Q Q' hs (b ()) d; ccorres rvr xf Q Q' hs (b ()) d \ ccorres rvr xf P P' hs (a >>=E b) (c ;; d) \ \ ccorres rvr xf P P' hs (a >>=E b) (c ;; d)" by simp lemma checkCapAt_ccorres: "\ \rv' t t'. ceqv \ ret__unsigned_long_' rv' t t' c (c' rv'); ccorres rvr xf P P' hs (f >>= g) (c' (scast true)); ccorres rvr xf Q Q' hs (g ()) (c' (scast false)); guard_is_UNIV dc xfdc (\_ _. P' \ Q') \ \ ccorres rvr xf (invs' and valid_cap' cap and P and Q) (UNIV \ {s. ccap_relation cap cap'} \ {s. slot' = cte_Ptr slot}) hs (checkCapAt cap slot f >>= g) (Guard C_Guard \hrs_htd \t_hrs \\<^sub>t slot'\ (\ret__unsigned_long :== CALL sameObjectAs(cap', h_val (hrs_mem \t_hrs) (cap_Ptr &(slot'\[''cap_C'']))));;c)" apply (rule ccorres_gen_asm2)+ apply (simp add: checkCapAt_def liftM_def bind_assoc del: Collect_const) apply (rule ccorres_symb_exec_l' [OF _ getCTE_inv getCTE_sp empty_fail_getCTE]) apply (rule ccorres_guard_imp2) apply (rule ccorres_move_c_guard_cte) apply (rule_tac xf'=ret__unsigned_long_' and val="from_bool (sameObjectAs cap (cteCap x))" and R="cte_wp_at' ((=) x) slot and valid_cap' cap and invs'" in ccorres_symb_exec_r_known_rv_UNIV[where R'=UNIV]) apply vcg apply (clarsimp simp: cte_wp_at_ctes_of) apply (erule(1) cmap_relationE1[OF cmap_relation_cte]) apply (rule exI, rule conjI, assumption) apply (clarsimp simp: typ_heap_simps dest!: ccte_relation_ccap_relation) apply (rule exI, rule conjI, assumption) apply (auto intro: valid_capAligned dest: ctes_of_valid')[1] apply assumption apply (simp only: when_def if_to_top_of_bind) apply (rule ccorres_if_lhs) apply (simp add: from_bool_def true_def) apply (simp add: from_bool_def false_def) apply (simp add: guard_is_UNIV_def) apply (clarsimp simp: cte_wp_at_ctes_of) done lemmas checkCapAt_ccorres2 = checkCapAt_ccorres[where g=return, simplified bind_return] lemma cte_is_derived_capMasterCap_strg: "cte_wp_at' (is_derived' (ctes_of s) ptr cap \ cteCap) ptr s \ cte_wp_at' (\scte. capMasterCap (cteCap scte) = capMasterCap cap \ P) ptr s" by (clarsimp simp: cte_wp_at_ctes_of is_derived'_def badge_derived'_def) lemma invokeTCB_ThreadControl_ccorres: "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and tcb_inv_wf' (ThreadControl target slot faultep mcp priority cRoot vRoot buf) and (\_. (faultep = None) = (cRoot = None) \ (cRoot = None) = (vRoot = None) \ (case buf of Some (ptr, Some (cap, slot)) \ slot \ 0 | _ \ True))) (UNIV \ {s. target_' s = tcb_ptr_to_ctcb_ptr target} \ {s. (cRoot \ None \ buf \ None) \ slot_' s = cte_Ptr slot} \ {s. faultep_' s = option_to_0 faultep} \ {s. mcp_' s = case_option 0 (ucast o fst) mcp} \ {s. priority_' s = case_option 0 (ucast o fst) priority} \ {s. case cRoot of None \ True | Some (cRootCap, cRootSlot) \ ccap_relation cRootCap (cRoot_newCap_' s)} \ {s. cRoot_srcSlot_' s = cte_Ptr (option_to_0 (option_map snd cRoot))} \ {s. case vRoot of None \ True | Some (vRootCap, vRootSlot) \ ccap_relation vRootCap (vRoot_newCap_' s)} \ {s. vRoot_srcSlot_' s = cte_Ptr (option_to_0 (option_map snd vRoot))} \ {s. bufferAddr_' s = option_to_0 (option_map fst buf)} \ {s. bufferSrcSlot_' s = cte_Ptr (case buf of Some (ptr, Some (cap, slot)) \ slot | _ \ 0)} \ {s. case buf of Some (ptr, Some (cap, slot)) \ ccap_relation cap (bufferCap_' s) | _ \ True} \ {s. updateFlags_' s = (if mcp \ None then scast thread_control_update_mcp else 0) || (if priority \ None then scast thread_control_update_priority else 0) || (if buf \ None then scast thread_control_update_ipc_buffer else 0) || (if cRoot \ None then scast thread_control_update_space else 0)}) [] (invokeTCB (ThreadControl target slot faultep mcp priority cRoot vRoot buf)) (Call invokeTCB_ThreadControl_'proc)" (is "ccorres ?rvr ?xf (?P and (\_. ?P')) ?Q [] ?af ?cf") supply option.case_cong_weak[cong] apply (rule ccorres_gen_asm) apply (cinit lift: target_' slot_' faultep_' mcp_' priority_' cRoot_newCap_' cRoot_srcSlot_' vRoot_newCap_' vRoot_srcSlot_' bufferAddr_' bufferSrcSlot_' bufferCap_' updateFlags_') apply csymbr apply (simp add: liftE_bindE case_option_If2 thread_control_flag_defs word_ao_dist if_and_helper if_n_0_0 tcb_cnode_index_defs[THEN ptr_add_assertion_positive[OF ptr_add_assertion_positive_helper]] del: Collect_const cong: call_ignore_cong if_cong) apply (rule_tac P="ptr_val (tcb_ptr_to_ctcb_ptr target) && ~~ mask 4 = ptr_val (tcb_ptr_to_ctcb_ptr target) \ ptr_val (tcb_ptr_to_ctcb_ptr target) && 0xFFFFFE00 = target" in ccorres_gen_asm) apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow_novcg) apply (rule ccorres_cond_both'[where Q=\ and Q'=\]) apply (simp add: Collect_const_mem) apply (rule ccorres_move_c_guard_tcb) apply (rule threadSet_ccorres_lemma2[where P=\]) apply vcg apply clarsimp apply (subst StateSpace.state.fold_congs[OF refl refl]) apply (rule globals.fold_congs[OF refl refl]) apply (rule heap_update_field_hrs) apply (simp add: typ_heap_simps) apply (fastforce intro: typ_heap_simps) apply simp apply (erule(1) rf_sr_tcb_update_no_queue2, (simp add: typ_heap_simps)+) apply (rule ball_tcb_cte_casesI, simp+) apply (clarsimp simp: ctcb_relation_def option_to_0_def) apply (rule ccorres_return_Skip) apply (rule ceqv_refl) apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow_novcg) apply (rule ccorres_cond_both'[where Q=\ and Q'=\]) apply (simp add: Collect_const_mem) apply (ctac add: setMCPriority_ccorres) apply (rule ccorres_return_Skip) apply (rule ceqv_refl) apply (rule ccorres_subgoal_tailE) apply (rule ccorres_subgoal_tailE) apply (rule_tac A="invs' and sch_act_simple and tcb_at' target and (\(s::kernel_state). (case priority of None \ True | Some x \ ((\y. fst y \ maxPriority)) x)) and case_option \ (case_option \ (valid_cap' \ fst) \ snd) buf and case_option \ (case_option \ (cte_at' \ snd) \ snd) buf and K (case_option True (swp is_aligned msg_align_bits \ fst) buf) and K (case_option True (case_option True (isArchObjectCap \ fst) \ snd) buf)" (* bits of tcb_inv_wf' *) in ccorres_guard_imp2[where A'=UNIV]) apply (rule ccorres_Cond_rhs_Seq) apply (simp only: if_True Collect_True split_def bindE_assoc) apply (rule ccorres_rhs_assoc)+ apply csymbr apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq)+ apply csymbr apply (simp add: liftE_bindE[symmetric] bindE_assoc getThreadBufferSlot_def locateSlot_conv o_def del: Collect_const) apply (simp add: liftE_bindE del: Collect_const) apply (ctac(no_vcg) add: cteDelete_ccorres) apply (simp del: Collect_const add: Collect_False) apply (rule ccorres_move_c_guard_tcb) apply (rule ccorres_split_nothrow_novcg) apply (rule threadSet_ccorres_lemma2[where P=\]) apply vcg apply clarsimp apply (erule(1) rf_sr_tcb_update_no_queue2, (simp add: typ_heap_simps')+, simp_all?)[1] apply (rule ball_tcb_cte_casesI, simp+) apply (clarsimp simp: ctcb_relation_def option_to_0_def) apply (rule ceqv_refl) apply csymbr apply (simp add: ccorres_cond_iffs Collect_False split_def del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) (* P *) apply (rule ccorres_rhs_assoc)+ apply (simp add: case_option_If2 if_n_0_0 split_def del: Collect_const) apply (rule checkCapAt_ccorres) apply ceqv apply csymbr apply (simp add: true_def Collect_True del: Collect_const) apply (rule ccorres_rhs_assoc)+ apply (rule checkCapAt_ccorres) apply ceqv apply csymbr apply (simp add: true_def Collect_True del: Collect_const) apply (simp add: assertDerived_def bind_assoc del: Collect_const) apply (rule ccorres_symb_exec_l) apply (ctac(no_vcg) add: cteInsert_ccorres) apply (rule ccorres_pre_getCurThread) apply (rule ccorres_split_nothrow_novcg_dc) apply (simp add: when_def) apply (rename_tac curThread) apply (rule_tac C'="{s. target = curThread}" and Q="\s. ksCurThread s = curThread" and Q'=UNIV in ccorres_rewrite_cond_sr) apply (clarsimp simp: Collect_const_mem rf_sr_ksCurThread) apply (rule ccorres_Cond_rhs; clarsimp) apply (ctac (no_vcg) add: rescheduleRequired_ccorres[unfolded dc_def]) apply (rule ccorres_return_Skip') apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_cond2[where R=\], simp add: Collect_const_mem) apply (ctac add: setPriority_ccorres) apply (rule ccorres_return_Skip) apply (rule ccorres_return_CE, simp+)[1] apply (wp (once)) apply (clarsimp simp: guard_is_UNIV_def) apply (wpsimp wp: when_def static_imp_wp) apply (strengthen sch_act_wf_weak, wp) apply clarsimp apply wp apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem) apply (rule hoare_strengthen_post[ where Q= "\rv s. Invariants_H.valid_queues s \ valid_objs' s \ weak_sch_act_wf (ksSchedulerAction s) s \ ((\a b. priority = Some (a, b)) \ tcb_at' target s \ ksCurDomain s \ maxDomain \ valid_queues' s \ fst (the priority) \ maxPriority)"]) apply (strengthen sch_act_wf_weak) apply (wp static_imp_wp) apply (clarsimp split: if_splits) apply (wp empty_fail_stateAssert hoare_case_option_wp | simp del: Collect_const)+ apply csymbr apply (simp add: false_def Collect_False ccorres_cond_iffs del: Collect_const) apply (rule ccorres_pre_getCurThread) apply (rename_tac curThread) apply (rule ccorres_split_nothrow_novcg_dc) apply (simp add: when_def to_bool_def) apply (rule_tac C'="{s. target = curThread}" and Q="\s. ksCurThread s = curThread" and Q'=UNIV in ccorres_rewrite_cond_sr) apply (clarsimp simp: Collect_const_mem rf_sr_ksCurThread) apply (rule ccorres_Cond_rhs; clarsimp) apply (ctac (no_vcg) add: rescheduleRequired_ccorres[unfolded dc_def]) apply (rule ccorres_return_Skip') apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_cond2[where R=\], simp add: Collect_const_mem) apply (ctac add: setPriority_ccorres) apply (rule ccorres_return_Skip) apply (rule ccorres_return_CE, simp+) apply wp apply (clarsimp simp: guard_is_UNIV_def) apply (simp add: when_def) apply (wp hoare_vcg_if_lift2(1) static_imp_wp, strengthen sch_act_wf_weak; wp) apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem) apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem tcbBuffer_def size_of_def cte_level_bits_def tcbIPCBufferSlot_def) apply csymbr apply (simp add: Collect_False false_def del: Collect_const) apply (rule ccorres_cond_false_seq, simp) apply (rule ccorres_pre_getCurThread) apply (rename_tac curThread) apply (simp add: when_def to_bool_def) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule_tac C'="{s. target = curThread}" and Q="\s. ksCurThread s = curThread" and Q'=UNIV in ccorres_rewrite_cond_sr) apply (clarsimp simp: Collect_const_mem rf_sr_ksCurThread) apply (rule ccorres_Cond_rhs; clarsimp) apply (ctac(no_vcg) add: rescheduleRequired_ccorres[unfolded dc_def]) apply (rule ccorres_return_Skip') apply (rule ccorres_split_nothrow_novcg_dc) apply(rule ccorres_cond2[where R=\], simp add: Collect_const_mem) apply(ctac add: setPriority_ccorres) apply(rule ccorres_return_Skip) apply (rule ccorres_return_CE, simp+) apply wp apply (clarsimp simp: guard_is_UNIV_def) apply (wp hoare_vcg_if_lift2(1) static_imp_wp, strengthen sch_act_wf_weak; wp) apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem) apply (simp add: guard_is_UNIV_def false_def Collect_const_mem) apply (clarsimp simp: ccap_relation_def cap_thread_cap_lift cap_to_H_def) apply simp apply (rule ccorres_cond_false_seq, simp) apply (rule ccorres_cond_false_seq, simp) apply (simp split: option.split_asm) apply (rule ccorres_pre_getCurThread) apply (rename_tac curThread) apply (simp add: when_def to_bool_def) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule_tac C'="{s. target = curThread}" and Q="\s. ksCurThread s = curThread" and Q'=UNIV in ccorres_rewrite_cond_sr) apply (clarsimp simp: Collect_const_mem rf_sr_ksCurThread) apply (rule ccorres_Cond_rhs; clarsimp) apply (ctac(no_vcg) add: rescheduleRequired_ccorres[unfolded dc_def]) apply (rule ccorres_return_Skip') apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_cond2[where R=\], simp add: Collect_const_mem) apply (ctac add: setPriority_ccorres) apply (rule ccorres_return_Skip) apply (rule ccorres_return_CE, simp+) apply wp apply (clarsimp simp: guard_is_UNIV_def) apply wpsimp apply (wp static_imp_wp, strengthen sch_act_wf_weak, wp ) apply wp apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem) apply (simp cong: conj_cong) apply (rule hoare_strengthen_post[ where Q="\a b. (Invariants_H.valid_queues b \ valid_objs' b \ sch_act_wf (ksSchedulerAction b) b \ ((\a b. priority = Some (a, b)) \ tcb_at' target b \ ksCurDomain b \ maxDomain \ valid_queues' b \ fst (the priority) \ maxPriority)) \ ((case snd (the buf) of None \ 0 | Some x \ snd x) \ 0 \ invs' b \ valid_cap' (capability.ThreadCap target) b \ valid_cap' (fst (the (snd (the buf)))) b \ (cte_wp_at' (\a. is_derived' (map_to_ctes (ksPSpace b)) (snd (the (snd (the buf)))) (fst (the (snd (the buf)))) (cteCap a)) (snd (the (snd (the buf)))) b \ cte_wp_at' (\scte. capMasterCap (cteCap scte) = capMasterCap (fst (the (snd (the buf)))) \ is_simple_cap' (fst (the (snd (the buf))))) (snd (the (snd (the buf)))) b \ valid_mdb' b \ pspace_aligned' b \ cte_wp_at' (\c. True) (snd (the (snd (the buf)))) b))"]) prefer 2 apply fastforce apply (strengthen cte_is_derived_capMasterCap_strg invs_queues invs_weak_sch_act_wf invs_sch_act_wf' invs_valid_objs' invs_mdb' invs_pspace_aligned', simp add: o_def) apply (rule_tac P="is_aligned (fst (the buf)) msg_align_bits" in hoare_gen_asm) apply (wp threadSet_ipcbuffer_trivial static_imp_wp | simp | strengthen invs_sch_act_wf' invs_valid_objs' invs_weak_sch_act_wf invs_queues invs_valid_queues' | wp hoare_drop_imps)+ (* \ P *) apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem option_to_0_def split: option.split_asm) apply (clarsimp simp: ccap_relation_def cap_thread_cap_lift cap_to_H_def) apply (rule ccorres_split_throws) apply (rule ccorres_return_C_errorE, simp+)[1] apply vcg apply (simp add: conj_comms cong: conj_cong) apply (strengthen invs_ksCurDomain_maxDomain') apply (wp hoare_vcg_const_imp_lift_R cteDelete_invs') apply simp apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_cond2[where R=\], simp add: Collect_const_mem) apply (ctac add: setPriority_ccorres) apply (rule ccorres_return_Skip) apply (rule ccorres_return_CE, simp+) apply wp apply (clarsimp simp: guard_is_UNIV_def) apply (clarsimp simp: inQ_def Collect_const_mem cintr_def exception_defs tcb_cnode_index_defs) apply (simp add: tcbBuffer_def tcbIPCBufferSlot_def word_sle_def cte_level_bits_def from_bool_def true_def size_of_def case_option_If2 ) apply (rule conjI) apply (clarsimp simp: case_option_If2 if_n_0_0 objBits_simps' valid_cap'_def capAligned_def word_bits_conv obj_at'_def projectKOs) apply (clarsimp simp: invs_valid_objs' invs_valid_queues' Invariants_H.invs_queues invs_ksCurDomain_maxDomain') apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_rhs_assoc)+ apply csymbr apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq)+ apply (simp add: split_def getThreadVSpaceRoot_def locateSlot_conv bindE_assoc liftE_bindE del: Collect_const) apply csymbr apply (ctac(no_vcg) add: cteDelete_ccorres) apply (simp add: liftE_bindE Collect_False ccorres_cond_iffs dc_def del: Collect_const) apply ((rule ccorres_split_nothrow_novcg_dc[rotated], assumption) | rule ccorres_rhs_assoc2)+ apply (simp add: conj_comms pred_conj_def) apply (simp add: o_def cong: conj_cong option.case_cong) apply (wp checked_insert_tcb_invs' hoare_case_option_wp checkCap_inv [where P="tcb_at' p0" for p0] checkCap_inv [where P="cte_at' p0" for p0] checkCap_inv [where P="valid_cap' c" for c] checkCap_inv [where P="sch_act_simple"] | simp)+ apply (simp add: guard_is_UNIV_def) apply (thin_tac "ccorres a1 a2 a3 a4 a5 a6 a7" for a1 a2 a3 a4 a5 a6 a7) apply (rule ccorres_rhs_assoc)+ apply (rule checkCapAt_ccorres2) apply ceqv apply csymbr apply (simp add: true_def Collect_True del: Collect_const) apply (rule ccorres_rhs_assoc)+ apply (rule checkCapAt_ccorres2) apply ceqv apply csymbr apply (simp add: true_def Collect_True assertDerived_def bind_assoc ccorres_cond_iffs dc_def[symmetric] del: Collect_const) apply (rule ccorres_symb_exec_l) apply (ctac add: cteInsert_ccorres) apply (wp empty_fail_stateAssert hoare_case_option_wp | simp del: Collect_const)+ apply csymbr apply (simp add: false_def Collect_False ccorres_cond_iffs del: Collect_const) apply (rule ccorres_return_Skip[unfolded dc_def]) apply (fastforce simp: guard_is_UNIV_def Kernel_C.tcbVTable_def tcbVTableSlot_def cte_level_bits_def size_of_def) apply csymbr apply (simp add: false_def Collect_False del: Collect_const) apply (rule ccorres_cond_false) apply (rule ccorres_return_Skip[unfolded dc_def]) apply (clarsimp simp: guard_is_UNIV_def false_def ccap_relation_def cap_thread_cap_lift cap_to_H_def) apply simp apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply (simp add: conj_comms, simp cong: conj_cong add: invs_mdb' invs_pspace_aligned') apply (simp add: cte_is_derived_capMasterCap_strg o_def) apply (wp cteDelete_invs' hoare_case_option_wp cteDelete_deletes cteDelete_sch_act_simple | strengthen invs_valid_objs')+ apply (rule hoare_post_imp_R[where Q' = "\r. invs'"]) apply (wp cteDelete_invs') apply (clarsimp simp:cte_wp_at_ctes_of) apply simp apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_rhs_assoc)+ apply csymbr apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq)+ apply (simp add: split_def getThreadCSpaceRoot_def locateSlot_conv bindE_assoc liftE_bindE del: Collect_const) apply csymbr apply (ctac(no_vcg) add: cteDelete_ccorres) apply (simp add: liftE_bindE Collect_False ccorres_cond_iffs dc_def del: Collect_const) apply ((rule ccorres_split_nothrow_novcg_dc[rotated], assumption) | rule ccorres_rhs_assoc2)+ apply (simp add: conj_comms pred_conj_def) apply (simp add: o_def cong: conj_cong option.case_cong) apply (wp checked_insert_tcb_invs' hoare_case_option_wp checkCap_inv [where P="tcb_at' p0" for p0] checkCap_inv [where P="cte_at' p0" for p0] checkCap_inv [where P="valid_cap' c" for c] checkCap_inv [where P="sch_act_simple"] | simp)+ apply (fastforce simp: guard_is_UNIV_def Kernel_C.tcbVTable_def tcbVTableSlot_def cte_level_bits_def size_of_def tcb_cnode_index_defs) apply (thin_tac "ccorres a1 a2 a3 a4 a5 a6 a7" for a1 a2 a3 a4 a5 a6 a7) apply (rule ccorres_rhs_assoc)+ apply (rule checkCapAt_ccorres2) apply ceqv apply csymbr apply (simp add: true_def Collect_True del: Collect_const) apply (rule ccorres_rhs_assoc)+ apply (rule checkCapAt_ccorres2) apply ceqv apply csymbr apply (simp add: true_def Collect_True assertDerived_def bind_assoc ccorres_cond_iffs dc_def[symmetric] del: Collect_const) apply (rule ccorres_symb_exec_l) apply (ctac add: cteInsert_ccorres) apply (wp empty_fail_stateAssert hoare_case_option_wp | simp del: Collect_const)+ apply csymbr apply (simp add: false_def Collect_False ccorres_cond_iffs del: Collect_const) apply (rule ccorres_return_Skip[unfolded dc_def]) apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem Kernel_C.tcbCTable_def tcbCTableSlot_def cte_level_bits_def size_of_def option_to_0_def) apply csymbr apply (simp add: false_def Collect_False del: Collect_const) apply (rule ccorres_cond_false) apply (rule ccorres_return_Skip[unfolded dc_def]) apply (clarsimp simp: guard_is_UNIV_def false_def ccap_relation_def cap_thread_cap_lift cap_to_H_def) apply simp apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply (simp add: conj_comms, simp cong: conj_cong add: invs_mdb' invs_pspace_aligned') apply (simp add: cte_is_derived_capMasterCap_strg o_def) apply (wp cteDelete_invs' hoare_case_option_wp cteDelete_deletes cteDelete_sch_act_simple | strengthen invs_valid_objs')+ apply (rule hoare_post_imp_R[where Q' = "\r. invs'"]) apply (wp cteDelete_invs') apply (clarsimp simp:cte_wp_at_ctes_of) apply simp apply (simp add: conj_comms) apply (wp hoare_case_option_wp threadSet_invs_trivial setMCPriority_invs' typ_at_lifts[OF setMCPriority_typ_at'] threadSet_cap_to' static_imp_wp | simp)+ apply (clarsimp simp: guard_is_UNIV_def tcbCTableSlot_def Kernel_C.tcbCTable_def cte_level_bits_def size_of_def word_sle_def option_to_0_def true_def from_bool_def cintr_def Collect_const_mem) apply (simp add: conj_comms) apply (wp hoare_case_option_wp threadSet_invs_trivial threadSet_cap_to' static_imp_wp | simp)+ apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem) apply (clarsimp simp: inQ_def) apply (subst is_aligned_neg_mask_eq) apply (simp add: tcb_ptr_to_ctcb_ptr_def) apply (rule aligned_add_aligned) apply (fastforce simp add: obj_at'_def projectKOs objBits_simps') apply (simp add: ctcb_offset_defs is_aligned_def) apply (simp add: word_bits_conv) apply simp apply (subgoal_tac "s \' capability.ThreadCap target") apply (clarsimp simp: cte_level_bits_def Kernel_C.tcbCTable_def Kernel_C.tcbVTable_def tcbCTableSlot_def tcbVTableSlot_def size_of_def tcb_cte_cases_def isCap_simps split: option.split_asm dest!: isValidVTableRootD) apply (clarsimp simp: valid_cap'_def capAligned_def word_bits_conv obj_at'_def objBits_simps' projectKOs) done lemma setupReplyMaster_ccorres: "ccorres dc xfdc (tcb_at' t) (UNIV \ {s. thread_' s = tcb_ptr_to_ctcb_ptr t}) [] (setupReplyMaster t) (Call setupReplyMaster_'proc)" apply (cinit lift: thread_') apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq)+ apply ctac apply (simp del: Collect_const add: dc_def[symmetric]) apply (rule ccorres_pre_getCTE) apply (rule ccorres_move_c_guard_cte) apply (rule_tac F="\rv'. (rv' = scast cap_null_cap) = (cteCap oldCTE = NullCap)" and R="cte_wp_at' ((=) oldCTE) rv" and xf'=ret__unsigned_' in ccorres_symb_exec_r_abstract_UNIV[where R'=UNIV]) apply (rule conseqPre, vcg) apply (clarsimp simp: cte_wp_at_ctes_of) apply (erule(1) cmap_relationE1[OF cmap_relation_cte]) apply (clarsimp simp: typ_heap_simps cap_get_tag_isCap dest!: ccte_relation_ccap_relation) apply ceqv apply (simp only:) apply (rule ccorres_when[where R=\]) apply (simp add: Collect_const_mem) apply (rule ccorres_symb_exec_l [OF _ _ _ empty_fail_stateAssert]) apply (rule_tac P="cte_at' rv and tcb_at' t" in ccorres_from_vcg[where P'=UNIV]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: cte_wp_at_ctes_of) apply (rule cmap_relationE1[OF cmap_relation_cte], assumption+) apply (rule conjI, fastforce intro: typ_heap_simps) apply (clarsimp simp: typ_heap_simps) apply (rule fst_setCTE[OF ctes_of_cte_at], assumption) apply (rule rev_bexI, assumption) apply (clarsimp simp: rf_sr_def cstate_relation_def cpspace_relation_def Let_def typ_heap_simps') apply (subst setCTE_tcb_case, assumption+) apply (rule_tac r="s'" in KernelStateData_H.kernel_state.cases) apply clarsimp apply (rule conjI) apply (erule(2) cmap_relation_updI) apply (clarsimp simp: ccte_relation_def cap_reply_cap_lift cte_lift_def cong: option.case_cong_weak) apply (simp add: cte_to_H_def cap_to_H_def mdb_node_to_H_def nullMDBNode_def c_valid_cte_def) apply (simp add: cap_reply_cap_lift) apply (subst is_aligned_neg_mask_weaken) apply (erule is_aligned_tcb_ptr_to_ctcb_ptr) apply (simp add: ctcb_size_bits_def) apply (simp add: true_def mask_def to_bool_def) apply simp apply (simp add: cmachine_state_relation_def typ_heap_simps' carch_state_relation_def carch_globals_def cvariable_array_map_const_add_map_option[where f="tcb_no_ctes_proj"]) apply (wp | simp)+ apply (clarsimp simp: guard_is_UNIV_def) apply (wp | simp add: locateSlot_conv)+ apply vcg apply (clarsimp simp: word_sle_def cte_wp_at_ctes_of tcb_cnode_index_defs tcbReplySlot_def) done lemma restart_ccorres: "ccorres dc xfdc (invs' and tcb_at' thread and sch_act_simple) (UNIV \ {s. target_' s = tcb_ptr_to_ctcb_ptr thread}) [] (restart thread) (Call restart_'proc)" apply (cinit lift: target_') apply (ctac(no_vcg) add: isStopped_ccorres) apply (simp only: when_def) apply (rule ccorres_cond2[where R=\]) apply (simp add: to_bool_def Collect_const_mem) apply (rule ccorres_rhs_assoc)+ apply (ctac(no_vcg) add: cancelIPC_ccorres1[OF cteDeleteOne_ccorres]) apply (ctac(no_vcg) add: setupReplyMaster_ccorres) apply (ctac(no_vcg)) apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres) apply (ctac add: possibleSwitchTo_ccorres) apply (wp weak_sch_act_wf_lift)[1] apply (wp sts_valid_queues setThreadState_st_tcb)[1] apply (simp add: valid_tcb_state'_def) apply wp apply (wp (once) sch_act_wf_lift, (wp tcb_in_cur_domain'_lift)+) apply (rule hoare_strengthen_post) apply (rule hoare_vcg_conj_lift) apply (rule delete_one_conc_fr.cancelIPC_invs) apply (rule cancelIPC_tcb_at'[where t=thread]) apply fastforce apply (rule ccorres_return_Skip) apply (wp hoare_drop_imps) apply (auto simp: Collect_const_mem mask_def "StrictC'_thread_state_defs") done lemma setNextPC_ccorres: "ccorres dc xfdc \ (UNIV \ \\thread = tcb_ptr_to_ctcb_ptr thread\ \ {s. v_' s = val}) [] (asUser thread (setNextPC val)) (Call setNextPC_'proc)" apply (cinit') apply (simp add: setNextPC_def) apply (ctac add: setRegister_ccorres) apply simp done lemma Arch_performTransfer_ccorres: "ccorres (K (K \) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') \ UNIV [] (liftE (performTransfer a b c)) (Call Arch_performTransfer_'proc)" apply (cinit' simp: performTransfer_def) apply (fold returnOk_liftE) apply (rule ccorres_return_CE) apply simp+ done (*FIXME: arch_split: C kernel names hidden by Haskell names *) abbreviation "frameRegistersC \ kernel_all_substitute.frameRegisters" lemmas frameRegistersC_def = kernel_all_substitute.frameRegisters_def abbreviation "gpRegistersC \ kernel_all_substitute.gpRegisters" lemmas gpRegistersC_def = kernel_all_substitute.gpRegisters_def lemma frame_gp_registers_convs: "length ARM_H.frameRegisters = unat n_frameRegisters" "length ARM_H.gpRegisters = unat n_gpRegisters" "n < length ARM_H.frameRegisters \ index frameRegistersC n = register_from_H (ARM_H.frameRegisters ! n)" "n < length ARM_H.gpRegisters \ index gpRegistersC n = register_from_H (ARM_H.gpRegisters ! n)" apply (simp_all add: ARM_H.gpRegisters_def ARM_H.frameRegisters_def ARM.gpRegisters_def n_gpRegisters_def ARM.frameRegisters_def n_frameRegisters_def frameRegistersC_def gpRegistersC_def msgRegisters_unfold fupdate_def Arrays.update_def toEnum_def upto_enum_def fromEnum_def enum_register) apply (auto simp: less_Suc_eq fcp_beta Kernel_C.LR_def R14_def) done lemma postModifyRegisters_ccorres: "ccorres dc xfdc \ UNIV hs (asUser dest $ postModifyRegisters ct dest) (Call Arch_postModifyRegisters_'proc)" apply (cinit simp: postModifyRegisters_def) apply (subst asUser_return) apply (rule ccorres_stateAssert) apply (rule ccorres_return_Skip) apply simp done lemma invokeTCB_CopyRegisters_ccorres: "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and tcb_at' destn and tcb_at' source and ex_nonz_cap_to' destn and ex_nonz_cap_to' source) (UNIV \ {s. dest_' s = tcb_ptr_to_ctcb_ptr destn} \ {s. tcb_src_' s = tcb_ptr_to_ctcb_ptr source} \ {s. to_bool (resumeTarget_' s) = resume} \ {s. to_bool (suspendSource_' s) = susp} \ {s. to_bool (transferFrame_' s) = frames} \ {s. to_bool (transferInteger_' s) = ints}) [] (invokeTCB (CopyRegisters destn source susp resume frames ints arch)) (Call invokeTCB_CopyRegisters_'proc)" including no_take_bit apply (cinit lift: dest_' tcb_src_' resumeTarget_' suspendSource_' transferFrame_' transferInteger_' simp: whileAnno_def) apply (simp add: liftE_def bind_assoc whileAnno_def del: Collect_const) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_when[where R=\]) apply (simp add: to_bool_def del: Collect_const) apply (ctac add: suspend_ccorres[OF cteDeleteOne_ccorres]) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_when[where R=\]) apply (simp add: to_bool_def del: Collect_const) apply (ctac add: restart_ccorres) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_when[where R=\]) apply (simp add: to_bool_def Collect_const_mem) apply (rule ccorres_rhs_assoc)+ apply (csymbr, csymbr, csymbr) apply (rule ccorres_rhs_assoc2, rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_rel_imp) apply (rule ccorres_mapM_x_while[where F="\x. tcb_at' destn and tcb_at' source"]) apply clarsimp apply (rule ccorres_guard_imp2) apply (ctac(no_vcg) add: getRegister_ccorres) apply (ctac add: setRegister_ccorres) apply wp apply (clarsimp simp: frame_gp_registers_convs n_frameRegisters_def unat_of_nat32 word_bits_def word_of_nat_less) apply (simp add: frame_gp_registers_convs n_frameRegisters_def) apply (rule allI, rule conseqPre, vcg) apply clarsimp apply (wp | simp)+ apply (simp add: frame_gp_registers_convs n_frameRegisters_def word_bits_def) apply simp apply (ctac(no_vcg) add: getRestartPC_ccorres) apply (ctac add: setNextPC_ccorres) apply wp+ apply (clarsimp simp: guard_is_UNIV_def) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule ccorres_when[where R=\]) apply (simp add: to_bool_def Collect_const_mem) apply (rule ccorres_rhs_assoc)+ apply (csymbr, csymbr) apply (rule ccorres_rel_imp) apply (rule ccorres_mapM_x_while[where F="\x. tcb_at' destn and tcb_at' source"]) apply clarsimp apply (rule ccorres_guard_imp2) apply ((wp | ctac(no_vcg) add: getRegister_ccorres setRegister_ccorres)+)[1] apply (clarsimp simp: frame_gp_registers_convs n_gpRegisters_def unat_of_nat32 word_bits_def word_of_nat_less) apply (simp add: frame_gp_registers_convs n_gpRegisters_def) apply (rule allI, rule conseqPre, vcg) apply clarsimp apply (wp | simp)+ apply (simp add: word_bits_def frame_gp_registers_convs n_gpRegisters_def) apply simp apply (rule ccorres_pre_getCurThread) apply (ctac add: postModifyRegisters_ccorres[simplified]) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule_tac R="\s. rvd = ksCurThread s" in ccorres_when) apply (clarsimp simp: rf_sr_ksCurThread) apply clarsimp apply (ctac (no_vcg) add: rescheduleRequired_ccorres) apply (simp only: liftE_bindE[symmetric] return_returnOk) apply (ctac(no_vcg) add: Arch_performTransfer_ccorres) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply simp apply wp+ apply (clarsimp simp: guard_is_UNIV_def) apply simp apply (wpsimp simp: postModifyRegisters_def pred_conj_def cong: if_cong wp: hoare_drop_imps) apply vcg apply (wp hoare_drop_imp) apply (simp add: pred_conj_def guard_is_UNIV_def cong: if_cong | wp mapM_x_wp_inv hoare_drop_imp)+ apply clarsimp apply (rule_tac Q="\rv. invs' and tcb_at' destn" in hoare_strengthen_post[rotated]) apply (fastforce simp: sch_act_wf_weak) apply (wpsimp wp: hoare_drop_imp restart_invs')+ apply (clarsimp simp add: guard_is_UNIV_def) apply (wp hoare_drop_imp hoare_vcg_if_lift)+ apply simp apply (rule_tac Q="\rv. invs' and tcb_at' destn" in hoare_strengthen_post[rotated]) apply (fastforce simp: sch_act_wf_weak) apply (wpsimp wp: hoare_drop_imp)+ apply (clarsimp simp add: guard_is_UNIV_def) apply (clarsimp simp: to_bool_def invs_weak_sch_act_wf invs_valid_objs' split: if_split cong: if_cong | rule conjI)+ apply (clarsimp dest!: global'_no_ex_cap simp: invs'_def valid_state'_def | rule conjI)+ done lemma invokeTCB_WriteRegisters_ccorres_helper: "\ unat (f (of_nat n)) = incn \ g (of_nat n) = register_from_H reg \ n'=incn \ of_nat n < bnd \ of_nat n < bnd2 \ \ ccorres dc xfdc (sysargs_rel args buffer and sysargs_rel_n args buffer n' and tcb_at' dst and P) (\\i = of_nat n\) hs (asUser dst (setRegister reg (sanitiseRegister tcb reg (args ! incn)))) (\ret__unsigned_long :== CALL getSyscallArg(f (\i),option_to_ptr buffer);; Guard ArrayBounds \\i < bnd\ (\unsigned_long_eret_2 :== CALL sanitiseRegister(g (\i),\ret__unsigned_long,from_bool t));; Guard ArrayBounds \\i < bnd2\ (CALL setRegister(tcb_ptr_to_ctcb_ptr dst,g (\i),\unsigned_long_eret_2)))" apply (rule ccorres_guard_imp2) apply (rule ccorres_add_return) apply (rule ccorres_rhs_assoc)+ apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n="incn" and buffer=buffer]) apply (rule ccorres_symb_exec_r) apply (ctac add: setRegister_ccorres) apply vcg apply (rule conseqPre, vcg, clarsimp) apply wp apply simp apply (vcg exspec=getSyscallArg_modifies) apply (fastforce) done lemma doMachineOp_context: "(rv,s') \ fst (doMachineOp f s) \ (rv,s'\ksPSpace := ksPSpace s(t \ KOTCB (tcbContext_update (\_. st) ko))\) \ fst (doMachineOp f (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbContext_update (\_. st) ko))\))" apply (clarsimp simp: doMachineOp_def split_def in_monad select_f_def) apply fastforce done lemma getObject_context: " \(x, s') \ fst (getObject t' s); ko_at' ko t s\ \ (if t = t' then tcbContext_update (\_. st) x else x, s'\ksPSpace := ksPSpace s(t \ KOTCB (tcbContext_update (\_. st) ko))\) \ fst (getObject t' (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbContext_update (\_. st) ko))\))" apply (simp split: if_split) apply (rule conjI) apply clarsimp apply (clarsimp simp: getObject_def split_def loadObject_default_def in_monad Corres_C.in_magnitude_check' projectKOs objBits_simps') apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs objBits_simps) apply (simp add: magnitudeCheck_def in_monad split: option.splits) apply clarsimp apply (simp add: lookupAround2_char2) apply (clarsimp split: if_split_asm) apply (erule_tac x=x2 in allE) apply (clarsimp simp: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE) apply simp apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply clarsimp apply (clarsimp simp: getObject_def split_def loadObject_default_def in_monad Corres_C.in_magnitude_check' projectKOs objBits_simps') apply (simp add: magnitudeCheck_def in_monad split: option.splits) apply clarsimp apply (simp add: lookupAround2_char2) apply (clarsimp split: if_split_asm) apply (erule_tac x=t in allE) apply simp apply (clarsimp simp: obj_at'_real_def projectKOs ko_wp_at'_def objBits_simps) apply (simp add: ps_clear_def) apply (drule_tac x=t in orthD2) apply fastforce apply clarsimp apply (erule impE) apply simp apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (erule_tac x=x2 in allE) apply (clarsimp simp: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE) apply (rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply fastforce done lemma threadGet_context: "\ (uc, s') \ fst (threadGet (atcbContextGet o tcbArch) (ksCurThread s) s); ko_at' ko t s; t \ ksCurThread s \ \ (uc, s'\ksPSpace := ksPSpace s(t \ KOTCB (tcbArch_update (\_. atcbContextSet st (tcbArch ko)) ko))\) \ fst (threadGet (atcbContextGet o tcbArch) (ksCurThread s) (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbArch_update (\_. atcbContextSet st (tcbArch ko)) ko))\))" apply (clarsimp simp: threadGet_def liftM_def in_monad) apply (drule (1) getObject_context [where st=st]) apply (rule exI) apply (erule conjI) apply (simp split: if_splits) done lemma asUser_context: "\(x,s) \ fst (asUser (ksCurThread s) f s); ko_at' ko t s; \s. \(=) s\ f \\_. (=) s\ ; t \ ksCurThread s\ \ (x,s\ksPSpace := ksPSpace s(t \ KOTCB (tcbArch_update (\_. atcbContextSet st (tcbArch ko)) ko))\) \ fst (asUser (ksCurThread s) f (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbArch_update (\_. atcbContextSet st (tcbArch ko)) ko))\))" apply (clarsimp simp: asUser_def in_monad select_f_def) apply (frule use_valid, rule threadGet_inv [where P="(=) s"], rule refl) apply (frule use_valid, assumption, rule refl) apply clarsimp apply (frule (2) threadGet_context) apply (intro exI) apply (erule conjI) apply (rule exI, erule conjI) apply (clarsimp simp: threadSet_def in_monad) apply (frule use_valid, rule getObject_inv [where P="(=) s"]) apply (simp add: loadObject_default_def) apply wp apply simp apply (rule refl) apply clarsimp apply (frule (1) getObject_context) apply (intro exI) apply (erule conjI) apply (clarsimp simp: setObject_def split_def updateObject_default_def threadGet_def Corres_C.in_magnitude_check' getObject_def loadObject_default_def liftM_def objBits_simps' projectKOs in_monad) apply (clarsimp simp: magnitudeCheck_def in_monad split: option.splits) apply (rule conjI) apply clarsimp apply (cases s, simp) apply (rule ext, clarsimp split: if_split) apply (case_tac tcb, simp) apply clarsimp apply (rule conjI) apply (clarsimp simp add: lookupAround2_char2 split: if_split_asm) apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs objBits_simps) apply (erule_tac x=t in allE) apply simp apply (simp add: ps_clear_def) apply (drule_tac x=t in orthD2) apply fastforce apply clarsimp apply (erule impE, simp) apply (erule notE, rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (erule_tac x=x2 in allE) apply simp apply (simp add: ps_clear_def) apply (drule_tac x=x2 in orthD2) apply fastforce apply clarsimp apply (erule impE) apply (rule word_diff_ls'(3)) apply unat_arith apply (drule is_aligned_no_overflow) apply simp apply (erule impE, simp) apply simp apply (rule exI) apply (rule conjI, fastforce) apply clarsimp apply (cases s, clarsimp) apply (rule ext, clarsimp split: if_split) apply (case_tac tcb, clarsimp) done lemma getMRs_rel_context: "\getMRs_rel args buffer s; (cur_tcb' and case_option \ valid_ipc_buffer_ptr' buffer) s; ko_at' ko t s ; t \ ksCurThread s\ \ getMRs_rel args buffer (s\ksPSpace := ksPSpace s(t \ KOTCB (tcbArch_update (\_. atcbContextSet st (tcbArch ko)) ko))\)" apply (clarsimp simp: getMRs_rel_def) apply (rule exI, erule conjI) apply (subst (asm) det_wp_use, rule det_wp_getMRs) apply (simp add: cur_tcb'_def) apply (subst det_wp_use, rule det_wp_getMRs) apply (simp add: cur_tcb'_def) apply (rule conjI) apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs objBits_simps ps_clear_def split: if_split) apply (clarsimp simp: valid_ipc_buffer_ptr'_def split: option.splits) apply (clarsimp simp: typ_at'_def ko_wp_at'_def projectKOs obj_at'_real_def objBits_simps ps_clear_def split: if_split) apply (clarsimp simp: getMRs_def in_monad) apply (frule use_valid, rule asUser_inv [where P="(=) s"]) apply (wp mapM_wp' getRegister_inv)[1] apply simp apply clarsimp apply (drule (1) asUser_context) apply (wp mapM_wp' getRegister_inv)[1] apply assumption apply (intro exI) apply (erule conjI) apply (cases buffer) apply (clarsimp simp: return_def) apply clarsimp apply (drule mapM_upd_inv [rotated -1]) prefer 3 apply fastforce prefer 2 apply wp apply (clarsimp simp: loadWordUser_def in_monad stateAssert_def word_size simp del: fun_upd_apply) apply (rule conjI) apply (clarsimp simp: pointerInUserData_def typ_at'_def ko_wp_at'_def projectKOs ps_clear_def obj_at'_real_def split: if_split) apply (erule doMachineOp_context) done lemma asUser_getMRs_rel: "\(\s. t \ ksCurThread s) and getMRs_rel args buffer and cur_tcb' and case_option \ valid_ipc_buffer_ptr' buffer \ asUser t f \\_. getMRs_rel args buffer\" apply (simp add: asUser_def) apply (rule hoare_pre, wp) apply (simp add: threadSet_def) apply (simp add: setObject_def split_def updateObject_default_def) apply wp apply (simp del: fun_upd_apply) apply (wp getObject_tcb_wp) apply (wp threadGet_wp)+ apply (clarsimp simp del: fun_upd_apply) apply (drule obj_at_ko_at')+ apply (clarsimp simp del: fun_upd_apply) apply (rule exI, rule conjI, assumption) apply (clarsimp split: if_split simp del: fun_upd_apply) apply (erule getMRs_rel_context, simp) apply (clarsimp simp: obj_at'_real_def ko_wp_at'_def projectKOs) apply simp done lemma asUser_sysargs_rel: "\\s. t \ ksCurThread s \ sysargs_rel args buffer s\ asUser t f \\_. sysargs_rel args buffer\" apply (cases buffer, simp_all add: sysargs_rel_def) apply (rule hoare_pre) apply (wp asUser_getMRs_rel hoare_valid_ipc_buffer_ptr_typ_at'|simp)+ done lemma threadSet_same: "\\s. \tcb'. ko_at' tcb' t s \ tcb = f tcb'\ threadSet f t \\rv. ko_at' tcb t\" unfolding threadSet_def by (wpsimp wp: setObject_tcb_strongest getObject_tcb_wp) fastforce lemma invokeTCB_WriteRegisters_ccorres[where S=UNIV]: notes static_imp_wp [wp] shows "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and tcb_at' dst and ex_nonz_cap_to' dst and sch_act_simple and sysargs_rel args buffer and (\s. dst \ ksCurThread s) and (\_. values = take someNum (drop 2 args) \ someNum + 2 \ length args)) ({s. unat (n_' s) = length values} \ S \ {s. unat (n_' s) = length values} \ {s. dest_' s = tcb_ptr_to_ctcb_ptr dst} \ {s. resumeTarget_' s = from_bool resume} \ {s. buffer_' s = option_to_ptr buffer}) [] (invokeTCB (WriteRegisters dst resume values arch)) (Call invokeTCB_WriteRegisters_'proc)" including no_take_bit apply (rule ccorres_gen_asm) apply (erule conjE) apply (cinit lift: n_' dest_' resumeTarget_' buffer_' simp: whileAnno_def) (* using S not univ seems to stop cinit doing this? *) apply (csymbr, csymbr, csymbr, csymbr) apply (simp add: liftE_def bind_assoc del: Collect_const) apply (rule ccorres_pre_getCurThread) apply (rule_tac P="\a. ccorres_underlying rf_sr \ r' xf arrel axf P P' hs a c" for r' xf arrel axf P P' hs c in subst) apply (rule liftE_bindE) apply (ctac add: Arch_performTransfer_ccorres) apply (simp add: Collect_False whileAnno_def del: Collect_const) apply (rule ccorres_add_return) apply (rule_tac xf'=n_' and r'="\rv rv'. rv' = min n (scast n_frameRegisters + scast n_gpRegisters)" in ccorres_split_nothrow) apply (rule_tac P'="{s. n_' s = n}" in ccorres_from_vcg[where P=\]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: return_def min_def) apply (simp add: linorder_not_less[symmetric] n_gpRegisters_def n_frameRegisters_def) apply ceqv apply (ctac add: Arch_getSanitiseRegisterInfo_ccorres) apply (simp add: zipWithM_mapM split_def zip_append1 mapM_discarded mapM_x_append del: Collect_const) apply (simp add: asUser_bind_distrib getRestartPC_def setNextPC_def bind_assoc del: Collect_const) apply (simp only: getRestartPC_def[symmetric] setNextPC_def[symmetric]) apply (simp add: asUser_mapM_x bind_assoc) apply (rule ccorres_stateAssert) apply (rule ccorres_rhs_assoc2, rule ccorres_split_nothrow_novcg) apply (rule_tac F="\n. sysargs_rel args buffer and sysargs_rel_n args buffer (n + 2) and tcb_at' dst and (\s. dst \ ksCurThread s)" and Q=UNIV in ccorres_mapM_x_whileQ) apply clarsimp apply (rule invokeTCB_WriteRegisters_ccorres_helper [where args=args]) apply (simp add: unat_word_ariths frame_gp_registers_convs n_frameRegisters_def unat_of_nat32 word_bits_def word_of_nat_less) apply (simp add: n_frameRegisters_def n_gpRegisters_def frame_gp_registers_convs word_less_nat_alt) apply (simp add: unat_of_nat32 word_bits_def) apply arith apply clarsimp apply (vcg exspec=setRegister_modifies exspec=getSyscallArg_modifies exspec=sanitiseRegister_modifies) apply clarsimp apply (simp add: sysargs_rel_n_def) apply (rule hoare_pre, wp asUser_sysargs_rel) apply (clarsimp simp: n_msgRegisters_def sysargs_rel_def) apply (simp add: frame_gp_registers_convs n_frameRegisters_def word_bits_def) apply simp apply (rule ceqv_refl) apply (rule ccorres_stateAssert) apply (rule ccorres_rhs_assoc2, rule ccorres_split_nothrow_novcg) apply (rule_tac F="\n. sysargs_rel args buffer and sysargs_rel_n args buffer (n + length ARM_H.frameRegisters + 2) and tcb_at' dst and (\s. dst \ ksCurThread s)" and Q=UNIV in ccorres_mapM_x_whileQ) apply clarsimp apply (rule invokeTCB_WriteRegisters_ccorres_helper [where args=args]) apply (simp add: n_gpRegisters_def unat_word_ariths frame_gp_registers_convs unat_of_nat32 word_bits_def n_frameRegisters_def word_of_nat_less) apply (simp add: n_frameRegisters_def n_gpRegisters_def frame_gp_registers_convs unat_of_nat32 word_less_nat_alt word_bits_def less_diff_conv) apply (simp add: unat_word_ariths cong: conj_cong) apply clarsimp apply (vcg exspec=setRegister_modifies exspec=getSyscallArg_modifies exspec=sanitiseRegister_modifies) apply clarsimp apply (simp add: sysargs_rel_n_def) apply (rule hoare_pre, wp asUser_sysargs_rel) apply (clarsimp simp: n_msgRegisters_def frame_gp_registers_convs n_frameRegisters_def) apply arith apply (simp add: ARM_H.gpRegisters_def word_bits_def ARM.gpRegisters_def) apply simp apply (rule ceqv_refl) apply (ctac(no_vcg) add: getRestartPC_ccorres) apply simp apply (ctac(no_vcg) add: setNextPC_ccorres) apply (ctac (no_vcg) add: postModifyRegisters_ccorres[simplified]) apply (rule ccorres_split_nothrow_novcg) apply (rule ccorres_when[where R=\]) apply (simp add: from_bool_0 Collect_const_mem) apply (rule_tac xf'="\_. 0" in ccorres_call) apply (rule restart_ccorres) apply simp apply (simp add: xfdc_def) apply simp apply (rule ceqv_refl) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule_tac R="\s. rv = ksCurThread s" in ccorres_when) apply (clarsimp simp: rf_sr_ksCurThread) apply clarsimp apply (ctac (no_vcg) add: rescheduleRequired_ccorres) apply (unfold return_returnOk)[1] apply (rule ccorres_return_CE, simp+)[1] apply wp apply (simp add: guard_is_UNIV_def) apply (wp hoare_drop_imp) apply (rule_tac Q="\rv. invs' and tcb_at' dst" in hoare_strengthen_post[rotated]) apply (fastforce simp: sch_act_wf_weak) apply (wpsimp wp: restart_invs')+ apply (clarsimp simp add: guard_is_UNIV_def) apply (wp hoare_drop_imp hoare_vcg_if_lift)+ apply simp apply (rule mapM_x_wp') apply (wpsimp) apply (simp add: guard_is_UNIV_def) apply (rule hoare_drop_imps) apply (simp add: sysargs_rel_n_def) apply (rule mapM_x_wp') apply (rule hoare_pre, wp asUser_sysargs_rel) apply clarsimp apply (simp add: guard_is_UNIV_def) apply (wp) apply vcg apply (wp threadGet_wp) apply vcg apply (rule ccorres_inst[where P=\ and P'=UNIV]) apply simp apply (simp add: performTransfer_def) apply wp apply clarsimp apply vcg apply (clarsimp simp: n_msgRegisters_def sysargs_rel_n_def split: if_split) apply (rule conjI) apply (cases args, simp) apply (case_tac list, simp) apply (case_tac lista, clarsimp simp: unat_eq_0) apply simp apply (clarsimp simp: frame_gp_registers_convs word_less_nat_alt sysargs_rel_def n_frameRegisters_def n_msgRegisters_def split: if_split_asm) apply (simp add: invs_weak_sch_act_wf invs_valid_objs' invs_queues) apply (fastforce dest!: global'_no_ex_cap simp: invs'_def valid_state'_def) done lemma invokeTCB_Suspend_ccorres: "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and tcb_at' t and ex_nonz_cap_to' t) (UNIV \ {s. thread_' s = tcb_ptr_to_ctcb_ptr t}) [] (invokeTCB (Suspend t)) (Call invokeTCB_Suspend_'proc)" apply (cinit lift: thread_') apply (simp add: liftE_def return_returnOk) apply (ctac(no_vcg) add: suspend_ccorres[OF cteDeleteOne_ccorres]) apply (rule ccorres_return_CE, simp+)[1] apply wp apply (clarsimp simp: from_bool_def true_def) apply (auto simp: invs'_def valid_state'_def global'_no_ex_cap) done lemma invokeTCB_Resume_ccorres: "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and tcb_at' t and ex_nonz_cap_to' t and sch_act_simple) (UNIV \ {s. thread_' s = tcb_ptr_to_ctcb_ptr t}) [] (invokeTCB (Resume t)) (Call invokeTCB_Resume_'proc)" apply (cinit lift: thread_') apply (simp add: liftE_def return_returnOk) apply (ctac(no_vcg) add: restart_ccorres) apply (rule ccorres_return_CE, simp+)[1] apply wp apply (clarsimp simp: from_bool_def true_def) done lemma Arch_decodeTransfer_spec: "\s. \ \ {s} Call Arch_decodeTransfer_'proc {s'. ret__unsigned_long_' s' = 0}" by (vcg, simp) lemmas ccorres_split_nothrow_dc = ccorres_split_nothrow[where r'=dc and xf'=xfdc, OF _ ceqv_refl] lemmas getRegister_ccorres_defer = ccorres_defer[OF getRegister_ccorres, OF no_fail_asUser [OF no_fail_getRegister]] lemma msg_registers_convs: "length ARM_H.msgRegisters = unat n_msgRegisters" "n < length ARM_H.msgRegisters \ index msgRegistersC n = register_from_H (ARM_H.msgRegisters ! n)" apply (simp_all add: msgRegisters_unfold ARM.msgRegisters_def n_msgRegisters_def msgRegistersC_def fupdate_def Arrays.update_def) apply (auto simp: less_Suc_eq fcp_beta) done lemma mapM_x_split_append: "mapM_x f xs = do _ \ mapM_x f (take n xs); mapM_x f (drop n xs) od" using mapM_x_append[where f=f and xs="take n xs" and ys="drop n xs"] by simp lemma ccorres_abstract_cong: "\ \s s'. \ P s ; s' \ P'; (s, s') \ sr \ \ a s = b s \ \ ccorres_underlying sr G r xf ar axf P P' hs a c = ccorres_underlying sr G r xf ar axf P P' hs b c" by (simp add: ccorres_underlying_def split_paired_Ball imp_conjL cong: conj_cong xstate.case_cong) lemma valid_ipc_buffer_ptr_the_strengthen: "x \ None \ case_option \ valid_ipc_buffer_ptr' x s \ valid_ipc_buffer_ptr' (the x) s" by clarsimp lemma lookupIPCBuffer_Some_0: "\\\ lookupIPCBuffer w t \\rv s. rv \ Some 0\" apply (simp add: lookupIPCBuffer_def ARM_H.lookupIPCBuffer_def Let_def getThreadBufferSlot_def locateSlot_conv cong: if_cong) apply (wp haskell_assert_wp | wpc | simp)+ done lemma asUser_valid_ipc_buffer_ptr': "\ valid_ipc_buffer_ptr' p \ asUser t m \ \rv s. valid_ipc_buffer_ptr' p s \" by (simp add: valid_ipc_buffer_ptr'_def, wp, auto simp: valid_ipc_buffer_ptr'_def) lemma invokeTCB_ReadRegisters_ccorres: notes nat_min_simps [simp del] wordSize_def' [simp] shows "ccorres ((intr_and_se_rel \ Inr) \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_in_state' ((=) Restart) and tcb_at' target and sch_act_simple and (\s. target \ ksIdleThread s) and (\_. target \ thread)) (UNIV \ {s. tcb_src_' s = tcb_ptr_to_ctcb_ptr target} \ {s. suspendSource_' s = from_bool susp} \ {s. n_' s = n} \ {s. call_' s = from_bool isCall}) [] (doE reply \ invokeTCB (ReadRegisters target susp n archCp); liftE (replyOnRestart thread reply isCall) odE) (Call invokeTCB_ReadRegisters_'proc)" including no_take_bit supply option.case_cong_weak[cong] apply (rule ccorres_gen_asm) apply (cinit' lift: tcb_src_' suspendSource_' n_' call_' simp: invokeTCB_def liftE_bindE bind_assoc) apply (rule ccorres_symb_exec_r) apply (rule_tac xf'=thread_' in ccorres_abstract, ceqv) apply (rename_tac cthread, rule_tac P="cthread = tcb_ptr_to_ctcb_ptr thread" in ccorres_gen_asm2) apply (rule ccorres_split_nothrow_dc) apply (simp add: when_def del: Collect_const split del: if_split) apply (rule ccorres_cond2[where R=\], simp add: from_bool_0 Collect_const_mem) apply (ctac add: suspend_ccorres[OF cteDeleteOne_ccorres]) apply (rule ccorres_return_Skip) apply (rule ccorres_pre_getCurThread) apply (simp only: liftE_bindE[symmetric]) apply (ctac add: Arch_performTransfer_ccorres) apply (simp add: liftE_bindE Collect_False del: Collect_const) apply (simp add: replyOnRestart_def liftE_def bind_assoc when_def replyFromKernel_def if_to_top_of_bind setMRs_def zipWithM_x_mapM_x asUser_mapM_x split_def del: Collect_const cong: if_cong) apply (rule ccorres_symb_exec_l) apply (rule ccorres_symb_exec_l[OF _ _ _ empty_fail_getThreadState]) apply (rule ccorres_if_lhs[OF _ ccorres_False[where P'=UNIV]]) apply (rule ccorres_if_lhs) apply (simp add: Collect_True true_def whileAnno_def del: Collect_const) apply (rule ccorres_rhs_assoc)+ apply csymbr apply (ctac add: lookupIPCBuffer_ccorres) apply (ctac add: setRegister_ccorres) apply (rule ccorres_stateAssert) apply (rule ccorres_rhs_assoc2) apply (rule_tac P="length reply = min (unat n) (unat n_frameRegisters + unat n_gpRegisters)" in ccorres_gen_asm) apply (rule ccorres_split_nothrow_novcg) apply (rule_tac F="\m s. obj_at' (\tcb. map ((atcbContextGet o tcbArch) tcb) (genericTake n (ARM_H.frameRegisters @ ARM_H.gpRegisters)) = reply) target s" in ccorres_mapM_x_while) apply clarsimp apply (rule ccorres_guard_imp2) apply (rule ccorres_add_return, ctac add: getRegister_ccorres_defer [where thread=target]) apply (ctac add: setRegister_ccorres) apply wp apply simp apply (vcg exspec=getRegister_modifies) apply (clarsimp simp: getRegister_def submonad_asUser.guarded_gets) apply (clarsimp simp: simpler_gets_def obj_at'_weakenE[OF _ TrueI] msg_registers_convs) apply (cut_tac x=na in unat_of_nat32) apply (simp add: word_bits_def n_msgRegisters_def) apply (simp add: msg_registers_convs n_msgRegisters_def word_of_nat_less) apply (subgoal_tac "na < unat n_frameRegisters") apply (intro conjI[rotated] allI impI) apply (assumption | erule sym) apply (rule frame_gp_registers_convs) apply (simp add: frame_gp_registers_convs) apply (drule obj_at_ko_at') apply (clarsimp simp: obj_at'_def projectKOs asUser_fetch_def frame_gp_registers_convs genericTake_def nth_append split: if_split) apply (simp add: n_frameRegisters_def n_msgRegisters_def) apply (simp add: frame_gp_registers_convs msg_registers_convs n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def msgMaxLength_def msgLengthBits_def split: option.split) apply (simp add: min_def word_less_nat_alt split: if_split)[1] apply arith apply (rule allI, rule conseqPre, vcg exspec=setRegister_modifies exspec=getRegister_modifies) apply clarsimp apply (wp asUser_obj_at') apply simp apply (simp add: word_bits_def msgMaxLength_def msg_registers_convs n_msgRegisters_def) apply ceqv (* got to split reply into frameregisters part and gpregisters part remaining, match against 2nd and 4th loop. 3rd loop never executes with current configuration *) apply (simp add: msg_registers_convs del: Collect_const) apply (rule iffD2 [OF ccorres_abstract_cong]) apply (rule bind_apply_cong[OF _ refl]) apply (rule_tac n1="min (unat n_frameRegisters - unat n_msgRegisters) (unat n)" in fun_cong [OF mapM_x_split_append]) apply (rule_tac P="rva \ Some 0" in ccorres_gen_asm) apply (subgoal_tac "(ipcBuffer = NULL) = (rva = None)") prefer 2 apply (clarsimp simp: option_to_ptr_def option_to_0_def split: option.split_asm) apply (simp add: bind_assoc del: Collect_const) apply (rule_tac xf'=i_' and r'="\_ rv. unat rv = min (unat n_frameRegisters) (min (unat n) (case rva of None \ unat n_msgRegisters | _ \ unat n_frameRegisters))" in ccorres_split_nothrow_novcg) apply (rule ccorres_Cond_rhs) apply (rule ccorres_rel_imp, rule_tac F="\m s. obj_at' (\tcb. map ((atcbContextGet o tcbArch) tcb) (genericTake n (ARM_H.frameRegisters @ ARM_H.gpRegisters)) = reply) target s \ valid_ipc_buffer_ptr' (the rva) s \ valid_pspace' s" and i="unat n_msgRegisters" in ccorres_mapM_x_while') apply (intro allI impI, elim conjE exE, hypsubst, simp) apply (simp add: less_diff_conv) apply (rule ccorres_guard_imp2) apply (rule ccorres_add_return, ctac add: getRegister_ccorres_defer[where thread=target]) apply (rule ccorres_move_array_assertion_ipc_buffer | (rule ccorres_flip_Guard, rule ccorres_move_array_assertion_ipc_buffer))+ apply (rule storeWordUser_ccorres) apply wp apply (vcg exspec=getRegister_modifies) apply (clarsimp simp: obj_at'_weakenE[OF _ TrueI] word_size unat_gt_0 option_to_ptr_def option_to_0_def) apply (intro conjI[rotated] impI allI) apply (simp add: n_msgRegisters_def n_frameRegisters_def word_less_nat_alt) apply (subst unat_add_lem[THEN iffD1], simp_all add: unat_of_nat)[1] prefer 3 apply (erule sym) apply (simp add: n_msgRegisters_def msg_registers_convs msg_align_bits msgMaxLength_def) apply (simp(no_asm) add: unat_arith_simps unat_of_nat cong: if_cong, simp) apply (simp add: n_msgRegisters_def msg_registers_convs msg_align_bits msgMaxLength_def) apply (simp(no_asm) add: unat_arith_simps unat_of_nat cong: if_cong, simp) apply (simp add: option_to_ptr_def option_to_0_def msg_registers_convs upto_enum_word wordSize_def' del: upt.simps) apply (rule frame_gp_registers_convs) apply (simp add: frame_gp_registers_convs less_diff_conv) apply (subst iffD1 [OF unat_add_lem]) apply (simp add: n_msgRegisters_def n_frameRegisters_def word_le_nat_alt unat_of_nat) apply (simp add: n_frameRegisters_def n_msgRegisters_def unat_of_nat) apply (clarsimp simp: valid_ipc_buffer_ptr'_def) apply (erule aligned_add_aligned) apply (rule is_aligned_mult_triv2[where n=2, simplified]) apply (simp add: msg_align_bits) apply (clarsimp simp: getRegister_def submonad_asUser.guarded_gets obj_at'_weakenE[OF _ TrueI]) apply (clarsimp simp: asUser_fetch_def simpler_gets_def obj_at'_def projectKOs genericTake_def nth_append frame_gp_registers_convs) apply (simp add: n_msgRegisters_def unat_of_nat n_frameRegisters_def) apply (subst iffD1 [OF unat_add_lem]) apply (simp add: unat_of_nat)+ apply (clarsimp simp: less_diff_conv) apply (simp add: frame_gp_registers_convs msg_registers_convs n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def Types_H.msgMaxLength_def Types_H.msgLengthBits_def split: option.split) apply (simp add: min_def word_less_nat_alt split: if_split)[1] apply (simp split: if_split_asm, arith+)[1] apply (rule allI, rule conseqPre, vcg) apply clarsimp apply (wp) apply (clarsimp simp: less_diff_conv) apply (simp add: word_bits_def n_msgRegisters_def n_frameRegisters_def Types_H.msgLengthBits_def Types_H.msgMaxLength_def msg_registers_convs) apply (clarsimp simp: n_msgRegisters_def n_frameRegisters_def msgMaxLength_def Types_H.msgLengthBits_def n_gpRegisters_def msg_registers_convs split: option.split_asm) apply (simp add: min_def split: if_split_asm if_split) apply arith apply (drule_tac s=rv'a in sym, simp) apply (rule_tac P=\ and P'="{s. i_' s = rv'a}" in ccorres_inst) apply clarsimp apply (elim disjE impCE) apply (clarsimp simp: word_le_nat_alt linorder_not_less) apply (subst (asm) unat_of_nat32) apply (simp add: n_msgRegisters_def word_bits_def) apply (clarsimp simp: mapM_x_Nil) apply (rule ccorres_guard_imp2, rule ccorres_return_Skip') apply (simp add: n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def cong: option.case_cong) apply (simp add: min_def split: if_split option.split) apply (simp add: mapM_x_Nil) apply (rule ccorres_guard_imp2, rule ccorres_return_Skip') apply (simp add: n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def cong: option.case_cong) apply (simp add: min_def split: if_split option.split) apply (clarsimp simp only: unat_arith_simps, simp) apply (clarsimp simp: less_diff_conv word_le_nat_alt linorder_not_less) apply (subst(asm) unat_of_nat32) apply (simp add: word_bits_def n_msgRegisters_def) apply (simp add: mapM_x_Nil n_frameRegisters_def n_gpRegisters_def) apply (rule ccorres_guard_imp2, rule ccorres_return_Skip') apply (simp add: n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def cong: option.case_cong) apply ceqv apply csymbr apply csymbr apply (rule iffD1[OF ccorres_expand_while_iff_Seq]) apply (rule ccorres_cond_false) apply (rule ccorres_split_nothrow_novcg) apply (rule_tac xf'=i_' in ccorres_abstract, ceqv) apply (rename_tac i_c, rule_tac P="i_c = 0" in ccorres_gen_asm2) apply (simp add: drop_zip del: Collect_const) apply (rule ccorres_Cond_rhs) apply (simp del: Collect_const) apply (rule_tac F="\m s. obj_at' (\tcb. map ((atcbContextGet o tcbArch) tcb) (genericTake n (ARM_H.frameRegisters @ ARM_H.gpRegisters)) = reply) target s \ valid_ipc_buffer_ptr' (the rva) s \ valid_pspace' s" and i="0" in ccorres_mapM_x_while') apply (clarsimp simp: less_diff_conv drop_zip) apply (rule ccorres_guard_imp2) apply (rule ccorres_add_return, ctac add: getRegister_ccorres_defer[where thread=target]) apply (rule ccorres_move_array_assertion_ipc_buffer | (rule ccorres_flip_Guard, rule ccorres_move_array_assertion_ipc_buffer))+ apply (rule storeWordUser_ccorres) apply wp apply (vcg exspec=getRegister_modifies) apply (clarsimp simp: obj_at'_weakenE[OF _ TrueI] word_size unat_gt_0 option_to_ptr_def option_to_0_def) apply (intro conjI[rotated] impI allI) apply (simp add: n_frameRegisters_def n_msgRegisters_def length_msgRegisters word_of_nat_less n_gpRegisters_def) prefer 3 apply (erule sym) apply (simp add: n_frameRegisters_def n_msgRegisters_def msg_registers_convs msg_align_bits msgMaxLength_def) apply (simp(no_asm) add: unat_arith_simps unat_of_nat cong: if_cong, simp) apply (simp add: n_frameRegisters_def n_msgRegisters_def msg_registers_convs msg_align_bits msgMaxLength_def) apply (simp(no_asm) add: unat_arith_simps unat_of_nat cong: if_cong, simp) apply (simp add: option_to_ptr_def option_to_0_def msg_registers_convs upto_enum_word n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def msgMaxLength_def msgLengthBits_def del: upt.simps upt_rec_numeral) apply (rule frame_gp_registers_convs) apply (simp add: frame_gp_registers_convs n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def msgMaxLength_def msgLengthBits_def unat_of_nat) apply (clarsimp simp: valid_ipc_buffer_ptr'_def, erule aligned_add_aligned) apply (rule is_aligned_mult_triv2[where n=2, simplified]) apply (simp add: msg_align_bits) apply (clarsimp simp: getRegister_def submonad_asUser.guarded_gets obj_at'_weakenE[OF _ TrueI]) apply (clarsimp simp: asUser_fetch_def simpler_gets_def obj_at'_def projectKOs genericTake_def nth_append frame_gp_registers_convs n_frameRegisters_def n_gpRegisters_def n_msgRegisters_def frame_gp_registers_convs cong: if_cong split: if_split) apply (clarsimp simp: frame_gp_registers_convs n_gpRegisters_def min.absorb1 unat_of_nat) apply (clarsimp simp: less_diff_conv) apply (clarsimp simp: nth_append frame_gp_registers_convs n_frameRegisters_def n_gpRegisters_def n_msgRegisters_def frame_gp_registers_convs Types_H.msgMaxLength_def Types_H.msgLengthBits_def msg_registers_convs cong: if_cong split: if_split) apply (simp add: word_less_nat_alt unat_of_nat) apply (simp add: iffD1[OF unat_add_lem] cong: conj_cong) apply (simp add: min_def split: if_split if_split_asm, arith+)[1] apply (rule allI, rule conseqPre, vcg) apply clarsimp apply wp apply (simp add: word_bits_def n_frameRegisters_def n_gpRegisters_def n_msgRegisters_def) apply (simp add: min_less_iff_disj less_imp_diff_less) apply (simp add: drop_zip n_gpRegisters_def) apply (elim disjE impCE) apply (clarsimp simp: mapM_x_Nil) apply (rule ccorres_return_Skip') apply (simp add: linorder_not_less word_le_nat_alt drop_zip mapM_x_Nil n_frameRegisters_def min.absorb1 n_msgRegisters_def) apply (rule ccorres_guard_imp2, rule ccorres_return_Skip') apply simp apply ceqv apply csymbr apply (rule ccorres_rhs_assoc2) apply (ctac (no_vcg) add: setMessageInfo_ccorres) apply (ctac (no_vcg)) apply (rule_tac P=\ and P'=UNIV in ccorres_from_vcg_throws) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: return_def) apply (wp | simp add: valid_tcb_state'_def)+ apply (clarsimp simp: ThreadState_Running_def mask_def) apply (rule mapM_x_wp') apply (rule hoare_pre) apply (wp sch_act_wf_lift valid_queues_lift tcb_in_cur_domain'_lift) apply clarsimp apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem) apply (simp add: message_info_to_H_def) apply (clarsimp simp: n_frameRegisters_def n_msgRegisters_def n_gpRegisters_def field_simps upto_enum_word word_less_nat_alt Types_H.msgMaxLength_def Types_H.msgLengthBits_def simp del: upt.simps split: option.split_asm) apply (clarsimp simp: min_def iffD2 [OF mask_eq_iff_w2p] word_size word_less_nat_alt split: if_split_asm dest!: word_unat.Rep_inverse') apply (clarsimp simp: length_msgRegisters n_msgRegisters_def) apply (clarsimp simp: min_def iffD2 [OF mask_eq_iff_w2p] word_size word_less_nat_alt split: if_split_asm dest!: word_unat.Rep_inverse') apply simp apply (wp mapM_x_wp' sch_act_wf_lift valid_queues_lift static_imp_wp tcb_in_cur_domain'_lift) apply (simp add: n_frameRegisters_def n_msgRegisters_def guard_is_UNIV_def) apply simp apply (rule mapM_x_wp') apply (rule hoare_pre) apply (wp asUser_obj_at'[where t'=target] static_imp_wp asUser_valid_ipc_buffer_ptr') apply clarsimp apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem msg_registers_convs n_msgRegisters_def n_frameRegisters_def n_gpRegisters_def msgMaxLength_def msgLengthBits_def word_less_nat_alt unat_of_nat) apply (wp (once) hoare_drop_imps) apply (wp asUser_obj_at'[where t'=target] static_imp_wp asUser_valid_ipc_buffer_ptr') apply (vcg exspec=setRegister_modifies) apply simp apply (strengthen valid_ipc_buffer_ptr_the_strengthen) apply simp apply (wp lookupIPCBuffer_Some_0 | wp (once) hoare_drop_imps)+ apply (simp add: Collect_const_mem ARM_H.badgeRegister_def ARM.badgeRegister_def "StrictC'_register_defs") apply (vcg exspec=lookupIPCBuffer_modifies) apply (simp add: false_def) apply (ctac(no_vcg) add: setThreadState_ccorres) apply (rule ccorres_from_vcg_throws[where P=\ and P'=UNIV]) apply (rule allI, rule conseqPre, vcg) apply (simp add: return_def) apply wp+ apply (simp cong: rev_conj_cong) apply wp apply (wp asUser_inv mapM_wp' getRegister_inv asUser_get_registers[simplified] static_imp_wp)+ apply (rule hoare_strengthen_post, rule asUser_get_registers) apply (clarsimp simp: obj_at'_def genericTake_def frame_gp_registers_convs) apply arith apply (wp static_imp_wp) apply simp apply (rule ccorres_inst[where P=\ and P'=UNIV], simp) apply (simp add: performTransfer_def) apply wp apply (simp add: Collect_const_mem "StrictC'_thread_state_defs" mask_def) apply vcg apply (rule_tac Q="\rv. invs' and st_tcb_at' ((=) Restart) thread and tcb_at' target" in hoare_post_imp) apply (clarsimp simp: pred_tcb_at') apply (auto elim!: pred_tcb'_weakenE)[1] apply (wp suspend_st_tcb_at') apply (vcg exspec=suspend_modifies) apply vcg apply (rule conseqPre, vcg, clarsimp) apply (clarsimp simp: rf_sr_ksCurThread ct_in_state'_def true_def split: if_split) done lemma capTCBPtr_eq: "\ ccap_relation cap cap'; isThreadCap cap \ \ cap_thread_cap_CL.capTCBPtr_CL (cap_thread_cap_lift cap') = ptr_val (tcb_ptr_to_ctcb_ptr (capTCBPtr cap))" apply (simp add: cap_get_tag_isCap[symmetric]) apply (drule(1) cap_get_tag_to_H) apply clarsimp done lemma decodeReadRegisters_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and (\s. ksCurThread s = thread) and ct_active' and sysargs_rel args buffer and tcb_at' (capTCBPtr cp) and ex_nonz_cap_to' (capTCBPtr cp) and K (isThreadCap cp)) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. call_' s = from_bool isCall} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeReadRegisters args cp >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeReadRegisters_'proc)" apply (cinit' lift: cap_' length___unsigned_long_' call_' buffer_') apply (simp add: decodeReadRegisters_def decodeTransfer_def del: Collect_const cong: list.case_cong) apply wpc apply (drule word_unat.Rep_inverse') apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply wpc apply (drule word_unat.Rep_inverse') apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: word_less_nat_alt Collect_False del: Collect_const) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=1 and buffer=buffer]) apply (rule ccorres_move_const_guards)+ apply (simp add: rangeCheck_def unlessE_whenE whenE_def if_to_top_of_bindE ccorres_seq_cond_raise if_to_top_of_bind del: Collect_const) apply (rule ccorres_cond2[where R=\]) apply (simp add: frame_gp_registers_convs n_frameRegisters_def n_gpRegisters_def Collect_const_mem) apply unat_arith apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def intr_and_se_rel_def syscall_error_rel_def syscall_error_to_H_cases exception_defs Collect_const_mem) apply (simp add: frame_gp_registers_convs n_frameRegisters_def n_gpRegisters_def) apply (simp add: ccorres_invocationCatch_Inr returnOk_bind performInvocation_def del: Collect_const) apply csymbr apply csymbr apply csymbr apply (simp add: liftE_bindE bind_assoc) apply (rule ccorres_pre_getCurThread) apply (rule ccorres_cond_seq) apply (rule_tac R="\s. rv = ksCurThread s \ isThreadCap cp" and P="\s. capTCBPtr cp = rv" in ccorres_cond_both) apply clarsimp apply (frule rf_sr_ksCurThread) apply clarsimp apply (frule (1) cap_get_tag_isCap[symmetric, THEN iffD1]) apply (drule (1) cap_get_tag_to_H) apply clarsimp apply (rule iffI) apply (drule_tac t="ksCurThread s" in sym) apply simp apply simp apply (rule_tac P="capTCBPtr cp = rv" in ccorres_gen_asm) apply simp apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (rule_tac P="capTCBPtr cp \ rv" in ccorres_gen_asm) apply (simp add: returnOk_bind) apply (simp add: ccorres_invocationCatch_Inr del: Collect_const) apply (ctac add: setThreadState_ccorres) apply csymbr apply (rule ccorres_Guard_Seq)+ apply (rule ccorres_nondet_refinement) apply (rule is_nondet_refinement_bindE) apply (rule is_nondet_refinement_refl) apply (simp split: if_split) apply (rule conjI[rotated], rule impI, rule is_nondet_refinement_refl) apply (rule impI) apply (rule is_nondet_refinement_alternative1) apply (simp add: performInvocation_def) apply (rule ccorres_add_returnOk) apply (ctac(no_vcg) add: invokeTCB_ReadRegisters_ccorres) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (wp ct_in_state'_set sts_invs_minor') apply (simp add: Collect_const_mem intr_and_se_rel_def cintr_def exception_defs) apply (vcg exspec=setThreadState_modifies) apply wp apply (vcg exspec=getSyscallArg_modifies) apply wp apply (vcg exspec=getSyscallArg_modifies) apply (clarsimp simp: Collect_const_mem rf_sr_ksCurThread "StrictC'_thread_state_defs" word_sless_def word_sle_def mask_eq_iff_w2p word_size isCap_simps ReadRegistersFlags_defs tcb_at_invs' cap_get_tag_isCap capTCBPtr_eq) apply (frule global'_no_ex_cap[OF invs_valid_global'], clarsimp) apply (rule conjI) apply clarsimp apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (auto simp: ct_in_state'_def n_frameRegisters_def n_gpRegisters_def valid_tcb_state'_def elim!: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')[1] apply (clarsimp simp: from_bool_def word_and_1 split: if_split) done lemma decodeWriteRegisters_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and (\s. ksCurThread s = thread) and ct_active' and K (isThreadCap cp) and valid_cap' cp and (\s. \x \ zobj_refs' cp. ex_nonz_cap_to' x s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeWriteRegisters args cp >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeWriteRegisters_'proc)" apply (cinit' lift: cap_' length___unsigned_long_' buffer_' simp: decodeWriteRegisters_def) apply (rename_tac length' cap') apply (rule ccorres_Cond_rhs_Seq) apply wpc apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: word_less_nat_alt) apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: word_less_nat_alt del: Collect_const) apply (rule_tac P="\a. ccorres rvr xf P P' hs a c" for rvr xf P P' hs c in ssubst, rule bind_cong [OF _ refl], rule list_case_helper, clarsimp simp: tl_drop_1)+ apply (rule ccorres_add_return) apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer]) apply (rule ccorres_add_return) apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=1 and buffer=buffer]) apply (rule_tac P="unat (of_nat (length args) :: word32) = length args" in ccorres_gen_asm) apply (simp add: unat_sub word_le_nat_alt genericLength_def word_less_nat_alt hd_drop_conv_nth2 tl_drop_1 del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: whenE_def throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: whenE_def decodeTransfer_def returnOk_bind del: Collect_const) apply csymbr apply csymbr apply csymbr apply (simp add: liftE_bindE bind_assoc) apply (rule ccorres_pre_getCurThread) apply (rule ccorres_cond_seq) apply (rule_tac R="\s. rv = ksCurThread s \ isThreadCap cp" and P="\s. capTCBPtr cp = rv" in ccorres_cond_both) apply clarsimp apply (frule rf_sr_ksCurThread) apply clarsimp apply (frule (1) cap_get_tag_isCap[symmetric, THEN iffD1]) apply (drule (1) cap_get_tag_to_H) apply clarsimp apply (rule iffI) apply (drule_tac t="ksCurThread s" in sym) apply simp apply simp apply (rule_tac P="capTCBPtr cp = rv" in ccorres_gen_asm) apply simp apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (rule_tac P="capTCBPtr cp \ rv" in ccorres_gen_asm) apply (simp add: returnOk_bind) apply (simp add: ccorres_invocationCatch_Inr del: Collect_const) apply (ctac add: setThreadState_ccorres) apply (rule ccorres_Guard_Seq)+ apply (simp add: performInvocation_def) apply (ctac(no_vcg) add: invokeTCB_WriteRegisters_ccorres [where args=args and someNum="unat (args ! 1)"]) apply (simp add: dc_def[symmetric] o_def) apply (rule ccorres_alternative2, rule ccorres_return_CE, simp+) apply (rule ccorres_return_C_errorE, simp+)[1] apply wp[1] apply simp apply (wp sts_invs_minor' setThreadState_sysargs_rel) apply (simp add: Collect_const_mem cintr_def intr_and_se_rel_def exception_defs) apply (vcg exspec=setThreadState_modifies) apply wp apply (vcg exspec=getSyscallArg_modifies) apply wp apply (vcg exspec=getSyscallArg_modifies) apply (clarsimp simp: Collect_const_mem ct_in_state'_def pred_tcb_at') apply (simp add: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (clarsimp simp: valid_cap'_def "StrictC'_thread_state_defs" mask_eq_iff_w2p word_size rf_sr_ksCurThread WriteRegisters_resume_def word_sle_def word_sless_def numeral_eqs simp del: unsigned_numeral) apply (frule arg_cong[where f="\x. unat (of_nat x :: word32)"], simp(no_asm_use) only: word_unat.Rep_inverse o_def, simp) apply (rule conjI) apply clarsimp apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def word_less_nat_alt) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def word_less_nat_alt) apply (auto simp: genericTake_def cur_tcb'_def linorder_not_less word_le_nat_alt valid_tcb_state'_def elim!: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')[1] apply (intro allI impI) apply (rule disjCI2) apply (clarsimp simp: genericTake_def linorder_not_less) apply (subst hd_conv_nth, clarsimp simp: unat_eq_0) apply (clarsimp simp: from_bool_def word_and_1 split: if_split) done lemma excaps_map_Nil: "(excaps_map caps = []) = (caps = [])" by (simp add: excaps_map_def) lemma decodeCopyRegisters_ccorres: "interpret_excaps extraCaps' = excaps_map extraCaps \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and (\s. ksCurThread s = thread) and ct_active' and (excaps_in_mem extraCaps o ctes_of) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and tcb_at' (capTCBPtr cp) and ex_nonz_cap_to' (capTCBPtr cp) and (\s. \v \ set extraCaps. \y \ zobj_refs' (fst v). ex_nonz_cap_to' y s) and sysargs_rel args buffer and K (isThreadCap cp)) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeCopyRegisters args cp (map fst extraCaps) >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeCopyRegisters_'proc)" apply (cinit' lift: cap_' length___unsigned_long_' current_extra_caps_' buffer_' simp: decodeCopyRegisters_def) apply csymbr apply wpc apply (simp add: if_1_0_0 unat_eq_0) apply (rule ccorres_cond_true_seq) apply (simp add: invocationCatch_def throwError_bind cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: if_1_0_0 del: Collect_const) apply (subst unat_eq_0[symmetric], simp add: Collect_False del: Collect_const) apply csymbr apply (simp add: if_1_0_0 interpret_excaps_test_null decodeTransfer_def del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: excaps_map_def invocationCatch_def throwError_bind null_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: excaps_map_def null_def del: Collect_const) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer]) apply (rule ccorres_symb_exec_r) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply csymbr apply (simp add: cap_get_tag_isCap if_1_0_0 del: Collect_const) apply (rule ccorres_assert2) apply (rule ccorres_Cond_rhs_Seq) apply (rule_tac P="Q' (capTCBPtr rva) rva" for Q' in ccorres_inst) apply (rule ccorres_rhs_assoc)+ apply (csymbr, csymbr) apply (simp add: hd_map del: Collect_const, simp add: hd_conv_nth del: Collect_const) apply (simp only: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (simp add: case_bool_If if_to_top_of_bindE if_to_top_of_bind del: Collect_const cong: if_cong) apply (simp add: to_bool_def returnOk_bind Collect_True ccorres_invocationCatch_Inr performInvocation_def del: Collect_const) apply (ctac add: setThreadState_ccorres) apply csymbr apply (rule ccorres_Guard_Seq)+ apply (ctac add: invokeTCB_CopyRegisters_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (simp add: cintr_def intr_and_se_rel_def exception_defs) apply (vcg exspec=invokeTCB_CopyRegisters_modifies) apply (wp sts_invs_minor') apply (simp add: Collect_const_mem) apply (vcg exspec=setThreadState_modifies) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (simp add: hd_map isCap_simps hd_conv_nth) apply (clarsimp simp: invocationCatch_def throwError_bind split: capability.split, auto simp: throwError_def return_def intr_and_se_rel_def syscall_error_rel_def syscall_error_to_H_cases exception_defs)[1] apply (simp add: getSlotCap_def) apply (wp getCTE_wp) apply (simp add: Collect_const_mem if_1_0_0 cap_get_tag_isCap) apply vcg apply (simp add: Collect_const_mem) apply vcg apply (rule conseqPre, vcg) apply clarsimp apply wp apply (simp add: Collect_const_mem) apply (vcg exspec=getSyscallArg_modifies) apply (clarsimp simp: Collect_const_mem excaps_map_Nil) apply (rule conjI) apply (clarsimp simp: excaps_in_mem_def neq_Nil_conv slotcap_in_mem_def cte_wp_at_ctes_of ct_in_state'_def pred_tcb_at') apply (rule conjI) apply (clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (cut_tac msk=ba and cap="cteCap cte" in capMasterCap_maskCapRights) apply (clarsimp simp: isCap_simps simp del: capMasterCap_maskCapRights) apply (frule ctes_of_valid', clarsimp+) apply (auto simp: valid_cap'_def excaps_map_def valid_tcb_state'_def elim!: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread' interpret_excaps_eq)[1] apply (clarsimp simp: word_sle_def CopyRegistersFlags_defs word_sless_def "StrictC'_thread_state_defs" rf_sr_ksCurThread split: if_split) apply (drule interpret_excaps_eq) apply (clarsimp simp: mask_def excaps_map_def split_def ccap_rights_relation_def rightsFromWord_wordFromRights excaps_map_Nil) apply (simp only: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (clarsimp simp: cap_get_tag_isCap to_bool_def) apply (auto simp: unat_eq_of_nat word_and_1_shiftls word_and_1_shiftl [where n=3,simplified] cap_get_tag_isCap[symmetric] split: if_split_asm) done lemma isDevice_PageCap_ccap_relation: "ccap_relation (capability.ArchObjectCap (arch_capability.PageCap d ref rghts sz data)) cap \ (generic_frame_cap_get_capFIsDevice_CL (cap_lift cap) \ 0) = d" by (clarsimp elim!: ccap_relationE simp: isPageCap_def generic_frame_cap_get_capFIsDevice_CL_def cap_to_H_def Let_def to_bool_def split: arch_capability.split_asm cap_CL.split_asm if_split_asm) lemma checkValidIPCBuffer_ccorres: "ccorres (syscall_error_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs') (UNIV \ {s. vptr_' s = vptr} \ {s. ccap_relation cp (cap_' s)}) [] (checkValidIPCBuffer vptr cp) (Call checkValidIPCBuffer_'proc)" apply (simp add:checkValidIPCBuffer_def ARM_H.checkValidIPCBuffer_def) apply (cases "isArchPageCap cp \ \ isDeviceCap cp") apply (simp only: isCap_simps isDeviceCap.simps, safe)[1] apply (cinit lift: vptr_' cap_') apply (simp add: ARM_H.checkValidIPCBuffer_def if_1_0_0 del: Collect_const) apply csymbr apply csymbr apply (clarsimp simp : if_1_0_0) apply (rule ccorres_symb_exec_r) apply simp apply (rule_tac xf'=ret__int_' in ccorres_abstract, ceqv) apply (rename_tac cond_is_frame) apply (rule ccorres_cond_false_seq) apply simp apply csymbr apply (rule ccorres_cond_false_seq) apply clarsimp apply (simp only:Cond_if_mem) apply (rule ccorres_Cond_rhs_Seq) apply (clarsimp simp add: msgAlignBits_def mask_def whenE_def) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def exception_defs syscall_error_rel_def syscall_error_to_H_cases) apply (simp add: whenE_def msgAlignBits_def mask_def) apply (rule ccorres_return_CE, simp+)[1] apply (clarsimp simp: cap_get_tag_isCap isCap_simps pageSize_def isDevice_PageCap_ccap_relation Collect_const_mem if_1_0_0 word_sle_def) apply vcg apply (clarsimp simp: cap_get_tag_isCap isCap_simps pageSize_def isDevice_PageCap_ccap_relation Collect_const_mem) apply (rule conseqPre, vcg) apply (clarsimp simp: cap_get_tag_isCap isCap_simps pageSize_def isDevice_PageCap_ccap_relation Collect_const_mem if_1_0_0 word_sle_def) apply (clarsimp simp: cap_get_tag_isCap isCap_simps pageSize_def isDevice_PageCap_ccap_relation Collect_const_mem) apply (clarsimp simp: Collect_const_mem if_1_0_0 word_sle_def) apply (cases "isArchPageCap cp") apply (simp only: isCap_simps isDeviceCap.simps, safe)[1] apply (cinit lift: vptr_' cap_') apply (simp add: ARM_H.checkValidIPCBuffer_def if_1_0_0 del: Collect_const) apply csymbr apply csymbr apply (clarsimp simp : if_1_0_0) apply (rule ccorres_symb_exec_r) apply simp apply (rule_tac xf'=ret__int_' in ccorres_abstract, ceqv) apply (rename_tac cond_is_frame) apply (rule ccorres_cond_false_seq) apply simp apply csymbr apply (rule ccorres_cond_true_seq) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def exception_defs syscall_error_rel_def syscall_error_to_H_cases) apply (simp add: cap_get_tag_isCap isCap_simps pageSize_def) apply vcg apply (rule conseqPre, vcg) apply (case_tac cp) apply (clarsimp simp: syscall_error_rel_def syscall_error_to_H_cases isCap_simps exception_defs throwError_def return_def if_1_0_0 split: capability.split arch_capability.split if_split_asm)+ apply (simp add: cap_get_tag_isCap isCap_simps pageSize_def Cond_if_mem) apply (frule ccap_relation_page_is_device) apply (auto simp add: isCap_simps isDeviceCap.simps pageSize_def split: if_splits)[1] apply (cinit lift: vptr_' cap_') apply csymbr apply (simp add: ARM_H.checkValidIPCBuffer_def cap_get_tag_isCap) apply csymbr apply (rule ccorres_cond_true_seq)+ apply (rule ccorres_rhs_assoc)+ apply csymbr apply csymbr apply (simp add: cap_get_tag_isCap) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (case_tac cp) apply (auto simp: syscall_error_rel_def syscall_error_to_H_cases isCap_simps exception_defs throwError_def return_def if_1_0_0 split: capability.split arch_capability.split if_split_asm) done lemma slotCapLongRunningDelete_ccorres: "ccorres ((=) \ from_bool) ret__unsigned_long_' invs' (UNIV \ {s. slot_' s = cte_Ptr slot}) [] (slotCapLongRunningDelete slot) (Call slotCapLongRunningDelete_'proc)" supply subst_all [simp del] apply (cinit lift: slot_') apply (simp add: case_Null_If del: Collect_const) apply (rule ccorres_pre_getCTE) apply (rule ccorres_move_c_guard_cte) apply (rule_tac P="cte_wp_at' ((=) rv) slot" in ccorres_cross_over_guard) apply (rule ccorres_symb_exec_r) apply (rule ccorres_if_lhs) apply (rule ccorres_cond_true_seq) apply (rule ccorres_split_throws, rule ccorres_return_C, simp+) apply vcg apply (rule ccorres_cond_false_seq) apply (rule ccorres_rhs_assoc)+ apply (rule_tac xf'=ret__unsigned_long_' in ccorres_split_nothrow_novcg) apply (ctac add: isFinalCapability_ccorres[where slot=slot]) apply (rule Seq_weak_ceqv) apply (rule Cond_ceqv [OF _ ceqv_refl ceqv_refl]) apply simp apply (rule impI, rule sym, rule mem_simps) apply (clarsimp simp del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_split_throws, rule ccorres_return_C, simp+) apply vcg apply (simp del: Collect_const) apply (rule ccorres_move_c_guard_cte) apply (rule_tac P="cte_wp_at' ((=) rv) slot" in ccorres_from_vcg_throws[where P'=UNIV]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: cte_wp_at_ctes_of return_def) apply (erule(1) cmap_relationE1 [OF cmap_relation_cte]) apply (clarsimp simp: typ_heap_simps cap_get_tag_isCap from_bool_0 dest!: ccte_relation_ccap_relation) apply (simp add: from_bool_def false_def true_def split: bool.split) apply (auto simp add: longRunningDelete_def isCap_simps split: capability.split)[1] apply simp apply (wp hoare_drop_imps isFinalCapability_inv) apply (clarsimp simp: Collect_const_mem guard_is_UNIV_def) apply (rename_tac rv') apply (case_tac rv'; clarsimp simp: false_def true_def) apply vcg apply (rule conseqPre, vcg, clarsimp) apply (clarsimp simp: cte_wp_at_ctes_of) apply (erule(1) cmap_relationE1 [OF cmap_relation_cte]) apply (clarsimp simp: typ_heap_simps cap_get_tag_isCap from_bool_def false_def map_comp_Some_iff dest!: ccte_relation_ccap_relation) done definition isValidVTableRoot_C :: "cap_C \ bool" where "isValidVTableRoot_C cap \ cap_get_tag cap = scast cap_page_directory_cap \ to_bool (capPDIsMapped_CL (cap_page_directory_cap_lift cap))" lemma isValidVTableRoot_spec: "\s. \ \ {s} Call isValidVTableRoot_'proc {s'. ret__unsigned_long_' s' = from_bool (isValidVTableRoot_C (cap_' s))}" apply vcg apply (clarsimp simp: isValidVTableRoot_C_def if_1_0_0 from_bool_0) apply (simp add: from_bool_def to_bool_def false_def split: if_split) done lemma isValidVTableRoot_conv: "\ ccap_relation cap cap' \ \ isValidVTableRoot_C cap' = isValidVTableRoot cap" apply (clarsimp simp: isValidVTableRoot_C_def if_1_0_0 from_bool_0 isValidVTableRoot_def ARM_H.isValidVTableRoot_def) apply (case_tac "isArchCap_tag (cap_get_tag cap')") apply (clarsimp simp: cap_get_tag_isCap cap_get_tag_isCap_ArchObject) apply (case_tac "cap_get_tag cap' = scast cap_page_directory_cap") apply (clarsimp split: arch_capability.split simp: isCap_simps) apply (clarsimp simp: ccap_relation_def map_option_Some_eq2 cap_page_directory_cap_lift cap_to_H_def from_bool_def) apply (clarsimp simp: to_bool_def split: if_split) apply (clarsimp simp: cap_get_tag_isCap cap_get_tag_isCap_ArchObject) apply (simp split: arch_capability.split_asm add: isCap_simps) apply (case_tac "cap_get_tag cap' = scast cap_page_directory_cap") apply (clarsimp simp: cap_page_directory_cap_def isArchCap_tag_def2) apply (clarsimp simp: cap_get_tag_isCap split: capability.split_asm) done lemma updateCapData_spec: "\cap preserve newData. \\ \ccap_relation cap \cap \ preserve = to_bool \preserve \ newData = \newData\ Call updateCapData_'proc \ccap_relation (RetypeDecls_H.updateCapData preserve newData cap) \ret__struct_cap_C\" by (simp add: updateCapData_spec) lemma length_excaps_map: "length (excaps_map xcs) = length xcs" by (simp add: excaps_map_def) lemma getSyscallArg_ccorres_foo': "ccorres (\a rv. rv = ucast (args ! n)) (\x. ucast (ret__unsigned_long_' x)) (sysargs_rel args buffer and sysargs_rel_n args buffer n) (UNIV \ \unat \i = n\ \ \\ipc_buffer = option_to_ptr buffer\) [] (return ()) (Call getSyscallArg_'proc)" apply (insert getSyscallArg_ccorres_foo [where args=args and n=n and buffer=buffer]) apply (clarsimp simp: ccorres_underlying_def) apply (erule (1) my_BallE) apply clarsimp apply (erule allE, erule allE, erule (1) impE) apply (clarsimp simp: return_def unif_rrel_def split: xstate.splits) done lemma tcb_at_capTCBPtr_CL: "ccap_relation cp cap \ valid_cap' cp s \ isThreadCap cp \ tcb_at' (cap_thread_cap_CL.capTCBPtr_CL (cap_thread_cap_lift cap) && ~~mask tcbBlockSizeBits) s" apply (clarsimp simp: cap_get_tag_isCap[symmetric] valid_cap_simps' dest!: cap_get_tag_to_H) apply (frule ctcb_ptr_to_tcb_ptr_mask[OF tcb_aligned'], simp) done lemma checkPrio_ccorres: "ccorres (syscall_error_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (tcb_at' auth) (UNIV \ {s. prio_' s = prio} \ {s. auth_' s = tcb_ptr_to_ctcb_ptr auth}) [] (checkPrio prio auth) (Call checkPrio_'proc)" apply (cinit lift: prio_' auth_') apply (clarsimp simp: liftE_bindE) apply (rule ccorres_split_nothrow_novcg[where r'="\rv rv'. rv' = ucast rv" and xf'=mcp_']) apply (rule threadGet_vcg_corres) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: rf_sr_ksCurThread obj_at'_def projectKOs typ_heap_simps' ctcb_relation_def) apply ceqv apply (simp add: whenE_def del: Collect_const split: if_split) apply (rule conjI; clarsimp) apply (rule ccorres_from_vcg_split_throws) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def syscall_error_rel_def syscall_error_to_H_cases exception_defs Collect_const_mem rf_sr_ksCurThread return_def seL4_MinPrio_def minPriority_def) apply clarsimp apply (rule ccorres_return_CE) apply clarsimp+ apply wp apply (simp add: guard_is_UNIV_def)+ done lemma mcpriority_tcb_at'_prio_bounded': assumes "mcpriority_tcb_at' (\mcp. prio \ ucast mcp) t s" "priorityBits \ len_of TYPE('a)" shows "(prio::'a::len word) \ ucast (max_word :: priority)" using assms by (clarsimp simp: pred_tcb_at'_def obj_at'_def priorityBits_def ucast_le_ucast simp del: unsigned_uminus1 elim!: order.trans) lemmas mcpriority_tcb_at'_prio_bounded = mcpriority_tcb_at'_prio_bounded'[simplified priorityBits_def] lemma decodeTCBConfigure_ccorres: notes tl_drop_1[simp] scast_mask_8 [simp] shows "interpret_excaps extraCaps' = excaps_map extraCaps \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and (\s. ksCurThread s = thread) and ct_active' and (excaps_in_mem extraCaps o ctes_of) and valid_cap' cp and cte_at' slot and K (isThreadCap cp) and ex_nonz_cap_to' (capTCBPtr cp) and tcb_at' (capTCBPtr cp) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. slot_' s = cte_Ptr slot} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeTCBConfigure args cp slot extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeTCBConfigure_'proc)" apply (cinit' lift: cap_' length___unsigned_long_' slot_' current_extra_caps_' buffer_' simp: decodeTCBConfigure_def) apply csymbr apply (clarsimp cong: StateSpace.state.fold_congs globals.fold_congs simp del: Collect_const simp add: interpret_excaps_test_null2 excaps_map_Nil) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_cond_true_seq | simp)+ apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: if_1_0_0 word_less_nat_alt) apply (clarsimp split: list.split simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def Collect_const_mem syscall_error_rel_def exception_defs syscall_error_to_H_cases) apply csymbr apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_cond_true_seq | simp)+ apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: if_1_0_0 word_less_nat_alt) apply (clarsimp split: list.split simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def Collect_const_mem syscall_error_rel_def exception_defs syscall_error_to_H_cases) apply csymbr apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_cond_true_seq | simp)+ apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: if_1_0_0 word_less_nat_alt) apply (clarsimp split: list.split simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def excaps_map_def Collect_const_mem syscall_error_rel_def exception_defs syscall_error_to_H_cases) apply csymbr apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_cond_true_seq | simp)+ apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: if_1_0_0 word_less_nat_alt) apply (clarsimp split: list.split simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def excaps_map_def Collect_const_mem syscall_error_rel_def exception_defs syscall_error_to_H_cases) apply (simp add: if_1_0_0 word_less_nat_alt linorder_not_less del: Collect_const) apply (rename_tac length' cap') apply (subgoal_tac "length extraCaps \ 3") prefer 2 apply (clarsimp simp: idButNot_def interpret_excaps_test_null excaps_map_def neq_Nil_conv) apply (thin_tac "P \ index exc n \ NULL" for P exc n)+ apply (rule_tac P="\a. ccorres rvr xf P P' hs a c" for rvr xf P P' hs c in ssubst, rule bind_cong [OF _ refl], rule list_case_helper, clarsimp)+ apply (simp add: hd_drop_conv_nth2 del: Collect_const) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo'[where args=args and n=1 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=2 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=3 and buffer=buffer]) apply csymbr apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply (rule ccorres_assert2) apply csymbr apply (rule ccorres_move_c_guard_cte) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=1]) apply ctac apply (rule ccorres_assert2) apply csymbr apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=2]) apply (rule ccorres_move_c_guard_cte) apply ctac apply (rule ccorres_assert2) apply (simp add: decodeSetIPCBuffer_def split_def bindE_assoc invocationCatch_use_injection_handler injection_bindE[OF refl refl] injection_handler_returnOk injection_handler_If del: Collect_const cong: if_cong) apply (rule_tac xf'="\s. (bufferCap_' s, bufferSlot_' s)" and r'="\v (cp', sl'). case v of None \ args ! 3 = 0 \ sl' = cte_Ptr 0 | Some (cp, sl) \ ccap_relation cp cp' \ args ! 3 \ 0 \ sl' = cte_Ptr sl" in ccorres_splitE) apply (rule ccorres_cond2[where R=\]) apply (clarsimp simp add: Collect_const_mem numeral_eqs) apply (rule_tac P="\s. args ! 3 = 0" in ccorres_from_vcg[where P'=UNIV]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: returnOk_def return_def) apply (rule ccorres_rhs_assoc)+ apply (rule ccorres_split_nothrowE) apply (simp add: numeral_eqs) apply (ctac add: ccorres_injection_handler_csum1[OF deriveCap_ccorres]) apply ceqv apply simp apply (clarsimp simp: numeral_eqs) apply csymbr apply (rule ccorres_split_nothrowE) apply (ctac add: ccorres_injection_handler_csum1[OF checkValidIPCBuffer_ccorres]) apply ceqv apply (match premises in "ccap_relation _ (deriveCap_ret_C.cap_C ccap)" for ccap \ \rule ccorres_from_vcg [where P'="{s. bufferCap_' s = (deriveCap_ret_C.cap_C ccap) \ bufferSlot_' s = cte_Ptr (snd (extraCaps ! 2))}" and P="\s. args ! 3 \ 0"]\) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: returnOk_def return_def numeral_eqs) apply (rule_tac P'="{s. err' = errstate s}" in ccorres_from_vcg_throws[where P=\]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def intr_and_se_rel_def) apply wp apply simp apply (vcg exspec=checkValidIPCBuffer_modifies) apply simp apply (rule_tac P'="{s. err' = errstate s}" in ccorres_from_vcg_split_throws[where P=\]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def intr_and_se_rel_def syscall_error_rel_def) apply simp apply (wp injection_wp_E [OF refl]) apply (simp add: all_ex_eq_helper Collect_const_mem numeral_eqs) apply (vcg exspec=deriveCap_modifies) apply (rule ceqv_tuple2, ceqv, ceqv) apply (rename_tac rv'dc) apply (rule_tac P="P (fst rv'dc) (snd rv'dc)" and P'="P' (fst rv'dc) (snd rv'dc)" for P P' in ccorres_inst) apply (clarsimp simp: tcb_cnode_index_defs [THEN ptr_add_assertion_positive [OF ptr_add_assertion_positive_helper]] simp del: Collect_const) apply csymbr apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq)+ apply (simp add: decodeSetSpace_def injection_bindE[OF refl] split_def del: Collect_const) apply (simp add: injection_liftE[OF refl] bindE_assoc liftM_def getThreadCSpaceRoot getThreadVSpaceRoot del: Collect_const) apply (simp add: liftE_bindE del: Collect_const) apply (rule ccorres_rhs_assoc)+ apply (ctac add: slotCapLongRunningDelete_ccorres) apply (rule ccorres_move_array_assertion_tcb_ctes) apply (simp del: Collect_const) apply csymbr apply (clarsimp simp add: if_1_0_0 from_bool_0 simp del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_symb_exec_l3 [OF _ _ _ empty_fail_slotCapLongRunningDelete]) apply (simp add: unlessE_def injection_handler_throwError cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule ccorres_cond_true_seq) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply wp+ apply (rule ccorres_rhs_assoc)+ apply csymbr apply (simp del: Collect_const) apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq ccorres_rhs_assoc)+ apply (ctac add: slotCapLongRunningDelete_ccorres) apply (rule ccorres_move_array_assertion_tcb_ctes) apply (simp del: Collect_const) apply csymbr apply (clarsimp simp add: if_1_0_0 from_bool_0 simp del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: unlessE_def injection_handler_throwError cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: unlessE_def injection_handler_returnOk del: Collect_const) apply (rule ccorres_add_return, rule_tac r'="\rv rv'. ccap_relation (if args ! 1 = 0 then fst (hd extraCaps) else updateCapData False (args ! 1) (fst (hd extraCaps))) rv'" and xf'="cRootCap_'" in ccorres_split_nothrow) apply (rule_tac P'="{s. cRootCap = cRootCap_' s}" in ccorres_from_vcg[where P=\]) apply (rule allI, rule conseqPre, vcg) apply (subgoal_tac "extraCaps \ []") apply (clarsimp simp: returnOk_def return_def hd_conv_nth false_def) apply fastforce apply clarsimp apply ceqv apply (ctac add: ccorres_injection_handler_csum1 [OF deriveCap_ccorres]) apply (simp add: Collect_False del: Collect_const) apply (csymbr, csymbr) apply (simp add: cap_get_tag_isCap cnode_cap_case_if del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: injection_handler_throwError cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: injection_handler_returnOk del: Collect_const) apply (rule ccorres_add_return, rule_tac r'="\rv rv'. ccap_relation (if args ! 2 = 0 then fst (extraCaps ! Suc 0) else updateCapData False (args ! 2) (fst (extraCaps ! Suc 0))) rv'" and xf'="vRootCap_'" in ccorres_split_nothrow) apply (rule_tac P'="{s. vRootCap = vRootCap_' s}" in ccorres_from_vcg[where P=\]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: returnOk_def return_def hd_drop_conv_nth2 false_def) apply fastforce apply ceqv apply (ctac add: ccorres_injection_handler_csum1 [OF deriveCap_ccorres]) apply (simp add: Collect_False del: Collect_const) apply csymbr apply csymbr apply (simp add: from_bool_0 isValidVTableRoot_conv del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: injection_handler_throwError cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: injection_handler_returnOk ccorres_invocationCatch_Inr performInvocation_def) apply (ctac add: setThreadState_ccorres) apply csymbr apply (ctac(no_vcg) add: invokeTCB_ThreadControl_ccorres) apply (simp, rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+) apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (simp add: o_def) apply (wp sts_invs_minor' hoare_case_option_wp) apply (simp add: Collect_const_mem cintr_def intr_and_se_rel_def exception_defs cong: option.case_cong) apply (vcg exspec=setThreadState_modifies) apply simp apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply simp apply (wp injection_wp_E[OF refl] hoare_drop_imps) apply (vcg exspec=deriveCap_modifies) apply (simp add: pred_conj_def cong: if_cong) apply wp apply (simp add: Collect_const_mem) apply (vcg) apply simp apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply (simp cong: if_cong) apply (wp injection_wp_E[OF refl] hoare_drop_imps) apply (simp add: Collect_const_mem intr_and_se_rel_def syscall_error_rel_def exception_defs cong: option.case_cong sum.case_cong) apply (simp add: all_ex_eq_helper numeral_eqs) apply (vcg exspec=deriveCap_modifies) apply (simp cong: if_cong) apply wp apply (simp add: Collect_const_mem del: Collect_const) apply vcg apply (simp cong: if_cong) apply (wp | wp (once) hoare_drop_imps)+ apply (simp add: Collect_const_mem all_ex_eq_helper cong: option.case_cong) apply (vcg exspec=slotCapLongRunningDelete_modifies) apply (simp cong: if_cong) apply (wp | wp (once) hoare_drop_imps)+ apply (simp add: Collect_const_mem) apply (vcg exspec=slotCapLongRunningDelete_modifies) apply (simp add: pred_conj_def cong: if_cong) apply (wp injection_wp_E[OF refl] checkValidIPCBuffer_ArchObject_wp) apply simp apply (wp | wp (once) hoare_drop_imps)+ apply (simp add: Collect_const_mem all_ex_eq_helper) apply (rule_tac P="{s. cRootCap_' s = cRootCap \ vRootCap_' s = vRootCap \ bufferAddr_' s = args ! 3 \ ccap_relation cp cap' \ isThreadCap cp \ is_aligned (capTCBPtr cp) tcbBlockSizeBits \ ksCurThread_' (globals s) = tcb_ptr_to_ctcb_ptr thread}" in conseqPre) apply (simp add: cong: option.case_cong) apply (vcg exspec=deriveCap_modifies exspec=checkValidIPCBuffer_modifies) apply (clarsimp simp: excaps_map_def Collect_const_mem ccHoarePost_def numeral_eqs cong: option.case_cong) apply (frule interpret_excaps_eq[rule_format, where n=0], clarsimp) apply (frule interpret_excaps_eq[rule_format, where n=1], clarsimp) apply (frule interpret_excaps_eq[rule_format, where n=2], clarsimp) apply (clarsimp simp: mask_def[where n=4] ccap_rights_relation_def rightsFromWord_wordFromRights capTCBPtr_eq ptr_val_tcb_ptr_mask2[unfolded mask_def objBits_defs, simplified] tcb_cnode_index_defs size_of_def option_to_0_def rf_sr_ksCurThread StrictC'_thread_state_defs mask_eq_iff_w2p word_size from_bool_all_helper all_ex_eq_helper ucast_ucast_mask objBits_defs) apply (subgoal_tac "args \ [] \ extraCaps \ []") apply (simp add: word_sle_def cap_get_tag_isCap numeral_eqs hd_conv_nth hd_drop_conv_nth2 word_FF_is_mask split_def thread_control_update_priority_def thread_control_update_mcp_def thread_control_update_space_def thread_control_update_ipc_buffer_def) apply (auto split: option.split elim!: inl_inrE)[1] apply (fastforce+)[2] apply clarsimp apply (strengthen if_n_updateCapData_valid_strg) apply (wp | wp (once) hoare_drop_imps)+ apply (clarsimp simp: Collect_const_mem all_ex_eq_helper cong: option.case_cong) apply vcg apply simp apply (wp | wp (once) hoare_drop_imps)+ apply (simp add: Collect_const_mem all_ex_eq_helper) apply vcg apply simp apply (wp | wp (once) hoare_drop_imps)+ apply (wpsimp | vcg exspec=getSyscallArg_modifies)+ apply (clarsimp simp: Collect_const_mem all_ex_eq_helper) apply (rule conjI) apply (clarsimp simp: idButNot_def interpret_excaps_test_null excaps_map_def neq_Nil_conv) apply (clarsimp simp: sysargs_rel_to_n word_less_nat_alt) apply (frule invs_mdb') apply (frule(2) tcb_at_capTCBPtr_CL) apply (rule conjI, fastforce) apply (drule interpret_excaps_eq) apply (clarsimp simp: cte_wp_at_ctes_of valid_tcb_state'_def numeral_eqs le_ucast_ucast_le tcb_at_invs' invs_valid_objs' invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'_def obj_at'_def tcb_st_refs_of'_def) apply (erule disjE; simp add: objBits_defs mask_def) apply (clarsimp simp: idButNot_def interpret_excaps_test_null excaps_map_def neq_Nil_conv word_sle_def word_sless_def) apply (frule interpret_excaps_eq[rule_format, where n=0], simp) apply (frule interpret_excaps_eq[rule_format, where n=1], simp) apply (frule interpret_excaps_eq[rule_format, where n=2], simp) apply (clarsimp simp: mask_def[where n=4] ccap_rights_relation_def rightsFromWord_wordFromRights capTCBPtr_eq tcb_cnode_index_defs size_of_def option_to_0_def rf_sr_ksCurThread StrictC'_thread_state_defs mask_eq_iff_w2p word_size from_bool_all_helper) apply (frule(1) tcb_at_h_t_valid [OF tcb_at_invs']) apply (clarsimp simp: typ_heap_simps numeral_eqs isCap_simps valid_cap'_def capAligned_def objBits_simps) done lemma not_isThreadCap_case: "\\isThreadCap cap\ \ (case cap of ThreadCap x \ f x | _ \ g) = g" by (clarsimp simp: isThreadCap_def split: capability.splits) lemma decodeSetMCPriority_ccorres: "\interpret_excaps extraCaps' = excaps_map extraCaps\ \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s) and valid_cap' cp and K (isThreadCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeSetMCPriority args cp extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeSetMCPriority_'proc)" supply Collect_const[simp del] supply dc_simp[simp del] apply (cinit' lift: cap_' length___unsigned_long_' current_extra_caps_' buffer_' simp: decodeSetMCPriority_def) apply (simp cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule ccorres_rhs_assoc2) apply (rule_tac xf'=ret__int_' and R'=UNIV and R=\ and val="from_bool (length args = 0 \ length extraCaps = 0)" in ccorres_symb_exec_r_known_rv) apply vcg apply (force simp: interpret_excaps_test_null excaps_map_def from_bool_def unat_eq_0 split: bool.splits) apply ceqv apply clarsimp apply wpc (* Case args = [] *) apply (rule ccorres_cond_true_seq) apply (clarsimp simp: throwError_bind invocationCatch_def) apply (rule ccorres_rhs_assoc) apply (ccorres_rewrite) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) (* Case args is Cons *) apply wpc (* Sub-case extraCaps = [] *) apply (rule ccorres_cond_true_seq) apply (clarsimp simp: throwError_bind invocationCatch_def) apply (rule ccorres_rhs_assoc) apply (ccorres_rewrite) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) (* Main case where args and extraCaps are both Cons *) apply (rule ccorres_cond_false_seq) apply (simp add: split_def) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo'[where args=args and n=0 and buffer=buffer]) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply csymbr apply (simp add: cap_get_tag_isCap cong: call_ignore_cong) apply (rule ccorres_assert2) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_rhs_assoc) apply ccorres_rewrite apply (clarsimp simp: not_isThreadCap_case throwError_bind invocationCatch_def simp del: id_simps) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (clarsimp simp: isCap_simps) apply csymbr apply csymbr (* Pre-conditions need to depend on the inner value of the thread cap *) apply (rule ccorres_inst[where P="Q (capTCBPtr (fst (extraCaps ! 0)))" and P'="Q' (capTCBPtr (fst (extraCaps ! 0)))" for Q Q']) apply (clarsimp simp: capTCBPtr_eq isCap_simps invocationCatch_use_injection_handler injection_bindE[OF refl refl] bindE_assoc injection_handler_returnOk) apply (ctac add: ccorres_injection_handler_csum1[OF checkPrio_ccorres]) apply (rule_tac P="hd args \ ucast (max_word :: priority)" in ccorres_cross_over_guard_no_st) apply (simp add: ccorres_invocationCatch_Inr performInvocation_def) apply ccorres_rewrite apply (ctac add: setThreadState_ccorres) apply (simp add: invocationCatch_def) apply ccorres_rewrite apply csymbr apply csymbr apply csymbr apply csymbr apply (ctac (no_vcg) add: invokeTCB_ThreadControl_ccorres) (* HACK: delete rules from the simpset to avoid the RVRs getting out of sync *) apply (clarsimp simp del: intr_and_se_rel_simps comp_apply dc_simp) apply (rule ccorres_alternative2) apply (rule ccorres_return_CE; simp) apply (rule ccorres_return_C_errorE; simp) apply wp apply (wpsimp wp: sts_invs_minor') apply simp apply (vcg exspec=setThreadState_modifies) apply simp apply (rename_tac err_c) apply (rule_tac P'="{s. err_c = errstate s}" in ccorres_from_vcg_split_throws) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def intr_and_se_rel_def syscall_error_rel_def) apply simp apply (rule injection_handler_wp) apply (rule checkPrio_wp[simplified validE_R_def]) apply vcg apply (wp | simp | wpc | wp (once) hoare_drop_imps)+ apply vcg apply wp apply (vcg exspec=getSyscallArg_modifies) apply (clarsimp simp: EXCEPTION_SYSCALL_ERROR_def EXCEPTION_NONE_def) apply vcg apply clarsimp apply (rule conjI) apply (clarsimp simp: ct_in_state'_def pred_tcb_at' valid_cap'_def isCap_simps) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (clarsimp simp: maxPriority_def numPriorities_def FF_eq_minus_1) apply (rule conjI, clarsimp) apply (frule mcpriority_tcb_at'_prio_bounded, simp) apply (auto simp: valid_tcb_state'_def le_ucast_ucast_le elim!: obj_at'_weakenE pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')[1] apply (clarsimp simp: interpret_excaps_eq excaps_map_def) apply (simp add: StrictC'_thread_state_defs mask_eq_iff_w2p word_size option_to_0_def) apply (frule rf_sr_ksCurThread) apply (simp only: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (clarsimp simp: valid_cap'_def capAligned_def interpret_excaps_eq excaps_map_def) apply (intro conjI impI allI) apply (clarsimp simp: unat_eq_0 le_max_word_ucast_id cap_get_tag_isCap_unfolded_H_cap isCap_simps)+ done lemma decodeSetPriority_ccorres: "\interpret_excaps extraCaps' = excaps_map extraCaps\ \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s) and valid_cap' cp and K (isThreadCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeSetPriority args cp extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeSetPriority_'proc)" supply Collect_const[simp del] dc_simp[simp del] apply (cinit' lift: cap_' length___unsigned_long_' current_extra_caps_' buffer_' simp: decodeSetPriority_def) apply (simp cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule ccorres_rhs_assoc2) apply (rule_tac xf'=ret__int_' and R'=UNIV and R=\ and val="from_bool (length args = 0 \ length extraCaps = 0)" in ccorres_symb_exec_r_known_rv) apply vcg apply (force simp: interpret_excaps_test_null excaps_map_def from_bool_def unat_eq_0 split: bool.splits) apply ceqv apply clarsimp apply wpc (* Case args = [] *) apply (rule ccorres_cond_true_seq) apply (clarsimp simp: throwError_bind invocationCatch_def) apply (rule ccorres_rhs_assoc) apply (ccorres_rewrite) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) (* Case args is Cons *) apply wpc (* Sub-case extraCaps = [] *) apply (rule ccorres_cond_true_seq) apply (clarsimp simp: throwError_bind invocationCatch_def) apply (rule ccorres_rhs_assoc) apply (ccorres_rewrite) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) (* Main case where args and extraCaps are both Cons *) apply (rule ccorres_cond_false_seq) apply (simp add: split_def) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo'[where args=args and n=0 and buffer=buffer]) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply csymbr apply (simp add: cap_get_tag_isCap cong: call_ignore_cong) apply (rule ccorres_assert2) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_rhs_assoc) apply ccorres_rewrite apply (clarsimp simp: not_isThreadCap_case throwError_bind invocationCatch_def simp del: id_simps) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (clarsimp simp: isCap_simps) apply csymbr apply csymbr (* Pre-conditions need to depend on the inner value of the thread cap *) apply (rule ccorres_inst[where P="Q (capTCBPtr (fst (extraCaps ! 0)))" and P'="Q' (capTCBPtr (fst (extraCaps ! 0)))" for Q Q']) apply (clarsimp simp: capTCBPtr_eq isCap_simps invocationCatch_use_injection_handler injection_bindE[OF refl refl] bindE_assoc injection_handler_returnOk) apply (ctac add: ccorres_injection_handler_csum1[OF checkPrio_ccorres]) apply (rule_tac P="hd args \ ucast (max_word :: priority)" in ccorres_cross_over_guard_no_st) apply (simp add: ccorres_invocationCatch_Inr performInvocation_def) apply ccorres_rewrite apply (ctac add: setThreadState_ccorres) apply (simp add: invocationCatch_def) apply ccorres_rewrite apply csymbr apply csymbr apply csymbr apply csymbr apply (ctac (no_vcg) add: invokeTCB_ThreadControl_ccorres) (* HACK: delete rules from the simpset to avoid the RVRs getting out of sync *) apply (clarsimp simp del: intr_and_se_rel_simps comp_apply dc_simp) apply (rule ccorres_alternative2) apply (rule ccorres_return_CE; simp) apply (rule ccorres_return_C_errorE; simp) apply wp apply (wpsimp wp: sts_invs_minor') apply simp apply (vcg exspec=setThreadState_modifies) apply simp apply (rename_tac err_c) apply (rule_tac P'="{s. err_c = errstate s}" in ccorres_from_vcg_split_throws) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def intr_and_se_rel_def syscall_error_rel_def) apply simp apply (rule injection_handler_wp) apply (rule checkPrio_wp[simplified validE_R_def]) apply vcg apply (wp | simp | wpc | wp (once) hoare_drop_imps)+ apply vcg apply wp apply (vcg exspec=getSyscallArg_modifies) apply (clarsimp simp: EXCEPTION_SYSCALL_ERROR_def EXCEPTION_NONE_def) apply vcg apply clarsimp apply (rule conjI) apply (clarsimp simp: ct_in_state'_def pred_tcb_at' valid_cap'_def isCap_simps) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (clarsimp simp: maxPriority_def numPriorities_def FF_eq_minus_1) apply (rule conjI, clarsimp) apply (frule mcpriority_tcb_at'_prio_bounded, simp) apply (auto simp: valid_tcb_state'_def le_ucast_ucast_le elim!: obj_at'_weakenE pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')[1] apply (clarsimp simp: interpret_excaps_eq excaps_map_def) apply (simp add: StrictC'_thread_state_defs mask_eq_iff_w2p word_size option_to_0_def) apply (frule rf_sr_ksCurThread) apply (simp only: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (clarsimp simp: valid_cap'_def capAligned_def interpret_excaps_eq excaps_map_def) apply (intro conjI impI allI) apply (clarsimp simp: unat_eq_0 le_max_word_ucast_id cap_get_tag_isCap_unfolded_H_cap isCap_simps)+ done lemma ucast_le_8_32_equiv: "x \ UCAST (8 \ 32) max_word \ (UCAST (32 \ 8) x \ y) = (x \ UCAST (8 \ 32) y)" apply (rule iffI) apply (word_bitwise; simp) apply (simp add: le_ucast_ucast_le) done lemma mcpriority_tcb_at'_le_ucast: "pred_tcb_at' itcbMCP (\mcp. x \ UCAST(8 \ 32) mcp) v s \ pred_tcb_at' itcbMCP (\mcp. UCAST(32 \ 8) x \ mcp) v s" by (clarsimp simp: ucast_le_8_32_equiv mcpriority_tcb_at'_prio_bounded simp del: unsigned_uminus1) lemma decodeSetSchedParams_ccorres: "\interpret_excaps extraCaps' = excaps_map extraCaps\ \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and (excaps_in_mem extraCaps \ ctes_of) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s) and valid_cap' cp and K (isThreadCap cp) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeSetSchedParams args cp extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeSetSchedParams_'proc)" supply Collect_const[simp del] dc_simp[simp del] apply (cinit' lift: cap_' length___unsigned_long_' current_extra_caps_' buffer_' simp: decodeSetSchedParams_def) apply (simp cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule ccorres_rhs_assoc2) apply (rule_tac xf'=ret__int_' and R'=UNIV and R=\ and val="from_bool (length args < 2 \ length extraCaps = 0)" in ccorres_symb_exec_r_known_rv) apply vcg apply (auto simp: interpret_excaps_test_null excaps_map_def from_bool_def unat_eq_0 split: bool.splits)[1] apply (unat_arith+)[2] apply ceqv apply clarsimp apply (wpc, rule ccorres_cond_true_seq, clarsimp simp: throwError_bind invocationCatch_def, rule ccorres_rhs_assoc, ccorres_rewrite, fastforce intro: syscall_error_throwError_ccorres_n simp: syscall_error_to_H_cases)+ (* Main case where args and extraCaps are both well-formed *) apply (rule ccorres_cond_false_seq) apply (simp add: split_def) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo'[where args=args and n=0 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo'[where args=args and n=1 and buffer=buffer]) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply csymbr apply (simp add: cap_get_tag_isCap cong: call_ignore_cong) apply (rule ccorres_assert2) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_rhs_assoc) apply ccorres_rewrite apply (clarsimp simp: not_isThreadCap_case throwError_bind invocationCatch_def simp del: id_simps) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (clarsimp simp: isCap_simps) apply csymbr apply csymbr (* Pre-conditions need to depend on the inner value of the thread cap *) apply (rule ccorres_inst[where P="Q (capTCBPtr (fst (extraCaps ! 0)))" and P'="Q' (capTCBPtr (fst (extraCaps ! 0)))" for Q Q']) apply (clarsimp simp: capTCBPtr_eq isCap_simps invocationCatch_use_injection_handler injection_bindE[OF refl refl] bindE_assoc injection_handler_returnOk) apply (ctac add: ccorres_injection_handler_csum1[OF checkPrio_ccorres]) apply (rule_tac P="args ! 0 \ ucast (max_word :: priority)" in ccorres_cross_over_guard_no_st) apply (simp add: ccorres_invocationCatch_Inr performInvocation_def) apply ccorres_rewrite apply (clarsimp simp: capTCBPtr_eq isCap_simps invocationCatch_use_injection_handler injection_bindE[OF refl refl] bindE_assoc injection_handler_returnOk) apply (ctac add: ccorres_injection_handler_csum1[OF checkPrio_ccorres]) apply (rule_tac P="args ! 1 \ ucast (max_word :: priority)" in ccorres_cross_over_guard_no_st) apply (simp add: ccorres_invocationCatch_Inr performInvocation_def) apply ccorres_rewrite apply (ctac add: setThreadState_ccorres) apply (simp add: invocationCatch_def) apply ccorres_rewrite apply csymbr apply csymbr apply csymbr apply csymbr apply (ctac (no_vcg) add: invokeTCB_ThreadControl_ccorres) (* HACK: delete rules from the simpset to avoid the RVRs getting out of sync *) apply (clarsimp simp del: intr_and_se_rel_simps comp_apply dc_simp) apply (rule ccorres_alternative2) apply (rule ccorres_return_CE; simp) apply (rule ccorres_return_C_errorE; simp) apply wp apply (wpsimp wp: sts_invs_minor') apply simp apply (vcg exspec=setThreadState_modifies) apply simp apply (rename_tac err_c) apply (rule_tac P'="{s. err_c = errstate s}" in ccorres_from_vcg_split_throws) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def intr_and_se_rel_def syscall_error_rel_def) apply simp apply (rule injection_handler_wp) apply (rule checkPrio_wp[simplified validE_R_def]) apply vcg apply clarsimp apply ccorres_rewrite apply (rule ccorres_return_C_errorE; simp) apply simp apply (rule injection_handler_wp) apply (rule checkPrio_wp[simplified validE_R_def]) apply vcg apply (wp | simp | wpc | wp (once) hoare_drop_imps)+ apply vcg apply simp apply (rule return_wp) apply (vcg exspec=getSyscallArg_modifies) apply simp apply (rule return_wp) apply simp apply (vcg exspec=getSyscallArg_modifies) apply simp apply (vcg exspec=getSyscallArg_modifies) apply clarsimp apply (rule conjI) apply (clarsimp simp: ct_in_state'_def pred_tcb_at' valid_cap'_def isCap_simps) apply (rule conjI; clarsimp simp: sysargs_rel_to_n n_msgRegisters_def) apply (clarsimp simp: maxPriority_def numPriorities_def FF_eq_minus_1) apply (rule conjI, clarsimp) apply (insert mcpriority_tcb_at'_prio_bounded[where prio="args ! 0"]) apply (insert mcpriority_tcb_at'_prio_bounded[where prio="args ! 1"]) apply (auto simp: valid_tcb_state'_def mcpriority_tcb_at'_le_ucast elim!: obj_at'_weakenE pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')[1] apply (clarsimp simp: interpret_excaps_eq excaps_map_def) apply (simp add: StrictC'_thread_state_defs mask_eq_iff_w2p word_size option_to_0_def) apply (frule rf_sr_ksCurThread) apply (simp only: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (clarsimp simp: valid_cap'_def capAligned_def interpret_excaps_eq excaps_map_def) apply (intro conjI impI allI) apply (clarsimp simp: unat_eq_0 le_max_word_ucast_id thread_control_update_mcp_def thread_control_update_priority_def cap_get_tag_isCap_unfolded_H_cap isCap_simps interpret_excaps_eq excaps_map_def)+ done lemma decodeSetIPCBuffer_ccorres: "interpret_excaps extraCaps' = excaps_map extraCaps \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and cte_at' slot and K (isThreadCap cp) and (excaps_in_mem extraCaps o ctes_of) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. slot_' s = cte_Ptr slot} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeSetIPCBuffer args cp slot extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeSetIPCBuffer_'proc)" apply (cinit' lift: cap_' length___unsigned_long_' slot_' current_extra_caps_' buffer_' simp: decodeSetIPCBuffer_def) apply wpc apply (simp add: unat_eq_0) apply csymbr apply simp apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (simp add: throwError_bind invocationCatch_def) apply (clarsimp simp: throwError_def return_def intr_and_se_rel_def exception_defs syscall_error_rel_def syscall_error_to_H_cases) apply csymbr apply (rule ccorres_cond_false_seq) apply csymbr apply (simp del: Collect_const) apply (simp add: interpret_excaps_test_null excaps_map_Nil if_1_0_0 del: Collect_const) apply wpc apply (simp add: throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (rule ccorres_cond_false_seq) apply (simp add: split_def del: Collect_const) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo [where args=args and n=0 and buffer=buffer]) apply csymbr apply (rule ccorres_move_c_guard_cte) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply ctac apply (rule ccorres_assert2) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: returnOk_bind ccorres_invocationCatch_Inr performInvocation_def) apply csymbr apply (ctac add: setThreadState_ccorres) apply csymbr apply csymbr apply csymbr apply (ctac add: invokeTCB_ThreadControl_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_ThreadControl_modifies) apply simp apply (wp sts_invs_minor') apply (vcg exspec=setThreadState_modifies) apply (simp add: bindE_assoc del: Collect_const) apply (rule ccorres_rhs_assoc)+ apply (csymbr, csymbr) apply (simp add: bindE_bind_linearise) apply (rule ccorres_split_nothrow_case_sum) apply (ctac add: deriveCap_ccorres) apply ceqv apply (simp add: Collect_False del: Collect_const) apply csymbr apply (rule ccorres_split_nothrow_case_sum) apply (ctac add: checkValidIPCBuffer_ccorres) apply ceqv apply (simp add: Collect_False returnOk_bind ccorres_invocationCatch_Inr del: Collect_const) apply (ctac add: setThreadState_ccorres) apply (simp add: performInvocation_def) apply (csymbr, csymbr, csymbr) apply (ctac add: invokeTCB_ThreadControl_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_ThreadControl_modifies) apply simp apply (wp sts_invs_minor') apply (simp add: Collect_const_mem cintr_def intr_and_se_rel_def) apply (vcg exspec=setThreadState_modifies) apply (simp add: invocationCatch_def) apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply simp apply (wp checkValidIPCBuffer_ArchObject_wp) apply (simp add: intr_and_se_rel_def syscall_error_rel_def exception_defs) apply (vcg exspec=checkValidIPCBuffer_modifies) apply (simp add: invocationCatch_def) apply (rule ccorres_split_throws) apply (rule ccorres_return_C_errorE, simp+)[1] apply vcg apply simp apply (wp | wp (once) hoare_drop_imps)+ apply (simp add: Collect_const_mem) apply (vcg exspec=deriveCap_modifies) apply simp apply (wp | wp (once) hoare_drop_imps)+ apply simp apply vcg apply wp apply simp apply (vcg exspec=getSyscallArg_modifies) apply (clarsimp simp: Collect_const_mem if_1_0_0 ct_in_state'_def pred_tcb_at' cintr_def intr_and_se_rel_def exception_defs syscall_error_rel_def) apply (rule conjI) apply (clarsimp simp: excaps_in_mem_def slotcap_in_mem_def) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (frule invs_mdb') apply (frule(2) tcb_at_capTCBPtr_CL) apply (auto simp: isCap_simps valid_cap'_def valid_mdb'_def valid_tcb_state'_def valid_mdb_ctes_def no_0_def excaps_map_def elim: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread' dest!: interpret_excaps_eq)[1] apply (clarsimp simp: option_to_0_def rf_sr_ksCurThread word_sless_def word_sle_def ThreadState_Restart_def mask_def) apply (rule conjI[rotated], clarsimp+) apply (drule interpret_excaps_eq[rule_format, where n=0], simp add: excaps_map_Nil) apply (simp add: mask_def "StrictC'_thread_state_defs" excaps_map_def) apply (clarsimp simp: ccap_rights_relation_def rightsFromWord_wordFromRights cap_get_tag_isCap) apply (frule cap_get_tag_to_H, subst cap_get_tag_isCap, assumption, assumption) apply clarsimp done lemma bindNTFN_alignment_junk: "\ is_aligned tcb tcbBlockSizeBits; bits \ ctcb_size_bits \ \ ptr_val (tcb_ptr_to_ctcb_ptr tcb) && ~~ mask bits = ptr_val (tcb_ptr_to_ctcb_ptr tcb)" apply (clarsimp simp: tcb_ptr_to_ctcb_ptr_def projectKOs) apply (rule is_aligned_neg_mask_eq) apply (erule aligned_add_aligned) apply (erule is_aligned_weaken[rotated]) by (auto simp add: is_aligned_def objBits_defs ctcb_offset_defs) lemma bindNotification_ccorres: "ccorres dc xfdc (invs' and tcb_at' tcb) (UNIV \ {s. tcb_' s = tcb_ptr_to_ctcb_ptr tcb} \ {s. ntfnPtr_' s = ntfn_Ptr ntfnptr}) [] (bindNotification tcb ntfnptr) (Call bindNotification_'proc)" apply (cinit lift: tcb_' ntfnPtr_' simp: bindNotification_def) apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification]) apply (rule_tac P="invs' and ko_at' rv ntfnptr and tcb_at' tcb" and P'=UNIV in ccorres_split_nothrow_novcg) apply (rule ccorres_from_vcg[where rrel=dc and xf=xfdc]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp) apply (frule cmap_relation_ntfn) apply (erule (1) cmap_relation_ko_atE) apply (rule conjI) apply (erule h_t_valid_clift) apply (clarsimp simp: setNotification_def split_def) apply (rule bexI [OF _ setObject_eq]) apply (simp add: rf_sr_def cstate_relation_def Let_def init_def cpspace_relation_def update_ntfn_map_tos typ_heap_simps') apply (elim conjE) apply (intro conjI) \ \tcb relation\ apply (rule cpspace_relation_ntfn_update_ntfn, assumption+) apply (clarsimp simp: cnotification_relation_def Let_def mask_def [where n=2] NtfnState_Waiting_def) apply (case_tac "ntfnObj rv") apply (auto simp: option_to_ctcb_ptr_def obj_at'_def objBits_simps projectKOs bindNTFN_alignment_junk)[4] apply (simp add: carch_state_relation_def typ_heap_simps') apply (simp add: cmachine_state_relation_def) apply (simp add: h_t_valid_clift_Some_iff) apply (simp add: objBits_simps') apply (simp add: objBits_simps) apply assumption apply ceqv apply (rule ccorres_move_c_guard_tcb) apply (simp add: setBoundNotification_def) apply (rule_tac P'=\ and P=\ in threadSet_ccorres_lemma3[unfolded dc_def]) apply vcg apply simp apply (erule (1) rf_sr_tcb_update_no_queue2, (simp add: typ_heap_simps')+, simp_all?)[1] apply (simp add: ctcb_relation_def option_to_ptr_def option_to_0_def) apply simp apply (wp get_ntfn_ko'| simp add: guard_is_UNIV_def)+ done lemma invokeTCB_NotificationControl_bind_ccorres: "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and tcb_inv_wf' (tcbinvocation.NotificationControl t (Some a))) (UNIV \ {s. tcb_' s = tcb_ptr_to_ctcb_ptr t} \ {s. ntfnPtr_' s = ntfn_Ptr a}) [] (invokeTCB (tcbinvocation.NotificationControl t (Some a))) (Call invokeTCB_NotificationControl_'proc)" apply (cinit lift: tcb_' ntfnPtr_') apply (clarsimp simp: option_to_0_def liftE_def) apply (rule ccorres_cond_true_seq) apply (ctac(no_vcg) add: bindNotification_ccorres) apply (rule ccorres_return_CE[unfolded returnOk_def, simplified]) apply simp apply simp apply simp apply wp apply (case_tac "a = 0", auto) done lemma invokeTCB_NotificationControl_unbind_ccorres: "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and tcb_inv_wf' (tcbinvocation.NotificationControl t None)) (UNIV \ {s. tcb_' s = tcb_ptr_to_ctcb_ptr t} \ {s. ntfnPtr_' s = NULL}) [] (invokeTCB (tcbinvocation.NotificationControl t None)) (Call invokeTCB_NotificationControl_'proc)" apply (cinit lift: tcb_' ntfnPtr_') apply (clarsimp simp add: option_to_0_def liftE_def) apply (ctac(no_vcg) add: unbindNotification_ccorres) apply (rule ccorres_return_CE[unfolded returnOk_def, simplified]) apply simp apply simp apply simp apply wp apply (clarsimp simp: option_to_0_def) done lemma valid_objs_boundNTFN_NULL: "ko_at' tcb p s ==> valid_objs' s \ no_0_obj' s \ tcbBoundNotification tcb \ Some 0" apply (drule(1) obj_at_valid_objs') apply (clarsimp simp: valid_tcb'_def projectKOs valid_obj'_def) done lemma decodeUnbindNotification_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and K (isThreadCap cp) and tcb_at' (capTCBPtr cp) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s)) (UNIV \ {s. ccap_relation cp (cap_' s)}) [] (decodeUnbindNotification cp >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeUnbindNotification_'proc)" apply (cinit' lift: cap_' simp: decodeUnbindNotification_def) apply csymbr apply csymbr apply (rule ccorres_Guard_Seq) apply (simp add: liftE_bindE bind_assoc) apply (rule ccorres_pre_getBoundNotification) apply (rule_tac P="\s. rv \ Some 0" in ccorres_cross_over_guard) apply (simp add: bindE_bind_linearise) apply wpc apply (simp add: bindE_bind_linearise[symmetric] injection_handler_throwError invocationCatch_use_injection_handler) apply (rule ccorres_cond_true_seq) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply (simp add: returnOk_bind ccorres_invocationCatch_Inr performInvocation_def) apply (rule ccorres_cond_false_seq) apply simp apply (ctac add: setThreadState_ccorres) apply (ctac add: invokeTCB_NotificationControl_unbind_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_NotificationControl_modifies) apply simp apply (wp sts_invs_minor' hoare_case_option_wp sts_bound_tcb_at' | wpc | simp)+ apply (vcg exspec=setThreadState_modifies) apply (clarsimp, frule obj_at_ko_at', clarsimp) apply (rule cmap_relationE1[OF cmap_relation_tcb], assumption) apply (erule ko_at_projectKO_opt) apply (clarsimp simp: isCap_simps) apply (frule cap_get_tag_isCap_unfolded_H_cap) apply (auto simp: ctcb_relation_def typ_heap_simps cap_get_tag_ThreadCap ct_in_state'_def option_to_ptr_def option_to_0_def ThreadState_Restart_def mask_def rf_sr_ksCurThread valid_tcb_state'_def elim!: pred_tcb'_weakenE dest!: valid_objs_boundNTFN_NULL) done lemma nTFN_case_If_ptr: "(case x of capability.NotificationCap a b c d \ P a d | _ \ Q) = (if (isNotificationCap x) then P (capNtfnPtr x) (capNtfnCanReceive x) else Q)" by (auto simp: isNotificationCap_def split: capability.splits) lemma decodeBindNotification_ccorres: "interpret_excaps extraCaps' = excaps_map extraCaps \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and tcb_at' (capTCBPtr cp) and ex_nonz_cap_to' (capTCBPtr cp) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s) and (\s. \v \ set extraCaps. \y \ zobj_refs' (fst v). ex_nonz_cap_to' y s ) and (excaps_in_mem extraCaps o ctes_of) and K (isThreadCap cp)) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. current_extra_caps_' (globals s) = extraCaps'}) [] (decodeBindNotification cp extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeBindNotification_'proc)" apply (simp, rule ccorres_gen_asm) apply (cinit' lift: cap_' current_extra_caps_' simp: decodeBindNotification_def) apply (simp add: bind_assoc whenE_def bind_bindE_assoc interpret_excaps_test_null del: Collect_const cong: call_ignore_cong) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: excaps_map_def invocationCatch_def throwError_bind null_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: excaps_map_def null_def del: Collect_const cong: call_ignore_cong) apply csymbr apply csymbr apply (rule ccorres_Guard_Seq) apply (simp add: liftE_bindE bind_assoc cong: call_ignore_cong) apply (rule ccorres_pre_getBoundNotification) apply (rule_tac P="\s. rv \ Some 0" in ccorres_cross_over_guard) apply (simp add: bindE_bind_linearise cong: call_ignore_cong) apply wpc prefer 2 apply (simp add: bindE_bind_linearise[symmetric] injection_handler_throwError invocationCatch_use_injection_handler throwError_bind invocationCatch_def) apply (rule ccorres_cond_true_seq) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply (simp add: returnOk_bind ccorres_invocationCatch_Inr performInvocation_def bindE_bind_linearise[symmetric] cong: call_ignore_cong) apply (rule ccorres_cond_false_seq) apply (simp cong: call_ignore_cong) apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply csymbr apply (simp add: cap_get_tag_isCap if_1_0_0 del: Collect_const cong: call_ignore_cong) apply (rule ccorres_assert2) apply (rule ccorres_Cond_rhs_Seq) apply (rule_tac P="Q (capNtfnPtr rva) (capNtfnCanReceive rva) rva"for Q in ccorres_inst) apply (rule ccorres_rhs_assoc)+ apply csymbr apply csymbr apply (simp add: hd_conv_nth del: Collect_const cong: call_ignore_cong) apply (simp only: cap_get_tag_isCap(3)[symmetric] cong: call_ignore_cong, frule(1) cap_get_tag_to_H(3) ) apply (simp add: case_bool_If if_to_top_of_bindE if_to_top_of_bind bind_assoc del: Collect_const cong: if_cong call_ignore_cong) apply csymbr apply (clarsimp simp add: if_to_top_of_bind to_bool_eq_0[symmetric] simp del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (clarsimp simp: to_bool_def throwError_bind invocationCatch_def) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply (clarsimp simp: to_bool_def) apply (rule ccorres_pre_getNotification) apply (rename_tac ntfn) apply (rule ccorres_rhs_assoc2) apply (rule ccorres_rhs_assoc2) apply (rule_tac xf'="ret__int_'" and val="from_bool (ntfnBoundTCB ntfn \ None \ isWaitingNtfn (ntfnObj ntfn))" and R="ko_at' ntfn (capNtfnPtr_CL (cap_notification_cap_lift ntfn_cap)) and valid_ntfn' ntfn" and R'=UNIV in ccorres_symb_exec_r_known_rv_UNIV) apply (rule conseqPre, vcg) apply (clarsimp simp: if_1_0_0) apply (erule cmap_relationE1[OF cmap_relation_ntfn], erule ko_at_projectKO_opt) apply (clarsimp simp: typ_heap_simps cnotification_relation_def Let_def valid_ntfn'_def) apply (case_tac "ntfnObj ntfn", simp_all add: isWaitingNtfn_def option_to_ctcb_ptr_def false_def true_def split: option.split_asm if_split, auto simp: neq_Nil_conv tcb_queue_relation'_def tcb_at_not_NULL[symmetric] tcb_at_not_NULL)[1] apply ceqv apply (rule_tac P="\s. ksCurThread s = thread" in ccorres_cross_over_guard) apply (simp add: bindE_bind_linearise del: Collect_const) apply wpc \ \IdleNtfn\ apply (simp add: case_option_If del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (clarsimp simp: isWaitingNtfn_def from_bool_neq_0) apply (simp add: bindE_bind_linearise[symmetric] injection_handler_throwError invocationCatch_use_injection_handler throwError_bind invocationCatch_def) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply (clarsimp simp: isWaitingNtfn_def from_bool_neq_0 returnOk_bind) apply (clarsimp simp: isWaitingNtfn_def from_bool_neq_0 returnOk_bind ccorres_invocationCatch_Inr performInvocation_def) apply (ctac add: setThreadState_ccorres) apply (ctac add: invokeTCB_NotificationControl_bind_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_NotificationControl_modifies) apply simp apply (wp sts_invs_minor' hoare_case_option_wp sts_bound_tcb_at' | wpc | simp)+ apply (vcg exspec=setThreadState_modifies) apply (simp add: case_option_If del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (clarsimp simp: isWaitingNtfn_def from_bool_neq_0) apply (simp add: bindE_bind_linearise[symmetric] injection_handler_throwError invocationCatch_use_injection_handler throwError_bind invocationCatch_def) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply (clarsimp simp: isWaitingNtfn_def from_bool_neq_0 returnOk_bind) apply (clarsimp simp: isWaitingNtfn_def from_bool_neq_0 returnOk_bind ccorres_invocationCatch_Inr performInvocation_def) apply (ctac add: setThreadState_ccorres) apply (ctac add: invokeTCB_NotificationControl_bind_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_NotificationControl_modifies) apply simp apply (wp sts_invs_minor' hoare_case_option_wp sts_bound_tcb_at' | wpc | simp)+ apply (vcg exspec=setThreadState_modifies) apply (simp add: bindE_bind_linearise[symmetric] injection_handler_throwError invocationCatch_use_injection_handler throwError_bind invocationCatch_def) apply (rule ccorres_cond_true_seq) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply (clarsimp simp add: guard_is_UNIV_def isWaitingNtfn_def from_bool_0 ThreadState_Restart_def mask_def true_def rf_sr_ksCurThread capTCBPtr_eq) apply (simp add: hd_conv_nth bindE_bind_linearise nTFN_case_If_ptr throwError_bind invocationCatch_def) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def syscall_error_rel_def syscall_error_to_H_cases exception_defs) apply clarsimp apply (wp | simp | wpc | wp (once) hoare_drop_imps)+ apply vcg apply clarsimp apply (rule conjI) apply safe[1] apply (fastforce simp: invs'_def valid_state'_def valid_pspace'_def dest!: valid_objs_boundNTFN_NULL) apply ((fastforce elim!: pred_tcb'_weakenE obj_at'_weakenE simp: ct_in_state'_def from_bool_0 isCap_simps excaps_map_def neq_Nil_conv obj_at'_def pred_tcb_at'_def valid_tcb_state'_def)+)[12] apply (clarsimp dest!: obj_at_valid_objs'[OF _ invs_valid_objs'] simp: projectKOs valid_obj'_def) apply (clarsimp simp: excaps_map_Nil cte_wp_at_ctes_of excaps_map_def neq_Nil_conv dest!: interpret_excaps_eq ) apply (clarsimp simp: excaps_map_Nil) apply (frule obj_at_ko_at', clarsimp) apply (rule cmap_relationE1[OF cmap_relation_tcb], assumption) apply (erule ko_at_projectKO_opt) apply (clarsimp simp: isCap_simps) apply (frule cap_get_tag_isCap_unfolded_H_cap) apply safe[1] apply (clarsimp simp: typ_heap_simps excaps_map_def neq_Nil_conv dest!: interpret_excaps_eq) apply clarsimp apply (frule cap_get_tag_isCap_unfolded_H_cap(3)) apply (clarsimp simp: typ_heap_simps cap_get_tag_ThreadCap ccap_relation_def) apply (auto simp: word_sless_alt typ_heap_simps cap_get_tag_ThreadCap ctcb_relation_def option_to_ptr_def option_to_0_def split: if_split) done lemma decodeSetSpace_ccorres: notes tl_drop_1[simp] scast_mask_8 [simp] shows "interpret_excaps extraCaps' = excaps_map extraCaps \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and cte_at' slot and K (isThreadCap cp) and tcb_at' (capTCBPtr cp) and (\s. \rf \ zobj_refs' cp. ex_nonz_cap_to' rf s) and (excaps_in_mem extraCaps o ctes_of) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. slot_' s = cte_Ptr slot} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeSetSpace args cp slot extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeSetSpace_'proc)" supply unsigned_numeral[simp del] apply (cinit' lift: cap_' length___unsigned_long_' slot_' current_extra_caps_' buffer_' simp: decodeSetSpace_def) apply csymbr apply (rule ccorres_Cond_rhs_Seq) apply (simp add: if_1_0_0) apply (rule ccorres_cond_true_seq | simp)+ apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (subgoal_tac "unat length___unsigned_long < 3") apply (clarsimp simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def syscall_error_rel_def syscall_error_to_H_cases exception_defs subset_iff split: list.split) apply unat_arith apply csymbr apply (rule ccorres_Cond_rhs_Seq) apply (simp add: if_1_0_0 interpret_excaps_test_null excaps_map_Nil) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply clarsimp apply (clarsimp simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def syscall_error_rel_def syscall_error_to_H_cases exception_defs split: list.split) apply csymbr apply (simp add: if_1_0_0 interpret_excaps_test_null del: Collect_const) apply (rule_tac P="\c. ccorres rvr xf P P' hs a (Cond c c1 c2 ;; c3)" for rvr xf P P' hs a c1 c2 c3 in ssubst) apply (rule Collect_cong) apply (rule interpret_excaps_test_null) apply (clarsimp simp: neq_Nil_conv) apply simp apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply clarsimp apply (clarsimp simp: throwError_def invocationCatch_def fst_return intr_and_se_rel_def syscall_error_rel_def syscall_error_to_H_cases exception_defs excaps_map_def split: list.split) apply (clarsimp simp add: linorder_not_less word_le_nat_alt excaps_map_Nil length_excaps_map simp del: Collect_const) apply (drule_tac a="Suc 0" in neq_le_trans [OF not_sym]) apply (clarsimp simp: neq_Nil_conv) apply (rule_tac P="\a. ccorres rvr xf P P' hs a c" for rvr xf P P' hs c in ssubst, rule bind_cong [OF _ refl], rule list_case_helper, clarsimp)+ apply (simp add: hd_drop_conv_nth2 del: Collect_const) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=1 and buffer=buffer]) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo[where args=args and n=2 and buffer=buffer]) apply csymbr apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0]) apply (rule ccorres_move_c_guard_cte) apply ctac apply (rule ccorres_assert2) apply csymbr apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=1]) apply (rule ccorres_move_c_guard_cte) apply ctac apply (rule ccorres_assert2) apply csymbr apply (simp add: decodeSetSpace_def injection_bindE[OF refl] split_def tcb_cnode_index_defs[THEN ptr_add_assertion_positive[OF ptr_add_assertion_positive_helper]] del: Collect_const) apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq ccorres_rhs_assoc)+ apply (simp add: injection_liftE[OF refl] bindE_assoc liftM_def getThreadCSpaceRoot getThreadVSpaceRoot del: Collect_const) apply (simp add: liftE_bindE bind_assoc del: Collect_const) apply (ctac add: slotCapLongRunningDelete_ccorres) apply (rule ccorres_move_array_assertion_tcb_ctes) apply (simp del: Collect_const) apply csymbr apply (clarsimp simp add: if_1_0_0 from_bool_0 simp del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (rule ccorres_symb_exec_l [OF _ _ _ empty_fail_slotCapLongRunningDelete]) apply (simp add: unlessE_def throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule ccorres_cond_true_seq) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply wp+ apply (rule ccorres_rhs_assoc)+ apply csymbr apply (simp add: tcb_cnode_index_defs[THEN ptr_add_assertion_positive[OF ptr_add_assertion_positive_helper]] del: Collect_const) apply (rule ccorres_move_array_assertion_tcb_ctes ccorres_Guard_Seq ccorres_rhs_assoc)+ apply (ctac add: slotCapLongRunningDelete_ccorres) apply (rule ccorres_move_array_assertion_tcb_ctes) apply (simp del: Collect_const) apply csymbr apply (clarsimp simp add: if_1_0_0 from_bool_0 simp del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: unlessE_def throwError_bind invocationCatch_def cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: unlessE_def del: Collect_const) apply (rule ccorres_add_return, rule_tac r'="\rv rv'. ccap_relation (if args ! Suc 0 = 0 then fst (hd extraCaps) else updateCapData False (args ! Suc 0) (fst (hd extraCaps))) rv'" and xf'="cRootCap_'" in ccorres_split_nothrow) apply (rule_tac P'="{s. cRootCap = cRootCap_' s}" in ccorres_from_vcg[where P=\]) apply (rule allI, rule conseqPre, vcg) apply (subgoal_tac "extraCaps \ []") apply (clarsimp simp: returnOk_def return_def hd_conv_nth false_def) apply fastforce apply clarsimp apply ceqv apply (simp add: invocationCatch_use_injection_handler injection_bindE [OF refl refl] bindE_assoc del: Collect_const) apply (ctac add: ccorres_injection_handler_csum1 [OF deriveCap_ccorres]) apply (simp add: Collect_False del: Collect_const) apply csymbr apply csymbr apply (simp add: cnode_cap_case_if cap_get_tag_isCap dc_def[symmetric] del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: injection_handler_throwError cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: injection_handler_returnOk del: Collect_const) apply (rule ccorres_add_return, rule_tac r'="\rv rv'. ccap_relation (if args ! 2 = 0 then fst (extraCaps ! Suc 0) else updateCapData False (args ! 2) (fst (extraCaps ! Suc 0))) rv'" and xf'="vRootCap_'" in ccorres_split_nothrow) apply (rule_tac P'="{s. vRootCap = vRootCap_' s}" in ccorres_from_vcg[where P=\]) apply (rule allI, rule conseqPre, vcg) apply (clarsimp simp: returnOk_def return_def hd_drop_conv_nth2 false_def) apply fastforce apply ceqv apply (ctac add: ccorres_injection_handler_csum1 [OF deriveCap_ccorres]) apply (simp add: Collect_False del: Collect_const) apply csymbr apply csymbr apply (simp add: from_bool_0 isValidVTableRoot_conv del: Collect_const) apply (rule ccorres_Cond_rhs_Seq) apply (simp add: injection_handler_throwError cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (simp add: injection_handler_returnOk ccorres_invocationCatch_Inr performInvocation_def) apply (ctac add: setThreadState_ccorres) apply csymbr apply csymbr apply (ctac(no_vcg) add: invokeTCB_ThreadControl_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply simp apply (wp sts_invs_minor') apply (vcg exspec=setThreadState_modifies) apply simp apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply simp apply (wp hoare_drop_imps) apply (wp injection_wp_E [OF refl]) apply (simp add: Collect_const_mem cintr_def intr_and_se_rel_def all_ex_eq_helper syscall_error_rel_def exception_defs) apply (vcg exspec=deriveCap_modifies) apply (simp cong: if_cong) apply wp apply (simp add: Collect_const_mem all_ex_eq_helper) apply vcg apply simp apply (rule ccorres_split_throws, rule ccorres_return_C_errorE, simp+) apply vcg apply (simp cong: if_cong) apply (wp hoare_drop_imps injection_wp_E[OF refl]) apply (simp add: Collect_const_mem all_ex_eq_helper numeral_eqs syscall_error_rel_def exception_defs cintr_def intr_and_se_rel_def) apply (vcg exspec=deriveCap_modifies) apply (simp cong: if_cong) apply wp apply (simp add: Collect_const_mem all_ex_eq_helper numeral_eqs syscall_error_rel_def exception_defs cintr_def intr_and_se_rel_def hd_drop_conv_nth2 cong: if_cong) apply vcg apply (simp cong: if_cong) apply (wp hoare_drop_imps) apply (simp add: Collect_const_mem) apply (vcg exspec=slotCapLongRunningDelete_modifies) apply (simp cong: if_cong) apply (wp hoare_drop_imps) apply (simp add: Collect_const_mem all_ex_eq_helper numeral_eqs syscall_error_rel_def exception_defs cintr_def intr_and_se_rel_def) apply (vcg exspec=slotCapLongRunningDelete_modifies) apply (simp add: pred_conj_def cong: if_cong) apply (strengthen if_n_updateCapData_valid_strg) apply (wp hoare_drop_imps) apply (simp add: Collect_const_mem all_ex_eq_helper numeral_eqs syscall_error_rel_def exception_defs cintr_def intr_and_se_rel_def) apply vcg apply simp apply (wp hoare_drop_imps) apply (simp add: Collect_const_mem all_ex_eq_helper numeral_eqs syscall_error_rel_def exception_defs cintr_def intr_and_se_rel_def) apply vcg apply simp apply (wp hoare_drop_imps) apply (simp add: Collect_const_mem all_ex_eq_helper numeral_eqs syscall_error_rel_def exception_defs cintr_def intr_and_se_rel_def cong: if_cong | vcg exspec=getSyscallArg_modifies | wp)+ apply (clarsimp simp: word_less_nat_alt) apply (rule conjI) apply (clarsimp simp: ct_in_state'_def interpret_excaps_test_null excaps_map_def neq_Nil_conv) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (rule conjI, clarsimp simp: sysargs_rel_n_def n_msgRegisters_def) apply (frule(2) tcb_at_capTCBPtr_CL) apply (auto simp: isCap_simps valid_tcb_state'_def objBits_defs mask_def elim!: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread' interpret_excaps_eq)[1] apply (clarsimp simp: linorder_not_le interpret_excaps_test_null excaps_map_def neq_Nil_conv word_sle_def word_sless_def) apply (frule interpret_excaps_eq[rule_format, where n=0], simp) apply (frule interpret_excaps_eq[rule_format, where n=1], simp) apply (clarsimp simp: mask_def[where n=4] ccap_rights_relation_def rightsFromWord_wordFromRights capTCBPtr_eq tcb_cnode_index_defs size_of_def option_to_0_def rf_sr_ksCurThread "StrictC'_thread_state_defs" mask_eq_iff_w2p word_size) apply (simp add: word_sle_def cap_get_tag_isCap) apply (subgoal_tac "args \ []") apply (clarsimp simp: hd_conv_nth) apply (drule sym, simp, simp add: true_def from_bool_0) apply (clarsimp simp: objBits_defs) apply fastforce apply clarsimp done lemma invokeTCB_SetTLSBase_ccorres: notes static_imp_wp [wp] shows "ccorres (cintr \ (\rv rv'. rv = [])) (liftxf errstate id (K ()) ret__unsigned_long_') (invs') ({s. thread_' s = tcb_ptr_to_ctcb_ptr tcb} \ {s. tls_base_' s = tls_base}) [] (invokeTCB (SetTLSBase tcb tls_base)) (Call invokeSetTLSBase_'proc)" apply (cinit lift: thread_' tls_base_') apply (simp add: liftE_def bind_assoc del: Collect_const) apply (ctac add: setRegister_ccorres[simplified dc_def]) apply (rule ccorres_pre_getCurThread) apply (rename_tac cur_thr) apply (rule ccorres_split_nothrow_novcg_dc) apply (rule_tac R="\s. cur_thr = ksCurThread s" in ccorres_when) apply (clarsimp simp: rf_sr_ksCurThread) apply clarsimp apply (ctac (no_vcg) add: rescheduleRequired_ccorres) apply (unfold return_returnOk)[1] apply (rule ccorres_return_CE, simp+)[1] apply (wpsimp wp: hoare_drop_imp simp: guard_is_UNIV_def)+ apply vcg apply (clarsimp simp: tlsBaseRegister_def ARM.tlsBaseRegister_def invs_weak_sch_act_wf invs_queues TLS_BASE_def TPIDRURW_def split: if_split) done lemma decodeSetTLSBase_ccorres: "ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and sch_act_simple and (\s. ksCurThread s = thread) and ct_active' and K (isThreadCap cp) and valid_cap' cp and (\s. \x \ zobj_refs' cp. ex_nonz_cap_to' x s) and sysargs_rel args buffer) (UNIV \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeSetTLSBase args cp >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeSetTLSBase_'proc)" apply (cinit' lift: cap_' length___unsigned_long_' buffer_' simp: decodeSetTLSBase_def) apply wpc apply (simp add: throwError_bind invocationCatch_def) apply (rule ccorres_from_vcg_split_throws[where P=\ and P'=UNIV]) apply vcg apply (rule conseqPre, vcg) apply (clarsimp simp: throwError_def return_def exception_defs syscall_error_rel_def syscall_error_to_H_cases) apply (rule ccorres_cond_false_seq; simp) apply (rule ccorres_add_return, ctac add: getSyscallArg_ccorres_foo'[where args=args and n=0 and buffer=buffer]) apply (simp add: invocationCatch_use_injection_handler bindE_assoc injection_handler_returnOk ccorres_invocationCatch_Inr performInvocation_def) apply (ctac add: setThreadState_ccorres) apply csymbr apply (ctac (no_vcg) add: invokeTCB_SetTLSBase_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply (wpsimp wp: sts_invs_minor')+ apply (vcg exspec=setThreadState_modifies) apply wp apply vcg apply (clarsimp simp: Collect_const_mem) apply (rule conjI) apply (clarsimp simp: ct_in_state'_def sysargs_rel_n_def n_msgRegisters_def) apply (auto simp: valid_tcb_state'_def elim!: pred_tcb'_weakenE)[1] apply (simp add: StrictC'_thread_state_defs mask_eq_iff_w2p word_size) apply (frule rf_sr_ksCurThread) apply (simp only: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply (auto simp: unat_eq_0 le_max_word_ucast_id)+ done lemma decodeTCBInvocation_ccorres: "interpret_excaps extraCaps' = excaps_map extraCaps \ ccorres (intr_and_se_rel \ dc) (liftxf errstate id (K ()) ret__unsigned_long_') (invs' and (\s. ksCurThread s = thread) and ct_active' and sch_act_simple and valid_cap' cp and cte_at' slot and K (isThreadCap cp) and (excaps_in_mem extraCaps o ctes_of) and tcb_at' (capTCBPtr cp) and ex_nonz_cap_to' (capTCBPtr cp) and (\s. \v \ set extraCaps. \y \ zobj_refs' (fst v). ex_nonz_cap_to' y s) and (\s. \v \ set extraCaps. s \' fst v \ cte_at' (snd v) s) and (\s. \v \ set extraCaps. ex_cte_cap_wp_to' isCNodeCap (snd v) s) and sysargs_rel args buffer) (UNIV \ {s. invLabel_' s = label} \ {s. ccap_relation cp (cap_' s)} \ {s. unat (length___unsigned_long_' s) = length args} \ {s. slot_' s = cte_Ptr slot} \ {s. current_extra_caps_' (globals s) = extraCaps'} \ {s. call_' s = from_bool isCall} \ {s. buffer_' s = option_to_ptr buffer}) [] (decodeTCBInvocation label args cp slot extraCaps >>= invocationCatch thread isBlocking isCall InvokeTCB) (Call decodeTCBInvocation_'proc)" apply (cinit' lift: invLabel_' cap_' length___unsigned_long_' slot_' current_extra_caps_' call_' buffer_') apply (simp add: decodeTCBInvocation_def invocation_eq_use_types gen_invocation_type_eq del: Collect_const) apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeReadRegisters_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeWriteRegisters_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeCopyRegisters_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply (simp add: returnOk_bind ccorres_invocationCatch_Inr) apply (rule ccorres_rhs_assoc)+ apply (ctac add: setThreadState_ccorres) apply csymbr apply (simp add: performInvocation_def) apply (ctac add: invokeTCB_Suspend_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_Suspend_modifies) apply (wp sts_invs_minor') apply (vcg exspec=setThreadState_modifies) apply (rule ccorres_Cond_rhs) apply (simp add: returnOk_bind ccorres_invocationCatch_Inr) apply (rule ccorres_rhs_assoc)+ apply (ctac add: setThreadState_ccorres) apply csymbr apply (simp add: performInvocation_def) apply (ctac add: invokeTCB_Resume_ccorres) apply simp apply (rule ccorres_alternative2) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (vcg exspec=invokeTCB_Resume_modifies) apply (wp sts_invs_minor') apply (vcg exspec=setThreadState_modifies) apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeTCBConfigure_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeSetPriority_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeSetMCPriority_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeSetSchedParams_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeSetIPCBuffer_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeSetSpace_ccorres [where buffer=buffer]) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeBindNotification_ccorres) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply simp apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeUnbindNotification_ccorres) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_Cond_rhs) apply (simp add: gen_invocation_type_eq) apply (rule ccorres_add_returnOk, ctac(no_vcg) add: decodeSetTLSBase_ccorres) apply (rule ccorres_return_CE, simp+)[1] apply (rule ccorres_return_C_errorE, simp+)[1] apply wp apply (rule ccorres_equals_throwError) apply (fastforce simp: throwError_bind invocationCatch_def split: invocation_label.split gen_invocation_labels.split) apply (simp add: ccorres_cond_iffs cong: StateSpace.state.fold_congs globals.fold_congs) apply (rule syscall_error_throwError_ccorres_n) apply (simp add: syscall_error_to_H_cases) apply (clarsimp simp: cintr_def intr_and_se_rel_def exception_defs rf_sr_ksCurThread Collect_const_mem) apply (rule conjI) apply (auto simp: ct_in_state'_def isCap_simps valid_tcb_state'_def elim!: pred_tcb'_weakenE dest!: st_tcb_at_idle_thread')[1] apply (simp split: sum.split add: cintr_def intr_and_se_rel_def exception_defs syscall_error_rel_def) apply (simp add: "StrictC'_thread_state_defs" mask_eq_iff_w2p word_size cap_get_tag_isCap) apply (simp add: cap_get_tag_isCap[symmetric], drule(1) cap_get_tag_to_H) apply clarsimp done end end