3076 lines
157 KiB
Plaintext
3076 lines
157 KiB
Plaintext
(*
|
|
* Copyright 2014, General Dynamics C4 Systems
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the GNU General Public License version 2. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_GPLv2.txt" for details.
|
|
*
|
|
* @TAG(GD_GPL)
|
|
*)
|
|
|
|
theory Invoke_C
|
|
imports Recycle_C "../../lib/clib/MonadicRewrite_C"
|
|
begin
|
|
|
|
context kernel_m
|
|
begin
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* decodeDomainInvocation **********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma slotcap_in_mem_ThreadCap:
|
|
"\<lbrakk> slotcap_in_mem cap slot (ctes_of s); (s, s') \<in> rf_sr \<rbrakk>
|
|
\<Longrightarrow> \<exists>v. cslift s' (cte_Ptr slot) = Some v
|
|
\<and> (cap_get_tag (cte_C.cap_C v) = scast cap_thread_cap)
|
|
= (isThreadCap cap)
|
|
\<and> (isThreadCap cap
|
|
\<longrightarrow> ccap_relation cap (cte_C.cap_C v))"
|
|
apply (clarsimp simp: slotcap_in_mem_def)
|
|
apply (erule(1) cmap_relationE1[OF cmap_relation_cte])
|
|
apply (clarsimp dest!: ccte_relation_ccap_relation)
|
|
apply (simp add: cap_get_tag_isCap)
|
|
done
|
|
|
|
lemma cap_case_ThreadCap2:
|
|
"(case cap of (ThreadCap ptr) \<Rightarrow> f ptr | _ \<Rightarrow> g)
|
|
= (if isThreadCap cap
|
|
then f (capTCBPtr cap)
|
|
else g)"
|
|
by (simp add: isCap_simps
|
|
split: capability.split)
|
|
|
|
lemma setDomain_ccorres:
|
|
"ccorres dc xfdc
|
|
(invs' and tcb_at' t and sch_act_simple
|
|
and (\<lambda>s. d \<le> maxDomain))
|
|
(UNIV \<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr t} \<inter> {s. dom_' s = ucast d})
|
|
[] (setDomain t d) (Call setDomain_'proc)"
|
|
apply (rule ccorres_gen_asm)
|
|
apply (cinit lift: tptr_' dom_')
|
|
apply (rule ccorres_pre_getCurThread)
|
|
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=\<top>])
|
|
apply vcg
|
|
apply clarsimp
|
|
apply (erule(1) rf_sr_tcb_update_no_queue2,
|
|
(simp add: typ_heap_simps)+, simp_all)[1]
|
|
apply (subst heap_update_field_hrs | fastforce intro: typ_heap_simps)+
|
|
apply (rule ball_tcb_cte_casesI, simp+)
|
|
apply (simp add: ctcb_relation_def)
|
|
apply (ctac(no_vcg) add: isRunnable_ccorres)
|
|
apply (rule ccorres_split_nothrow_novcg_dc)
|
|
apply (simp add: when_def to_bool_def del: Collect_const)
|
|
apply (rule ccorres_cond2[where R=\<top>], simp add: Collect_const_mem)
|
|
apply (ctac add: tcbSchedEnqueue_ccorres)
|
|
apply (rule ccorres_return_Skip)
|
|
apply (simp add: when_def to_bool_def)
|
|
apply (rule_tac R="\<lambda>s. rv = ksCurThread s"
|
|
in ccorres_cond2)
|
|
apply (clarsimp simp: rf_sr_ksCurThread)
|
|
apply (ctac add: rescheduleRequired_ccorres[unfolded dc_def])
|
|
apply (rule ccorres_return_Skip')
|
|
apply simp
|
|
apply (wp hoare_drop_imps weak_sch_act_wf_lift_linear)
|
|
apply (simp add: guard_is_UNIV_def)
|
|
apply simp
|
|
apply wp
|
|
apply (rule_tac Q="\<lambda>_. all_invs_but_sch_extra and tcb_at' t and sch_act_simple
|
|
and (\<lambda>s. rv = ksCurThread s)" in hoare_strengthen_post)
|
|
apply (wp_trace threadSet_all_invs_but_sch_extra)
|
|
apply (clarsimp simp:valid_pspace_valid_objs' st_tcb_at_def[symmetric]
|
|
sch_act_simple_def st_tcb_at'_def o_def weak_sch_act_wf_def split:if_splits)
|
|
apply (simp add: guard_is_UNIV_def)
|
|
apply (rule_tac Q="\<lambda>_. invs' and tcb_at' t and sch_act_simple
|
|
and (\<lambda>s. rv = ksCurThread s \<and> (\<forall>p. t \<notin> set (ksReadyQueues s p)))" in hoare_strengthen_post)
|
|
apply (wp weak_sch_act_wf_lift_linear tcbSchedDequeue_not_queued
|
|
tcbSchedDequeue_not_in_queue hoare_vcg_imp_lift hoare_vcg_all_lift)
|
|
apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
|
|
apply (fastforce simp: valid_tcb'_def tcb_cte_cases_def
|
|
invs'_def valid_state'_def valid_pspace'_def)
|
|
done
|
|
|
|
lemma active_runnable':
|
|
"active' state \<Longrightarrow> runnable' state"
|
|
by (fastforce simp: runnable'_def)
|
|
|
|
lemma decodeDomainInvocation_ccorres:
|
|
notes Collect_const[simp del]
|
|
shows
|
|
"interpret_excaps extraCaps' = excaps_map extraCaps \<Longrightarrow>
|
|
ccorres (intr_and_se_rel \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and (\<lambda>s. ksCurThread s = thread)
|
|
and sch_act_simple and ct_active'
|
|
and (excaps_in_mem extraCaps \<circ> ctes_of)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v).
|
|
ex_nonz_cap_to' y s)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps.
|
|
s \<turnstile>' fst v)
|
|
and sysargs_rel args buffer)
|
|
(UNIV
|
|
\<inter> {s. unat (length___unsigned_long_' s) = length args}
|
|
\<inter> {s. excaps_' s = extraCaps'}
|
|
\<inter> {s. call_' s = from_bool isCall}
|
|
\<inter> {s. invLabel_' s = lab}
|
|
\<inter> {s. buffer_' s = option_to_ptr buffer}) []
|
|
(decodeDomainInvocation lab args extraCaps
|
|
>>= invocationCatch thread isBlocking isCall (uncurry InvokeDomain))
|
|
(Call decodeDomainInvocation_'proc)"
|
|
apply (cinit' lift: length___unsigned_long_' excaps_' call_' invLabel_' buffer_'
|
|
simp: decodeDomainInvocation_def list_case_If2 whenE_def)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: throwError_bind invocationCatch_def invocation_eq_use_types
|
|
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: invocation_eq_use_types)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
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: unat_gt_0[symmetric] del:)
|
|
apply (rule ccorres_add_return)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer])
|
|
apply (simp add: numDomains_def hd_conv_nth word_le_nat_alt)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: throwError_bind invocationCatch_def numDomains_def
|
|
hd_conv_nth word_le_nat_alt
|
|
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: null_def excaps_map_def)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: throwError_bind invocationCatch_def
|
|
interpret_excaps_test_null
|
|
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: interpret_excaps_test_null hd_conv_nth cap_case_ThreadCap2)
|
|
apply (rule ccorres_add_return)
|
|
apply (rule_tac r'="(\<lambda>rv _ rv'. ((cap_get_tag rv' = scast cap_thread_cap)
|
|
= (isThreadCap rv))
|
|
\<and> (cap_get_tag rv' = scast cap_thread_cap \<longrightarrow> ccap_relation rv rv'))
|
|
(fst (extraCaps ! 0))"
|
|
and xf'=tcap_' in ccorres_split_nothrow)
|
|
apply (rule ccorres_from_vcg[where P="excaps_in_mem extraCaps \<circ> ctes_of" and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: excaps_in_mem_def return_def neq_Nil_conv)
|
|
apply (drule(1) slotcap_in_mem_ThreadCap)
|
|
apply (frule interpret_excaps_eq[rule_format, where n=0], simp)
|
|
apply (clarsimp simp: typ_heap_simps' mask_def word_sless_def word_sle_def)
|
|
apply ceqv
|
|
apply csymbr
|
|
apply clarsimp
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: Collect_const)
|
|
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: Collect_const returnOk_def uncurry_def)
|
|
apply (simp (no_asm) add: ccorres_invocationCatch_Inr split_def
|
|
performInvocation_def liftE_bindE bind_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply csymbr
|
|
apply (ctac add: setDomain_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (ctac add: ccorres_return_CE)
|
|
apply wp
|
|
apply (vcg exspec=setDomain_modifies)
|
|
apply (wp sts_invs_minor')
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply wp
|
|
apply simp
|
|
apply clarsimp
|
|
apply vcg
|
|
apply wp
|
|
apply simp
|
|
apply clarsimp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
|
|
apply (clarsimp simp: valid_tcb_state'_def invs_valid_queues' invs_valid_objs'
|
|
invs_queues invs_sch_act_wf' ct_in_state'_def pred_tcb_at'
|
|
rf_sr_ksCurThread word_sle_def word_sless_def sysargs_rel_to_n
|
|
mask_eq_iff_w2p mask_eq_iff_w2p word_size "StrictC'_thread_state_defs"
|
|
maxDomain_def numDomains_def)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: linorder_not_le isCap_simps)
|
|
apply (rule conjI, clarsimp simp: unat32_eq_of_nat)
|
|
apply clarsimp
|
|
apply (drule_tac x="extraCaps ! 0" and P="\<lambda>v. valid_cap' (fst v) s" in bspec)
|
|
apply (clarsimp simp: nth_mem interpret_excaps_test_null excaps_map_def)
|
|
apply (clarsimp simp: valid_cap_simps' pred_tcb'_weakenE active_runnable')
|
|
apply (rule conjI)
|
|
apply (fastforce simp: tcb_st_refs_of'_def elim:pred_tcb'_weakenE)
|
|
apply (simp add: word_le_nat_alt unat_ucast)
|
|
apply (clarsimp simp: ucast_ucast_len word_less_nat_alt
|
|
ccap_relation_def cap_to_H_simps cap_thread_cap_lift)
|
|
done
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeDelete_ccorres ********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma invokeCNodeDelete_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(\<lambda>s. invs' s \<and> sch_act_simple s)
|
|
(UNIV \<inter> {s. destSlot_' s = Ptr destSlot}) []
|
|
(invokeCNode (Delete destSlot))
|
|
(Call invokeCNodeDelete_'proc)"
|
|
apply (cinit lift: destSlot_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (rule ccorres_trim_returnE, simp, simp)
|
|
apply (rule ccorres_callE)
|
|
apply (rule cteDelete_ccorres[simplified])
|
|
apply (simp add: from_bool_def true_def)+
|
|
done
|
|
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeRevoke_ccorres ********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
lemma invokeCNodeRevoke_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and sch_act_simple)
|
|
(UNIV \<inter> {s. destSlot_' s = cte_Ptr destSlot}) []
|
|
(invokeCNode (Revoke destSlot))
|
|
(Call invokeCNodeRevoke_'proc)"
|
|
apply (cinit lift: destSlot_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (rule ccorres_trim_returnE, simp, simp)
|
|
apply (rule ccorres_callE)
|
|
apply (rule cteRevoke_ccorres[simplified])
|
|
apply (simp add: from_bool_def true_def)+
|
|
done
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeRecycle_ccorres ********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma invokeCNodeRecycle_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and sch_act_simple) (UNIV \<inter> {s. destSlot_' s = cte_Ptr destSlot}) []
|
|
(invokeCNode (Recycle destSlot))
|
|
(Call invokeCNodeRecycle_'proc)"
|
|
apply (cinit lift: destSlot_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (rule ccorres_trim_returnE, simp, simp)
|
|
apply (rule ccorres_callE)
|
|
apply (rule cteRecycle_ccorres[simplified])
|
|
apply (simp add: from_bool_def true_def)+
|
|
done
|
|
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeInsert_ccorres ********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma invokeCNodeInsert_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(cte_wp_at' (\<lambda>scte. capMasterCap (cteCap scte) = capMasterCap cap) src
|
|
and valid_mdb' and pspace_aligned' and valid_objs' and valid_cap' cap)
|
|
(UNIV \<inter> {s. destSlot_' s = Ptr dest} \<inter>
|
|
{s. srcSlot_' s = Ptr src} \<inter>
|
|
{s. ccap_relation cap (cap_' s)}) []
|
|
(invokeCNode (Insert cap src dest))
|
|
(Call invokeCNodeInsert_'proc)"
|
|
apply (cinit lift: destSlot_' srcSlot_' cap_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (simp add: liftE_def)
|
|
apply (ctac (no_vcg) add: cteInsert_ccorres)
|
|
apply (rule ccorres_from_vcg_throws [where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre,vcg) apply clarsimp apply (simp add: return_def)
|
|
apply wp
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
done
|
|
|
|
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeMove_ccorres *********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma invokeCNodeMove_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(valid_mdb' and pspace_aligned' )
|
|
(UNIV \<inter> {s. destSlot_' s = Ptr dest} \<inter>
|
|
{s. srcSlot_' s = Ptr src} \<inter>
|
|
{s. ccap_relation cap (cap_' s)}) []
|
|
(invokeCNode (Move cap src dest))
|
|
(Call invokeCNodeMove_'proc)"
|
|
apply (cinit lift: destSlot_' srcSlot_' cap_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (simp add: liftE_def)
|
|
apply (ctac (no_vcg) add: cteMove_ccorres)
|
|
apply (rule ccorres_from_vcg_throws [where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre,vcg) apply clarsimp apply (simp add: return_def)
|
|
apply wp
|
|
apply clarsimp
|
|
done
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeRotate_ccorres *******************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
|
|
|
|
lemma invokeCNodeRotate_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(\<lambda>s. cte_at' slot1 s \<and> cte_at' slot2 s \<and> slot1 \<noteq> slot2
|
|
\<and> valid_pspace' s \<and> valid_cap' cap2 s
|
|
\<and> cte_wp_at' (\<lambda>c. weak_derived' cap2 (cteCap c)) slot2 s
|
|
\<and> cte_wp_at' (\<lambda>c. isUntypedCap (cteCap c) \<longrightarrow> (cteCap c) = cap2) slot2 s
|
|
\<and> cte_wp_at' (\<lambda>c. cteCap c \<noteq> NullCap) slot2 s
|
|
\<and> (slot1 \<noteq> slot3 \<longrightarrow> cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) slot3 s))
|
|
(UNIV \<inter> {s. slot1_' s = Ptr slot1} \<inter>
|
|
{s. slot2_' s = Ptr slot2} \<inter>
|
|
{s. slot3_' s = Ptr slot3} \<inter>
|
|
{s. ccap_relation cap1 (cap1_' s)} \<inter>
|
|
{s. ccap_relation cap2 (cap2_' s)}) []
|
|
(invokeCNode (Rotate cap1 cap2 slot1 slot2 slot3))
|
|
(Call invokeCNodeRotate_'proc)"
|
|
apply (cinit lift: slot1_' slot2_' slot3_' cap1_' cap2_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (simp split del: split_if del: Collect_const)
|
|
apply (simp only: liftE_def)
|
|
apply (rule_tac r'="dc" and xf'="xfdc" in ccorres_split_nothrow_novcg)
|
|
apply (rule ccorres_cond [where R = \<top>])
|
|
apply (clarsimp simp: Collect_const_mem)
|
|
apply (ctac (no_vcg) add: cteSwap_ccorres)
|
|
apply (ctac (no_vcg) add: cteMove_ccorres)
|
|
apply (simp only: K_bind_def)
|
|
apply (ctac (no_vcg) add: cteMove_ccorres)
|
|
apply (rule hoare_strengthen_post)
|
|
apply (rule cteMove_valid_pspace')
|
|
apply (simp add: valid_pspace'_def)
|
|
apply ceqv
|
|
apply (rule ccorres_from_vcg_throws [where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre,vcg)
|
|
apply clarsimp
|
|
apply (simp add: return_def)
|
|
apply wp
|
|
apply (simp add: guard_is_UNIV_def dc_def xfdc_def)
|
|
apply (clarsimp simp: valid_pspace'_def)
|
|
apply (rule conjI, clarsimp)
|
|
apply (clarsimp simp:cte_wp_at_ctes_of)
|
|
apply (clarsimp simp: weak_derived'_def isCap_simps)
|
|
done
|
|
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* invokeCNodeSaveCaller ***********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma invokeCNodeSaveCaller_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(valid_mdb' and pspace_aligned' and cur_tcb')
|
|
(UNIV \<inter> {s. destSlot_' s = Ptr destSlot}) []
|
|
(invokeCNode (SaveCaller destSlot))
|
|
(Call invokeCNodeSaveCaller_'proc)"
|
|
apply (cinit lift: destSlot_' simp del: return_bind cong:call_ignore_cong)
|
|
apply (simp add: Collect_True split del: split_if del: Collect_const cong:call_ignore_cong)
|
|
apply (simp only: liftE_def)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply (simp only: bind_assoc)
|
|
apply (rule ccorres_pre_getCurThread)
|
|
|
|
apply (simp only: getThreadCallerSlot_def locateSlot_conv)
|
|
|
|
apply (rule_tac P="\<lambda>s. rv=ksCurThread s \<and> is_aligned rv 9" and r'="\<lambda> a c. c = Ptr a"
|
|
and xf'="srcSlot_'" and P'=UNIV in ccorres_split_nothrow)
|
|
|
|
apply (rule ccorres_return)
|
|
apply vcg
|
|
apply clarsimp
|
|
apply (simp add: cte_level_bits_def size_of_def of_nat_def)
|
|
apply (simp add: rf_sr_def cstate_relation_def Kernel_C.tcbCaller_def tcbCallerSlot_def)
|
|
apply (clarsimp simp: Let_def)
|
|
apply (subst ptr_val_tcb_ptr_mask2 [simplified mask_def, simplified])
|
|
apply assumption
|
|
apply simp
|
|
apply ceqv
|
|
|
|
apply (simp del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_getSlotCap_cte_at)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (ctac (no_vcg))
|
|
apply csymbr
|
|
apply (wpc, simp_all add: cap_get_tag_isCap isCap_simps
|
|
Collect_False Collect_True
|
|
del: Collect_const)[1]
|
|
apply (rule ccorres_fail)+
|
|
-- "NullCap case"
|
|
apply (rule ccorres_from_vcg_throws [where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply clarsimp
|
|
apply (simp add: return_def)
|
|
apply (rule ccorres_fail)+
|
|
-- "ReplyCap case"
|
|
apply (rule ccorres_rhs_assoc)
|
|
apply csymbr
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
apply (simp add: cap_get_tag_ReplyCap)
|
|
apply (case_tac " (capReplyMaster_CL (cap_reply_cap_lift cap))=0", simp_all add: to_bool_def)[1]
|
|
apply (ctac (no_vcg) add: cteMove_ccorres)
|
|
apply (rule ccorres_return_CE [unfolded returnOk_def,simplified], simp+)[1]
|
|
apply wp
|
|
apply (rule ccorres_fail')
|
|
apply (rule ccorres_fail)+
|
|
apply (wp getSlotCap_wp)
|
|
apply (clarsimp simp: cap_get_tag_isCap isCap_simps)
|
|
apply wp
|
|
apply vcg
|
|
apply (clarsimp simp: word_sle_def cte_wp_at_ctes_of
|
|
tcb_aligned' cur_tcb'_def
|
|
tcb_cnode_index_defs ptr_add_assertion_positive)
|
|
apply (frule(1) rf_sr_tcb_ctes_array_assertion2[rotated])
|
|
apply (simp add: tcb_cnode_index_defs array_assertion_shrink_right
|
|
rf_sr_ksCurThread)
|
|
done
|
|
|
|
|
|
|
|
|
|
|
|
(************************************************************************)
|
|
(* *)
|
|
(* decodeCNodeInvocation ***********************************************)
|
|
(* *)
|
|
(************************************************************************)
|
|
|
|
lemma ccorres_basic_srnoop2:
|
|
"\<lbrakk> \<And>s. globals (g s) = globals s;
|
|
ccorres_underlying rf_sr Gamm r xf arrel axf G (g ` G') hs a c \<rbrakk>
|
|
\<Longrightarrow> ccorres_underlying rf_sr Gamm r xf arrel axf G G'
|
|
hs a (Basic g ;; c)"
|
|
apply (rule ccorres_guard_imp2)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply assumption
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply clarsimp
|
|
apply simp
|
|
done
|
|
|
|
lemma updateCapData_spec2:
|
|
"\<forall>cap preserve newData. \<Gamma> \<turnstile> \<lbrace> ccap_relation cap \<acute>cap \<and> preserve = to_bool (\<acute>preserve) \<and> newData = \<acute>newData\<rbrace>
|
|
Call updateCapData_'proc
|
|
\<lbrace> ccap_relation (updateCapData preserve newData cap) \<acute>ret__struct_cap_C \<rbrace>"
|
|
by (simp add: updateCapData_spec)
|
|
|
|
lemma mdbRevocable_CL_cte_to_H:
|
|
"(mdbRevocable_CL (cteMDBNode_CL clcte) = 0)
|
|
= (\<not> mdbRevocable (cteMDBNode (cte_to_H clcte)))"
|
|
by (simp add: cte_to_H_def mdb_node_to_H_def to_bool_def)
|
|
|
|
lemma ccorres_add_specific_return:
|
|
"ccorres_underlying sr \<Gamma> r xf arrel axf P P' hs
|
|
(do v \<leftarrow> return val; f v od) c
|
|
\<Longrightarrow> ccorres_underlying sr \<Gamma> r xf arrel axf P P' hs (f val) c"
|
|
by simp
|
|
|
|
(* FIXME: also in Tcb_C *)
|
|
lemma ccorres_subgoal_tailE:
|
|
"\<lbrakk> ccorres rvr xf Q Q' hs (b ()) d;
|
|
ccorres rvr xf Q Q' hs (b ()) d \<Longrightarrow> ccorres rvr xf P P' hs (a >>=E b) (c ;; d) \<rbrakk>
|
|
\<Longrightarrow> ccorres rvr xf P P' hs (a >>=E b) (c ;; d)"
|
|
by simp
|
|
|
|
lemma label_in_CNodeInv_ranges:
|
|
notes invocation_eq_use_types_symm
|
|
= all_invocation_label_defs[THEN invocation_eq_use_type, symmetric, simplified,
|
|
unfolded enum_invocation_label, simplified]
|
|
shows
|
|
"(label < scast Kernel_C.CNodeRevoke \<or> scast Kernel_C.CNodeSaveCaller < label)
|
|
= (invocation_type label \<notin> set [CNodeRevoke .e. CNodeSaveCaller])"
|
|
"(scast Kernel_C.CNodeCopy \<le> label \<and> label \<le> scast Kernel_C.CNodeMutate)
|
|
= (invocation_type label \<in> set [CNodeCopy .e. CNodeMutate])"
|
|
apply (simp_all add: upto_enum_def fromEnum_def enum_invocation_label
|
|
del: upt.simps)
|
|
apply (simp_all add: atLeastLessThanSuc)
|
|
apply (simp_all add: toEnum_def enum_invocation_label)
|
|
apply (simp_all add: invocation_eq_use_types_symm[simplified] invocation_label_defs)
|
|
apply (simp_all add: unat_arith_simps)
|
|
apply arith+
|
|
done
|
|
|
|
lemma cnode_invok_case_cleanup2:
|
|
"i \<in> set [CNodeCopy .e. CNodeMutate] \<Longrightarrow>
|
|
(case i of CNodeRevoke \<Rightarrow> P | CNodeDelete \<Rightarrow> Q | CNodeRecycle \<Rightarrow> R
|
|
| CNodeRotate \<Rightarrow> S | CNodeSaveCaller \<Rightarrow> T | _ \<Rightarrow> U) = U"
|
|
apply (rule cnode_invok_case_cleanup)
|
|
apply (simp add: upto_enum_def fromEnum_def toEnum_def
|
|
enum_invocation_label)
|
|
apply auto
|
|
done
|
|
|
|
lemma Arch_hasRecycleRights_spec:
|
|
"\<forall>cap. \<Gamma> \<turnstile> \<lbrace> ccap_relation (ArchObjectCap cap) \<acute>cap \<rbrace>
|
|
Call Arch_hasRecycleRights_'proc
|
|
\<lbrace> \<acute>ret__unsigned_long = from_bool (Arch.hasRecycleRights cap) \<rbrace>"
|
|
apply vcg
|
|
apply clarsimp
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (frule cap_get_tag_PageCap_frame [THEN iffD1], assumption)
|
|
apply clarsimp
|
|
apply (drule ccap_relation_PageCap_generics)
|
|
apply (auto simp: ARM_H.hasRecycleRights_def
|
|
vmrights_to_H_def true_def false_def
|
|
vmrights_defs
|
|
dest: less_4_cases
|
|
split: if_splits)[1]
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (frule cap_get_tag_PageCap_small_frame [THEN iffD1], assumption)
|
|
apply clarsimp
|
|
apply (drule ccap_relation_PageCap_generics)
|
|
apply (auto simp: ARM_H.hasRecycleRights_def
|
|
vmrights_to_H_def true_def false_def
|
|
vmrights_defs
|
|
dest: less_4_cases
|
|
split: if_splits)[1]
|
|
apply (case_tac cap,
|
|
auto simp: ARM_H.hasRecycleRights_def
|
|
dest: ccap_relation_frame_tags)[1]
|
|
done
|
|
|
|
lemma hasRecycleRights_spec:
|
|
"\<forall>cap. \<Gamma> \<turnstile> \<lbrace> ccap_relation cap \<acute>cap \<rbrace>
|
|
Call hasRecycleRights_'proc
|
|
\<lbrace> \<acute>ret__unsigned_long = from_bool (hasRecycleRights cap) \<rbrace>"
|
|
apply vcg
|
|
apply (clarsimp simp: if_1_0_0)
|
|
apply (rule conjI)
|
|
-- "DomainCap"
|
|
apply clarsimp
|
|
apply (drule (1) cap_get_tag_to_H)
|
|
apply (clarsimp simp: hasRecycleRights_def)
|
|
apply (rule conjI)
|
|
-- "NullCap"
|
|
apply clarsimp
|
|
apply (drule cap_get_tag_to_H, simp)
|
|
apply (clarsimp simp: hasRecycleRights_def)
|
|
apply (rule impI)
|
|
apply (rule conjI)
|
|
-- "EP"
|
|
apply clarsimp
|
|
apply (drule sym, drule (1) cap_get_tag_to_H)
|
|
apply (clarsimp simp: hasRecycleRights_def to_bool_def
|
|
true_def false_def
|
|
split: split_if bool.splits)
|
|
apply (rule impI)
|
|
apply (rule conjI)
|
|
-- "NTFN"
|
|
apply clarsimp
|
|
apply (drule sym, drule (1) cap_get_tag_to_H)
|
|
apply (clarsimp simp: hasRecycleRights_def to_bool_def
|
|
true_def false_def
|
|
split: split_if bool.splits)
|
|
apply (rule impI)
|
|
apply (rule conjI)
|
|
-- "Arch"
|
|
apply (clarsimp simp: from_bool_neq_0)
|
|
apply (frule (1) cap_get_tag_isCap_ArchObject2_worker [rotated])
|
|
apply (rule refl)
|
|
apply (clarsimp simp: isCap_simps hasRecycleRights_def)
|
|
apply fastforce
|
|
-- "rest"
|
|
apply (case_tac cap,
|
|
auto simp: cap_get_tag_isCap_unfolded_H_cap cap_tag_defs
|
|
from_bool_def false_def true_def hasRecycleRights_def
|
|
dest: cap_get_tag_isArchCap_unfolded_H_cap
|
|
split: capability.splits bool.splits)[1]
|
|
done
|
|
|
|
lemma updateCapData_Untyped:
|
|
"isUntypedCap a
|
|
\<Longrightarrow> updateCapData b c a = a"
|
|
by (clarsimp simp:isCap_simps updateCapData_def)
|
|
|
|
lemma ctes_of_valid_strengthen:
|
|
"(invs' s \<and> ctes_of s p = Some cte) \<longrightarrow> valid_cap' (cteCap cte) s"
|
|
apply (case_tac cte)
|
|
apply clarsimp
|
|
apply (erule ctes_of_valid_cap')
|
|
apply fastforce
|
|
done
|
|
|
|
lemma decodeCNodeInvocation_ccorres:
|
|
shows
|
|
"interpret_excaps extraCaps' = excaps_map extraCaps \<Longrightarrow>
|
|
ccorres (intr_and_se_rel \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and (\<lambda>s. ksCurThread s = thread)
|
|
and sch_act_simple and ct_active'
|
|
and valid_cap' cp
|
|
and (excaps_in_mem extraCaps \<circ> ctes_of)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v).
|
|
ex_nonz_cap_to' y s)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps.
|
|
s \<turnstile>' fst v)
|
|
and sysargs_rel args buffer)
|
|
(UNIV
|
|
\<inter> {s. unat (length___unsigned_long_' s) = length args}
|
|
\<inter> {s. ccap_relation cp (cap_' s)}
|
|
\<inter> {s. excaps_' s = extraCaps'}
|
|
\<inter> {s. call_' s = from_bool isCall}
|
|
\<inter> {s. invLabel_' s = lab}
|
|
\<inter> {s. buffer_' s = option_to_ptr buffer}) []
|
|
(decodeCNodeInvocation lab args cp (map fst extraCaps)
|
|
>>= invocationCatch thread isBlocking isCall InvokeCNode)
|
|
(Call decodeCNodeInvocation_'proc)"
|
|
apply (cases "\<not>isCNodeCap cp")
|
|
apply (simp add: decodeCNodeInvocation_def
|
|
cong: conj_cong)
|
|
apply (rule ccorres_fail')
|
|
apply (cinit' (no_subst_asm) lift: length___unsigned_long_' cap_' excaps_'
|
|
call_' invLabel_' buffer_')
|
|
apply (clarsimp simp: word_less_nat_alt decodeCNodeInvocation_def
|
|
list_case_If2 invocation_eq_use_types
|
|
label_in_CNodeInv_ranges[unfolded word_less_nat_alt]
|
|
cnode_invok_case_cleanup2
|
|
simp del: Collect_const
|
|
cong: call_ignore_cong globals.fold_congs
|
|
StateSpace.state.fold_congs bool.case_cong
|
|
cong del: invocation_label.case_cong_weak)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: unlessE_def throwError_bind invocationCatch_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: throwError_bind invocationCatch_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: length_ineq_not_Nil unlessE_whenE
|
|
del: Collect_const cong: call_ignore_cong)
|
|
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 (simp add: split_def Let_def invocationCatch_use_injection_handler
|
|
injection_bindE [OF refl refl] bindE_assoc
|
|
del: Collect_const)
|
|
(* sigh \<dots> just going to blog this here. i can't use call_ignore_cong
|
|
because we need to rewrite within at least one argument in order to
|
|
match the rewrite that's happened in the argument to ?R13918 and we
|
|
can't apply ctac below. but once we have simplified away
|
|
newData = newData below there's no way to get it back. sigh *)
|
|
apply (ctac add: ccorres_injection_handler_csum1
|
|
[OF lookupTargetSlot_ccorres,
|
|
unfolded lookupTargetSlot_def])
|
|
apply (simp add: Collect_False del: Collect_const
|
|
cong: call_ignore_cong)
|
|
apply csymbr
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: word_less_nat_alt
|
|
del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_rhs_assoc | csymbr)+
|
|
apply (simp add: invocationCatch_use_injection_handler
|
|
[symmetric, unfolded o_def]
|
|
if_1_0_0 dc_def[symmetric]
|
|
del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add:if_P del: Collect_const)
|
|
apply (rule ccorres_cond_true_seq)
|
|
apply (simp add: throwError_bind invocationCatch_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: linorder_not_less del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (simp add: if_1_0_0 interpret_excaps_test_null
|
|
excaps_map_def
|
|
del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: throwError_bind invocationCatch_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=2 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=3 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 (rule ccorres_assert2)
|
|
apply (simp add: split_def invocationCatch_use_injection_handler
|
|
injection_bindE [OF refl refl] bindE_assoc
|
|
injection_liftE [OF refl] if_not_P
|
|
cong: call_ignore_cong)
|
|
apply (ctac add: ccorres_injection_handler_csum1 [OF ensureEmptySlot_ccorres])
|
|
prefer 2
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply simp
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply simp
|
|
apply (ctac add: ccorres_injection_handler_csum1
|
|
[OF lookupSourceSlot_ccorres,
|
|
unfolded lookupSourceSlot_def])
|
|
prefer 2
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply simp
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply (simp add: liftE_bindE cong: call_ignore_cong)
|
|
apply csymbr
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_pre_getCTE)
|
|
apply (rule ccorres_add_return)
|
|
apply (rule_tac xf'=ret__unsigned_'
|
|
and r'="\<lambda>_ rv'. (rv' = scast cap_null_cap)
|
|
= (cteCap rvb = NullCap)"
|
|
in ccorres_split_nothrow)
|
|
apply (rule_tac P'="{s. \<exists>v. cslift s (cte_Ptr rva) = Some v
|
|
\<and> ccte_relation rvb v}"
|
|
in ccorres_from_vcg[where P=\<top>])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (rule subsetI, clarsimp simp: Collect_const_mem return_def)
|
|
apply (clarsimp dest!: ccte_relation_ccap_relation
|
|
simp: cap_get_tag_NullCap
|
|
typ_heap_simps)
|
|
apply ceqv
|
|
apply (simp del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError)
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def hd_conv_nth
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases numeral_eqs)
|
|
apply (clarsimp simp: lookup_fault_missing_capability_lift
|
|
mask_eq_iff_w2p word_size word_less_nat_alt
|
|
word_bits_def hd_conv_nth)
|
|
apply (simp add: whenE_def[where P=False]
|
|
injection_handler_returnOk Collect_const[symmetric]
|
|
cong: call_ignore_cong del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
-- "CNodeCopy case"
|
|
apply (simp add: Collect_const[symmetric] del: Collect_const)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_throwError dc_def[symmetric]
|
|
if_P)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: list_case_helper injection_handler_returnOk
|
|
split_def hd_conv_nth numeral_eqs[symmetric]
|
|
if_not_P
|
|
del: Collect_const)
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=4 and buffer=buffer])
|
|
apply csymbr
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (simp add: split_def del: Collect_const)
|
|
apply (rule_tac val="maskCapRights (rightsFromWord (args ! 4)) (cteCap rvb)"
|
|
in ccorres_add_specific_return)
|
|
apply (ctac add: maskCapRights_ccorres)
|
|
apply (ctac add: ccorres_injection_handler_csum1 [OF deriveCap_ccorres])
|
|
prefer 2
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply simp
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply simp
|
|
apply csymbr
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (simp add: cap_get_tag_NullCap del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_throwError whenE_def
|
|
dc_def[symmetric])
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: whenE_def injection_handler_returnOk
|
|
ccorres_invocationCatch_Inr performInvocation_def
|
|
bindE_assoc false_def)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (simp add: ccorres_cond_iffs)
|
|
apply (ctac(no_vcg) add: invokeCNodeInsert_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply wp
|
|
apply (wp sts_valid_pspace_hangers)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply simp
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply (rule hoare_post_imp_R)
|
|
apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
|
|
and valid_cap' rv and valid_objs'
|
|
and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
|
|
in hoare_vcg_R_conj)
|
|
apply (rule deriveCap_Null_helper[OF deriveCap_derived])
|
|
apply wp
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
apply (simp add: is_derived'_def badge_derived'_def
|
|
valid_tcb_state'_def)
|
|
apply (simp add: Collect_const_mem all_ex_eq_helper)
|
|
apply (vcg exspec=deriveCap_modifies)
|
|
apply wp
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=maskCapRights_modifies)
|
|
apply wp
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
-- "CNodeMint case"
|
|
apply (simp add: Collect_const[symmetric]
|
|
del: Collect_const)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp split: split_if simp: injection_handler_throwError)
|
|
apply (auto simp: throwError_def return_def
|
|
syscall_error_to_H_cases syscall_error_rel_def
|
|
exception_defs)[1]
|
|
apply (simp add: list_case_helper injection_handler_returnOk
|
|
split_def linorder_not_less numeral_eqs[symmetric]
|
|
hd_conv_nth le_Suc_eq le_imp_diff_is_add if_not_P
|
|
del: Collect_const)
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=4 and buffer=buffer])
|
|
apply csymbr
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=5 and buffer=buffer])
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (simp del: Collect_const)
|
|
apply (rule_tac val="maskCapRights (rightsFromWord (args ! 4)) (cteCap rvb)"
|
|
in ccorres_add_specific_return)
|
|
apply (ctac add: maskCapRights_ccorres)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (ctac add: ccorres_injection_handler_csum1 [OF deriveCap_ccorres])
|
|
prefer 2
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply simp
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply simp
|
|
apply csymbr
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (simp add: cap_get_tag_NullCap del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_returnOk
|
|
invocationCatch_def injection_handler_throwError
|
|
dc_def[symmetric])
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: whenE_def injection_handler_returnOk
|
|
ccorres_invocationCatch_Inr false_def
|
|
performInvocation_def bindE_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (simp add: ccorres_cond_iffs)
|
|
apply (ctac(no_vcg) add: invokeCNodeInsert_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply wp
|
|
apply (wp sts_valid_pspace_hangers)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (simp add: conj_comms valid_tcb_state'_def)
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply (rule hoare_post_imp_R)
|
|
apply (rule_tac Q'="\<lambda>rv. valid_pspace' and valid_queues
|
|
and valid_cap' rv and valid_objs'
|
|
and tcb_at' thread and (\<lambda>s. sch_act_wf (ksSchedulerAction s) s)"
|
|
in hoare_vcg_R_conj)
|
|
apply (rule deriveCap_Null_helper [OF deriveCap_derived])
|
|
apply wp
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
apply (simp add: is_derived'_def badge_derived'_def)
|
|
apply (simp add: Collect_const_mem all_ex_eq_helper)
|
|
apply (vcg exspec=deriveCap_modifies)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=updateCapData_spec2)
|
|
apply (rule conseqPre, vcg exspec=updateCapData_spec2, clarsimp)
|
|
apply fastforce
|
|
apply simp
|
|
apply wp
|
|
apply (simp add: Collect_const_mem hd_drop_conv_nth)
|
|
apply (vcg exspec=maskCapRights_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
-- "CNodeMove case"
|
|
apply (simp add: Collect_const[symmetric] split_def
|
|
injection_handler_returnOk whenE_def
|
|
ccorres_invocationCatch_Inr
|
|
performInvocation_def bindE_assoc
|
|
del: Collect_const)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'=newCap_' in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="ccap_relation (cteCap rvb) rv'a"
|
|
in ccorres_gen_asm2)
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (simp add: cap_get_tag_NullCap true_def)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (simp add: ccorres_cond_iffs)
|
|
apply (ctac(no_vcg) add: invokeCNodeMove_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply wp
|
|
apply (wp sts_valid_pspace_hangers)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply vcg
|
|
apply (rule conseqPre, vcg, clarsimp)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
-- "CNodeMutate case"
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (simp add: Collect_const[symmetric] del: Collect_const
|
|
cong: call_ignore_cong)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_throwError dc_def[symmetric] if_P)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: if_not_P del: Collect_const)
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=4 and buffer=buffer])
|
|
apply (simp add: list_case_helper split_def hd_conv_nth
|
|
Collect_const[symmetric]
|
|
injection_handler_returnOk
|
|
del: Collect_const)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'="newCap_'" in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="ccap_relation (updateCapData True (args ! 4) (cteCap rvb)) rv'a"
|
|
in ccorres_gen_asm2)
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (simp add: cap_get_tag_isCap del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError
|
|
dc_def[symmetric] numeral_eqs)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: whenE_def injection_handler_returnOk
|
|
ccorres_invocationCatch_Inr numeral_eqs
|
|
performInvocation_def bindE_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (simp add: true_def ccorres_cond_iffs)
|
|
apply (ctac(no_vcg) add: invokeCNodeMove_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply (wp sts_valid_pspace_hangers)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (simp add: Collect_const_mem exception_defs)
|
|
apply (vcg exspec=updateCapData_spec2)
|
|
apply (rule conseqPre, vcg exspec=updateCapData_spec2, clarsimp)
|
|
apply fastforce
|
|
apply wp
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply (rule ccorres_inst[where P=\<top> and P'=UNIV])
|
|
apply (simp add: upto_enum_def fromEnum_def toEnum_def
|
|
enum_invocation_label)
|
|
apply (wp getCTE_wp')
|
|
apply (simp add: Collect_const_mem)
|
|
apply vcg
|
|
apply (simp add: cte_wp_at_ctes_of[where P="op = cte" for cte]
|
|
cte_wp_at_ctes_of[where P="\<lambda>cte. Q cte \<and> R cte" for Q R]
|
|
badge_derived_updateCapData)
|
|
apply (rule validE_R_validE)
|
|
apply (rule_tac Q'="\<lambda>a b. cte_wp_at' (\<lambda>x. True) a b \<and> invs' b \<and>
|
|
tcb_at' thread b \<and> sch_act_wf (ksSchedulerAction b) b \<and> valid_tcb_state' Restart b
|
|
\<and> Q2 b" for Q2 in hoare_post_imp_R)
|
|
prefer 2
|
|
apply (clarsimp simp:cte_wp_at_ctes_of)
|
|
apply (drule ctes_of_valid')
|
|
apply (erule invs_valid_objs')
|
|
apply (clarsimp simp:valid_updateCapDataI invs_queues invs_valid_objs' invs_valid_pspace')
|
|
apply (assumption)
|
|
apply (wp hoare_vcg_all_lift_R injection_wp_E[OF refl]
|
|
lsfco_cte_at' hoare_vcg_const_imp_lift_R
|
|
)+
|
|
apply (simp add: Collect_const_mem word_sle_def word_sless_def
|
|
all_ex_eq_helper)
|
|
apply (vcg exspec=lookupSourceSlot_modifies)
|
|
apply simp
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=ensureEmptySlot_modifies)
|
|
apply simp
|
|
apply (wp hoare_drop_imps)[1]
|
|
apply (simp add: Collect_const_mem)
|
|
apply vcg
|
|
apply wp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply wp
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (vcg exspec=getSyscallArg_modifies
|
|
exspec=ensureEmptySlot_modifies exspec=lookupSourceSlot_modifies
|
|
exspec=maskCapRights_modifies exspec=updateCapData_modifies
|
|
exspec=setThreadState_modifies exspec=invokeCNodeMove_modifies
|
|
exspec=invokeCNodeInsert_modifies exspec=deriveCap_modifies)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_returnOk ccorres_invocationCatch_Inr
|
|
performInvocation_def bindE_assoc)
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (ctac(no_vcg) add: invokeCNodeRevoke_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply (wp sts_invs_minor')
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (vcg exspec=setThreadState_modifies exspec=invokeCNodeRevoke_modifies)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_returnOk ccorres_invocationCatch_Inr
|
|
performInvocation_def bindE_assoc)
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (ctac(no_vcg) add: invokeCNodeDelete_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply (wp sts_invs_minor')
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (vcg exspec=setThreadState_modifies exspec=invokeCNodeDelete_modifies)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_returnOk bindE_assoc
|
|
injection_bindE[OF refl refl] split_def
|
|
dc_def[symmetric])
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (ctac add: ccorres_injection_handler_csum1 [OF ensureEmptySlot_ccorres])
|
|
apply (simp add: ccorres_invocationCatch_Inr performInvocation_def
|
|
dc_def[symmetric] bindE_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (ctac(no_vcg) add: invokeCNodeSaveCaller_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply (wp sts_valid_pspace_hangers)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (simp add: dc_def[symmetric])
|
|
apply (rule ccorres_split_throws)
|
|
apply simp
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply (simp add: all_ex_eq_helper)
|
|
apply (vcg exspec=ensureEmptySlot_modifies)
|
|
apply (vcg exspec=invokeCNodeSaveCaller_modifies exspec=setThreadState_modifies
|
|
exspec=ensureEmptySlot_modifies)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: injection_handler_returnOk ccorres_invocationCatch_Inr
|
|
injection_bindE[OF refl refl] bindE_assoc
|
|
injection_liftE [OF refl] split_def
|
|
del: Collect_const)
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (simp only: liftE_bindE)
|
|
apply (rule ccorres_pre_getCTE)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'=ret__unsigned_long_' in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="rv' = from_bool (hasRecycleRights (cteCap rva))"
|
|
in ccorres_gen_asm2)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: unlessE_def whenE_def injection_handler_throwError
|
|
dc_def[symmetric] from_bool_0)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: unlessE_def whenE_def injection_handler_returnOk
|
|
from_bool_neq_0
|
|
del: Collect_const)
|
|
apply (simp add: unlessE_def injection_handler_returnOk
|
|
ccorres_invocationCatch_Inr
|
|
performInvocation_def bindE_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (ctac(no_vcg) add: invokeCNodeRecycle_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply (wp sts_invs_minor')
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (simp add: Collect_const_mem)
|
|
apply vcg
|
|
apply (rule conseqPre, vcg, clarsimp)
|
|
apply fastforce
|
|
apply (vcg exspec=setThreadState_modifies
|
|
exspec=invokeCNodeRecycle_modifies
|
|
exspec=hasRecycleRights_modifies)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply csymbr+
|
|
apply (simp add: if_1_0_0 del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: if_P | rule ccorres_cond_true_seq)+
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp simp: injection_handler_throwError
|
|
split: list.split)
|
|
apply (simp add: throwError_def return_def exception_defs
|
|
syscall_error_rel_def syscall_error_to_H_cases)
|
|
apply clarsimp
|
|
apply (simp add: invocationCatch_use_injection_handler
|
|
[symmetric, unfolded o_def]
|
|
del: Collect_const)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (simp add: interpret_excaps_test_null excaps_map_def
|
|
if_1_0_0 dc_def[symmetric]
|
|
del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: throwError_bind invocationCatch_def)
|
|
apply (rule ccorres_cond_true_seq)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (simp add: interpret_excaps_test_null Suc_length_not_empty'
|
|
if_1_0_0 del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (clarsimp simp: neq_Nil_conv)
|
|
apply (simp add: throwError_bind invocationCatch_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: split_def Collect_const[symmetric] del: Collect_const)
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=2 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=3 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=4 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=5 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=6 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=7 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 (rule ccorres_assert2)
|
|
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 (simp add: le_Suc_eq if_not_P length_ineq_not_Nil)
|
|
apply (simp add: invocationCatch_use_injection_handler
|
|
injection_liftE [OF refl] injection_handler_returnOk
|
|
injection_bindE [OF refl refl] bindE_assoc)
|
|
apply (ctac add: ccorres_injection_handler_csum1
|
|
[OF lookupSourceSlot_ccorres, unfolded lookupSourceSlot_def])
|
|
prefer 2
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply (simp add: Collect_False del: Collect_const)
|
|
apply csymbr
|
|
apply (ctac add: ccorres_injection_handler_csum1
|
|
[OF lookupPivotSlot_ccorres, unfolded lookupPivotSlot_def])
|
|
prefer 2
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply (simp add: Collect_False split_def
|
|
del: Collect_const)
|
|
apply csymbr
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError
|
|
dc_def[symmetric])
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: whenE_def[where P=False] injection_handler_returnOk
|
|
del: Collect_const)
|
|
apply (rule ccorres_subgoal_tailE)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (simp add: injection_handler_returnOk del: Collect_const)
|
|
apply (simp add: liftE_bindE liftM_def del: Collect_const)
|
|
apply (rule ccorres_pre_getCTE)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'=ret__unsigned_' in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="(rv' = scast cap_null_cap) = (cteCap rvc = NullCap)"
|
|
in ccorres_gen_asm2)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError)
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def hd_conv_nth
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases numeral_eqs[symmetric])
|
|
apply (clarsimp simp: lookup_fault_missing_capability_lift
|
|
mask_eq_iff_w2p word_size word_less_nat_alt
|
|
word_bits_def)
|
|
apply (simp add: injection_handler_returnOk whenE_def[where P=False]
|
|
del: Collect_const)
|
|
apply (rule ccorres_pre_getCTE)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'=ret__unsigned_' in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="(rv'a = scast cap_null_cap) = (cteCap x = NullCap)"
|
|
in ccorres_gen_asm2)
|
|
apply (simp del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError)
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def hd_conv_nth
|
|
exception_defs syscall_error_rel_def
|
|
numeral_eqs)
|
|
apply (simp add: syscall_error_to_H_cases
|
|
lookup_fault_missing_capability_lift)
|
|
apply (simp add: mask_eq_iff_w2p word_less_nat_alt
|
|
word_size word_bits_def)
|
|
apply (simp add: whenE_def[where P=False] injection_handler_returnOk
|
|
hd_conv_nth numeral_eqs[symmetric]
|
|
del: Collect_const)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'="newSrcCap_'" in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="ccap_relation (updateCapData True (args ! 5) (cteCap rvc)) rv'b"
|
|
in ccorres_gen_asm2)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'="newPivotCap_'" in ccorres_abstract, ceqv)
|
|
apply (rule_tac P="ccap_relation (updateCapData True (args ! 2) (cteCap x)) rv'c"
|
|
in ccorres_gen_asm2)
|
|
apply csymbr
|
|
apply (simp add: cap_get_tag_NullCap del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError
|
|
dc_def[symmetric])
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: whenE_def[where P=False] injection_handler_returnOk
|
|
del: Collect_const)
|
|
apply csymbr
|
|
apply (simp add: cap_get_tag_NullCap del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: whenE_def injection_handler_throwError
|
|
dc_def[symmetric])
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (simp add: whenE_def injection_handler_returnOk
|
|
ccorres_invocationCatch_Inr
|
|
performInvocation_def bindE_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_split_throws)
|
|
apply (ctac(no_vcg) add: invokeCNodeRotate_ccorres)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_return_CE, simp+)[1]
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply wp
|
|
apply (vcg exspec=invokeCNodeRotate_modifies)
|
|
apply (wp static_imp_wp)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=updateCapData_spec2)
|
|
apply (rule conseqPre, vcg exspec=updateCapData_spec2)
|
|
apply clarsimp
|
|
apply fastforce
|
|
apply (simp add: Collect_const_mem)
|
|
apply (vcg exspec=updateCapData_spec2)
|
|
apply (rule conseqPre, vcg exspec=updateCapData_spec2)
|
|
apply clarsimp
|
|
apply fastforce
|
|
apply (simp add: Collect_const_mem)
|
|
apply vcg
|
|
apply (rule conseqPre, vcg, clarsimp)
|
|
apply (simp add: Collect_const_mem)
|
|
apply vcg
|
|
apply (rule conseqPre, vcg, clarsimp)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (simp add: unlessE_def)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
apply (ctac add: ccorres_injection_handler_csum1
|
|
[OF ensureEmptySlot_ccorres])
|
|
apply (simp add: Collect_False del: Collect_const)
|
|
apply simp
|
|
apply (rule ccorres_split_throws)
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply simp
|
|
apply (wp injection_wp_E[OF refl] ensureEmptySlot_stronger)
|
|
apply (simp add: Collect_const_mem all_ex_eq_helper)
|
|
apply (vcg exspec=ensureEmptySlot_modifies)
|
|
apply (simp add: unlessE_def injection_handler_returnOk
|
|
del: Collect_const)
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply (rule_tac Q'="\<lambda>rvb. invs'
|
|
and cte_at' rv and cte_at' rva
|
|
and tcb_at' thread"
|
|
in hoare_post_imp_R)
|
|
apply (wp lsfco_cte_at')
|
|
apply (clarsimp simp: cte_wp_at_ctes_of weak_derived_updateCapData
|
|
capBadge_updateCapData_True)
|
|
apply (simp add: valid_tcb_state'_def)
|
|
apply (auto simp:updateCapData_Untyped
|
|
elim!: valid_updateCapDataI[OF ctes_of_valid'])[1]
|
|
apply (simp add: Collect_const_mem all_ex_eq_helper)
|
|
apply (vcg exspec=lookupPivotSlot_modifies)
|
|
apply simp
|
|
apply (wp injection_wp_E[OF refl]
|
|
lsfco_cte_at')
|
|
apply (simp add: Collect_const_mem all_ex_eq_helper)
|
|
apply (vcg exspec=lookupSourceSlot_modifies)
|
|
apply simp
|
|
apply (wp | wp_once hoare_drop_imps)+
|
|
apply simp
|
|
apply vcg
|
|
apply simp
|
|
apply (wp | wp_once hoare_drop_imps)+
|
|
apply simp
|
|
apply vcg
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (wp static_imp_wp)
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (wp static_imp_wp)
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (wp static_imp_wp)
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (rule ccorres_inst[where P=\<top> and P'=UNIV])
|
|
apply (simp add: upto_enum_def fromEnum_def toEnum_def
|
|
enum_invocation_label)
|
|
apply (rule ccorres_split_throws)
|
|
apply (simp add: ccorres_cond_iffs)
|
|
apply (rule ccorres_return_C_errorE, simp+)[1]
|
|
apply vcg
|
|
apply simp
|
|
apply (wp injection_wp_E[OF refl] hoare_vcg_const_imp_lift_R
|
|
hoare_vcg_all_lift_R lsfco_cte_at' static_imp_wp | wp_once hoare_drop_imps)+
|
|
apply (simp add: all_ex_eq_helper)
|
|
apply (vcg exspec=lookupTargetSlot_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply (clarsimp simp: valid_tcb_state'_def invs_valid_objs' invs_valid_pspace'
|
|
ct_in_state'_def pred_tcb_at' invs_queues
|
|
cur_tcb'_def word_sle_def word_sless_def
|
|
unat_lt2p[where 'a=32, folded word_bits_def])
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: sysargs_rel_n_def n_msgRegisters_def excaps_map_def
|
|
cte_wp_at_ctes_of excaps_in_mem_def slotcap_in_mem_def
|
|
sysargs_rel_def length_ineq_not_Nil
|
|
dest!: interpret_excaps_eq)
|
|
(* why does auto with these rules take ten times as long? *)
|
|
apply ((rule conjI | clarsimp simp:split_def neq_Nil_conv
|
|
| erule pred_tcb'_weakenE disjE
|
|
| drule st_tcb_at_idle_thread')+)[1]
|
|
apply (frule interpret_excaps_eq)
|
|
apply (clarsimp simp: excaps_map_def mask_def[where n=4]
|
|
ccap_rights_relation_def rightsFromWord_wordFromRights
|
|
"StrictC'_thread_state_defs" map_comp_Some_iff
|
|
rf_sr_ksCurThread hd_conv_nth hd_drop_conv_nth)
|
|
apply ((rule conjI
|
|
| clarsimp simp: rightsFromWord_wordFromRights
|
|
ccte_relation_def c_valid_cte_def
|
|
cl_valid_cte_def c_valid_cap_def
|
|
map_option_Some_eq2 neq_Nil_conv
|
|
ccap_relation_def numeral_eqs
|
|
ccap_relation_NullCap_iff[symmetric]
|
|
if_1_0_0 interpret_excaps_test_null
|
|
mdbRevocable_CL_cte_to_H false_def true_def
|
|
| clarsimp simp: typ_heap_simps'
|
|
| frule length_ineq_not_Nil)+)
|
|
done
|
|
|
|
end
|
|
|
|
context begin interpretation Arch . (*FIXME: arch_split*)
|
|
|
|
crunch valid_queues[wp]: insertNewCap "valid_queues"
|
|
(wp: crunch_wps)
|
|
|
|
lemmas setCTE_def3 = setCTE_def2[THEN eq_reflection]
|
|
|
|
lemma setCTE_sch_act_wf[wp]:
|
|
"\<lbrace> \<lambda>s. sch_act_wf (ksSchedulerAction s) s \<rbrace>
|
|
setCTE src cte
|
|
\<lbrace>\<lambda>x s. sch_act_wf (ksSchedulerAction s) s \<rbrace>"
|
|
by (wp sch_act_wf_lift setCTE_pred_tcb_at' setCTE_tcb_in_cur_domain')
|
|
|
|
crunch sch_act_wf[wp]: insertNewCap "\<lambda>s. sch_act_wf (ksSchedulerAction s) s"
|
|
(wp: crunch_wps ignore: setCTE)
|
|
|
|
crunch ksCurThread[wp]: deleteObjects "\<lambda>s. P (ksCurThread s)"
|
|
(wp: crunch_wps ignore:freeMemory simp : unless_def)
|
|
|
|
lemma deleteObjects_gsCNodes_at_pt:
|
|
"\<lbrace>(\<lambda>s. P (gsCNodes s ptr))
|
|
and K (ptr \<notin> {ptr_base .. ptr_base + 2 ^ sz - 1} \<and> is_aligned ptr_base sz)\<rbrace>
|
|
deleteObjects ptr_base sz
|
|
\<lbrace>\<lambda>rv s. P (gsCNodes s ptr)\<rbrace>"
|
|
apply (rule hoare_gen_asm)
|
|
apply (simp add: deleteObjects_def2)
|
|
apply (wp | simp cong: conj_cong
|
|
| wp_once hoare_drop_imps)+
|
|
done
|
|
|
|
crunch gsCNodes[wp]: setThreadState, updateFreeIndex,
|
|
preemptionPoint "\<lambda>s. P (gsCNodes s)"
|
|
(simp: unless_def whenE_def)
|
|
|
|
lemma resetUntypedCap_gsCNodes_at_pt:
|
|
"\<lbrace>(\<lambda>s. P (gsCNodes s ptr))
|
|
and cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and> ptr \<notin> untypedRange (cteCap cte)) slot
|
|
and valid_objs'\<rbrace>
|
|
resetUntypedCap slot
|
|
\<lbrace>\<lambda>rv s. P (gsCNodes s ptr)\<rbrace>, -"
|
|
apply (simp add: resetUntypedCap_def unlessE_def)
|
|
apply (rule hoare_pre)
|
|
apply (wp mapME_x_wp')
|
|
apply (wp hoare_vcg_const_imp_lift
|
|
deleteObjects_gsCNodes_at_pt
|
|
getSlotCap_wp)
|
|
apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
|
|
apply (frule(1) ctes_of_valid')
|
|
apply (clarsimp simp: valid_cap_simps' capAligned_def)
|
|
done
|
|
|
|
end
|
|
|
|
context kernel_m begin
|
|
|
|
lemma wordFromMessageInfo_spec:
|
|
"\<forall>s. \<Gamma> \<turnstile> {s} Call wordFromMessageInfo_'proc
|
|
\<lbrace>\<acute>ret__unsigned_long = index (seL4_MessageInfo_C.words_C (mi_' s)) (unat 0)\<rbrace>"
|
|
apply (hoare_rule HoarePartial.ProcNoRec1)
|
|
apply vcg
|
|
apply (simp add: word_sless_def word_sle_def)
|
|
done
|
|
|
|
lemma seL4_MessageInfo_lift_def2:
|
|
"seL4_MessageInfo_lift message_info \<equiv>
|
|
\<lparr>label_CL = (index (seL4_MessageInfo_C.words_C message_info) 0 >> 12) && mask 20,
|
|
capsUnwrapped_CL = (index (seL4_MessageInfo_C.words_C message_info) 0 >> 9) && mask 3,
|
|
extraCaps_CL = (index (seL4_MessageInfo_C.words_C message_info) 0 >> 7) && mask 2,
|
|
length_CL = (index (seL4_MessageInfo_C.words_C message_info) 0 >> 0) && mask 7\<rparr>"
|
|
apply (simp add: seL4_MessageInfo_lift_def mask_def)
|
|
done
|
|
|
|
lemma globals_update_id:
|
|
"globals_update (t_hrs_'_update (hrs_htd_update id)) x = x"
|
|
by (simp add:id_def hrs_htd_update_def)
|
|
|
|
lemma getObjectSize_spec:
|
|
"\<forall>s. \<Gamma>\<turnstile>\<lbrace>s. \<acute>t \<le> of_nat (length (enum::object_type list) - 1)\<rbrace> Call getObjectSize_'proc
|
|
\<lbrace>\<acute>ret__unsigned_long = of_nat (getObjectSize (object_type_to_H (t_' s)) (unat (userObjSize_' s)))\<rbrace>"
|
|
apply vcg
|
|
apply (clarsimp simp:ARMSmallPageBits_def ARMLargePageBits_def objBits_simps
|
|
object_type_to_H_def Kernel_C_defs APIType_capBits_def ARMSectionBits_def ARMSuperSectionBits_def)
|
|
apply (simp add:nAPIObjects_def)
|
|
apply (simp add:enum_object_type enum_apiobject_type)
|
|
apply unat_arith
|
|
done
|
|
|
|
lemma object_type_from_H_bound:
|
|
"object_type_from_H newType \<le> of_nat (length (enum::object_type list) - Suc 0)"
|
|
apply (simp add:enum_object_type enum_apiobject_type object_type_from_H_def)
|
|
apply (case_tac newType)
|
|
apply (clarsimp simp:ARMSmallPageBits_def ARMLargePageBits_def objBits_simps
|
|
Kernel_C_defs split:apiobject_type.splits)+
|
|
done
|
|
|
|
lemma updateCap_ct_active'[wp]:
|
|
"\<lbrace>ct_active'\<rbrace> updateCap srcSlot cap \<lbrace>\<lambda>rva. ct_active' \<rbrace>"
|
|
apply (rule hoare_pre)
|
|
apply (simp add:ct_in_state'_def)
|
|
apply (wps|wp|simp add:ct_in_state'_def)+
|
|
done
|
|
|
|
lemma APIType_capBits_low:
|
|
"\<lbrakk> newType = APIObjectType apiobject_type.CapTableObject \<longrightarrow> 0 < us;
|
|
newType = APIObjectType apiobject_type.Untyped \<longrightarrow> 4 \<le> us \<and> us \<le> 29\<rbrakk>
|
|
\<Longrightarrow> 4 \<le> APIType_capBits newType us"
|
|
apply (case_tac newType)
|
|
apply (clarsimp simp:invokeUntyped_proofs_def APIType_capBits_def objBits_simps
|
|
split: apiobject_type.splits)+
|
|
done
|
|
|
|
lemma APIType_capBits_high:
|
|
"\<lbrakk> newType = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28;
|
|
newType = APIObjectType apiobject_type.Untyped \<longrightarrow> us \<le> 29\<rbrakk>
|
|
\<Longrightarrow> APIType_capBits newType us < 32"
|
|
apply (case_tac newType)
|
|
apply (clarsimp simp:invokeUntyped_proofs_def APIType_capBits_def objBits_simps
|
|
split: apiobject_type.splits)+
|
|
done
|
|
|
|
lemma typ_clear_region_eq:
|
|
notes blah[simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
|
|
Int_atLeastAtMost atLeastatMost_empty_iff
|
|
shows
|
|
"\<lbrakk>ctes_of (s::kernel_state) (ptr_val p) = Some cte; is_aligned ptr bits; bits < word_bits;
|
|
{ptr..ptr + 2 ^ bits - 1} \<inter> {ptr_val p..ptr_val p + 0xF} = {}; ((clift hp) :: (cte_C ptr \<rightharpoonup> cte_C)) p = Some to\<rbrakk> \<Longrightarrow>
|
|
(clift (hrs_htd_update (typ_clear_region ptr bits) hp) :: (cte_C ptr \<rightharpoonup> cte_C)) p = Some to"
|
|
apply (clarsimp simp:lift_t_def lift_typ_heap_def Fun.comp_def restrict_map_def split:if_splits)
|
|
apply (intro conjI impI)
|
|
apply (case_tac hp)
|
|
apply (clarsimp simp:typ_clear_region_def hrs_htd_update_def)
|
|
apply (rule arg_cong[where f = from_bytes])
|
|
apply (clarsimp simp:heap_list_s_def lift_state_def proj_h_def)
|
|
apply (case_tac hp)
|
|
apply (clarsimp simp:typ_clear_region_def hrs_htd_update_def)
|
|
apply (clarsimp simp:heap_list_s_def lift_state_def proj_h_def)
|
|
apply (clarsimp simp:s_valid_def h_t_valid_def)
|
|
apply (clarsimp simp:valid_footprint_def Let_def)
|
|
apply (drule spec)
|
|
apply (erule(1) impE)
|
|
apply clarsimp
|
|
apply (rule conjI)
|
|
apply (clarsimp simp add:map_le_def)
|
|
apply (drule_tac x = aa in bspec)
|
|
apply simp
|
|
apply (clarsimp simp:proj_d_def)
|
|
apply (clarsimp simp:hrs_htd_update_def typ_clear_region_def
|
|
split:if_splits option.splits)
|
|
apply (simp add:intvl_range_conv[where 'a=32, folded word_bits_def])
|
|
apply (subgoal_tac "ptr_val p + of_nat y \<in> {ptr_val p..ptr_val p + 0xF}")
|
|
apply blast
|
|
apply (clarsimp simp:blah)
|
|
apply (rule context_conjI)
|
|
apply (rule is_aligned_no_wrap')
|
|
apply (rule ctes_of_is_aligned[where cte = cte and s = s])
|
|
apply simp
|
|
apply (simp add:objBits_simps of_nat_power[where x = 4,simplified])
|
|
apply (rule word_plus_mono_right)
|
|
apply (simp add:word_of_nat_le)
|
|
apply (rule is_aligned_no_wrap')
|
|
apply (rule ctes_of_is_aligned[where cte = cte and s = s])
|
|
apply simp
|
|
apply (clarsimp simp:objBits_simps)
|
|
apply (clarsimp simp:proj_d_def)
|
|
done
|
|
|
|
lemma cte_size_inter_empty:
|
|
notes blah[simp del] = atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
|
|
Int_atLeastAtMost atLeastatMost_empty_iff
|
|
shows "\<lbrakk>invs' s;ctes_of s p = Some cte;isUntypedCap (cteCap cte);p\<notin> capRange (cteCap cte) \<rbrakk>
|
|
\<Longrightarrow> {p .. p + 0xF} \<inter> capRange (cteCap cte) = {}"
|
|
apply (frule ctes_of_valid')
|
|
apply fastforce
|
|
apply (clarsimp simp:isCap_simps valid_cap'_def valid_untyped'_def)
|
|
apply (frule ctes_of_ko_at_strong)
|
|
apply (erule is_aligned_weaken[OF ctes_of_is_aligned])
|
|
apply (simp add:objBits_simps)
|
|
apply clarsimp
|
|
apply (drule_tac x = ptr in spec)
|
|
apply (clarsimp simp:ko_wp_at'_def)
|
|
apply (erule impE)
|
|
apply (erule pspace_alignedD',fastforce)
|
|
apply (frule pspace_distinctD')
|
|
apply fastforce
|
|
apply (clarsimp simp:capAligned_def)
|
|
apply (drule_tac p = v0 and p' = ptr in aligned_ranges_subset_or_disjoint)
|
|
apply (erule pspace_alignedD',fastforce)
|
|
apply (subst (asm) intvl_range_conv[where bits = 4,simplified])
|
|
apply (erule is_aligned_weaken[OF ctes_of_is_aligned])
|
|
apply (simp add:objBits_simps)
|
|
apply (simp add:word_bits_def)
|
|
apply (erule disjE)
|
|
apply (simp add:obj_range'_def field_simps)
|
|
apply blast
|
|
apply (subgoal_tac "p \<in> {p..p+0xF}")
|
|
prefer 2
|
|
apply (clarsimp simp:blah)
|
|
apply (rule is_aligned_no_wrap'[where sz = 4])
|
|
apply (erule is_aligned_weaken[OF ctes_of_is_aligned])
|
|
apply (simp add:objBits_simps)
|
|
apply simp
|
|
apply (simp add:obj_range'_def field_simps)
|
|
apply blast
|
|
done
|
|
|
|
lemma region_is_typelessI:
|
|
"\<lbrakk>hrs_htd (t_hrs_' (globals t)) = hrs_htd (hrs_htd_update (typ_clear_region ptr sz) h) \<rbrakk>
|
|
\<Longrightarrow> region_is_typeless ptr (2^sz) t"
|
|
apply (case_tac h)
|
|
apply (clarsimp simp: typ_clear_region_def region_is_typeless_def
|
|
hrs_htd_def hrs_htd_update_def split:if_splits)
|
|
done
|
|
|
|
lemma rf_sr_cpspace_relation:
|
|
"(s,s') \<in> rf_sr \<Longrightarrow> cpspace_relation (ksPSpace s) (underlying_memory (ksMachineState s)) (t_hrs_' (globals s'))"
|
|
by (clarsimp simp:rf_sr_def cstate_relation_def Let_def)
|
|
|
|
lemma rf_sr_htd_safe_kernel_data_refs:
|
|
"(s, s') \<in> rf_sr \<Longrightarrow> htd_safe (- kernel_data_refs) (hrs_htd (t_hrs_' (globals s')))"
|
|
by (clarsimp simp: rf_sr_def cstate_relation_def Let_def
|
|
kernel_data_refs_domain_eq_rotate)
|
|
|
|
lemma cNodeNoOverlap_retype_have_size:
|
|
"\<not> cNodeOverlap cns (\<lambda>x. ptr \<le> x \<and> x \<le> ptr + of_nat num * 2 ^ bits - 1)
|
|
\<Longrightarrow> cnodes_retype_have_size {ptr .. ptr + of_nat num * 2 ^ bits - 1} anysz cns"
|
|
apply (clarsimp simp: cnodes_retype_have_size_def cNodeOverlap_def)
|
|
apply (elim allE, drule(1) mp, clarsimp simp: upto_intvl_eq[symmetric])
|
|
apply (erule disjoint_subset2[rotated])
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma resetUntypedCap_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and ct_active' and ex_cte_cap_to' cnodeptr)
|
|
(UNIV \<inter> {s. srcSlot_' s = Ptr slot})
|
|
[]
|
|
(resetUntypedCap slot)
|
|
(Call resetUntypedCap_'proc)"
|
|
apply (cinit lift: srcSlot_')
|
|
apply (simp add: liftE_bindE getSlotCap_def del: Collect_const)
|
|
apply (rule ccorres_getCTE, rename_tac cte)
|
|
apply (rule ccorres_move_c_guard_cte ccorres_rhs_assoc
|
|
| (csymbr, rule ccorres_abstract_cleanup))+
|
|
sorry
|
|
\<lbrace>to_bool \<acute>deviceMemory = isdev\<rbrace> \<inter>
|
|
\<or> isFrameType newType))\<rbrace>
|
|
)
|
|
[] (do invokeUntyped (Retype cref ptr_base ptr newType us destSlots isdev);
|
|
"isdev \<longrightarrow> (newType = APIObjectType ArchTypes_H.apiobject_type.Untyped \<or> isFrameType newType)"
|
|
\<lbrace>to_bool \<acute>deviceMemory = isdev\<rbrace> \<inter>
|
|
|
|
lemma ccorres_cross_retype_zero_bytes_over_guard:
|
|
"range_cover ptr sz (APIType_capBits newType userSize) num_ret
|
|
\<Longrightarrow> ccorres_underlying rf_sr Gamm rvr xf arrel axf P' Q hs af cf
|
|
\<Longrightarrow> ccorres_underlying rf_sr Gamm rvr xf arrel axf
|
|
((\<lambda>s. invs' s
|
|
\<and> cte_wp_at' (\<lambda>cte. \<exists>idx. cteCap cte = UntypedCap (ptr &&~~ mask sz) sz idx
|
|
\<and> idx \<le> unat (ptr && mask sz)) p s) and P')
|
|
{s'. region_is_zero_bytes ptr
|
|
(num_ret * 2 ^ APIType_capBits newType userSize) s' \<longrightarrow> s' \<in> Q} hs af cf"
|
|
apply (erule ccorres_guard_imp2)
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
apply (frule(2) retype_offs_region_is_zero_bytes, simp+)
|
|
done
|
|
|
|
lemma invokeUntyped_Retype_ccorres:
|
|
"ccorres (cintr \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and ct_active' and ex_cte_cap_to' cnodeptr
|
|
and (\<lambda>s. case gsCNodes s cnodeptr of None \<Rightarrow> False
|
|
| Some n \<Rightarrow> length destSlots + unat start \<le> 2 ^ n)
|
|
and valid_untyped_inv' (Retype cref reset ptr_base ptr newType us destSlots))
|
|
(UNIV \<inter> {s. retypeBase_' s = Ptr ptr}
|
|
\<inter> {s. srcSlot_' s = Ptr cref}
|
|
\<inter> {s. reset_' s = from_bool reset}
|
|
\<inter> {s. newType_' s = object_type_from_H newType }
|
|
\<inter> {s. unat (userSize_' s) = us }
|
|
\<inter> {s. to_bool (deviceMemory_' s) = isdev}
|
|
\<inter> \<lbrace>\<acute>destSlots = slot_range_C (cte_Ptr cnodeptr) start
|
|
(of_nat (length destSlots)) \<and>
|
|
(\<forall>n<length destSlots.
|
|
destSlots ! n = cnodeptr + (start + of_nat n) * 0x10) \<and>
|
|
(isdev \<longrightarrow> (newType = APIObjectType ArchTypes_H.apiobject_type.Untyped
|
|
\<or> isFrameType newType))\<rbrace>
|
|
)
|
|
[]
|
|
(invokeUntyped (Retype cref reset ptr_base ptr newType us destSlots))
|
|
(Call invokeUntyped_Retype_'proc)"
|
|
apply (rule ccorres_name_pre)
|
|
apply (clarsimp simp only: valid_untyped_inv_wcap')
|
|
apply clarsimp+
|
|
apply (subgoal_tac
|
|
"invokeUntyped_proofs s cref reset ptr_base ptr newType us
|
|
destSlots ptr_base sz idx")
|
|
prefer 2
|
|
apply (clarsimp simp:invokeUntyped_proofs_def cte_wp_at_ctes_of)
|
|
(* This is the main case involving deleteObjects. *)
|
|
(* FIXME: proof very similar to invokeUntyped_Retype_ccorres_side_case. *)
|
|
proof -
|
|
fix s sz idx cte ptr'
|
|
assume proofs:
|
|
"invokeUntyped_proofs s cref reset ptr_base ptr newType us destSlots ptr_base sz idx"
|
|
and vui:
|
|
"valid_untyped_inv_wcap' (Retype cref reset ptr_base ptr newType us destSlots)
|
|
(Some (UntypedCap ptr' sz idx)) s"
|
|
and misc1:
|
|
"ct_active' s" "invs' s" "ex_cte_cap_to' cnodeptr s"
|
|
"case gsCNodes s cnodeptr of None \<Rightarrow> False
|
|
| Some n \<Rightarrow> length destSlots + unat start \<le> 2 ^ n"
|
|
"isdev \<longrightarrow> (newType = APIObjectType ArchTypes_H.apiobject_type.Untyped \<or> isFrameType newType)"
|
|
note no_simps[simp del] = untyped_range.simps usable_untyped_range.simps
|
|
atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
|
|
Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
|
|
usableUntypedRange.simps
|
|
|
|
have cover:
|
|
"range_cover ptr sz (APIType_capBits newType us) (length destSlots)"
|
|
using vui
|
|
by (clarsimp simp: cte_wp_at_ctes_of)
|
|
|
|
have us_misc:
|
|
"newType = APIObjectType apiobject_type.CapTableObject \<longrightarrow> 0 < us"
|
|
"newType = APIObjectType apiobject_type.Untyped \<longrightarrow> 4 \<le> us \<and> us \<le> 30"
|
|
using vui
|
|
by (auto simp: cte_wp_at_ctes_of)
|
|
|
|
note bits_low = APIType_capBits_low[OF us_misc]
|
|
|
|
have misc2:
|
|
"destSlots \<noteq> []" "ptr_base && ~~ mask sz = ptr_base"
|
|
using vui
|
|
by (clarsimp simp: cte_wp_at_ctes_of)+
|
|
|
|
note misc = misc1 misc2
|
|
|
|
have us_misc':
|
|
"(newType = APIObjectType apiobject_type.CapTableObject \<longrightarrow> us < 28)"
|
|
using cover
|
|
apply -
|
|
apply (drule range_cover_sz')
|
|
apply (clarsimp simp:APIType_capBits_def objBits_simps word_bits_conv)
|
|
done
|
|
|
|
have ptr_base_eq:
|
|
"ptr_base = ptr && ~~ mask sz"
|
|
using vui
|
|
by (clarsimp simp: cte_wp_at_ctes_of)
|
|
|
|
(*
|
|
have cte_size_inter_empty:
|
|
"{cref..cref + 0xF} \<inter> {ptr_base..ptr_base + 2 ^ sz - 1} = {}"
|
|
using cover misc
|
|
apply -
|
|
apply (rule disjoint_subset2[rotated])
|
|
apply (erule(1) cte_size_inter_empty)
|
|
apply (clarsimp simp:isCap_simps)
|
|
apply (cut_tac invokeUntyped_proofs.cref_inv[OF proofs])\<^sup>
|
|
apply (simp add: ptr_base_eq)
|
|
find_theorems name: subs intro
|
|
apply (erule contra_subsetD[rotated])
|
|
apply (simp add: atLeastatMost_subset_iff)
|
|
find_theorems range_cover
|
|
defer
|
|
apply simp
|
|
done
|
|
*)
|
|
|
|
show
|
|
"ccorres (cintr \<currency> dc)
|
|
(liftxf errstate id (K ()) ret__unsigned_long_') (\<lambda>s'. s' = s)
|
|
(UNIV \<inter> \<lbrace>\<acute>retypeBase = Ptr ptr\<rbrace> \<inter>
|
|
\<lbrace>\<acute>srcSlot = cte_Ptr cref\<rbrace> \<inter>
|
|
\<lbrace>\<acute>reset = from_bool reset\<rbrace> \<inter>
|
|
\<lbrace>\<acute>newType = object_type_from_H newType\<rbrace> \<inter>
|
|
\<lbrace>unat \<acute>userSize = us\<rbrace> \<inter>
|
|
\<lbrace>to_bool \<acute>deviceMemory = isdev\<rbrace> \<inter>
|
|
\<lbrace>\<acute>destSlots = slot_range_C (cte_Ptr cnodeptr) start
|
|
(of_nat (length destSlots)) \<and>
|
|
(\<forall>n<length destSlots. destSlots ! n = cnodeptr + (start + of_nat n) * 0x10)\<rbrace>)
|
|
[] (invokeUntyped (Retype cref reset ptr_base ptr newType us destSlots))
|
|
(Call invokeUntyped_Retype_'proc)"
|
|
apply (cinit lift: retypeBase_' srcSlot_' reset_' newType_'
|
|
userSize_' deviceMemory_' destSlots_'
|
|
simp: when_def)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply csymbr
|
|
apply (rule ccorres_abstract_cleanup)
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply csymbr
|
|
apply (rule ccorres_abstract_cleanup)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (simp add: from_bool_0 del: Collect_const)
|
|
apply (rule_tac xf'=xfdc and r'=dc in ccorres_splitE)
|
|
apply (rule ccorres_Cond_rhs)
|
|
apply (simp add: whenE_def)
|
|
apply (rule ccorres_add_returnOk)
|
|
apply (ctac add: resetUntypedCap_ccorres)
|
|
apply (simp add: ccorres_cond_empty_iff)
|
|
apply (rule ccorres_returnOk_skip)
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def cintr_def)
|
|
apply wp
|
|
apply (vcg exspec=resetUntypedCap_modifies)
|
|
apply (simp add: whenE_def)
|
|
apply (rule ccorres_returnOk_skip)
|
|
apply ceqv
|
|
apply simp
|
|
apply (simp add: liftE_def bind_assoc)
|
|
apply csymbr
|
|
apply (rule ccorres_Guard_Seq)
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply (rule ccorres_stateAssert)
|
|
apply (rule ccorres_cross_retype_zero_bytes_over_guard[where p=cref, OF cover])
|
|
apply (rule ccorres_split_nothrow[where r'=dc and xf'=xfdc])
|
|
|
|
apply (rule_tac P=\<top> and P'=UNIV in ccorres_inst)
|
|
defer
|
|
apply ceqv
|
|
|
|
apply (ctac add: createNewObjects_ccorres[where sz = sz and
|
|
start = start and cnodeptr=cnodeptr and
|
|
num = "of_nat (length destSlots)"
|
|
and idx = "getFreeIndex ptr_base
|
|
(ptr + of_nat (shiftL (length destSlots) (APIType_capBits newType us)))"])
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: return_def)
|
|
apply wp
|
|
apply (vcg exspec=createNewObjects_modifies)
|
|
apply (wp updateFreeIndex_forward_invs' sch_act_simple_lift
|
|
updateFreeIndex_cte_wp_at hoare_vcg_const_Ball_lift
|
|
updateFreeIndex_pspace_no_overlap'
|
|
updateFreeIndex_caps_no_overlap''
|
|
updateFreeIndex_caps_overlap_reserved
|
|
updateFreeIndex_descendants_range_in'
|
|
| simp)+
|
|
apply (clarsimp simp: misc
|
|
unat_of_nat_eq[OF range_cover.weak, OF cover])
|
|
apply (vcg exspec=cap_untyped_cap_ptr_set_capFreeIndex_modifies)
|
|
apply simp
|
|
apply (rule validE_validE_R, rule hoare_post_impErr,
|
|
rule hoare_vcg_conj_liftE1[rotated, where Q="\<lambda>_ s.
|
|
case gsCNodes s cnodeptr of None \<Rightarrow> False
|
|
| Some n \<Rightarrow> length destSlots + unat start \<le> 2 ^ n"],
|
|
rule whenE_reset_resetUntypedCap_invs_etc
|
|
[where ui="Retype cref reset ptr_base ptr newType us destSlots"
|
|
and ptr="ptr && ~~ mask sz" and ptr'=ptr and sz=sz and idx=idx])
|
|
apply (simp add: whenE_def, wp resetUntypedCap_gsCNodes_at_pt)[1]
|
|
prefer 2
|
|
apply simp
|
|
apply (clarsimp simp only: )
|
|
apply (frule(2) invokeUntyped_proofs.intro)
|
|
apply (cut_tac bits_low us_misc us_misc')
|
|
apply (clarsimp simp: cte_wp_at_ctes_of
|
|
invokeUntyped_proofs.caps_no_overlap'
|
|
invokeUntyped_proofs.ps_no_overlap'
|
|
invokeUntyped_proofs.descendants_range
|
|
split_if[where P="\<lambda>v. v \<le> getFreeIndex x y" for x y]
|
|
empty_descendants_range_in'
|
|
invs_pspace_aligned' invs_pspace_distinct'
|
|
invs_ksCurDomain_maxDomain'
|
|
invokeUntyped_proofs.not_0_ptr
|
|
atLeastAtMost_iff[where i=0]
|
|
cong: if_cong)
|
|
apply (frule invokeUntyped_proofs.idx_le_new_offs)
|
|
apply (frule invokeUntyped_proofs.szw)
|
|
apply (frule invokeUntyped_proofs.descendants_range(2), simp)
|
|
apply (simp add: cNodeNoOverlap_retype_have_size shiftL_nat mult.commute)
|
|
apply (clarsimp simp: getFreeIndex_def conj_comms shiftL_nat
|
|
is_aligned_weaken[OF range_cover.funky_aligned]
|
|
invs_valid_pspace' isCap_simps
|
|
arg_cong[OF mask_out_sub_mask, where f="\<lambda>y. x - y" for x]
|
|
field_simps unat_of_nat_eq[OF range_cover.weak, OF cover]
|
|
if_apply_def2)
|
|
|
|
apply (intro conjI)
|
|
(* pspace_no_overlap *)
|
|
apply (cases reset, simp_all)[1]
|
|
|
|
(* is_aligned 4 *)
|
|
apply (erule is_aligned_weaken[OF range_cover.aligned])
|
|
apply (clarsimp simp: APIType_capBits_low)
|
|
|
|
(* new idx le *)
|
|
apply (clarsimp split: split_if)
|
|
|
|
(* cnodeptr not in area *)
|
|
apply (rule contra_subsetD[rotated],
|
|
rule invokeUntyped_proofs.ex_cte_no_overlap'[OF proofs], rule misc)
|
|
apply (simp add: shiftl_t2n mult.commute)
|
|
apply (rule order_trans, erule range_cover_subset', simp_all)[1]
|
|
(* gsCNodes *)
|
|
apply (clarsimp split: option.split_asm)
|
|
|
|
(* kernel data refs *)
|
|
|
|
apply (drule(1) valid_global_refsD'[OF _ invs_valid_global'])
|
|
apply clarsimp
|
|
apply (subst Int_commute, erule disjoint_subset2[rotated])
|
|
apply (rule order_trans, erule invokeUntyped_proofs.subset_stuff)
|
|
apply (simp add: atLeastatMost_subset_iff word_and_le2)
|
|
|
|
(* offset bounds *)
|
|
apply (frule range_cover.unat_of_nat_n_shift, rule order_refl)
|
|
apply (rule order_trans[rotated], erule range_cover.range_cover_compare_bound)
|
|
apply (subst unat_plus_simple[THEN iffD1])
|
|
apply (rule order_trans, erule range_cover.range_cover_base_le,
|
|
simp add: shiftl_t2n field_simps)
|
|
apply (simp add: shiftl_t2n field_simps)
|
|
|
|
(* subsets *)
|
|
apply (rule order_trans, erule invokeUntyped_proofs.subset_stuff)
|
|
apply (simp add: atLeastatMost_subset_iff word_and_le2)
|
|
|
|
(* destSlots *)
|
|
apply (clarsimp split: split_if)
|
|
apply (frule invokeUntyped_proofs.slots_invD[OF proofs])
|
|
apply (simp add: conj_comms)
|
|
|
|
|
|
(* usableUntyped *)
|
|
apply (drule invokeUntyped_proofs.usableRange_disjoint)
|
|
apply (clarsimp simp: field_simps mask_out_sub_mask)
|
|
|
|
apply (clarsimp simp: ccHoarePost_def)
|
|
apply (vcg exspec=resetUntypedCap_modifies)
|
|
|
|
|
|
apply simp
|
|
apply (cut_tac misc us_misc' proofs us_misc bits_low
|
|
invokeUntyped_proofs.cref_inv[OF proofs])
|
|
apply (clarsimp simp: cte_wp_at_ctes_of invokeUntyped_proofs_def
|
|
descendants_range'_def2 sch_act_simple_def
|
|
invs_valid_pspace' range_cover.sz)
|
|
apply (simp add: APIType_capBits_high word_of_nat_less
|
|
word_sle_def object_type_from_H_bound)
|
|
apply (frule ctes_of_valid', fastforce)
|
|
apply (clarsimp simp: valid_cap'_def capAligned_def ct_in_state'_def
|
|
invs_valid_objs' inr_rrel_def)
|
|
apply (intro conjI)
|
|
apply fast
|
|
apply clarsimp
|
|
apply (drule invokeUntyped_proofs.ex_cte_no_overlap'[OF proofs])
|
|
apply simp
|
|
|
|
apply (clarsimp split: sum.split)
|
|
|
|
apply (erule(1) rf_sr_ctes_of_cliftE)
|
|
apply (frule(2) rf_sr_cte_relation)
|
|
apply (clarsimp simp: cap_get_tag_isCap typ_heap_simps
|
|
dest!: ccte_relation_ccap_relation)
|
|
|
|
defer
|
|
|
|
|
|
apply (frule rf_sr_cpspace_relation)
|
|
apply (frule cap_CL_lift[symmetric])
|
|
apply (frule(2) rf_sr_cte_relation)
|
|
apply (subst (asm) cap_untyped_cap_lift[THEN iffD1])
|
|
apply (subst cap_get_tag_isCap[OF ccte_relation_ccap_relation])
|
|
apply simp
|
|
apply simp
|
|
apply (simp add: cap_to_H_simps)
|
|
apply (frule typ_clear_region_eq[rotated -1], simp+)
|
|
apply (simp add: Int_ac cte_size_inter_empty)
|
|
apply (clarsimp simp: range_cover.unat_of_nat_n
|
|
region_is_typeless_def[symmetric])
|
|
apply (intro conjI impI allI)
|
|
apply (rule of_nat_power[where x = 5,simplified])
|
|
apply (rule APIType_capBits_high)
|
|
apply (clarsimp simp: unat_of_nat32[where x=us] word_bits_def)+
|
|
apply (clarsimp simp:getFreeIndex_def)
|
|
apply (simp add: shiftL_nat word_bits_conv shiftl_t2n)
|
|
apply (clarsimp dest!: range_cover_sz'
|
|
simp: unat_of_nat32 word_bits_def)
|
|
apply (rule object_type_from_H_bound)
|
|
apply (subst cap_get_tag_isCap)
|
|
apply (erule ccte_relation_ccap_relation)
|
|
apply (simp add:isCap_simps cap_to_H_def)
|
|
done
|
|
qed
|
|
|
|
lemma ccorres_returnOk_Basic:
|
|
"\<lbrakk> \<And>\<sigma> s. (\<sigma>, s) \<in> sr \<Longrightarrow> r (Inr v) (xf (f s))
|
|
\<and> (\<sigma>, f s) \<in> sr \<rbrakk> \<Longrightarrow>
|
|
ccorres_underlying sr \<Gamma> r xf arrel axf \<top> UNIV hs
|
|
(returnOk v) (Basic f)"
|
|
apply (rule ccorres_from_vcg)
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: returnOk_def return_def)
|
|
done
|
|
|
|
lemma injection_handler_whenE:
|
|
"injection_handler injf (whenE P f)
|
|
= whenE P (injection_handler injf f)"
|
|
by (simp add: whenE_def injection_handler_returnOk split: split_if)
|
|
|
|
lemma fromEnum_object_type_to_H:
|
|
"fromEnum x = unat (object_type_from_H x)"
|
|
apply (cut_tac eqset_imp_iff[where x=x, OF enum_surj])
|
|
apply (simp add: fromEnum_def enum_object_type
|
|
enum_apiobject_type
|
|
object_type_from_H_def
|
|
"StrictC'_object_defs" "api_object_defs"
|
|
split: split_if)
|
|
apply (auto simp: "api_object_defs")
|
|
done
|
|
|
|
lemma injection_handler_sequenceE:
|
|
"injection_handler injf (sequenceE xs)
|
|
= sequenceE (map (injection_handler injf) xs)"
|
|
apply (induct xs, simp_all add: sequenceE_def)
|
|
apply (simp add: injection_handler_returnOk)
|
|
apply (simp add: injection_bindE[OF refl refl]
|
|
injection_handler_returnOk
|
|
Let_def)
|
|
done
|
|
|
|
lemma getSlotCap_capAligned[wp]:
|
|
"\<lbrace>valid_objs'\<rbrace> getSlotCap ptr \<lbrace>\<lambda>rv s. capAligned rv\<rbrace>"
|
|
apply (rule hoare_strengthen_post, rule getSlotCap_valid_cap)
|
|
apply (clarsimp simp: valid_capAligned)
|
|
done
|
|
|
|
lemma ccorres_throwError_inl_rrel:
|
|
"ccorres_underlying sr Gamm (inl_rrel r) xf arrel axf hs P P'
|
|
(throwError v) c
|
|
\<Longrightarrow> ccorres_underlying sr Gamm r xf (inl_rrel arrel) axf hs P P'
|
|
(throwError v) c"
|
|
apply (rule ccorresI')
|
|
apply (erule(3) ccorresE)
|
|
apply (simp add: throwError_def return_def)
|
|
apply assumption
|
|
apply (simp add: throwError_def return_def
|
|
unif_rrel_def split: split_if_asm)
|
|
done
|
|
|
|
lemmas ccorres_return_C_errorE_inl_rrel
|
|
= ccorres_throwError_inl_rrel[OF ccorres_return_C_errorE]
|
|
|
|
lemma mapME_ensureEmptySlot':
|
|
"\<lbrace>P\<rbrace>
|
|
mapME (\<lambda>x. injection_handler Inl (ensureEmptySlot (f x))) slots
|
|
\<lbrace>\<lambda>rva s. P s \<and> (\<forall>slot \<in> set slots. (\<exists>cte. cteCap cte = capability.NullCap \<and> ctes_of s (f slot) = Some cte))\<rbrace>, -"
|
|
apply (induct slots arbitrary: P)
|
|
apply simp
|
|
apply wp
|
|
apply (rename_tac a slots P)
|
|
apply (simp add: mapME_def sequenceE_def Let_def)
|
|
apply (rule_tac Q="\<lambda>rv. P and (\<lambda>s. \<exists>cte. cteCap cte = capability.NullCap \<and> ctes_of s (f a) = Some cte)" in validE_R_sp)
|
|
apply (simp add: ensureEmptySlot_def unlessE_def)
|
|
apply (wp injection_wp_E[OF refl] getCTE_wp')
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
apply (erule meta_allE)
|
|
apply wp
|
|
apply (fold validE_R_def)
|
|
apply (erule hoare_post_imp_R)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma mapME_ensureEmptySlot:
|
|
"\<lbrace>\<top>\<rbrace>
|
|
mapME (\<lambda>x. injection_handler Inl (ensureEmptySlot (f x))) [S .e. (E::word32)]
|
|
\<lbrace>\<lambda>rva s. \<forall>slot. S \<le> slot \<and> slot \<le> E \<longrightarrow>
|
|
(\<exists>cte. cteCap cte = capability.NullCap \<and> ctes_of s (f slot) = Some cte)\<rbrace>, -"
|
|
apply (rule hoare_post_imp_R)
|
|
apply (rule mapME_ensureEmptySlot')
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma capCNodeRadix_CL_less_32:
|
|
"cap_get_tag ccap = scast cap_cnode_cap \<Longrightarrow> capCNodeRadix_CL (cap_cnode_cap_lift ccap) < 32"
|
|
apply (simp add: cap_cnode_cap_lift_def cap_lift_cnode_cap)
|
|
apply (rule order_le_less_trans, rule word_and_le1)
|
|
apply simp
|
|
done
|
|
|
|
lemmas unat_capCNodeRadix_CL_less_32
|
|
= capCNodeRadix_CL_less_32[unfolded word_less_nat_alt, simplified]
|
|
|
|
lemmas capCNodeRadix_CL_less_32s
|
|
= capCNodeRadix_CL_less_32 unat_capCNodeRadix_CL_less_32
|
|
linorder_not_le[THEN iffD2, OF capCNodeRadix_CL_less_32]
|
|
linorder_not_le[THEN iffD2, OF unat_capCNodeRadix_CL_less_32]
|
|
|
|
lemma TripleSuc:
|
|
"Suc (Suc (Suc 0)) = 3"
|
|
by simp
|
|
|
|
lemma case_sum_distrib:
|
|
"case_sum a b x >>= f = case_sum (\<lambda>x. a x >>= f) (\<lambda>x. b x >>= f) x"
|
|
by (case_tac x,simp+)
|
|
|
|
lemma alignUp_spec:
|
|
"\<forall>s. \<Gamma>\<turnstile> \<lbrace>s. alignment_' s < 0x20 \<rbrace> Call alignUp_'proc
|
|
\<lbrace>\<acute>ret__unsigned_long = alignUp (baseValue_' s) (unat (alignment_' s))\<rbrace>"
|
|
apply vcg
|
|
apply (simp add:alignUp_def2 mask_def field_simps)
|
|
done
|
|
|
|
lemma checkFreeIndex_ccorres:
|
|
"ccap_relation cp cap \<Longrightarrow>
|
|
ccorresG rf_sr \<Gamma> (intr_and_se_rel \<currency> (\<lambda>r r'. r = unat (r' << 4))) (liftxf errstate (K (scast EXCEPTION_NONE)) id freeIndex_')
|
|
(cte_wp_at' (\<lambda>cte. (cteCap cte = cp \<and> isUntypedCap cp)) slot and valid_objs' and valid_mdb') UNIV hs
|
|
(liftE $ constOnFailure (capFreeIndex cp) (doE y \<leftarrow> ensureNoChildren slot;
|
|
returnOk 0 odE))
|
|
(\<acute>status :== CALL ensureNoChildren(cte_Ptr slot);;
|
|
(Cond \<lbrace>\<acute>status \<noteq> scast EXCEPTION_NONE\<rbrace> (\<acute>freeIndex :== CALL cap_untyped_cap_get_capFreeIndex(cap))
|
|
(\<acute>freeIndex :== 0)))"
|
|
apply (simp add: constOnFailure_def catch_def liftE_def bindE_bind_linearise bind_assoc case_sum_distrib)
|
|
apply (rule ccorres_guard_imp2)
|
|
apply (rule ccorres_split_nothrow_case_sum)
|
|
apply (ctac add:ensureNoChildren_ccorres)
|
|
apply (ceqv)
|
|
apply (rule ccorres_from_vcg[where P' = UNIV])
|
|
apply (clarsimp simp:returnOk_def return_def bind_def)
|
|
apply (rule conseqPre)
|
|
apply vcg
|
|
apply clarsimp
|
|
apply simp
|
|
apply (rule ccorres_from_vcg[where P'= UNIV])
|
|
apply (clarsimp simp:return_def)
|
|
apply (rule conseqPre)
|
|
apply vcg
|
|
apply clarsimp
|
|
apply (rule context_conjI)
|
|
apply (clarsimp simp:cap_get_tag_isCap)
|
|
apply assumption
|
|
apply (clarsimp simp:ccap_relation_def isCap_simps cap_untyped_cap_lift_def
|
|
cap_lift_def cap_to_H_def
|
|
split:if_splits)
|
|
apply (rule ensureNoChildren_wp[where P = dc])
|
|
apply clarsimp
|
|
apply vcg
|
|
apply (clarsimp simp:cte_wp_at_ctes_of rf_sr_def cstate_relation_def cpspace_relation_def Let_def)
|
|
apply (rule cmap_relationE1,assumption+)
|
|
apply (rule exI)+
|
|
apply (rule conjI,assumption)
|
|
apply (rule conjI,simp add:typ_heap_simps')
|
|
apply (clarsimp simp:typ_heap_simps')
|
|
apply (subst (asm) mdbNext_not_zero_eq_simpler[symmetric])
|
|
apply (erule ccte_relation_cmdbnode_relation)
|
|
apply (frule(2) valid_mdbD1')
|
|
apply (drule_tac s'= s' in valid_mdb_cslift_next)
|
|
apply (simp add:rf_sr_def Let_def cstate_relation_def cpspace_relation_def)
|
|
apply simp
|
|
apply simp
|
|
apply clarsimp
|
|
apply (erule_tac y = c in cmap_relationE1)
|
|
apply assumption
|
|
apply (clarsimp simp:cmdb_node_relation_mdbNext[OF ccte_relation_cmdbnode_relation])
|
|
apply (intro conjI exI,assumption)
|
|
apply (erule(1) valid_capAligned[OF ctes_of_valid'])
|
|
apply (erule(1) ctes_of_valid')
|
|
done
|
|
|
|
lemma ccap_relation_untyped_CL_simps:
|
|
"\<lbrakk>ccap_relation cp cap;isUntypedCap cp\<rbrakk>
|
|
\<Longrightarrow> unat (capBlockSize_CL (cap_untyped_cap_lift cap)) = (capBlockSize cp)
|
|
\<and> (capPtr_CL (cap_untyped_cap_lift cap)) = (capPtr cp)"
|
|
apply (frule cap_get_tag_UntypedCap)
|
|
apply (simp add:cap_get_tag_isCap)
|
|
done
|
|
|
|
lemma valid_untyped_capBlockSize_misc:
|
|
"\<lbrakk>s \<turnstile>' cp; isUntypedCap cp; (z::nat) \<le> capFreeIndex cp
|
|
\<rbrakk> \<Longrightarrow> 2 ^ capBlockSize cp - z < 2 ^ word_bits
|
|
\<and> of_nat (2^capBlockSize cp - z) = (2::word32) ^ capBlockSize cp - of_nat z"
|
|
apply (clarsimp simp:valid_cap'_def isCap_simps)
|
|
apply (rule le_less_trans[OF diff_le_self])
|
|
apply (rule power_strict_increasing)
|
|
apply (simp add:word_bits_def)
|
|
apply simp
|
|
done
|
|
|
|
lemma alternative_distrib:
|
|
"(do r\<leftarrow>c; (a \<sqinter> b) od) = ((do c; a od) \<sqinter> (do c ; b od))"
|
|
apply (rule ext)+
|
|
apply (clarsimp simp:alternative_def bind_def split_def)
|
|
apply force
|
|
done
|
|
|
|
lemma setThreadStateRestart_ct_active':
|
|
"\<lbrace>ct_active'\<rbrace> setThreadState Restart thread
|
|
\<lbrace>\<lambda>rva s. ct_active' s\<rbrace>"
|
|
apply (simp add:ct_in_state'_def)
|
|
apply (rule hoare_pre)
|
|
apply (wps)
|
|
apply (wp sts_st_tcb_at'_cases)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma toEnum_object_type_to_H:
|
|
"unat v \<le> (fromEnum::object_type \<Rightarrow> nat) maxBound
|
|
\<Longrightarrow> toEnum (unat v) = (object_type_to_H (v::word32))"
|
|
apply (simp add:enum_object_type enum_apiobject_type object_type_to_H_def toEnum_def
|
|
maxBound_less_length)
|
|
apply (clarsimp simp: Kernel_C_defs split:if_splits)
|
|
apply unat_arith
|
|
done
|
|
|
|
lemma unat_of_nat_APIType_capBits:
|
|
"b \<le> 29
|
|
\<Longrightarrow> unat (of_nat (APIType_capBits z b) ::word32) = APIType_capBits z b"
|
|
apply (rule unat_of_nat32)
|
|
apply (case_tac z)
|
|
apply (clarsimp simp:invokeUntyped_proofs_def word_bits_conv APIType_capBits_def objBits_simps
|
|
split: apiobject_type.splits)+
|
|
done
|
|
|
|
lemma valid_untyped_inv'_D:
|
|
"valid_untyped_inv' (Retype slot ptr_base ptr ty us slots isdev) s
|
|
\<Longrightarrow> APIType_capBits ty us < 32"
|
|
apply (clarsimp simp:valid_untyped_inv'.simps)
|
|
apply (drule range_cover_sz')
|
|
apply (simp add:word_bits_def)
|
|
done
|
|
|
|
lemma object_type_from_to_H:
|
|
"unat v \<le> (fromEnum::object_type \<Rightarrow> nat) maxBound
|
|
\<Longrightarrow> v = object_type_from_H (object_type_to_H v)"
|
|
apply (simp add:toEnum_object_type_to_H[symmetric])
|
|
apply (rule iffD1[OF word_unat.Rep_inject])
|
|
apply (subst fromEnum_object_type_to_H[symmetric])
|
|
apply (simp add:from_to_enum)
|
|
done
|
|
|
|
lemma shiftR_gt0_le32:
|
|
"\<lbrakk>0 < unat (of_nat (shiftR a b ));a < 2 ^ word_bits\<rbrakk> \<Longrightarrow> b< 32"
|
|
apply (rule ccontr)
|
|
apply (clarsimp simp:not_less shiftR_nat)
|
|
apply (subst (asm) div_less)
|
|
apply (erule less_le_trans)
|
|
apply (rule power_increasing)
|
|
apply (simp add:word_bits_def)+
|
|
done
|
|
|
|
lemma shiftr_overflow:
|
|
"32\<le> a \<Longrightarrow> (b::word32) >> a = 0"
|
|
apply (word_bitwise)
|
|
apply simp
|
|
done
|
|
|
|
lemma impI':
|
|
"(\<not> B \<Longrightarrow> \<not> A) \<Longrightarrow> A \<longrightarrow> B"
|
|
by auto
|
|
|
|
lemma base_length_minus_one_inequality:
|
|
assumes foo: "wbase \<le> 2 ^ sz - 1"
|
|
"1 \<le> (wlength :: ('a :: len) word)"
|
|
"wlength \<le> 2 ^ sz - wbase"
|
|
"sz < len_of TYPE ('a)"
|
|
shows "wbase \<le> wbase + wlength - 1"
|
|
proof -
|
|
|
|
note sz_less = power_strict_increasing[OF foo(4), where a=2]
|
|
|
|
from foo have plus: "unat wbase + unat wlength < 2 ^ len_of TYPE('a)"
|
|
apply -
|
|
apply (rule order_le_less_trans[rotated], rule sz_less, simp)
|
|
apply (simp add: unat_arith_simps split: split_if_asm)
|
|
done
|
|
|
|
from foo show ?thesis
|
|
by (simp add: unat_arith_simps plus)
|
|
qed
|
|
|
|
lemma unat_2tp_if:
|
|
"unat (2 ^ n :: ('a :: len) word) = (if n < len_of TYPE ('a) then 2 ^ n else 0)"
|
|
by (split split_if, simp_all add: power_overflow)
|
|
|
|
lemma ctes_of_ex_cte_cap_to':
|
|
"ctes_of s p = Some cte \<Longrightarrow> \<forall>r \<in> cte_refs' (cteCap cte) (irq_node' s). ex_cte_cap_to' r s"
|
|
by (auto simp add: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of)
|
|
|
|
|
|
lemma Arch_isFrameType_spec:
|
|
"\<forall>s. \<Gamma> \<turnstile> \<lbrace>s. unat \<acute>type \<le> fromEnum (maxBound::ArchTypes_H.object_type)\<rbrace>
|
|
Call Arch_isFrameType_'proc
|
|
\<lbrace> \<acute>ret__unsigned_long =
|
|
from_bool (isFrameType ((toEnum (unat \<^bsup>s\<^esup> type))::ArchTypes_H.object_type))\<rbrace>"
|
|
apply vcg
|
|
apply (simp add: toEnum_object_type_to_H)
|
|
apply (frule object_type_from_to_H)
|
|
apply (auto dest!: object_type_from_H_toAPIType_simps[THEN iffD1,OF eq_commute[THEN iffD1]])
|
|
apply (auto simp: object_type_to_H_def isFrameType_def isFrameType_def
|
|
split: if_splits object_type.splits)
|
|
apply (auto simp: object_type_from_H_def )
|
|
done
|
|
|
|
lemma decodeUntypedInvocation_ccorres_helper:
|
|
notes TripleSuc[simp]
|
|
notes valid_untyped_inv'.simps[simp del] tl_drop_1[simp]
|
|
shows
|
|
"interpret_excaps extraCaps' = excaps_map extraCaps \<Longrightarrow>
|
|
ccorres (intr_and_se_rel \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and (\<lambda>s. ksCurThread s = thread)
|
|
and sch_act_simple and ct_active'
|
|
and valid_cap' cp and K (isUntypedCap cp)
|
|
and cte_wp_at' (\<lambda>cte. cteCap cte = cp) slot
|
|
and (excaps_in_mem extraCaps \<circ> ctes_of)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v).
|
|
ex_nonz_cap_to' y s)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps.
|
|
s \<turnstile>' fst v)
|
|
and sysargs_rel args buffer)
|
|
(UNIV
|
|
\<inter> {s. invLabel_' s = label}
|
|
\<inter> {s. unat (length___unsigned_long_' s) = length args}
|
|
\<inter> {s. ccap_relation cp (cap_' s)}
|
|
\<inter> {s. slot_' s = cte_Ptr slot}
|
|
\<inter> {s. excaps_' s = extraCaps'}
|
|
\<inter> {s. call_' s = from_bool isCall}
|
|
\<inter> {s. buffer_' s = option_to_ptr buffer})
|
|
[]
|
|
((doE uinv \<leftarrow> decodeUntypedInvocation label args slot cp (map fst extraCaps);
|
|
liftE (stateAssert (valid_untyped_inv' uinv) []); returnOk uinv odE)
|
|
>>= invocationCatch thread isBlocking isCall InvokeUntyped)
|
|
(Call decodeUntypedInvocation_'proc)"
|
|
apply (rule ccorres_name_pre)
|
|
apply (cinit' lift: invLabel_' length___unsigned_long_' cap_' slot_' excaps_' call_' buffer_'
|
|
simp: decodeUntypedInvocation_def list_case_If2
|
|
invocation_eq_use_types)
|
|
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 del: Collect_const cong: call_ignore_cong)
|
|
apply csymbr
|
|
apply (simp add: if_1_0_0 word_less_nat_alt
|
|
del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply simp
|
|
apply (rule ccorres_cond_true_seq)
|
|
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_Guard_Seq)+
|
|
apply csymbr
|
|
apply (simp add: interpret_excaps_test_null
|
|
excaps_map_def if_1_0_0
|
|
del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_bind invocationCatch_def
|
|
split: list.split,
|
|
simp add: throwError_def return_def
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases)
|
|
apply (simp add: list_case_helper[OF neq_Nil_lengthI]
|
|
list_case_helper
|
|
del: Collect_const cong: call_ignore_cong)
|
|
apply (rule ccorres_add_return)
|
|
apply (simp only: )
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=0 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (simp only: )
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=1 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (simp only: )
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=2 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (simp only: )
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=3 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (simp only: )
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=4 and buffer=buffer])
|
|
apply (rule ccorres_add_return)
|
|
apply (simp only: )
|
|
apply (ctac add: getSyscallArg_ccorres_foo[where args=args and n=5 and buffer=buffer])
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (simp add: invocationCatch_use_injection_handler
|
|
injection_bindE[OF refl refl]
|
|
injection_handler_whenE
|
|
rangeCheck_def unlessE_whenE
|
|
injection_liftE [OF refl]
|
|
injection_handler_throwError
|
|
bindE_assoc length_ineq_not_Nil
|
|
injection_handler_If
|
|
cong: StateSpace.state.fold_congs globals.fold_congs
|
|
del: Collect_const)
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (simp add: seL4_ObjectTypeCount_def maxBound_is_length)
|
|
apply (subst hd_conv_nth, clarsimp)
|
|
apply (clarsimp simp: enum_object_type enum_apiobject_type
|
|
word_le_nat_alt)
|
|
apply arith
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (clarsimp simp: word_size Collect_const_mem
|
|
fromIntegral_def integral_inv
|
|
hd_drop_conv_nth2 word_le_nat_alt)
|
|
apply arith
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases)
|
|
apply (simp add: word_size word_sle_def)
|
|
apply (simp add: fromIntegral_def integral_inv
|
|
hd_drop_conv_nth2
|
|
del: Collect_const)
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (clarsimp simp: Collect_const_mem unat_eq_0
|
|
linorder_not_less
|
|
hd_conv_nth length_ineq_not_Nil)
|
|
apply (simp add: toEnum_eq_to_fromEnum_eq
|
|
fromEnum_object_type_to_H
|
|
object_type_from_H_def
|
|
fromAPIType_def ARM_H.fromAPIType_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (clarsimp simp: Collect_const_mem unat_eq_0
|
|
linorder_not_less
|
|
hd_conv_nth length_ineq_not_Nil
|
|
toEnum_eq_to_fromEnum_eq)
|
|
apply (simp add: fromEnum_object_type_to_H
|
|
object_type_from_H_def
|
|
fromAPIType_def ARM_H.fromAPIType_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (simp add: syscall_error_to_H_cases)
|
|
apply (rule_tac xf'="nodeCap_'"
|
|
and r'="\<lambda>rv rv'. ccap_relation rv rv' \<and> unat (args ! 3) \<le> word_bits"
|
|
in ccorres_splitE)
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
apply (clarsimp simp add: unat_eq_0 )
|
|
apply (rule_tac P="args ! 3 = 0" in ccorres_gen_asm)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply (simp add: injection_handler_returnOk)
|
|
apply (rule ccorres_nohs)
|
|
apply (rule getSlotCap_ccorres_fudge_n[where vals=extraCaps and n=0])
|
|
apply (rule ccorres_seq_skip'[THEN iffD1])
|
|
apply ctac
|
|
apply (rule ccorres_assert2)
|
|
apply (rule_tac P'="{s. nodeCap_' s = nodeCap}" in ccorres_from_vcg[where P=\<top>])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: returnOk_def return_def hd_conv_nth)
|
|
apply (wp hoare_drop_imps)
|
|
apply vcg
|
|
apply (simp add: split_def injection_bindE[OF refl refl]
|
|
del: Collect_const)
|
|
apply (rule ccorres_rhs_assoc)+
|
|
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 (ctac add: ccorres_injection_handler_csum1
|
|
[OF lookupTargetSlot_ccorres,
|
|
unfolded lookupTargetSlot_def])
|
|
apply (simp add: injection_liftE[OF refl])
|
|
apply (simp add: liftE_liftM o_def split_def withoutFailure_def
|
|
hd_drop_conv_nth2 numeral_eqs[symmetric])
|
|
apply (rule ccorres_nohs)
|
|
apply (rule ccorres_getSlotCap_cte_at)
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
apply ctac
|
|
apply simp
|
|
apply (rule ccorres_split_throws, simp?,
|
|
rule ccorres_return_C_errorE_inl_rrel, simp+)
|
|
apply vcg
|
|
apply simp
|
|
apply wp
|
|
apply (simp add: all_ex_eq_helper)
|
|
apply (vcg exspec=lookupTargetSlot_modifies)
|
|
apply simp
|
|
apply (wp hoare_drop_imps)
|
|
apply (simp add: hd_conv_nth)
|
|
apply vcg
|
|
apply ceqv
|
|
apply (rule_tac P="\<lambda>_. capAligned rv" in ccorres_cross_over_guard)
|
|
apply csymbr
|
|
apply (elim conjE)
|
|
apply (simp add: if_1_0_0 cap_get_tag_isCap
|
|
cap_case_CNodeCap_True_throw
|
|
injection_handler_whenE
|
|
injection_handler_throwError
|
|
del: Collect_const)
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
apply simp
|
|
apply (rule ccorres_from_vcg_split_throws[where P=\<top> and P'=UNIV])
|
|
apply vcg
|
|
apply (rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases)
|
|
apply (simp add: lookup_fault_missing_capability_lift
|
|
hd_drop_conv_nth2 numeral_eqs[symmetric])
|
|
apply (rule le_32_mask_eq)
|
|
apply (simp add: word_bits_def word_le_nat_alt)
|
|
apply simp
|
|
apply csymbr
|
|
apply (rule ccorres_Guard_Seq)
|
|
apply csymbr
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (clarsimp simp: Collect_const_mem cap_get_tag_isCap[symmetric])
|
|
apply (drule(1) cap_get_tag_to_H)
|
|
apply (clarsimp simp: linorder_not_le)
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases)
|
|
apply (simp add: cap_get_tag_isCap[symmetric])
|
|
apply (drule(1) cap_get_tag_to_H)
|
|
apply clarsimp
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (clarsimp simp:)
|
|
apply (simp add: retypeFanOutLimit_def word_le_nat_alt
|
|
linorder_not_le)
|
|
apply (auto simp: linorder_not_le unat_eq_0)[1]
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases)
|
|
apply (simp add: retypeFanOutLimit_def)
|
|
apply (rule ccorres_split_when_throwError_cond
|
|
[where Q=\<top> and Q'=\<top>, rotated -1])
|
|
apply vcg
|
|
apply (clarsimp simp: numeral_eqs[symmetric]
|
|
word_le_nat_alt linorder_not_le
|
|
cap_get_tag_isCap[symmetric])
|
|
apply (drule(1) cap_get_tag_to_H)
|
|
apply clarsimp
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
apply (clarsimp simp: throwError_def return_def
|
|
syscall_error_rel_def exception_defs
|
|
syscall_error_to_H_cases)
|
|
apply (simp add: cap_get_tag_isCap[symmetric])
|
|
apply (drule(1) cap_get_tag_to_H)
|
|
apply (clarsimp)
|
|
apply csymbr
|
|
apply csymbr
|
|
apply csymbr
|
|
apply csymbr
|
|
|
|
apply (simp add: mapM_locate_eq liftE_bindE
|
|
injection_handler_sequenceE mapME_x_sequenceE
|
|
whileAnno_def injection_bindE[OF refl refl]
|
|
bindE_assoc injection_handler_returnOk)
|
|
(* gsCNodes assertion *)
|
|
apply (rule ccorres_stateAssert)
|
|
apply csymbr
|
|
apply (simp add: liftE_bindE[symmetric])
|
|
apply (rule_tac P="capAligned rv" in ccorres_gen_asm)
|
|
apply (subgoal_tac "args ! 5 \<le> args ! 4 + args ! 5")
|
|
prefer 2
|
|
apply (clarsimp simp: numeral_eqs[symmetric])
|
|
apply (subst field_simps, erule plus_minus_no_overflow_ab)
|
|
apply (erule order_trans)
|
|
apply (rule order_less_imp_le, rule word_power_less_1)
|
|
apply (clarsimp simp: capAligned_def isCap_simps word_bits_def)
|
|
apply (rule ccorres_splitE)
|
|
apply (rule_tac F="\<lambda>_ s. case gsCNodes s (RetypeDecls_H.capUntypedPtr rv) of
|
|
None \<Rightarrow> False | Some n \<Rightarrow> args ! 4 + args ! 5 - 1 < 2 ^ n"
|
|
in ccorres_sequenceE_while_gen'
|
|
[where i="unat (args ! 4)" and xf'=xfdc
|
|
and xf_update="i_'_update" and xf="i_'"
|
|
and r'=dc and Q=UNIV])
|
|
apply simp
|
|
apply (rule ccorres_guard_imp2)
|
|
apply (rule ccorres_add_returnOk)
|
|
apply (rule ccorres_Guard_Seq
|
|
ccorres_rhs_assoc)+
|
|
apply (ctac add: ccorres_injection_handler_csum1
|
|
[OF ensureEmptySlot_ccorres])
|
|
apply (rule ccorres_Guard_Seq
|
|
ccorres_rhs_assoc)+
|
|
apply (simp add: ccorres_cond_iffs returnOk_def)
|
|
apply (rule ccorres_return_Skip')
|
|
apply (rule ccorres_Guard_Seq
|
|
ccorres_rhs_assoc)+
|
|
apply (simp add: ccorres_cond_iffs inl_rrel_inl_rrel)
|
|
apply (rule ccorres_return_C_errorE_inl_rrel,
|
|
simp+)[1]
|
|
apply wp
|
|
apply (simp add: all_ex_eq_helper)
|
|
apply (vcg exspec=ensureEmptySlot_modifies)
|
|
apply (clarsimp simp: upto_enum_word
|
|
split: split_if_asm simp del: upt.simps)
|
|
apply (simp add: cte_level_bits_def field_simps size_of_def
|
|
numeral_eqs[symmetric])
|
|
apply (simp add: cap_get_tag_isCap[symmetric]
|
|
split: option.split_asm)
|
|
apply (drule(1) rf_sr_gsCNodes_array_assertion)
|
|
apply (drule(1) cap_get_tag_to_H)
|
|
apply clarsimp
|
|
apply (subgoal_tac P for P)
|
|
apply (subst array_assertion_shrink_right, assumption, assumption)
|
|
apply (simp add: array_assertion_shrink_right)
|
|
apply (rule unat_le_helper, simp)
|
|
apply (erule order_trans[rotated])
|
|
apply (subst add.commute, rule word_plus_mono_right)
|
|
apply (simp add: unat_plus_simple[THEN iffD1] olen_add_eqv[symmetric])
|
|
apply (simp add: word_le_nat_alt unat_of_nat)
|
|
apply (simp add: olen_add_eqv[symmetric])
|
|
apply (clarsimp simp add: upto_enum_word
|
|
simp del: upt.simps)
|
|
apply (simp add: word_less_nat_alt[symmetric] numeral_eqs[symmetric])
|
|
apply (simp add: Suc_unat_diff_1)
|
|
apply (subst iffD1 [OF unat_plus_simple])
|
|
apply (erule iffD2 [OF olen_add_eqv])
|
|
apply simp
|
|
apply (rule conseqPre, vcg exspec=ensureEmptySlot_modifies)
|
|
apply clarsimp
|
|
apply simp
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply (simp only: word_bits_def[symmetric])
|
|
apply clarsimp
|
|
apply (simp add: upto_enum_word numeral_eqs[symmetric]
|
|
Suc_unat_diff_1
|
|
del: upt.simps)
|
|
apply (subst(asm) olen_add_eqv[symmetric])
|
|
apply (simp add: iffD1 [OF unat_plus_simple])
|
|
apply (simp add: iffD1 [OF unat_plus_simple, symmetric])
|
|
apply (simp only: word_bits_def)
|
|
apply (rule unat_lt2p)
|
|
apply simp
|
|
apply simp
|
|
apply (rule ceqv_refl)
|
|
apply (ctac (c_lines 2) add:checkFreeIndex_ccorres[unfolded fun_app_def])
|
|
apply (rule_tac P = "rvb \<le> (capFreeIndex cp)" in ccorres_gen_asm)
|
|
apply csymbr
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr+
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (rule ccorres_Guard_Seq)+
|
|
apply csymbr
|
|
apply (rule ccorres_symb_exec_r)
|
|
apply (rule_tac xf'=ret__int_' in ccorres_abstract, ceqv)
|
|
apply (rule_tac P = "rv'b = (if (unat (2 ^ capBlockSize cp - (xfdc << 4)
|
|
>> (APIType_capBits (toEnum (unat (hd args))) (unat (args ! Suc 0))))
|
|
< unat (args ! 5)) then 1 else 0)" in ccorres_gen_asm2)
|
|
apply (rule
|
|
ccorres_split_when_throwError_cond[where Q = \<top> and Q' = \<top>])
|
|
apply (clarsimp simp: ccap_relation_untyped_CL_simps shiftL_nat
|
|
valid_untyped_capBlockSize_misc
|
|
of_nat_shiftR)
|
|
apply (clarsimp simp:toEnum_object_type_to_H
|
|
unat_of_nat_APIType_capBits word_size hd_conv_nth length_ineq_not_Nil
|
|
split:if_splits)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (clarsimp simp: syscall_error_rel_def
|
|
ccap_relation_untyped_CL_simps shiftL_nat
|
|
syscall_error_to_H_cases valid_untyped_capBlockSize_misc)
|
|
apply csymbr
|
|
apply csymbr
|
|
apply (rule ccorres_symb_exec_r)
|
|
|
|
apply (rule_tac xf'=ret__int_' in ccorres_abstract, ceqv)
|
|
apply (rule_tac P = "rv'c = from_bool (capIsDevice cp \<and>
|
|
\<not> isFrameType (toEnum (unat (hd args))))"
|
|
in ccorres_gen_asm2)
|
|
apply (rule_tac
|
|
ccorres_split_when_throwError_cond[where Q = \<top> and Q' = \<top>])
|
|
apply (clarsimp simp: toEnum_eq_to_fromEnum_eq
|
|
fromEnum_object_type_to_H from_bool_0
|
|
object_type_from_H_def hd_conv_nth length_ineq_not_Nil
|
|
fromAPIType_def ARM_H.fromAPIType_def)
|
|
apply (rule syscall_error_throwError_ccorres_n)
|
|
apply (clarsimp simp: syscall_error_rel_def
|
|
ccap_relation_untyped_CL_simps shiftL_nat
|
|
syscall_error_to_H_cases )
|
|
apply csymbr
|
|
apply (simp add:liftE_bindE)
|
|
apply (rule ccorres_symb_exec_l)
|
|
apply (simp (no_asm) add: ccorres_invocationCatch_Inr split_def
|
|
performInvocation_def liftE_bindE bind_assoc)
|
|
apply (ctac add: setThreadState_ccorres)
|
|
apply csymbr
|
|
apply (rule ccorres_trim_returnE, (simp (no_asm))+)
|
|
apply (simp (no_asm) add: o_def dc_def[symmetric]
|
|
bindE_assoc id_def[symmetric] bind_bindE_assoc)
|
|
apply (simp (no_asm) only:alternative_distrib)
|
|
apply (rule ccorres_alternative2)
|
|
apply (rule ccorres_call)
|
|
apply (rule_tac cnodeptr="capCNodePtr rv" in invokeUntyped_Retype_ccorres[where start = "args!4"])
|
|
apply simp
|
|
apply simp
|
|
apply simp
|
|
apply (wp sts_invs_minor' setThreadStateRestart_ct_active' sts_valid_untyped_inv')
|
|
apply (clarsimp simp: ccap_relation_untyped_CL_simps shiftL_nat
|
|
toEnum_object_type_to_H unat_of_nat_APIType_capBits word_size
|
|
valid_untyped_capBlockSize_misc getFreeRef_def hd_conv_nth length_ineq_not_Nil)
|
|
apply (rule_tac conseqPost[where A' = "{}" and Q' = UNIV])
|
|
apply (vcg exspec=setThreadState_modifies)
|
|
apply (clarsimp simp: object_type_from_to_H cap_get_tag_isCap
|
|
ccap_relation_isDeviceCap)
|
|
apply (frule_tac cap = rv in cap_get_tag_to_H(5))
|
|
apply (simp add: cap_get_tag_isCap)
|
|
apply (simp add: field_simps Suc_unat_diff_1)
|
|
apply (frule iffD2[OF olen_add_eqv])
|
|
apply (clarsimp simp: unat_plus_simple[THEN iffD1])
|
|
apply (case_tac slots,simp)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (subst upto_enum_word)
|
|
apply (subst nth_map_upt)
|
|
apply (clarsimp simp: field_simps Suc_unat_diff_1 unat_plus_simple[THEN iffD1])
|
|
apply (clarsimp simp: cte_level_bits_def)
|
|
apply (clarsimp simp: isFrameType_def
|
|
fromAPIType_def ARM_H.fromAPIType_def)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (simp (no_asm))
|
|
apply (rule hoare_strengthen_post[OF stateAssert_sp])
|
|
apply clarsimp
|
|
apply assumption
|
|
apply simp
|
|
apply clarsimp
|
|
apply vcg
|
|
apply clarsimp
|
|
apply vcg
|
|
apply clarsimp
|
|
apply (rule conseqPre,vcg,clarsimp)
|
|
apply vcg
|
|
apply (clarsimp simp: if_1_0_0 ccap_relation_isDeviceCap)
|
|
apply vcg
|
|
apply (clarsimp simp: if_1_0_0 from_bool_neq_0 from_bool_0
|
|
ccap_relation_isDeviceCap[unfolded to_bool_neq_0])
|
|
apply (rule conseqPre,vcg,clarsimp)
|
|
apply (rule ccorres_guard_imp
|
|
[where Q =\<top> and Q' = UNIV,rotated],assumption+)
|
|
apply (simp add: o_def)
|
|
apply (simp add: liftE_validE)
|
|
apply (rule checkFreeIndex_wp)
|
|
apply (clarsimp simp: ccap_relation_untyped_CL_simps shiftL_nat cap_get_tag_isCap
|
|
toEnum_object_type_to_H unat_of_nat_APIType_capBits word_size
|
|
valid_untyped_capBlockSize_misc getFreeRef_def hd_conv_nth length_ineq_not_Nil)
|
|
apply (rule_tac Q' ="{sa.
|
|
ksCurThread_' (globals sa) = tcb_ptr_to_ctcb_ptr (ksCurThread s)}" in conseqPost[where
|
|
A' = "{}"])
|
|
apply vcg
|
|
apply (clarsimp simp: toEnum_object_type_to_H not_le word_sle_def
|
|
enum_apiobject_type enum_object_type maxBound_is_length
|
|
unat_of_nat_APIType_capBits word_size hd_conv_nth length_ineq_not_Nil
|
|
not_less word_le_nat_alt
|
|
split: if_splits)
|
|
apply (clarsimp simp: from_bool_0 ccap_relation_isDeviceCap2)
|
|
apply (intro conjI allI impI)
|
|
apply (clarsimp simp: shiftL_nat isCap_simps valid_cap_simps', simp add: word_bits_def)
|
|
apply (rule conjI allI)
|
|
apply (rule ccontr)
|
|
apply (clarsimp simp: not_less shiftr_overflow)
|
|
apply (intro conjI allI impI)
|
|
apply ((clarsimp simp: shiftL_nat isCap_simps valid_cap_simps' isFrameType_def
|
|
ThreadState_Restart_def not_less mask_def
|
|
split:split_if_asm |
|
|
simp add: false_def of_nat_power[where x = 5,simplified] not_less)+)[8]
|
|
apply (intro conjI allI impI APIType_capBits_high word_of_nat_less)
|
|
apply ((clarsimp simp: shiftL_nat isCap_simps valid_cap_simps' isFrameType_def
|
|
ThreadState_Restart_def not_less mask_def isFrameType_def split:split_if_asm |
|
|
simp add: false_def of_nat_power[where x = 5,simplified] not_less)+)[5]
|
|
apply (rule_tac Q'="\<lambda>r. cte_wp_at' (\<lambda>cte. cteCap cte = cp) slot
|
|
and invs' and (\<lambda>s. ksCurThread s = thread)
|
|
and ex_cte_cap_to' (capCNodePtr rv)
|
|
and (\<lambda>s. case gsCNodes s (capCNodePtr rv) of None \<Rightarrow> False
|
|
| Some n \<Rightarrow> args ! 4 + args ! 5 - 1 < 2 ^ n)
|
|
and sch_act_simple and ct_active'" in hoare_post_imp_R)
|
|
prefer 2
|
|
apply (clarsimp simp: invs_valid_objs' invs_mdb'
|
|
invs_queues ct_in_state'_def pred_tcb_at')
|
|
apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread sa")
|
|
prefer 2
|
|
apply clarsimp
|
|
apply (frule st_tcb_at_idle_thread',fastforce)
|
|
apply (clarsimp simp: valid_idle'_def)
|
|
apply (clarsimp simp: st_tcb_at'_def obj_at'_def
|
|
invs'_def valid_state'_def)
|
|
apply (subgoal_tac "tcbState obja \<noteq> Inactive \<and> \<not> idle' (tcbState obja)")
|
|
prefer 2
|
|
apply (rule conjI, clarsimp)
|
|
apply (clarsimp dest!:invs_valid_idle')
|
|
apply (subgoal_tac "tcb_st_refs_of' (tcbState obja) = {}")
|
|
prefer 2
|
|
apply fastforce (* slow fastforce *)
|
|
apply (clarsimp split:if_splits simp: not_less toEnum_object_type_to_H
|
|
word_size hd_conv_nth length_ineq_not_Nil)
|
|
apply (subgoal_tac "tcbQueued obja \<longrightarrow> runnable' (tcbState obja)")
|
|
apply (simp add: trans [OF olen_add_eqv[symmetric] unat_plus_simple])
|
|
apply (clarsimp simp: word_le_nat_alt unat_2tp_if
|
|
valid_tcb_state'_def
|
|
split: option.split_asm split_if_asm)
|
|
apply (case_tac "tcbState obja",
|
|
(simp add: runnable'_def valid_tcb_state'_def)+)[1]
|
|
apply simp
|
|
apply (rule validE_validE_R, rule mapME_wp'[unfolded mapME_def])
|
|
apply (rule hoare_pre)
|
|
apply (rule validE_R_validE)
|
|
apply (wp injection_wp_E[OF refl])
|
|
apply clarsimp
|
|
apply (simp add: ccHoarePost_def xfdc_def)
|
|
apply (simp only: whileAnno_def[where I=UNIV and V=UNIV, symmetric])
|
|
apply (rule_tac V=UNIV
|
|
in HoarePartial.reannotateWhileNoGuard)
|
|
apply (vcg exspec=ensureEmptySlot_modifies)
|
|
prefer 2
|
|
apply clarsimp
|
|
apply (subst (asm) mem_Collect_eq, assumption)
|
|
apply clarsimp
|
|
apply (rule_tac Q'="\<lambda>r s. cte_wp_at' (\<lambda>cte. cteCap cte = cp) slot s
|
|
\<and> invs' s \<and> ksCurThread s = thread
|
|
\<and> valid_cap' r s
|
|
\<and> (\<forall>rf\<in>cte_refs' r (irq_node' s). ex_cte_cap_to' rf s)
|
|
\<and> sch_act_simple s \<and> ct_active' s" in hoare_post_imp_R)
|
|
apply clarsimp
|
|
apply (wp injection_wp_E[OF refl] getSlotCap_cap_to'
|
|
getSlotCap_capAligned
|
|
| wp_once hoare_drop_imps)+
|
|
apply (clarsimp simp: valid_capAligned isCap_simps)
|
|
apply (drule_tac x=0 in bspec, simp+)
|
|
apply (frule(1) base_length_minus_one_inequality[where
|
|
wbase="args ! 4" and wlength="args ! 5"], simp_all)[1]
|
|
apply (simp add: valid_cap_simps' capAligned_def word_bits_def)
|
|
apply (clarsimp simp: upto_enum_def word_le_nat_alt[symmetric]
|
|
split: option.split_asm split_if_asm)
|
|
apply (drule spec, drule mp, erule conjI, rule order_refl)
|
|
apply clarsimp
|
|
apply (simp del: Collect_const)
|
|
apply (vcg exspec=lookupTargetSlot_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply (simp add: all_ex_eq_helper)
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply simp
|
|
apply wp
|
|
apply simp
|
|
apply (vcg exspec=getSyscallArg_modifies)
|
|
apply clarsimp
|
|
apply (clarsimp simp: hd_drop_conv_nth2 hd_conv_nth neq_Nil_lengthI
|
|
ct_in_state'_def pred_tcb_at'
|
|
rf_sr_ksCurThread mask_eq_iff_w2p
|
|
"StrictC'_thread_state_defs" numeral_eqs[symmetric]
|
|
cap_get_tag_isCap cte_wp_at_ctes_of
|
|
unat_eq_0 ccHoarePost_def)
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: linorder_not_less isCap_simps)
|
|
apply (clarsimp simp: sysargs_rel_to_n)
|
|
apply (rule conjI, clarsimp)
|
|
apply (clarsimp simp: fromAPIType_def)
|
|
apply (subgoal_tac "unat (args ! Suc 0) < word_bits")
|
|
prefer 2
|
|
apply (erule le_less_trans)
|
|
apply (simp add: word_size fromIntegral_def fromInteger_nat toInteger_nat word_bits_def)
|
|
apply (clarsimp simp: excaps_map_def neq_Nil_conv excaps_in_mem_def
|
|
slotcap_in_mem_def cte_wp_at_ctes_of
|
|
valid_capAligned[OF ctes_of_valid'] invs_valid_objs'
|
|
dest!: interpret_excaps_eq)
|
|
apply (clarsimp dest!: ctes_of_ex_cte_cap_to')
|
|
apply (simp only: word_bits_def unat_lt2p)
|
|
apply (frule interpret_excaps_eq)
|
|
apply (clarsimp simp: if_1_0_0 word_less_nat_alt neq_Nil_conv
|
|
mask_def[where n=4] excaps_map_def
|
|
ccap_rights_relation_def word_sle_def
|
|
rightsFromWord_wordFromRights
|
|
excaps_in_mem_def slotcap_in_mem_def
|
|
signed_shift_guard_simpler_32
|
|
extra_sle_sless_unfolds
|
|
elim!: inl_inrE
|
|
simp del: rf_sr_upd_safe)
|
|
apply (clarsimp simp:cap_get_tag_isCap[symmetric])
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: cap_get_tag_isCap[symmetric]
|
|
capCNodeRadix_CL_less_32s rf_sr_ksCurThread not_le
|
|
elim!: inl_inrE)
|
|
apply (drule(1) cap_get_tag_to_H)+
|
|
apply (clarsimp simp: isCap_simps capAligned_def[unfolded capUntypedPtr_def, split_simps capability.split]
|
|
objBits_simps word_bits_def)
|
|
apply (rule rf_sr_ctes_of_cliftE,assumption+)
|
|
apply (intro exI)+
|
|
apply (rule conjI,assumption)
|
|
apply (rule conjI,erule(2) rf_sr_cte_relation)
|
|
apply (frule(1) h_t_valid_and_cslift_and_c_guard_field_mdbNext_CL[rotated -1])
|
|
apply (clarsimp simp:cte_wp_at_ctes_of)
|
|
apply fastforce
|
|
apply (clarsimp simp: typ_heap_simps)
|
|
apply (frule_tac p = slot in valid_mdb_ctes_of_next[rotated])
|
|
apply simp
|
|
apply fastforce
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
apply (frule_tac src = "(mdbNext_CL (cteMDBNode_CL ctel'))" in rf_sr_cte_relation)
|
|
apply simp
|
|
apply simp
|
|
apply (intro exI conjI,assumption)
|
|
apply (erule valid_capAligned[OF ctes_of_valid'])
|
|
apply fastforce
|
|
apply simp
|
|
apply (clarsimp elim!:inl_inrE)
|
|
apply (drule(1) cap_get_tag_to_H)+
|
|
apply (rule conjI)
|
|
apply (clarsimp simp: cap_get_tag_isCap[symmetric]
|
|
capCNodeRadix_CL_less_32s rf_sr_ksCurThread not_le
|
|
elim!: inl_inrE)
|
|
apply (rule rf_sr_ctes_of_cliftE,assumption+)
|
|
apply (intro exI)+
|
|
apply (rule conjI,assumption)
|
|
apply (rule conjI,erule(2) rf_sr_cte_relation)
|
|
apply (frule(1) h_t_valid_and_cslift_and_c_guard_field_mdbNext_CL[rotated -1])
|
|
apply (clarsimp simp: cte_wp_at_ctes_of simp del: rf_sr_upd_safe)
|
|
apply fastforce
|
|
apply (clarsimp simp: typ_heap_simps simp del: rf_sr_upd_safe)
|
|
apply (frule_tac p = slot in valid_mdb_ctes_of_next[rotated])
|
|
apply (simp del: rf_sr_upd_safe)
|
|
apply fastforce
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
apply (frule_tac src = "(mdbNext_CL (cteMDBNode_CL ctel'))" in rf_sr_cte_relation)
|
|
apply simp
|
|
apply simp
|
|
apply (intro exI conjI,assumption)
|
|
apply (erule valid_capAligned[OF ctes_of_valid'])
|
|
apply fastforce
|
|
apply simp
|
|
apply (clarsimp simp: cap_get_tag_isCap[symmetric])
|
|
apply (drule(1) cap_get_tag_to_H)+
|
|
apply (clarsimp simp: capAligned_def objBits_simps word_bits_def)
|
|
done
|
|
|
|
lemma decodeUntypedInvocation_ccorres:
|
|
notes TripleSuc[simp]
|
|
notes valid_untyped_inv'.simps[simp del]
|
|
shows
|
|
"interpret_excaps extraCaps' = excaps_map extraCaps \<Longrightarrow>
|
|
ccorres (intr_and_se_rel \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
|
(invs' and (\<lambda>s. ksCurThread s = thread)
|
|
and sch_act_simple and ct_active'
|
|
and valid_cap' cp and K (isUntypedCap cp)
|
|
and cte_wp_at' (\<lambda>cte. cteCap cte = cp) slot
|
|
and (excaps_in_mem extraCaps \<circ> ctes_of)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps. \<forall>y \<in> zobj_refs' (fst v).
|
|
ex_nonz_cap_to' y s)
|
|
and (\<lambda>s. \<forall>v \<in> set extraCaps.
|
|
s \<turnstile>' fst v)
|
|
and sysargs_rel args buffer)
|
|
(UNIV
|
|
\<inter> {s. invLabel_' s = label}
|
|
\<inter> {s. unat (length___unsigned_long_' s) = length args}
|
|
\<inter> {s. ccap_relation cp (cap_' s)}
|
|
\<inter> {s. slot_' s = cte_Ptr slot}
|
|
\<inter> {s. excaps_' s = extraCaps'}
|
|
\<inter> {s. call_' s = from_bool isCall}
|
|
\<inter> {s. buffer_' s = option_to_ptr buffer})
|
|
[]
|
|
(decodeUntypedInvocation label args slot cp (map fst extraCaps)
|
|
>>= invocationCatch thread isBlocking isCall InvokeUntyped)
|
|
(Call decodeUntypedInvocation_'proc)"
|
|
apply (rule ccorres_name_pre)
|
|
apply (clarsimp simp: isCap_simps)
|
|
apply (rule ccorres_guard_imp2)
|
|
apply (rule monadic_rewrite_ccorres_assemble)
|
|
apply (rule_tac isBlocking=isBlocking and isCall=isCall and buffer=buffer
|
|
in decodeUntypedInvocation_ccorres_helper[unfolded K_def])
|
|
apply assumption
|
|
apply (rule monadic_rewrite_transverse)
|
|
apply (rule monadic_rewrite_bind_head)
|
|
apply (rule monadic_rewrite_bindE[OF monadic_rewrite_refl])
|
|
apply (simp add: liftE_bindE stateAssert_def2 bind_assoc)
|
|
apply (rule monadic_rewrite_bind_tail)
|
|
apply (rule_tac P=x in monadic_rewrite_gen_asm)
|
|
apply simp
|
|
apply (rule monadic_rewrite_refl)
|
|
apply (wp | simp)+
|
|
apply (simp add: gets_bind_ign)
|
|
apply (rule monadic_rewrite_refl)
|
|
apply (clarsimp simp: ex_cte_cap_wp_to'_def excaps_in_mem_def)
|
|
apply (drule(1) bspec)+
|
|
apply (rule_tac x = b in exI)
|
|
apply (clarsimp simp: slotcap_in_mem_def cte_wp_at_ctes_of)
|
|
done
|
|
|
|
end
|
|
end
|