2014-07-14 19:32:44 +00:00
|
|
|
(*
|
|
|
|
* 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 Finalise_C
|
|
|
|
imports IpcCancel_C
|
|
|
|
begin
|
|
|
|
|
|
|
|
context kernel_m
|
|
|
|
begin
|
|
|
|
|
|
|
|
lemma switchIfRequiredTo_ccorres [corres]:
|
2016-11-16 03:02:03 +00:00
|
|
|
"ccorres dc xfdc (valid_queues and valid_objs' and tcb_at' thread
|
2014-07-14 19:32:44 +00:00
|
|
|
and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s) and st_tcb_at' runnable' thread)
|
|
|
|
(UNIV \<inter> \<lbrace>\<acute>target = tcb_ptr_to_ctcb_ptr thread\<rbrace>) hs
|
|
|
|
(switchIfRequiredTo thread)
|
|
|
|
(Call switchIfRequiredTo_'proc)"
|
|
|
|
apply (cinit lift: target_')
|
|
|
|
apply (ctac add: possibleSwitchTo_ccorres)
|
|
|
|
apply clarsimp
|
|
|
|
done
|
|
|
|
|
2016-10-25 06:01:30 +00:00
|
|
|
declare if_split [split del]
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
lemma empty_fail_getEndpoint:
|
|
|
|
"empty_fail (getEndpoint ep)"
|
|
|
|
unfolding getEndpoint_def
|
|
|
|
by (auto intro: empty_fail_getObject)
|
|
|
|
|
|
|
|
definition
|
|
|
|
"option_map2 f m = option_map f \<circ> m"
|
|
|
|
|
|
|
|
lemma tcbSchedEnqueue_cslift_spec:
|
|
|
|
"\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. \<exists>d v. option_map2 tcbPriority_C (cslift s) \<acute>tcb = Some v
|
|
|
|
\<and> v \<le> ucast maxPrio
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s) \<acute>tcb = Some d
|
|
|
|
\<and> d \<le> ucast maxDom
|
|
|
|
\<and> (end_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))) \<noteq> NULL
|
|
|
|
\<longrightarrow> option_map2 tcbPriority_C (cslift s)
|
|
|
|
(head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
|
|
|
|
\<noteq> None
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s)
|
|
|
|
(head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
|
|
|
|
\<noteq> None)\<rbrace>
|
|
|
|
Call tcbSchedEnqueue_'proc
|
|
|
|
{s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
|
|
|
|
\<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
|
|
|
|
\<and> option_map2 tcbPriority_C (cslift s') = option_map2 tcbPriority_C (cslift s)
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s') = option_map2 tcbDomain_C (cslift s)}"
|
|
|
|
apply (hoare_rule HoarePartial.ProcNoRec1)
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: option_map2_def fun_eq_iff h_t_valid_clift
|
|
|
|
h_t_valid_field[OF h_t_valid_clift])
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (clarsimp simp: typ_heap_simps cong: if_cong)
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (simp split: if_split)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: typ_heap_simps if_Some_helper cong: if_cong)
|
2016-10-25 06:01:30 +00:00
|
|
|
by (simp split: if_split)
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
lemma setThreadState_cslift_spec:
|
|
|
|
"\<forall>s. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> \<lbrace>s. s \<Turnstile>\<^sub>c \<acute>tptr \<and> (\<forall>x. ksSchedulerAction_' (globals s) = tcb_Ptr x
|
|
|
|
\<and> x \<noteq> 0 \<and> x \<noteq> ~~ 0
|
|
|
|
\<longrightarrow> (\<exists>d v. option_map2 tcbPriority_C (cslift s) (tcb_Ptr x) = Some v
|
|
|
|
\<and> v \<le> ucast maxPrio
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s) (tcb_Ptr x) = Some d
|
|
|
|
\<and> d \<le> ucast maxDom
|
|
|
|
\<and> (end_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))) \<noteq> NULL
|
|
|
|
\<longrightarrow> option_map2 tcbPriority_C (cslift s)
|
|
|
|
(head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
|
|
|
|
\<noteq> None
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s)
|
|
|
|
(head_C (index \<acute>ksReadyQueues (unat (d*0x100 + v))))
|
|
|
|
\<noteq> None)))\<rbrace>
|
|
|
|
Call setThreadState_'proc
|
|
|
|
{s'. option_map2 tcbEPNext_C (cslift s') = option_map2 tcbEPNext_C (cslift s)
|
|
|
|
\<and> option_map2 tcbEPPrev_C (cslift s') = option_map2 tcbEPPrev_C (cslift s)
|
|
|
|
\<and> option_map2 tcbPriority_C (cslift s') = option_map2 tcbPriority_C (cslift s)
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s') = option_map2 tcbDomain_C (cslift s)
|
|
|
|
\<and> ksReadyQueues_' (globals s') = ksReadyQueues_' (globals s)}"
|
|
|
|
apply (rule allI, rule conseqPre)
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply (vcg exspec=tcbSchedEnqueue_cslift_spec)
|
|
|
|
apply (vcg_step+)[2]
|
|
|
|
apply vcg_step
|
|
|
|
apply (vcg exspec=isRunnable_modifies)
|
|
|
|
apply vcg
|
|
|
|
apply vcg_step
|
|
|
|
apply vcg_step
|
|
|
|
apply (vcg_step+)[1]
|
|
|
|
apply vcg
|
|
|
|
apply vcg_step+
|
|
|
|
apply (clarsimp simp: typ_heap_simps h_t_valid_clift_Some_iff
|
|
|
|
fun_eq_iff option_map2_def if_1_0_0)
|
2016-10-25 06:01:30 +00:00
|
|
|
by (simp split: if_split)
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
lemma ep_queue_relation_shift:
|
|
|
|
"(option_map2 tcbEPNext_C (cslift s')
|
|
|
|
= option_map2 tcbEPNext_C (cslift s)
|
|
|
|
\<and> option_map2 tcbEPPrev_C (cslift s')
|
|
|
|
= option_map2 tcbEPPrev_C (cslift s))
|
|
|
|
\<longrightarrow> ep_queue_relation (cslift s') ts qPrev qHead
|
|
|
|
= ep_queue_relation (cslift s) ts qPrev qHead"
|
|
|
|
apply clarsimp
|
|
|
|
apply (induct ts arbitrary: qPrev qHead)
|
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
apply (simp add: option_map2_def fun_eq_iff
|
2014-08-09 11:09:37 +00:00
|
|
|
map_option_case)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (drule_tac x=qHead in spec)+
|
|
|
|
apply (clarsimp split: option.split_asm)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma rf_sr_cscheduler_relation:
|
|
|
|
"(s, s') \<in> rf_sr \<Longrightarrow> cscheduler_action_relation
|
|
|
|
(ksSchedulerAction s) (ksSchedulerAction_' (globals s'))"
|
|
|
|
by (clarsimp simp: rf_sr_def cstate_relation_def Let_def)
|
|
|
|
|
|
|
|
lemma obj_at_ko_at2':
|
|
|
|
"\<lbrakk> obj_at' P p s; ko_at' ko p s \<rbrakk> \<Longrightarrow> P ko"
|
|
|
|
apply (drule obj_at_ko_at')
|
|
|
|
apply clarsimp
|
|
|
|
apply (drule ko_at_obj_congD', simp+)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma ctcb_relation_tcbDomain:
|
|
|
|
"ctcb_relation tcb tcb' \<Longrightarrow> ucast (tcbDomain tcb) = tcbDomain_C tcb'"
|
|
|
|
by (simp add: ctcb_relation_def)
|
|
|
|
|
|
|
|
lemma ctcb_relation_tcbPriority:
|
|
|
|
"ctcb_relation tcb tcb' \<Longrightarrow> ucast (tcbPriority tcb) = tcbPriority_C tcb'"
|
|
|
|
by (simp add: ctcb_relation_def)
|
|
|
|
|
|
|
|
lemma ctcb_relation_tcbDomain_maxDom:
|
|
|
|
"\<lbrakk> ctcb_relation tcb tcb'; tcbDomain tcb \<le> maxDomain \<rbrakk> \<Longrightarrow> tcbDomain_C tcb' \<le> ucast maxDom"
|
|
|
|
apply (subst ctcb_relation_tcbDomain[symmetric], simp)
|
|
|
|
apply (subst ucast_le_migrate)
|
|
|
|
apply ((simp add:maxDom_def word_size)+)[2]
|
|
|
|
apply (simp add: ucast_up_ucast is_up_def source_size_def word_size target_size_def)
|
|
|
|
apply (simp add: maxDom_to_H)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma ctcb_relation_tcbPriority_maxPrio:
|
|
|
|
"\<lbrakk> ctcb_relation tcb tcb'; tcbPriority tcb \<le> maxPriority \<rbrakk>
|
|
|
|
\<Longrightarrow> tcbPriority_C tcb' \<le> ucast maxPrio"
|
|
|
|
apply (subst ctcb_relation_tcbPriority[symmetric], simp)
|
|
|
|
apply (subst ucast_le_migrate)
|
|
|
|
apply ((simp add: seL4_MaxPrio_def word_size)+)[2]
|
|
|
|
apply (simp add: ucast_up_ucast is_up_def source_size_def word_size target_size_def)
|
|
|
|
apply (simp add: maxPrio_to_H)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma tcbSchedEnqueue_cslift_precond_discharge:
|
|
|
|
"\<lbrakk> (s, s') \<in> rf_sr; obj_at' (P :: tcb \<Rightarrow> bool) x s;
|
|
|
|
valid_queues s; valid_objs' s \<rbrakk> \<Longrightarrow>
|
|
|
|
(\<exists>d v. option_map2 tcbPriority_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some v
|
|
|
|
\<and> v \<le> ucast maxPrio
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s') (tcb_ptr_to_ctcb_ptr x) = Some d
|
|
|
|
\<and> d \<le> ucast maxDom
|
|
|
|
\<and> (end_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))) \<noteq> NULL
|
|
|
|
\<longrightarrow> option_map2 tcbPriority_C (cslift s')
|
|
|
|
(head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
|
|
|
|
\<noteq> None
|
|
|
|
\<and> option_map2 tcbDomain_C (cslift s')
|
|
|
|
(head_C (index (ksReadyQueues_' (globals s')) (unat (d*0x100 + v))))
|
|
|
|
\<noteq> None))"
|
|
|
|
apply (drule(1) obj_at_cslift_tcb)
|
|
|
|
apply (clarsimp simp: typ_heap_simps' option_map2_def)
|
|
|
|
apply (frule_tac t=x in valid_objs'_maxPriority, fastforce simp: obj_at'_def)
|
|
|
|
apply (frule_tac t=x in valid_objs'_maxDomain, fastforce simp: obj_at'_def)
|
|
|
|
apply (drule_tac P="\<lambda>tcb. tcbPriority tcb \<le> maxPriority" in obj_at_ko_at2', simp)
|
|
|
|
apply (drule_tac P="\<lambda>tcb. tcbDomain tcb \<le> maxDomain" in obj_at_ko_at2', simp)
|
|
|
|
|
|
|
|
apply (simp add: ctcb_relation_tcbDomain_maxDom ctcb_relation_tcbPriority_maxPrio)
|
|
|
|
apply (frule_tac d="tcbDomain ko" and p="tcbPriority ko"
|
|
|
|
in rf_sr_sched_queue_relation)
|
|
|
|
apply (simp add: maxDom_to_H maxPrio_to_H)+
|
|
|
|
apply (simp add: cready_queues_index_to_C_def2 numPriorities_def)
|
|
|
|
apply (clarsimp simp: ctcb_relation_def)
|
|
|
|
apply (frule arg_cong[where f=unat], subst(asm) unat_ucast_8_32)
|
|
|
|
apply (frule tcb_queue'_head_end_NULL)
|
|
|
|
apply (erule conjunct1[OF valid_queues_valid_q])
|
|
|
|
apply (frule(1) tcb_queue_relation_qhead_valid')
|
|
|
|
apply (simp add: valid_queues_valid_q)
|
|
|
|
apply (clarsimp simp: h_t_valid_clift_Some_iff)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma cancel_all_ccorres_helper:
|
|
|
|
"ccorres dc xfdc
|
|
|
|
(\<lambda>s. valid_objs' s \<and> valid_queues s
|
|
|
|
\<and> (\<forall>t\<in>set ts. tcb_at' t s \<and> t \<noteq> 0)
|
|
|
|
\<and> sch_act_wf (ksSchedulerAction s) s)
|
|
|
|
{s'. \<exists>p. ep_queue_relation (cslift s') ts
|
|
|
|
p (thread_' s')} hs
|
|
|
|
(mapM_x (\<lambda>t. do
|
|
|
|
y \<leftarrow> setThreadState Restart t;
|
|
|
|
tcbSchedEnqueue t
|
|
|
|
od) ts)
|
|
|
|
(WHILE \<acute>thread \<noteq> tcb_Ptr 0 DO
|
|
|
|
(CALL setThreadState(\<acute>thread, scast ThreadState_Restart));;
|
|
|
|
(CALL tcbSchedEnqueue(\<acute>thread));;
|
|
|
|
Guard C_Guard \<lbrace>hrs_htd \<acute>t_hrs \<Turnstile>\<^sub>t \<acute>thread\<rbrace>
|
|
|
|
(\<acute>thread :== h_val (hrs_mem \<acute>t_hrs) (Ptr &(\<acute>thread\<rightarrow>[''tcbEPNext_C'']) :: tcb_C ptr ptr))
|
|
|
|
OD)"
|
|
|
|
unfolding whileAnno_def
|
|
|
|
proof (induct ts)
|
|
|
|
case Nil
|
|
|
|
show ?case
|
|
|
|
apply (simp del: Collect_const)
|
|
|
|
apply (rule iffD1 [OF ccorres_expand_while_iff])
|
|
|
|
apply (rule ccorres_tmp_lift2[where G'=UNIV and G''="\<lambda>x. UNIV", simplified])
|
|
|
|
apply ceqv
|
|
|
|
apply (simp add: ccorres_cond_iffs mapM_x_def sequence_x_def
|
|
|
|
dc_def[symmetric])
|
|
|
|
apply (rule ccorres_guard_imp2, rule ccorres_return_Skip)
|
|
|
|
apply simp
|
|
|
|
done
|
|
|
|
next
|
|
|
|
case (Cons thread threads)
|
|
|
|
show ?case
|
|
|
|
apply (rule iffD1 [OF ccorres_expand_while_iff])
|
|
|
|
apply (simp del: Collect_const
|
|
|
|
add: dc_def[symmetric] mapM_x_Cons)
|
|
|
|
apply (rule ccorres_guard_imp2)
|
|
|
|
apply (rule_tac xf'=thread_' in ccorres_abstract)
|
|
|
|
apply ceqv
|
|
|
|
apply (rule_tac P="rv' = tcb_ptr_to_ctcb_ptr thread"
|
|
|
|
in ccorres_gen_asm2)
|
|
|
|
apply (rule_tac P="tcb_ptr_to_ctcb_ptr thread \<noteq> Ptr 0"
|
|
|
|
in ccorres_gen_asm)
|
|
|
|
apply (clarsimp simp add: Collect_True ccorres_cond_iffs
|
|
|
|
simp del: Collect_const)
|
|
|
|
apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow[where F=UNIV])
|
|
|
|
apply (intro ccorres_rhs_assoc)
|
|
|
|
apply (ctac(no_vcg) add: setThreadState_ccorres)
|
|
|
|
apply (rule ccorres_add_return2)
|
|
|
|
apply (ctac(no_vcg) add: tcbSchedEnqueue_ccorres)
|
|
|
|
apply (rule_tac P="tcb_at' thread"
|
|
|
|
in ccorres_from_vcg[where P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def)
|
|
|
|
apply (drule obj_at_ko_at', clarsimp)
|
|
|
|
apply (erule cmap_relationE1 [OF cmap_relation_tcb])
|
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (fastforce intro: typ_heap_simps)
|
|
|
|
apply (wp sts_running_valid_queues | simp)+
|
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (rule "Cons.hyps")
|
|
|
|
apply (wp sts_valid_objs' sts_sch_act sch_act_wf_lift hoare_vcg_const_Ball_lift
|
|
|
|
sts_running_valid_queues sts_st_tcb' setThreadState_oa_queued | simp)+
|
|
|
|
|
|
|
|
apply (vcg exspec=setThreadState_cslift_spec exspec=tcbSchedEnqueue_cslift_spec)
|
|
|
|
apply (clarsimp simp: tcb_at_not_NULL
|
|
|
|
Collect_const_mem valid_tcb_state'_def
|
|
|
|
ThreadState_Restart_def mask_def
|
|
|
|
valid_objs'_maxDomain valid_objs'_maxPriority)
|
|
|
|
apply (drule(1) obj_at_cslift_tcb)
|
|
|
|
apply (clarsimp simp: typ_heap_simps)
|
|
|
|
apply (rule conjI)
|
|
|
|
apply clarsimp
|
|
|
|
apply (frule rf_sr_cscheduler_relation)
|
|
|
|
apply (clarsimp simp: cscheduler_action_relation_def
|
|
|
|
st_tcb_at'_def
|
|
|
|
split: scheduler_action.split_asm)
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (rename_tac word)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (frule_tac x=word in tcbSchedEnqueue_cslift_precond_discharge)
|
|
|
|
apply simp
|
|
|
|
apply clarsimp
|
|
|
|
apply clarsimp
|
|
|
|
apply clarsimp
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (frule(3) tcbSchedEnqueue_cslift_precond_discharge)
|
|
|
|
apply clarsimp
|
|
|
|
apply clarsimp
|
|
|
|
apply (subst ep_queue_relation_shift, fastforce)
|
|
|
|
apply (drule_tac x="tcb_ptr_to_ctcb_ptr thread"
|
|
|
|
in fun_cong)+
|
|
|
|
apply (clarsimp simp add: option_map2_def typ_heap_simps)
|
|
|
|
apply fastforce
|
|
|
|
done
|
|
|
|
qed
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma cancelAllIPC_ccorres:
|
2014-07-14 19:32:44 +00:00
|
|
|
"ccorres dc xfdc
|
|
|
|
(invs') (UNIV \<inter> {s. epptr_' s = Ptr epptr}) []
|
2015-11-02 00:00:32 +00:00
|
|
|
(cancelAllIPC epptr) (Call cancelAllIPC_'proc)"
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (cinit lift: epptr_')
|
|
|
|
apply (rule ccorres_symb_exec_l [OF _ getEndpoint_inv _ empty_fail_getEndpoint])
|
2015-12-08 06:29:42 +00:00
|
|
|
apply (rule_tac xf'=ret__unsigned_'
|
2014-07-14 19:32:44 +00:00
|
|
|
and val="case rv of IdleEP \<Rightarrow> scast EPState_Idle
|
|
|
|
| RecvEP _ \<Rightarrow> scast EPState_Recv | SendEP _ \<Rightarrow> scast EPState_Send"
|
|
|
|
and R="ko_at' rv epptr"
|
|
|
|
in ccorres_symb_exec_r_known_rv_UNIV[where R'=UNIV])
|
|
|
|
apply vcg
|
|
|
|
apply clarsimp
|
|
|
|
apply (erule cmap_relationE1 [OF cmap_relation_ep])
|
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (clarsimp simp add: typ_heap_simps)
|
|
|
|
apply (simp add: cendpoint_relation_def Let_def
|
|
|
|
split: endpoint.split_asm)
|
|
|
|
apply ceqv
|
|
|
|
apply (rule_tac A="invs' and ko_at' rv epptr"
|
|
|
|
in ccorres_guard_imp2[where A'=UNIV])
|
|
|
|
apply wpc
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (rename_tac list)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: endpoint_state_defs
|
|
|
|
Collect_False Collect_True
|
|
|
|
ccorres_cond_iffs
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_abstract_cleanup)
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2)
|
|
|
|
apply (rule_tac r'=dc and xf'=xfdc
|
|
|
|
in ccorres_split_nothrow)
|
|
|
|
apply (rule_tac P="ko_at' (RecvEP list) epptr and invs'"
|
|
|
|
in ccorres_from_vcg[where P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule cmap_relationE1 [OF cmap_relation_ep])
|
|
|
|
apply assumption
|
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (clarsimp simp: typ_heap_simps setEndpoint_def)
|
|
|
|
apply (rule rev_bexI)
|
2016-01-20 03:42:36 +00:00
|
|
|
apply (rule setObject_eq; simp add: objBits_simps)[1]
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: rf_sr_def cstate_relation_def
|
|
|
|
Let_def carch_state_relation_def carch_globals_def
|
|
|
|
cmachine_state_relation_def)
|
|
|
|
apply (clarsimp simp: cpspace_relation_def
|
2016-09-21 00:33:03 +00:00
|
|
|
update_ep_map_tos typ_heap_simps')
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (erule(2) cpspace_relation_ep_update_ep)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (simp add: cendpoint_relation_def endpoint_state_defs)
|
|
|
|
subgoal by simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (simp only: ccorres_seq_skip dc_def[symmetric])
|
|
|
|
apply (rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule cancel_all_ccorres_helper)
|
|
|
|
apply ceqv
|
|
|
|
apply (ctac add: rescheduleRequired_ccorres)
|
|
|
|
apply (wp weak_sch_act_wf_lift_linear
|
2015-11-02 00:00:32 +00:00
|
|
|
cancelAllIPC_mapM_x_valid_queues
|
2014-07-14 19:32:44 +00:00
|
|
|
| simp)+
|
|
|
|
apply (rule mapM_x_wp', wp)+
|
|
|
|
apply (wp sts_st_tcb')
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (clarsimp split: if_split)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule mapM_x_wp', wp)+
|
|
|
|
apply (clarsimp simp: valid_tcb_state'_def)
|
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
|
|
|
|
weak_sch_act_wf_lift_linear)
|
|
|
|
apply vcg
|
|
|
|
apply (simp add: ccorres_cond_iffs dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (rename_tac list)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: endpoint_state_defs
|
|
|
|
Collect_False Collect_True
|
|
|
|
ccorres_cond_iffs dc_def[symmetric]
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_abstract_cleanup)
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2)
|
|
|
|
apply (rule_tac r'=dc and xf'=xfdc
|
|
|
|
in ccorres_split_nothrow)
|
|
|
|
apply (rule_tac P="ko_at' (SendEP list) epptr and invs'"
|
|
|
|
in ccorres_from_vcg[where P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule cmap_relationE1 [OF cmap_relation_ep])
|
|
|
|
apply assumption
|
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (clarsimp simp: typ_heap_simps setEndpoint_def)
|
|
|
|
apply (rule rev_bexI)
|
|
|
|
apply (rule setObject_eq, simp_all add: objBits_simps)[1]
|
|
|
|
apply (clarsimp simp: rf_sr_def cstate_relation_def
|
|
|
|
Let_def carch_state_relation_def carch_globals_def
|
|
|
|
cmachine_state_relation_def)
|
2016-09-21 00:33:03 +00:00
|
|
|
apply (clarsimp simp: cpspace_relation_def typ_heap_simps'
|
2014-07-14 19:32:44 +00:00
|
|
|
update_ep_map_tos)
|
|
|
|
apply (erule(2) cpspace_relation_ep_update_ep)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (simp add: cendpoint_relation_def endpoint_state_defs)
|
|
|
|
subgoal by simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (simp only: ccorres_seq_skip dc_def[symmetric])
|
|
|
|
apply (rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule cancel_all_ccorres_helper)
|
|
|
|
apply ceqv
|
|
|
|
apply (ctac add: rescheduleRequired_ccorres)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp cancelAllIPC_mapM_x_valid_queues)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
|
2016-10-25 06:01:30 +00:00
|
|
|
sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply (wp set_ep_valid_objs' hoare_vcg_const_Ball_lift
|
|
|
|
weak_sch_act_wf_lift_linear)
|
|
|
|
apply vcg
|
|
|
|
apply (clarsimp simp: valid_ep'_def invs_valid_objs' invs_queues)
|
|
|
|
apply (rule cmap_relationE1[OF cmap_relation_ep], assumption)
|
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (frule obj_at_valid_objs', clarsimp+)
|
|
|
|
apply (clarsimp simp: projectKOs valid_obj'_def valid_ep'_def)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (auto simp: typ_heap_simps cendpoint_relation_def
|
2014-07-14 19:32:44 +00:00
|
|
|
Let_def tcb_queue_relation'_def
|
|
|
|
invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
|
2016-01-20 03:42:36 +00:00
|
|
|
intro!: obj_at_conj')
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: guard_is_UNIV_def)
|
|
|
|
apply (wp getEndpoint_wp)
|
|
|
|
apply clarsimp
|
|
|
|
done
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma empty_fail_getNotification:
|
|
|
|
"empty_fail (getNotification ep)"
|
|
|
|
unfolding getNotification_def
|
2014-07-14 19:32:44 +00:00
|
|
|
by (auto intro: empty_fail_getObject)
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma cancelAllSignals_ccorres:
|
2014-07-14 19:32:44 +00:00
|
|
|
"ccorres dc xfdc
|
2015-11-02 00:00:32 +00:00
|
|
|
(invs') (UNIV \<inter> {s. ntfnPtr_' s = Ptr ntfnptr}) []
|
|
|
|
(cancelAllSignals ntfnptr) (Call cancelAllSignals_'proc)"
|
|
|
|
apply (cinit lift: ntfnPtr_')
|
|
|
|
apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
|
2015-12-08 06:29:42 +00:00
|
|
|
apply (rule_tac xf'=ret__unsigned_'
|
2015-11-02 00:00:32 +00:00
|
|
|
and val="case ntfnObj rv of IdleNtfn \<Rightarrow> scast NtfnState_Idle
|
|
|
|
| ActiveNtfn _ \<Rightarrow> scast NtfnState_Active | WaitingNtfn _ \<Rightarrow> scast NtfnState_Waiting"
|
|
|
|
and R="ko_at' rv ntfnptr"
|
2014-07-14 19:32:44 +00:00
|
|
|
in ccorres_symb_exec_r_known_rv_UNIV[where R'=UNIV])
|
|
|
|
apply vcg
|
|
|
|
apply clarsimp
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (erule cmap_relationE1 [OF cmap_relation_ntfn])
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (clarsimp simp add: typ_heap_simps)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: cnotification_relation_def Let_def
|
|
|
|
split: ntfn.split_asm)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply ceqv
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule_tac A="invs' and ko_at' rv ntfnptr"
|
2014-07-14 19:32:44 +00:00
|
|
|
in ccorres_guard_imp2[where A'=UNIV])
|
|
|
|
apply wpc
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: notification_state_defs ccorres_cond_iffs
|
2014-07-14 19:32:44 +00:00
|
|
|
dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: notification_state_defs ccorres_cond_iffs
|
2014-07-14 19:32:44 +00:00
|
|
|
dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (rename_tac list)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: notification_state_defs ccorres_cond_iffs
|
2014-07-14 19:32:44 +00:00
|
|
|
dc_def[symmetric] Collect_True
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_abstract_cleanup)
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2)
|
|
|
|
apply (rule_tac r'=dc and xf'=xfdc in ccorres_split_nothrow)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule_tac P="ko_at' rv ntfnptr and invs'"
|
2014-07-14 19:32:44 +00:00
|
|
|
in ccorres_from_vcg[where P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply clarsimp
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule_tac x=ntfnptr in cmap_relationE1 [OF cmap_relation_ntfn], assumption)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (erule ko_at_projectKO_opt)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (clarsimp simp: typ_heap_simps setNotification_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule rev_bexI)
|
|
|
|
apply (rule setObject_eq, simp_all add: objBits_simps)[1]
|
|
|
|
apply (clarsimp simp: rf_sr_def cstate_relation_def
|
|
|
|
Let_def carch_state_relation_def carch_globals_def
|
|
|
|
cmachine_state_relation_def)
|
2016-09-21 00:33:03 +00:00
|
|
|
apply (clarsimp simp: cpspace_relation_def typ_heap_simps'
|
2015-11-02 00:00:32 +00:00
|
|
|
update_ntfn_map_tos)
|
|
|
|
apply (erule(2) cpspace_relation_ntfn_update_ntfn)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (simp add: cnotification_relation_def notification_state_defs Let_def)
|
|
|
|
subgoal by simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (simp only: ccorres_seq_skip dc_def[symmetric])
|
|
|
|
apply (rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule cancel_all_ccorres_helper)
|
|
|
|
apply ceqv
|
|
|
|
apply (ctac add: rescheduleRequired_ccorres)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp cancelAllIPC_mapM_x_valid_queues)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (wp mapM_x_wp' weak_sch_act_wf_lift_linear
|
2016-10-25 06:01:30 +00:00
|
|
|
sts_st_tcb' | clarsimp simp: valid_tcb_state'_def split: if_split)+
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: guard_is_UNIV_def)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp set_ntfn_valid_objs' hoare_vcg_const_Ball_lift
|
2014-07-14 19:32:44 +00:00
|
|
|
weak_sch_act_wf_lift_linear)
|
|
|
|
apply vcg
|
|
|
|
apply clarsimp
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule cmap_relationE1[OF cmap_relation_ntfn], assumption)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (erule ko_at_projectKO_opt)
|
|
|
|
apply (frule obj_at_valid_objs', clarsimp+)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (clarsimp simp add: valid_obj'_def valid_ntfn'_def projectKOs)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (auto simp: typ_heap_simps cnotification_relation_def
|
2014-07-14 19:32:44 +00:00
|
|
|
Let_def tcb_queue_relation'_def
|
|
|
|
invs_valid_objs' valid_objs'_maxDomain valid_objs'_maxPriority
|
2016-01-20 03:42:36 +00:00
|
|
|
intro!: obj_at_conj')
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: guard_is_UNIV_def)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp getNotification_wp)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply clarsimp
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma tcb_queue_concat:
|
|
|
|
"tcb_queue_relation getNext getPrev mp (xs @ z # ys) qprev qhead
|
|
|
|
\<Longrightarrow> tcb_queue_relation getNext getPrev mp (z # ys)
|
|
|
|
(tcb_ptr_to_ctcb_ptr (last ((ctcb_ptr_to_tcb_ptr qprev) # xs))) (tcb_ptr_to_ctcb_ptr z)"
|
|
|
|
apply (induct xs arbitrary: qprev qhead)
|
|
|
|
apply clarsimp
|
|
|
|
apply clarsimp
|
|
|
|
apply (elim meta_allE, drule(1) meta_mp)
|
|
|
|
apply (clarsimp cong: if_cong)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma tcb_fields_ineq_helper:
|
|
|
|
"\<lbrakk> tcb_at' (ctcb_ptr_to_tcb_ptr x) s; tcb_at' (ctcb_ptr_to_tcb_ptr y) s \<rbrakk> \<Longrightarrow>
|
|
|
|
&(x\<rightarrow>[''tcbSchedPrev_C'']) \<noteq> &(y\<rightarrow>[''tcbSchedNext_C''])"
|
|
|
|
apply (clarsimp dest!: tcb_aligned'[OF obj_at'_weakenE, OF _ TrueI]
|
|
|
|
ctcb_ptr_to_tcb_ptr_aligned)
|
|
|
|
apply (clarsimp simp: field_lvalue_def)
|
|
|
|
apply (subgoal_tac "is_aligned (ptr_val y - ptr_val x) 8")
|
|
|
|
apply (drule sym, fastforce simp: is_aligned_def dvd_def)
|
|
|
|
apply (erule(1) aligned_sub_aligned)
|
|
|
|
apply (simp add: word_bits_conv)
|
|
|
|
done
|
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
primrec
|
|
|
|
tcb_queue_relation2 :: "(tcb_C \<Rightarrow> tcb_C ptr) \<Rightarrow> (tcb_C \<Rightarrow> tcb_C ptr)
|
|
|
|
\<Rightarrow> (tcb_C ptr \<rightharpoonup> tcb_C) \<Rightarrow> tcb_C ptr list
|
|
|
|
\<Rightarrow> tcb_C ptr \<Rightarrow> tcb_C ptr \<Rightarrow> bool"
|
|
|
|
where
|
|
|
|
"tcb_queue_relation2 getNext getPrev hp [] before after = True"
|
|
|
|
| "tcb_queue_relation2 getNext getPrev hp (x # xs) before after =
|
|
|
|
(\<exists>tcb. hp x = Some tcb \<and> getPrev tcb = before
|
|
|
|
\<and> getNext tcb = hd (xs @ [after])
|
|
|
|
\<and> tcb_queue_relation2 getNext getPrev hp xs x after)"
|
|
|
|
|
|
|
|
lemma use_tcb_queue_relation2:
|
|
|
|
"tcb_queue_relation getNext getPrev hp xs qprev qhead
|
|
|
|
= (tcb_queue_relation2 getNext getPrev hp
|
|
|
|
(map tcb_ptr_to_ctcb_ptr xs) qprev (tcb_Ptr 0)
|
|
|
|
\<and> qhead = (hd (map tcb_ptr_to_ctcb_ptr xs @ [tcb_Ptr 0])))"
|
|
|
|
apply (induct xs arbitrary: qhead qprev)
|
|
|
|
apply simp
|
2015-05-16 09:52:49 +00:00
|
|
|
apply (simp add: conj_comms cong: conj_cong)
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
lemma tcb_queue_relation2_concat:
|
|
|
|
"tcb_queue_relation2 getNext getPrev hp
|
|
|
|
(xs @ ys) before after
|
|
|
|
= (tcb_queue_relation2 getNext getPrev hp
|
|
|
|
xs before (hd (ys @ [after]))
|
|
|
|
\<and> tcb_queue_relation2 getNext getPrev hp
|
|
|
|
ys (last (before # xs)) after)"
|
|
|
|
apply (induct xs arbitrary: before)
|
|
|
|
apply simp
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (rename_tac x xs before)
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (simp split del: if_split)
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (case_tac "hp x")
|
2014-07-14 19:32:44 +00:00
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma tcb_queue_relation2_cong:
|
|
|
|
"\<lbrakk>queue = queue'; before = before'; after = after';
|
|
|
|
\<And>p. p \<in> set queue' \<Longrightarrow> mp p = mp' p\<rbrakk>
|
|
|
|
\<Longrightarrow> tcb_queue_relation2 getNext getPrev mp queue before after =
|
|
|
|
tcb_queue_relation2 getNext getPrev mp' queue' before' after'"
|
2014-09-10 07:26:44 +00:00
|
|
|
using [[hypsubst_thin = true]]
|
2014-07-14 19:32:44 +00:00
|
|
|
apply clarsimp
|
|
|
|
apply (induct queue' arbitrary: before')
|
|
|
|
apply simp+
|
|
|
|
done
|
|
|
|
|
|
|
|
context kernel_m begin
|
|
|
|
|
2015-09-02 05:43:39 +00:00
|
|
|
lemma setThreadState_ccorres_valid_queues'_simple:
|
|
|
|
"ccorres dc xfdc (\<lambda>s. tcb_at' thread s \<and> valid_queues' s \<and> \<not> runnable' st \<and> sch_act_simple s)
|
|
|
|
({s'. (\<forall>cl fl. cthread_state_relation_lifted st (cl\<lparr>tsType_CL := ts_' s' && mask 4\<rparr>, fl))}
|
|
|
|
\<inter> {s. tptr_' s = tcb_ptr_to_ctcb_ptr thread}) []
|
|
|
|
(setThreadState st thread) (Call setThreadState_'proc)"
|
|
|
|
apply (cinit lift: tptr_' cong add: call_ignore_cong)
|
|
|
|
apply (ctac (no_vcg) add: threadSet_tcbState_simple_corres)
|
|
|
|
apply (ctac add: scheduleTCB_ccorres_valid_queues'_simple)
|
|
|
|
apply (wp threadSet_valid_queues'_and_not_runnable')
|
|
|
|
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
|
|
|
done
|
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemma suspend_ccorres:
|
|
|
|
assumes cteDeleteOne_ccorres:
|
2015-05-22 03:55:35 +00:00
|
|
|
"\<And>w slot. ccorres dc xfdc
|
2015-09-10 07:06:45 +00:00
|
|
|
(invs' and cte_wp_at' (\<lambda>ct. w = -1 \<or> cteCap ct = NullCap
|
2015-05-22 03:55:35 +00:00
|
|
|
\<or> (\<forall>cap'. ccap_relation (cteCap ct) cap' \<longrightarrow> cap_get_tag cap' = w)) slot)
|
|
|
|
({s. gs_get_assn cteDeleteOne_'proc (ghost'state_' (globals s)) = w}
|
|
|
|
\<inter> {s. slot_' s = Ptr slot}) []
|
2014-07-14 19:32:44 +00:00
|
|
|
(cteDeleteOne slot) (Call cteDeleteOne_'proc)"
|
|
|
|
shows
|
|
|
|
"ccorres dc xfdc
|
|
|
|
(invs' and sch_act_simple and tcb_at' thread and (\<lambda>s. thread \<noteq> ksIdleThread s))
|
|
|
|
(UNIV \<inter> {s. target_' s = tcb_ptr_to_ctcb_ptr thread}) []
|
|
|
|
(suspend thread) (Call suspend_'proc)"
|
|
|
|
apply (cinit lift: target_')
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (ctac add: tcbSchedDequeue_ccorres')
|
|
|
|
apply (rule_tac Q="\<lambda>_.
|
2015-09-02 05:43:39 +00:00
|
|
|
(\<lambda>s. \<forall>t' d p. (t' \<in> set (ksReadyQueues s (d, p)) \<longrightarrow>
|
2014-07-14 19:32:44 +00:00
|
|
|
obj_at' (\<lambda>tcb. tcbQueued tcb \<and> tcbDomain tcb = d
|
|
|
|
\<and> tcbPriority tcb = p) t' s \<and>
|
2015-09-02 05:43:39 +00:00
|
|
|
(t' \<noteq> thread \<longrightarrow> st_tcb_at' runnable' t' s)) \<and>
|
|
|
|
distinct (ksReadyQueues s (d, p))) and valid_queues' and valid_objs' and tcb_at' thread"
|
|
|
|
in hoare_post_imp)
|
|
|
|
apply clarsimp
|
|
|
|
apply (drule_tac x="t" in spec)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (drule_tac x=d in spec)
|
|
|
|
apply (drule_tac x=p in spec)
|
|
|
|
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (wp_trace sts_valid_queues_partial)[1]
|
|
|
|
apply (rule hoare_strengthen_post)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule hoare_vcg_conj_lift)
|
|
|
|
apply (rule hoare_vcg_conj_lift)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule cancelIPC_sch_act_simple)
|
|
|
|
apply (rule cancelIPC_tcb_at'[where t=thread])
|
|
|
|
apply (rule delete_one_conc_fr.cancelIPC_invs)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
|
|
|
|
valid_tcb_state'_def)
|
|
|
|
apply (auto simp: "StrictC'_thread_state_defs")
|
|
|
|
done
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma cap_to_H_NTFNCap_tag:
|
|
|
|
"\<lbrakk> cap_to_H cap = NotificationCap word1 word2 a b;
|
2015-09-02 05:43:39 +00:00
|
|
|
cap_lift C_cap = Some cap \<rbrakk> \<Longrightarrow>
|
2015-11-02 00:00:32 +00:00
|
|
|
cap_get_tag C_cap = scast cap_notification_cap"
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (clarsimp simp: cap_to_H_def Let_def split: cap_CL.splits if_split_asm)
|
2016-01-20 03:42:36 +00:00
|
|
|
by (simp_all add: Let_def cap_lift_def split: if_splits)
|
2015-09-02 05:43:39 +00:00
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemmas ccorres_pre_getBoundNotification = ccorres_pre_threadGet [where f=tcbBoundNotification, folded getBoundNotification_def]
|
2015-09-02 05:43:39 +00:00
|
|
|
|
|
|
|
lemma option_to_ptr_not_NULL:
|
|
|
|
"option_to_ptr x \<noteq> NULL \<Longrightarrow> x \<noteq> None"
|
|
|
|
by (auto simp: option_to_ptr_def option_to_0_def split: option.splits)
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma doUnbindNotification_ccorres:
|
2017-07-12 05:13:51 +00:00
|
|
|
"ccorres dc xfdc (invs' and tcb_at' tcb)
|
2015-11-02 00:00:32 +00:00
|
|
|
(UNIV \<inter> {s. ntfnPtr_' s = ntfn_Ptr ntfnptr} \<inter> {s. tcbptr_' s = tcb_ptr_to_ctcb_ptr tcb}) []
|
|
|
|
(do ntfn \<leftarrow> getNotification ntfnptr; doUnbindNotification ntfnptr ntfn tcb od)
|
2017-07-12 05:13:51 +00:00
|
|
|
(Call doUnbindNotification_'proc)"
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (cinit' lift: ntfnPtr_' tcbptr_')
|
|
|
|
apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
|
|
|
|
apply (rule_tac P="invs' and ko_at' rv ntfnptr" and P'=UNIV
|
2015-09-02 05:43:39 +00:00
|
|
|
in ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule ccorres_from_vcg[where rrel=dc and xf=xfdc])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: option_to_ptr_def option_to_0_def)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (frule cmap_relation_ntfn)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (erule (1) cmap_relation_ko_atE)
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (erule h_t_valid_clift)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (clarsimp simp: setNotification_def split_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (rule bexI [OF _ setObject_eq])
|
|
|
|
apply (simp add: rf_sr_def cstate_relation_def Let_def init_def
|
2016-09-21 00:33:03 +00:00
|
|
|
typ_heap_simps'
|
|
|
|
cpspace_relation_def update_ntfn_map_tos)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (elim conjE)
|
|
|
|
apply (intro conjI)
|
|
|
|
-- "tcb relation"
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
|
|
|
|
apply (clarsimp simp: cnotification_relation_def Let_def
|
|
|
|
mask_def [where n=2] NtfnState_Waiting_def)
|
2016-02-16 01:52:24 +00:00
|
|
|
apply (case_tac "ntfnObj rv", ((simp add: option_to_ctcb_ptr_def)+)[4])
|
2016-09-21 00:33:03 +00:00
|
|
|
subgoal by (simp add: carch_state_relation_def typ_heap_simps')
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (simp add: cmachine_state_relation_def)
|
|
|
|
subgoal by (simp add: h_t_valid_clift_Some_iff)
|
|
|
|
subgoal by (simp add: objBits_simps)
|
|
|
|
subgoal by (simp add: objBits_simps)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply assumption
|
|
|
|
apply ceqv
|
|
|
|
apply (rule ccorres_move_c_guard_tcb)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: setBoundNotification_def)
|
2017-07-12 05:13:51 +00:00
|
|
|
apply (rule_tac P'="\<top>" and P="\<top>"
|
2015-09-02 05:43:39 +00:00
|
|
|
in threadSet_ccorres_lemma3[unfolded dc_def])
|
|
|
|
apply vcg
|
|
|
|
apply simp
|
|
|
|
apply (erule(1) rf_sr_tcb_update_no_queue2)
|
2016-09-21 00:33:03 +00:00
|
|
|
apply (simp add: typ_heap_simps')+
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (simp add: tcb_cte_cases_def)
|
|
|
|
apply (simp add: ctcb_relation_def option_to_ptr_def option_to_0_def)
|
|
|
|
apply (simp add: invs'_def valid_state'_def)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp get_ntfn_ko' | simp add: guard_is_UNIV_def)+
|
2015-09-02 05:43:39 +00:00
|
|
|
done
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma doUnbindNotification_ccorres':
|
2017-07-12 05:13:51 +00:00
|
|
|
"ccorres dc xfdc (invs' and tcb_at' tcb and ko_at' ntfn ntfnptr)
|
2015-11-02 00:00:32 +00:00
|
|
|
(UNIV \<inter> {s. ntfnPtr_' s = ntfn_Ptr ntfnptr} \<inter> {s. tcbptr_' s = tcb_ptr_to_ctcb_ptr tcb}) []
|
|
|
|
(doUnbindNotification ntfnptr ntfn tcb)
|
2017-07-12 05:13:51 +00:00
|
|
|
(Call doUnbindNotification_'proc)"
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (cinit' lift: ntfnPtr_' tcbptr_')
|
|
|
|
apply (rule_tac P="invs' and ko_at' ntfn ntfnptr" and P'=UNIV
|
2015-09-02 05:43:39 +00:00
|
|
|
in ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule ccorres_from_vcg[where rrel=dc and xf=xfdc])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: option_to_ptr_def option_to_0_def)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (frule cmap_relation_ntfn)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (erule (1) cmap_relation_ko_atE)
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (erule h_t_valid_clift)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (clarsimp simp: setNotification_def split_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (rule bexI [OF _ setObject_eq])
|
|
|
|
apply (simp add: rf_sr_def cstate_relation_def Let_def init_def
|
2016-09-21 00:33:03 +00:00
|
|
|
typ_heap_simps'
|
|
|
|
cpspace_relation_def update_ntfn_map_tos)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (elim conjE)
|
|
|
|
apply (intro conjI)
|
|
|
|
-- "tcb relation"
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule cpspace_relation_ntfn_update_ntfn, assumption+)
|
|
|
|
apply (clarsimp simp: cnotification_relation_def Let_def
|
|
|
|
mask_def [where n=2] NtfnState_Waiting_def)
|
2016-02-16 01:52:24 +00:00
|
|
|
apply (fold_subgoals (prefix))[2]
|
|
|
|
subgoal premises prems using prems
|
|
|
|
by (case_tac "ntfnObj ntfn", (simp add: option_to_ctcb_ptr_def)+)
|
2016-09-21 00:33:03 +00:00
|
|
|
subgoal by (simp add: carch_state_relation_def typ_heap_simps')
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (simp add: cmachine_state_relation_def)
|
|
|
|
subgoal by (simp add: h_t_valid_clift_Some_iff)
|
|
|
|
subgoal by (simp add: objBits_simps)
|
|
|
|
subgoal by (simp add: objBits_simps)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply assumption
|
|
|
|
apply ceqv
|
|
|
|
apply (rule ccorres_move_c_guard_tcb)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: setBoundNotification_def)
|
2017-07-12 05:13:51 +00:00
|
|
|
apply (rule_tac P'="\<top>" and P="\<top>"
|
2015-09-02 05:43:39 +00:00
|
|
|
in threadSet_ccorres_lemma3[unfolded dc_def])
|
|
|
|
apply vcg
|
|
|
|
apply simp
|
|
|
|
apply (erule(1) rf_sr_tcb_update_no_queue2)
|
2016-09-21 00:33:03 +00:00
|
|
|
apply (simp add: typ_heap_simps')+
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (simp add: tcb_cte_cases_def)
|
|
|
|
apply (simp add: ctcb_relation_def option_to_ptr_def option_to_0_def)
|
|
|
|
apply (simp add: invs'_def valid_state'_def)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp get_ntfn_ko' | simp add: guard_is_UNIV_def)+
|
2015-09-02 05:43:39 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma unbindNotification_ccorres:
|
2015-09-02 05:43:39 +00:00
|
|
|
"ccorres dc xfdc
|
|
|
|
(invs') (UNIV \<inter> {s. tcb_' s = tcb_ptr_to_ctcb_ptr tcb}) []
|
2015-11-02 00:00:32 +00:00
|
|
|
(unbindNotification tcb) (Call unbindNotification_'proc)"
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (cinit lift: tcb_')
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule_tac xf'=ntfnPtr_'
|
2015-09-02 05:43:39 +00:00
|
|
|
and r'="\<lambda>rv rv'. rv' = option_to_ptr rv \<and> rv \<noteq> Some 0"
|
|
|
|
in ccorres_split_nothrow)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (simp add: getBoundNotification_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (rule_tac P="no_0_obj' and valid_objs'" in threadGet_vcg_corres_P)
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply clarsimp
|
|
|
|
apply (drule obj_at_ko_at', clarsimp)
|
|
|
|
apply (drule spec, drule(1) mp, clarsimp)
|
|
|
|
apply (clarsimp simp: typ_heap_simps ctcb_relation_def)
|
|
|
|
apply (drule(1) ko_at_valid_objs', simp add: projectKOs)
|
|
|
|
apply (clarsimp simp: option_to_ptr_def option_to_0_def projectKOs
|
|
|
|
valid_obj'_def valid_tcb'_def)
|
|
|
|
apply ceqv
|
|
|
|
apply simp
|
|
|
|
apply wpc
|
|
|
|
apply (rule ccorres_cond_false)
|
|
|
|
apply (rule ccorres_return_Skip[unfolded dc_def])
|
|
|
|
apply (rule ccorres_cond_true)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (ctac (no_vcg) add: doUnbindNotification_ccorres[unfolded dc_def, simplified])
|
|
|
|
apply (wp gbn_wp')
|
2015-09-02 05:43:39 +00:00
|
|
|
apply vcg
|
|
|
|
apply (clarsimp simp: option_to_ptr_def option_to_0_def pred_tcb_at'_def
|
|
|
|
obj_at'_weakenE[OF _ TrueI]
|
|
|
|
split: option.splits)
|
|
|
|
apply (clarsimp simp: invs'_def valid_pspace'_def valid_state'_def)
|
|
|
|
done
|
|
|
|
|
|
|
|
|
2015-11-02 00:00:32 +00:00
|
|
|
lemma unbindMaybeNotification_ccorres:
|
|
|
|
"ccorres dc xfdc (invs') (UNIV \<inter> {s. ntfnPtr_' s = ntfn_Ptr ntfnptr}) []
|
|
|
|
(unbindMaybeNotification ntfnptr) (Call unbindMaybeNotification_'proc)"
|
|
|
|
apply (cinit lift: ntfnPtr_')
|
|
|
|
apply (rule ccorres_symb_exec_l [OF _ get_ntfn_inv' _ empty_fail_getNotification])
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (rule ccorres_rhs_assoc2)
|
2017-07-12 05:13:51 +00:00
|
|
|
apply (rule_tac P="ntfnBoundTCB rv \<noteq> None \<longrightarrow>
|
2015-11-02 00:00:32 +00:00
|
|
|
option_to_ctcb_ptr (ntfnBoundTCB rv) \<noteq> NULL"
|
2015-09-02 05:43:39 +00:00
|
|
|
in ccorres_gen_asm)
|
|
|
|
apply (rule_tac xf'=boundTCB_'
|
2015-11-02 00:00:32 +00:00
|
|
|
and val="option_to_ctcb_ptr (ntfnBoundTCB rv)"
|
|
|
|
and R="ko_at' rv ntfnptr and valid_bound_tcb' (ntfnBoundTCB rv)"
|
2015-09-02 05:43:39 +00:00
|
|
|
in ccorres_symb_exec_r_known_rv_UNIV[where R'=UNIV])
|
|
|
|
apply vcg
|
|
|
|
apply clarsimp
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (erule cmap_relationE1[OF cmap_relation_ntfn])
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (erule ko_at_projectKO_opt)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (clarsimp simp: typ_heap_simps cnotification_relation_def Let_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply ceqv
|
|
|
|
apply wpc
|
|
|
|
apply (rule ccorres_cond_false)
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (rule ccorres_cond_true)
|
|
|
|
apply (rule ccorres_call[where xf'=xfdc])
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule doUnbindNotification_ccorres'[simplified])
|
2015-09-02 05:43:39 +00:00
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
apply (clarsimp simp add: guard_is_UNIV_def option_to_ctcb_ptr_def )
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (wp getNotification_wp)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (clarsimp )
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (frule (1) ko_at_valid_ntfn'[OF _ invs_valid_objs'])
|
2017-07-12 05:13:51 +00:00
|
|
|
by (auto simp: valid_ntfn'_def valid_bound_tcb'_def obj_at'_def projectKOs
|
2015-09-02 05:43:39 +00:00
|
|
|
objBitsKO_def is_aligned_def option_to_ctcb_ptr_def tcb_at_not_NULL
|
2015-11-02 00:00:32 +00:00
|
|
|
split: ntfn.splits)
|
2015-09-02 05:43:39 +00:00
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemma finaliseCap_True_cases_ccorres:
|
2015-11-02 00:00:32 +00:00
|
|
|
"\<And>final. isEndpointCap cap \<or> isNotificationCap cap
|
2014-07-14 19:32:44 +00:00
|
|
|
\<or> isReplyCap cap \<or> isDomainCap cap \<or> cap = NullCap \<Longrightarrow>
|
|
|
|
ccorres (\<lambda>rv rv'. ccap_relation (fst rv) (finaliseCap_ret_C.remainder_C rv')
|
|
|
|
\<and> irq_opt_relation (snd rv) (finaliseCap_ret_C.irq_C rv'))
|
|
|
|
ret__struct_finaliseCap_ret_C_'
|
|
|
|
(invs') (UNIV \<inter> {s. ccap_relation cap (cap_' s)} \<inter> {s. final_' s = from_bool final}
|
|
|
|
\<inter> {s. exposed_' s = from_bool flag (* dave has name wrong *)}) []
|
|
|
|
(finaliseCap cap final flag) (Call finaliseCap_'proc)"
|
|
|
|
apply (subgoal_tac "\<not> isArchCap \<top> cap")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (cinit lift: cap_' final_' exposed_' cong: call_ignore_cong)
|
|
|
|
apply csymbr
|
|
|
|
apply (simp add: cap_get_tag_isCap Collect_False del: Collect_const)
|
2014-08-11 08:51:04 +00:00
|
|
|
apply (fold case_bool_If)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: false_def)
|
|
|
|
apply csymbr
|
|
|
|
apply wpc
|
|
|
|
apply (simp add: cap_get_tag_isCap ccorres_cond_univ_iff Let_def)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply (rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (simp add: when_def)
|
|
|
|
apply (rule ccorres_cond2)
|
|
|
|
apply (clarsimp simp: Collect_const_mem from_bool_0)
|
|
|
|
apply csymbr
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (rule ccorres_call[where xf'=xfdc], rule cancelAllIPC_ccorres)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
|
|
|
|
apply (simp add: return_def, vcg)
|
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2,
|
|
|
|
rule ccorres_split_throws)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp add: return_def ccap_relation_NullCap_iff
|
|
|
|
irq_opt_relation_def)
|
|
|
|
apply vcg
|
|
|
|
apply wp
|
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply wpc
|
|
|
|
apply (simp add: cap_get_tag_isCap Let_def
|
|
|
|
ccorres_cond_empty_iff ccorres_cond_univ_iff)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply (rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (simp add: when_def)
|
|
|
|
apply (rule ccorres_cond2)
|
|
|
|
apply (clarsimp simp: Collect_const_mem from_bool_0)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (subgoal_tac "cap_get_tag capa = scast cap_notification_cap") prefer 2
|
|
|
|
apply (clarsimp simp: ccap_relation_def isNotificationCap_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (case_tac cap, simp_all)[1]
|
2015-09-10 07:06:45 +00:00
|
|
|
apply (clarsimp simp: option_map_def split: option.splits)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (drule (2) cap_to_H_NTFNCap_tag[OF sym])
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)
|
|
|
|
apply (rule ccorres_rhs_assoc)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply csymbr
|
2015-09-02 05:43:39 +00:00
|
|
|
apply csymbr
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (ctac (no_vcg) add: unbindMaybeNotification_ccorres)
|
|
|
|
apply (rule ccorres_call[where xf'=xfdc], rule cancelAllSignals_ccorres)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply simp
|
|
|
|
apply simp
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (wp | wpc | simp add: guard_is_UNIV_def)+
|
|
|
|
apply (rule ccorres_return_Skip')
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2,
|
|
|
|
rule ccorres_split_throws)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp add: return_def ccap_relation_NullCap_iff
|
|
|
|
irq_opt_relation_def)
|
|
|
|
apply vcg
|
|
|
|
apply wp
|
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply wpc
|
|
|
|
apply (simp add: cap_get_tag_isCap Let_def
|
|
|
|
ccorres_cond_empty_iff ccorres_cond_univ_iff)
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2,
|
|
|
|
rule ccorres_split_throws)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp add: return_def ccap_relation_NullCap_iff
|
|
|
|
irq_opt_relation_def)
|
|
|
|
apply vcg
|
|
|
|
apply wpc
|
|
|
|
apply (simp add: cap_get_tag_isCap Let_def
|
|
|
|
ccorres_cond_empty_iff ccorres_cond_univ_iff)
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2,
|
|
|
|
rule ccorres_split_throws)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp add: return_def ccap_relation_NullCap_iff)
|
|
|
|
apply (clarsimp simp add: irq_opt_relation_def)
|
|
|
|
apply vcg
|
|
|
|
-- "NullCap case by exhaustion"
|
|
|
|
apply (simp add: cap_get_tag_isCap Let_def
|
|
|
|
ccorres_cond_empty_iff ccorres_cond_univ_iff)
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_rhs_assoc2,
|
|
|
|
rule ccorres_split_throws)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp add: return_def ccap_relation_NullCap_iff
|
|
|
|
irq_opt_relation_def)
|
|
|
|
apply vcg
|
|
|
|
apply (clarsimp simp: Collect_const_mem cap_get_tag_isCap)
|
|
|
|
apply (rule TrueI conjI impI TrueI)+
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
2017-07-12 05:13:51 +00:00
|
|
|
apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def isNotificationCap_def
|
|
|
|
isEndpointCap_def valid_obj'_def projectKOs valid_ntfn'_def
|
|
|
|
valid_bound_tcb'_def
|
2015-09-02 05:43:39 +00:00
|
|
|
dest!: obj_at_valid_objs')
|
2014-07-14 19:32:44 +00:00
|
|
|
apply clarsimp
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
|
|
|
apply clarsimp
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma finaliseCap_True_standin_ccorres:
|
|
|
|
"\<And>final.
|
|
|
|
ccorres (\<lambda>rv rv'. ccap_relation (fst rv) (finaliseCap_ret_C.remainder_C rv')
|
|
|
|
\<and> irq_opt_relation (snd rv) (finaliseCap_ret_C.irq_C rv'))
|
|
|
|
ret__struct_finaliseCap_ret_C_'
|
|
|
|
(invs') (UNIV \<inter> {s. ccap_relation cap (cap_' s)} \<inter> {s. final_' s = from_bool final}
|
|
|
|
\<inter> {s. exposed_' s = from_bool True (* dave has name wrong *)}) []
|
|
|
|
(finaliseCapTrue_standin cap final) (Call finaliseCap_'proc)"
|
|
|
|
unfolding finaliseCapTrue_standin_simple_def
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (case_tac "P :: bool" for P)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (erule finaliseCap_True_cases_ccorres)
|
|
|
|
apply (simp add: finaliseCap_def ccorres_fail')
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma offset_xf_for_sequence:
|
|
|
|
"\<forall>s f. offset_' (offset_'_update f s) = f (offset_' s)
|
|
|
|
\<and> globals (offset_'_update f s) = globals s"
|
|
|
|
by simp
|
|
|
|
|
|
|
|
end
|
|
|
|
|
2016-05-03 04:01:20 +00:00
|
|
|
context begin interpretation Arch . (*FIXME: arch_split*)
|
2014-07-14 19:32:44 +00:00
|
|
|
crunch pde_mappings'[wp]: invalidateHWASIDEntry "valid_pde_mappings'"
|
2016-05-03 04:01:20 +00:00
|
|
|
end
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
context kernel_m begin
|
|
|
|
|
|
|
|
|
|
|
|
lemma invalidateASIDEntry_ccorres:
|
|
|
|
"ccorres dc xfdc (\<lambda>s. valid_pde_mappings' s \<and> asid \<le> mask asid_bits)
|
|
|
|
(UNIV \<inter> {s. asid_' s = asid}) []
|
|
|
|
(invalidateASIDEntry asid) (Call invalidateASIDEntry_'proc)"
|
|
|
|
apply (cinit lift: asid_')
|
|
|
|
apply (ctac(no_vcg) add: loadHWASID_ccorres)
|
|
|
|
apply csymbr
|
|
|
|
apply (simp(no_asm) add: when_def del: Collect_const)
|
|
|
|
apply (rule ccorres_split_nothrow_novcg_dc)
|
|
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
|
|
apply (clarsimp simp: Collect_const_mem pde_stored_asid_def to_bool_def
|
2016-10-25 06:01:30 +00:00
|
|
|
split: if_split)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_Guard)+
|
|
|
|
apply (rule_tac P="rv \<noteq> None" in ccorres_gen_asm)
|
|
|
|
apply (ctac(no_simp) add: invalidateHWASIDEntry_ccorres)
|
|
|
|
apply (clarsimp simp: pde_stored_asid_def unat_ucast
|
2016-10-25 06:01:30 +00:00
|
|
|
split: if_split_asm)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule sym, rule nat_mod_eq')
|
|
|
|
apply (simp add: pde_pde_invalid_lift_def pde_lift_def)
|
|
|
|
apply (rule unat_less_power[where sz=8, simplified])
|
|
|
|
apply (simp add: word_bits_conv)
|
|
|
|
apply (rule order_le_less_trans, rule word_and_le1)
|
|
|
|
apply simp
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (fold dc_def)
|
|
|
|
apply (ctac add: invalidateASID_ccorres)
|
|
|
|
apply wp
|
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply wp
|
|
|
|
apply (clarsimp simp: Collect_const_mem pde_pde_invalid_lift_def pde_lift_def
|
|
|
|
order_le_less_trans[OF word_and_le1])
|
|
|
|
done
|
|
|
|
|
|
|
|
end
|
|
|
|
|
2016-05-03 04:01:20 +00:00
|
|
|
context begin interpretation Arch . (*FIXME: arch_split*)
|
2014-07-14 19:32:44 +00:00
|
|
|
crunch obj_at'[wp]: invalidateASIDEntry "obj_at' P p"
|
|
|
|
crunch obj_at'[wp]: flushSpace "obj_at' P p"
|
|
|
|
crunch valid_objs'[wp]: invalidateASIDEntry "valid_objs'"
|
|
|
|
crunch valid_objs'[wp]: flushSpace "valid_objs'"
|
|
|
|
crunch pde_mappings'[wp]: invalidateASIDEntry "valid_pde_mappings'"
|
|
|
|
crunch pde_mappings'[wp]: flushSpace "valid_pde_mappings'"
|
2016-05-03 04:01:20 +00:00
|
|
|
end
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
context kernel_m begin
|
|
|
|
|
|
|
|
lemma invs'_invs_no_cicd':
|
|
|
|
"invs' s \<longrightarrow> all_invs_but_ct_idle_or_in_cur_domain' s"
|
|
|
|
by (simp add: invs'_invs_no_cicd)
|
|
|
|
|
|
|
|
lemma deleteASIDPool_ccorres:
|
2016-07-04 07:35:42 +00:00
|
|
|
"ccorres dc xfdc (invs' and (\<lambda>_. base < 2 ^ 17 \<and> pool \<noteq> 0))
|
2014-07-14 19:32:44 +00:00
|
|
|
(UNIV \<inter> {s. asid_base_' s = base} \<inter> {s. pool_' s = Ptr pool}) []
|
|
|
|
(deleteASIDPool base pool) (Call deleteASIDPool_'proc)"
|
|
|
|
apply (rule ccorres_gen_asm)
|
|
|
|
apply (cinit lift: asid_base_' pool_' simp: whileAnno_def)
|
|
|
|
apply (rule ccorres_assert)
|
|
|
|
apply (clarsimp simp: liftM_def dc_def[symmetric] fun_upd_def[symmetric]
|
|
|
|
when_def
|
|
|
|
simp del: Collect_const)
|
|
|
|
apply (rule ccorres_Guard)+
|
|
|
|
apply (rule ccorres_pre_gets_armKSASIDTable_ksArchState)
|
|
|
|
apply (rule_tac R="\<lambda>s. rv = armKSASIDTable (ksArchState s)" in ccorres_cond2)
|
|
|
|
apply clarsimp
|
|
|
|
apply (subst rf_sr_armKSASIDTable, assumption)
|
|
|
|
apply (simp add: asid_high_bits_word_bits)
|
|
|
|
apply (rule shiftr_less_t2n)
|
|
|
|
apply (simp add: asid_low_bits_def asid_high_bits_def)
|
|
|
|
apply (subst ucast_asid_high_bits_is_shift)
|
|
|
|
apply (simp add: mask_def, simp add: asid_bits_def)
|
|
|
|
apply (simp add: option_to_ptr_def option_to_0_def split: option.split)
|
|
|
|
apply (rule ccorres_Guard_Seq ccorres_rhs_assoc)+
|
|
|
|
apply (rule ccorres_pre_getObject_asidpool)
|
|
|
|
apply (rename_tac poolKO)
|
|
|
|
apply (simp only: mapM_discarded)
|
|
|
|
apply (rule ccorres_rhs_assoc2,
|
|
|
|
rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (simp add: word_sle_def Kernel_C.asidLowBits_def Collect_True
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_semantic_equivD2[rotated])
|
|
|
|
apply (simp only: semantic_equiv_def)
|
|
|
|
apply (rule Seq_ceqv [OF ceqv_refl _ xpres_triv])
|
|
|
|
apply (simp only: ceqv_Guard_UNIV)
|
|
|
|
apply (rule While_ceqv [OF _ _ xpres_triv], rule impI, rule refl)
|
|
|
|
apply (rule ceqv_remove_eqv_skip)
|
|
|
|
apply (simp add: ceqv_Guard_UNIV ceqv_refl)
|
|
|
|
apply (rule_tac F="\<lambda>n. ko_at' poolKO pool and valid_objs' and valid_pde_mappings'"
|
|
|
|
in ccorres_mapM_x_while_gen[OF _ _ _ _ _ offset_xf_for_sequence,
|
|
|
|
where j=1, simplified])
|
|
|
|
apply (intro allI impI)
|
|
|
|
apply (rule ccorres_guard_imp2)
|
|
|
|
apply (rule_tac xf'="offset_'" in ccorres_abstract, ceqv)
|
|
|
|
apply (rule_tac P="rv' = of_nat n" in ccorres_gen_asm2)
|
|
|
|
apply (rule ccorres_Guard[where F=ArrayBounds])
|
|
|
|
apply (rule ccorres_move_c_guard_ap)
|
|
|
|
apply (rule_tac R="ko_at' poolKO pool and valid_objs'" in ccorres_cond2)
|
|
|
|
apply (clarsimp dest!: rf_sr_cpspace_asidpool_relation)
|
|
|
|
apply (erule cmap_relationE1, erule ko_at_projectKO_opt)
|
|
|
|
apply (clarsimp simp: casid_pool_relation_def typ_heap_simps
|
|
|
|
inv_ASIDPool
|
|
|
|
split: asidpool.split_asm asid_pool_C.split_asm)
|
|
|
|
apply (simp add: upto_enum_word del: upt.simps)
|
|
|
|
apply (drule(1) ko_at_valid_objs')
|
|
|
|
apply (simp add: projectKOs)
|
|
|
|
apply (clarsimp simp: array_relation_def valid_obj'_def
|
|
|
|
ran_def)
|
|
|
|
apply (drule_tac x="of_nat n" in spec)+
|
|
|
|
apply (simp add: asid_low_bits_def word_le_nat_alt)
|
|
|
|
apply (simp add: word_unat.Abs_inverse unats_def)
|
|
|
|
apply (simp add: option_to_ptr_def option_to_0_def split: option.split_asm)
|
|
|
|
apply clarsimp
|
|
|
|
apply (ctac(no_vcg) add: flushSpace_ccorres)
|
|
|
|
apply (ctac add: invalidateASIDEntry_ccorres)
|
|
|
|
apply wp
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (clarsimp simp: Collect_const_mem)
|
|
|
|
apply (simp add: upto_enum_word typ_at_to_obj_at_arches
|
|
|
|
obj_at'_weakenE[OF _ TrueI]
|
|
|
|
del: upt.simps)
|
|
|
|
apply (simp add: is_aligned_mask[symmetric])
|
|
|
|
apply (rule conjI[rotated])
|
|
|
|
apply (simp add: asid_low_bits_def word_of_nat_less)
|
|
|
|
apply (clarsimp simp: mask_def)
|
|
|
|
apply (erule is_aligned_add_less_t2n)
|
|
|
|
apply (subst(asm) Suc_unat_diff_1)
|
|
|
|
apply (simp add: asid_low_bits_def)
|
|
|
|
apply (simp add: unat_power_lower asid_low_bits_word_bits)
|
2016-04-18 20:25:44 +00:00
|
|
|
apply (erule of_nat_less_pow_32 [OF _ asid_low_bits_word_bits])
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: asid_low_bits_def asid_bits_def)
|
|
|
|
apply (simp add: asid_bits_def)
|
|
|
|
apply (simp add: upto_enum_word )
|
|
|
|
apply (vcg exspec=flushSpace_modifies exspec=invalidateASIDEntry_modifies)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule hoare_pre, wp)
|
|
|
|
apply simp
|
|
|
|
apply (simp add: upto_enum_word asid_low_bits_def)
|
|
|
|
apply ceqv
|
|
|
|
apply (rule ccorres_move_const_guard)+
|
|
|
|
apply (rule ccorres_split_nothrow_novcg_dc)
|
|
|
|
apply (rule_tac P="\<lambda>s. rv = armKSASIDTable (ksArchState s)"
|
|
|
|
in ccorres_from_vcg[where P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: simpler_modify_def)
|
|
|
|
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
|
2017-07-12 05:13:51 +00:00
|
|
|
carch_state_relation_def cmachine_state_relation_def
|
2014-07-14 19:32:44 +00:00
|
|
|
carch_globals_def h_t_valid_clift_Some_iff)
|
|
|
|
apply (erule array_relation_update[unfolded fun_upd_def])
|
|
|
|
apply (simp add: asid_high_bits_of_def unat_ucast asid_low_bits_def)
|
|
|
|
apply (rule sym, rule nat_mod_eq')
|
|
|
|
apply (rule order_less_le_trans, rule iffD1[OF word_less_nat_alt])
|
2016-07-04 07:35:42 +00:00
|
|
|
apply (rule shiftr_less_t2n[where m=7])
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by simp
|
|
|
|
subgoal by simp
|
|
|
|
subgoal by (simp add: option_to_ptr_def option_to_0_def)
|
|
|
|
subgoal by (simp add: asid_high_bits_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_pre_getCurThread)
|
|
|
|
apply (ctac add: setVMRoot_ccorres)
|
|
|
|
apply wp
|
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply (simp add: pred_conj_def fun_upd_def[symmetric]
|
|
|
|
cur_tcb'_def[symmetric])
|
|
|
|
apply (strengthen invs'_invs_no_cicd', strengthen invs_asid_update_strg')
|
|
|
|
apply (rule mapM_x_wp')
|
|
|
|
apply (rule hoare_pre, wp)
|
|
|
|
apply simp
|
|
|
|
apply (simp add: guard_is_UNIV_def Kernel_C.asidLowBits_def
|
|
|
|
word_sle_def word_sless_def Collect_const_mem
|
|
|
|
mask_def asid_bits_def plus_one_helper
|
|
|
|
asid_shiftr_low_bits_less)
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (simp add: Kernel_C.asidLowBits_def
|
|
|
|
word_sle_def word_sless_def)
|
|
|
|
apply (auto simp: asid_shiftr_low_bits_less Collect_const_mem
|
|
|
|
mask_def asid_bits_def plus_one_helper)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma deleteASID_ccorres:
|
2016-07-04 07:35:42 +00:00
|
|
|
"ccorres dc xfdc (invs' and K (asid < 2 ^ 17) and K (pdPtr \<noteq> 0))
|
2014-07-14 19:32:44 +00:00
|
|
|
(UNIV \<inter> {s. asid_' s = asid} \<inter> {s. pd_' s = Ptr pdPtr}) []
|
|
|
|
(deleteASID asid pdPtr) (Call deleteASID_'proc)"
|
|
|
|
apply (cinit lift: asid_' pd_' cong: call_ignore_cong)
|
|
|
|
apply (rule ccorres_Guard_Seq)+
|
|
|
|
apply (rule_tac r'="\<lambda>rv rv'. case rv (ucast (asid_high_bits_of asid)) of
|
|
|
|
None \<Rightarrow> rv' = NULL
|
|
|
|
| Some v \<Rightarrow> rv' = Ptr v \<and> rv' \<noteq> NULL"
|
|
|
|
and xf'="poolPtr_'" in ccorres_split_nothrow)
|
2016-07-04 07:35:42 +00:00
|
|
|
apply (rule_tac P="invs' and K (asid < 2 ^ 17)"
|
2014-07-14 19:32:44 +00:00
|
|
|
and P'=UNIV in ccorres_from_vcg)
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: simpler_gets_def Let_def)
|
|
|
|
apply (erule(1) getKSASIDTable_ccorres_stuff)
|
|
|
|
apply (simp add: asid_high_bits_of_def
|
|
|
|
asidLowBits_def Kernel_C.asidLowBits_def
|
|
|
|
asid_low_bits_def unat_ucast)
|
|
|
|
apply (rule sym, rule mod_less)
|
2016-07-04 07:35:42 +00:00
|
|
|
apply (rule unat_less_power[where sz=7, simplified])
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: word_bits_conv)
|
2016-07-04 07:35:42 +00:00
|
|
|
apply (rule shiftr_less_t2n[where m=7, simplified])
|
2014-07-14 19:32:44 +00:00
|
|
|
apply simp
|
|
|
|
apply (rule order_less_le_trans, rule ucast_less)
|
|
|
|
apply simp
|
|
|
|
apply (simp add: asid_high_bits_def)
|
|
|
|
apply ceqv
|
|
|
|
apply csymbr
|
|
|
|
apply wpc
|
|
|
|
apply (simp add: ccorres_cond_iffs dc_def[symmetric]
|
|
|
|
Collect_False
|
|
|
|
del: Collect_const
|
|
|
|
cong: call_ignore_cong)
|
|
|
|
apply (rule ccorres_cond_false)
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (simp add: dc_def[symmetric] when_def
|
|
|
|
Collect_True liftM_def
|
|
|
|
cong: conj_cong call_ignore_cong
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_pre_getObject_asidpool)
|
|
|
|
apply (rule ccorres_Guard_Seq[where F=ArrayBounds])
|
|
|
|
apply (rule ccorres_move_c_guard_ap)
|
|
|
|
apply (rule ccorres_Guard_Seq)+
|
|
|
|
apply (rename_tac pool)
|
|
|
|
apply (rule_tac xf'=ret__int_'
|
|
|
|
and val="from_bool (inv ASIDPool pool (asid && mask asid_low_bits)
|
|
|
|
= Some pdPtr)"
|
2014-09-10 07:26:44 +00:00
|
|
|
and R="ko_at' pool x2 and K (pdPtr \<noteq> 0)"
|
2014-07-14 19:32:44 +00:00
|
|
|
in ccorres_symb_exec_r_known_rv_UNIV[where R'=UNIV])
|
|
|
|
apply (vcg, clarsimp)
|
|
|
|
apply (clarsimp dest!: rf_sr_cpspace_asidpool_relation)
|
|
|
|
apply (erule(1) cmap_relation_ko_atE)
|
|
|
|
apply (clarsimp simp: typ_heap_simps casid_pool_relation_def
|
|
|
|
array_relation_def
|
|
|
|
split: asidpool.split_asm asid_pool_C.split_asm)
|
|
|
|
apply (drule_tac x="asid && mask asid_low_bits" in spec)
|
|
|
|
apply (simp add: asid_low_bits_def Kernel_C.asidLowBits_def
|
|
|
|
mask_def word_and_le1)
|
|
|
|
apply (drule sym, simp)
|
|
|
|
apply (simp add: option_to_ptr_def option_to_0_def
|
|
|
|
from_bool_def inv_ASIDPool
|
2016-10-25 06:01:30 +00:00
|
|
|
split: option.split if_split bool.split)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply ceqv
|
|
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
|
|
apply (simp add: Collect_const_mem from_bool_0)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply (ctac (no_vcg) add: flushSpace_ccorres)
|
|
|
|
apply (ctac (no_vcg) add: invalidateASIDEntry_ccorres)
|
|
|
|
apply (rule ccorres_Guard_Seq[where F=ArrayBounds])
|
|
|
|
apply (rule ccorres_move_c_guard_ap)
|
|
|
|
apply (rule ccorres_Guard_Seq)+
|
|
|
|
apply (rule ccorres_split_nothrow_novcg_dc)
|
2014-09-10 07:26:44 +00:00
|
|
|
apply (rule_tac P="ko_at' pool x2" in ccorres_from_vcg[where P'=UNIV])
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule cmap_relationE1[OF rf_sr_cpspace_asidpool_relation],
|
|
|
|
assumption, erule ko_at_projectKO_opt)
|
|
|
|
apply (rule bexI [OF _ setObject_eq],
|
|
|
|
simp_all add: objBits_simps archObjSize_def pageBits_def)[1]
|
|
|
|
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def typ_heap_simps)
|
|
|
|
apply (rule conjI)
|
2016-09-21 00:33:03 +00:00
|
|
|
apply (clarsimp simp: cpspace_relation_def typ_heap_simps'
|
2014-07-14 19:32:44 +00:00
|
|
|
update_asidpool_map_tos
|
|
|
|
update_asidpool_map_to_asidpools)
|
|
|
|
apply (rule cmap_relation_updI, simp_all)[1]
|
|
|
|
apply (simp add: casid_pool_relation_def fun_upd_def[symmetric]
|
|
|
|
inv_ASIDPool
|
|
|
|
split: asidpool.split_asm asid_pool_C.split_asm)
|
|
|
|
apply (erule array_relation_update)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (simp add: mask_def)
|
|
|
|
subgoal by (simp add: option_to_ptr_def option_to_0_def)
|
|
|
|
subgoal by (simp add: asid_low_bits_def)
|
2017-07-12 05:13:51 +00:00
|
|
|
subgoal by (simp add: carch_state_relation_def cmachine_state_relation_def
|
2015-11-16 03:12:37 +00:00
|
|
|
carch_globals_def update_asidpool_map_tos
|
2016-09-21 00:33:03 +00:00
|
|
|
typ_heap_simps')
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_pre_getCurThread)
|
|
|
|
apply (ctac add: setVMRoot_ccorres)
|
|
|
|
apply (simp add: cur_tcb'_def[symmetric])
|
|
|
|
apply (strengthen invs'_invs_no_cicd')
|
|
|
|
apply wp
|
|
|
|
apply (clarsimp simp: rf_sr_def guard_is_UNIV_def
|
|
|
|
cstate_relation_def Let_def)
|
|
|
|
apply wp[1]
|
|
|
|
apply (simp add: fun_upd_def[symmetric])
|
|
|
|
apply wp
|
|
|
|
apply (rule ccorres_return_Skip)
|
2016-01-20 03:42:36 +00:00
|
|
|
subgoal by (clarsimp simp: guard_is_UNIV_def Collect_const_mem
|
2014-07-14 19:32:44 +00:00
|
|
|
word_sle_def word_sless_def
|
|
|
|
Kernel_C.asidLowBits_def
|
|
|
|
asid_low_bits_def order_le_less_trans [OF word_and_le1])
|
|
|
|
apply wp
|
|
|
|
apply vcg
|
|
|
|
apply (clarsimp simp: Collect_const_mem if_1_0_0
|
|
|
|
word_sless_def word_sle_def
|
|
|
|
Kernel_C.asidLowBits_def
|
|
|
|
typ_at_to_obj_at_arches)
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (clarsimp simp: mask_def inv_ASIDPool
|
|
|
|
split: asidpool.split)
|
|
|
|
apply (frule obj_at_valid_objs', clarsimp+)
|
|
|
|
apply (clarsimp simp: asid_bits_def typ_at_to_obj_at_arches
|
|
|
|
obj_at'_weakenE[OF _ TrueI]
|
|
|
|
fun_upd_def[symmetric] valid_obj'_def
|
|
|
|
projectKOs invs_valid_pde_mappings'
|
|
|
|
invs_cur')
|
|
|
|
apply (rule conjI, blast)
|
2016-10-25 06:01:30 +00:00
|
|
|
subgoal by (fastforce simp: inv_into_def ran_def split: if_split_asm)
|
2016-01-20 03:42:36 +00:00
|
|
|
by (clarsimp simp: order_le_less_trans [OF word_and_le1]
|
2014-07-14 19:32:44 +00:00
|
|
|
asid_shiftr_low_bits_less asid_bits_def mask_def
|
|
|
|
plus_one_helper arg_cong[where f="\<lambda>x. 2 ^ x", OF meta_eq_to_obj_eq, OF asid_low_bits_def]
|
|
|
|
split: option.split_asm)
|
|
|
|
|
|
|
|
lemma setObject_ccorres_lemma:
|
|
|
|
fixes val :: "'a :: pspace_storable" shows
|
|
|
|
"\<lbrakk> \<And>s. \<Gamma> \<turnstile> (Q s) c {s'. (s \<lparr> ksPSpace := ksPSpace s (ptr \<mapsto> injectKO val) \<rparr>, s') \<in> rf_sr},{};
|
|
|
|
\<And>s s' val (val' :: 'a). \<lbrakk> ko_at' val' ptr s; (s, s') \<in> rf_sr \<rbrakk>
|
|
|
|
\<Longrightarrow> s' \<in> Q s;
|
|
|
|
\<And>val :: 'a. updateObject val = updateObject_default val;
|
|
|
|
\<And>val :: 'a. (1 :: word32) < 2 ^ objBits val;
|
|
|
|
\<And>(val :: 'a) (val' :: 'a). objBits val = objBits val';
|
|
|
|
\<Gamma> \<turnstile> Q' c UNIV \<rbrakk>
|
|
|
|
\<Longrightarrow> ccorres dc xfdc \<top> Q' hs
|
|
|
|
(setObject ptr val) c"
|
|
|
|
apply (rule ccorres_from_vcg_nofail)
|
|
|
|
apply (rule allI)
|
|
|
|
apply (case_tac "obj_at' (\<lambda>x :: 'a. True) ptr \<sigma>")
|
|
|
|
apply (rule_tac P'="Q \<sigma>" in conseqPre, rule conseqPost, assumption)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule bexI [OF _ setObject_eq], simp+)
|
|
|
|
apply (drule obj_at_ko_at')
|
|
|
|
apply clarsimp
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule conseqPre, erule conseqPost)
|
|
|
|
apply clarsimp
|
|
|
|
apply (subgoal_tac "fst (setObject ptr val \<sigma>) = {}")
|
|
|
|
apply simp
|
|
|
|
apply (erule notE, erule_tac s=\<sigma> in empty_failD[rotated])
|
|
|
|
apply (simp add: setObject_def split_def)
|
|
|
|
apply (rule ccontr)
|
|
|
|
apply (clarsimp elim!: nonemptyE)
|
|
|
|
apply (frule use_valid [OF _ obj_at_setObject3[where P=\<top>]], simp_all)[1]
|
|
|
|
apply (simp add: typ_at_to_obj_at'[symmetric])
|
|
|
|
apply (frule(1) use_valid [OF _ setObject_typ_at'])
|
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
apply clarsimp
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma findPDForASID_nonzero:
|
|
|
|
"\<lbrace>\<top>\<rbrace> findPDForASID asid \<lbrace>\<lambda>rv s. rv \<noteq> 0\<rbrace>,-"
|
|
|
|
apply (simp add: findPDForASID_def cong: option.case_cong)
|
|
|
|
apply (wp | wpc | simp only: o_def simp_thms)+
|
|
|
|
done
|
|
|
|
|
2015-11-16 03:12:37 +00:00
|
|
|
lemma unat_shiftr_le_bound:
|
2015-12-01 05:29:29 +00:00
|
|
|
"2 ^ (len_of TYPE('a :: len) - n) - 1 \<le> bnd \<Longrightarrow> 0 < n
|
|
|
|
\<Longrightarrow> unat ((x :: 'a word) >> n) \<le> bnd"
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (erule order_trans[rotated], simp)
|
|
|
|
apply (rule nat_le_Suc_less_imp)
|
|
|
|
apply (rule unat_less_helper, simp)
|
|
|
|
apply (rule shiftr_less_t2n3)
|
|
|
|
apply simp
|
|
|
|
apply simp
|
|
|
|
done
|
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemma pageTableMapped_ccorres:
|
|
|
|
"ccorres (\<lambda>rv rv'. rv' = option_to_ptr rv \<and> rv \<noteq> Some 0) ret__ptr_to_struct_pde_C_'
|
|
|
|
(invs' and K (asid \<le> mask asid_bits))
|
|
|
|
(UNIV \<inter> {s. asid_' s = asid} \<inter> {s. vaddr_' s = vaddr} \<inter> {s. pt_' s = Ptr ptPtr}) []
|
|
|
|
(pageTableMapped asid vaddr ptPtr) (Call pageTableMapped_'proc)"
|
|
|
|
apply (cinit lift: asid_' vaddr_' pt_')
|
|
|
|
apply (simp add: ignoreFailure_def catch_def
|
|
|
|
bindE_bind_linearise liftE_def
|
|
|
|
del: Collect_const cong: call_ignore_cong)
|
2014-08-09 05:16:17 +00:00
|
|
|
apply (rule ccorres_split_nothrow_novcg_case_sum)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply clarsimp
|
|
|
|
apply (ctac (no_vcg) add: findPDForASID_ccorres)
|
|
|
|
apply ceqv
|
|
|
|
apply (simp add: Collect_False del: Collect_const cong: call_ignore_cong)
|
|
|
|
apply csymbr
|
|
|
|
apply (rule_tac xf'=pde_' and r'=cpde_relation in ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule ccorres_add_return2, rule ccorres_pre_getObject_pde)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (rule ccorres_move_array_assertion_pd
|
|
|
|
| (rule ccorres_flip_Guard, rule ccorres_move_array_assertion_pd))+
|
2015-10-12 13:11:13 +00:00
|
|
|
apply (rule_tac P="ko_at' x (lookup_pd_slot rv vaddr) and no_0_obj'
|
|
|
|
and page_directory_at' rv"
|
2014-07-14 19:32:44 +00:00
|
|
|
in ccorres_from_vcg[where P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def lookup_pd_slot_def Let_def)
|
2015-10-12 13:11:13 +00:00
|
|
|
apply (drule(1) page_directory_at_rf_sr)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (erule cmap_relationE1[OF rf_sr_cpde_relation],
|
|
|
|
erule ko_at_projectKO_opt)
|
|
|
|
apply (clarsimp simp: typ_heap_simps' shiftl_t2n field_simps)
|
|
|
|
apply ceqv
|
|
|
|
apply (rule_tac P="rv \<noteq> 0" in ccorres_gen_asm)
|
|
|
|
apply csymbr+
|
|
|
|
apply (wpc, simp_all add: if_1_0_0 returnOk_bind throwError_bind
|
|
|
|
del: Collect_const)
|
|
|
|
prefer 2
|
|
|
|
apply (rule ccorres_cond_true_seq)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: if_1_0_0 cpde_relation_def Let_def
|
|
|
|
return_def addrFromPPtr_def
|
|
|
|
pde_pde_coarse_lift_def)
|
|
|
|
apply (rule conjI)
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (simp add: pde_lift_def Let_def split: if_split_asm)
|
|
|
|
apply (clarsimp simp: option_to_0_def option_to_ptr_def split: if_split)
|
2016-05-01 03:35:49 +00:00
|
|
|
apply (clarsimp simp: ARM.addrFromPPtr_def ARM.ptrFromPAddr_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply ((rule ccorres_cond_false_seq ccorres_cond_false
|
|
|
|
ccorres_return_C | simp)+)[3]
|
|
|
|
apply (simp only: simp_thms)
|
|
|
|
apply wp
|
|
|
|
apply (clarsimp simp: guard_is_UNIV_def Collect_const_mem if_1_0_0)
|
|
|
|
apply (simp add: cpde_relation_def Let_def pde_lift_def
|
2016-10-25 06:01:30 +00:00
|
|
|
split: if_split_asm,
|
2014-07-14 19:32:44 +00:00
|
|
|
auto simp: option_to_0_def option_to_ptr_def pde_tag_defs)[1]
|
|
|
|
apply simp
|
|
|
|
apply (rule ccorres_split_throws)
|
|
|
|
apply (rule ccorres_return_C, simp+)
|
|
|
|
apply vcg
|
|
|
|
apply (wp hoare_drop_imps findPDForASID_nonzero)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (simp add: guard_is_UNIV_def word_sle_def pdBits_def pageBits_def
|
2017-06-05 04:55:42 +00:00
|
|
|
unat_gt_0 unat_shiftr_le_bound pdeBits_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: guard_is_UNIV_def option_to_0_def option_to_ptr_def)
|
|
|
|
apply auto[1]
|
|
|
|
done
|
|
|
|
|
2015-11-16 03:12:37 +00:00
|
|
|
lemma pageTableMapped_pd:
|
|
|
|
"\<lbrace>\<top>\<rbrace> pageTableMapped asid vaddr ptPtr
|
|
|
|
\<lbrace>\<lambda>rv s. case rv of Some x \<Rightarrow> page_directory_at' x s | _ \<Rightarrow> True\<rbrace>"
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: pageTableMapped_def)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (rule hoare_pre)
|
|
|
|
apply (wp getPDE_wp hoare_vcg_all_lift_R | wpc)+
|
|
|
|
apply (rule hoare_post_imp_R, rule findPDForASID_page_directory_at'_simple)
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (clarsimp split: if_split)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply simp
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
lemma unmapPageTable_ccorres:
|
|
|
|
"ccorres dc xfdc (invs' and (\<lambda>s. asid \<le> mask asid_bits \<and> vaddr < kernelBase))
|
|
|
|
(UNIV \<inter> {s. asid_' s = asid} \<inter> {s. vaddr_' s = vaddr} \<inter> {s. pt_' s = Ptr ptPtr}) []
|
|
|
|
(unmapPageTable asid vaddr ptPtr) (Call unmapPageTable_'proc)"
|
|
|
|
apply (rule ccorres_gen_asm)
|
|
|
|
apply (cinit lift: asid_' vaddr_' pt_')
|
|
|
|
apply (ctac(no_vcg) add: pageTableMapped_ccorres)
|
|
|
|
apply wpc
|
|
|
|
apply (simp add: option_to_ptr_def option_to_0_def ccorres_cond_iffs)
|
|
|
|
apply (rule ccorres_return_Skip[unfolded dc_def])
|
|
|
|
apply (simp add: option_to_ptr_def option_to_0_def ccorres_cond_iffs)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (rule ccorres_move_array_assertion_pd)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_split_nothrow_novcg_dc)
|
|
|
|
apply (rule storePDE_Basic_ccorres)
|
|
|
|
apply (simp add: cpde_relation_def Let_def pde_lift_pde_invalid)
|
|
|
|
apply (fold dc_def)
|
|
|
|
apply csymbr
|
|
|
|
apply (ctac add: cleanByVA_PoU_ccorres)
|
|
|
|
apply (ctac(no_vcg) add:flushTable_ccorres)
|
|
|
|
apply wp
|
2014-08-29 03:57:28 +00:00
|
|
|
apply (vcg exspec=cleanByVA_PoU_modifies)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply wp
|
|
|
|
apply (fastforce simp: guard_is_UNIV_def Collect_const_mem Let_def
|
|
|
|
shiftl_t2n field_simps lookup_pd_slot_def)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (rule_tac Q="\<lambda>rv s. (case rv of Some pd \<Rightarrow> page_directory_at' pd s | _ \<Rightarrow> True) \<and> invs' s"
|
2014-07-14 19:32:44 +00:00
|
|
|
in hoare_post_imp)
|
|
|
|
apply (clarsimp simp: lookup_pd_slot_def Let_def
|
2015-11-16 03:12:37 +00:00
|
|
|
mask_add_aligned less_kernelBase_valid_pde_offset''
|
|
|
|
page_directory_at'_def)
|
|
|
|
apply (wp pageTableMapped_pd)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: word_sle_def lookup_pd_slot_def
|
2015-11-16 03:12:37 +00:00
|
|
|
Let_def shiftl_t2n field_simps
|
|
|
|
Collect_const_mem pdBits_def pageBits_def)
|
2017-06-05 04:55:42 +00:00
|
|
|
apply (simp add: unat_shiftr_le_bound unat_eq_0 pdeBits_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
lemma return_Null_ccorres:
|
|
|
|
"ccorres ccap_relation ret__struct_cap_C_'
|
|
|
|
\<top> UNIV (SKIP # hs)
|
|
|
|
(return NullCap) (\<acute>ret__struct_cap_C :== CALL cap_null_cap_new()
|
|
|
|
;; return_C ret__struct_cap_C_'_update ret__struct_cap_C_')"
|
|
|
|
apply (rule ccorres_from_vcg_throws)
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp add: ccap_relation_NullCap_iff return_def)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma no_0_pd_at'[elim!]:
|
|
|
|
"\<lbrakk> page_directory_at' 0 s; no_0_obj' s \<rbrakk> \<Longrightarrow> P"
|
|
|
|
apply (clarsimp simp: page_directory_at'_def)
|
|
|
|
apply (drule spec[where x=0], clarsimp)
|
|
|
|
done
|
|
|
|
|
2017-06-06 06:49:45 +00:00
|
|
|
lemma capFSize_eq: "\<lbrakk>ccap_relation (capability.ArchObjectCap (arch_capability.PageCap x31 x32 x33 x34 (Some (a, b)))) cap;
|
|
|
|
x34 \<noteq> Wellformed_C.ARMSmallPage\<rbrakk>
|
|
|
|
\<Longrightarrow> gen_framesize_to_H (capFSize_CL (cap_frame_cap_lift cap)) = x34"
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if gen_framesize_to_H_def
|
|
|
|
ARM_H.kernelBase_def
|
|
|
|
framesize_to_H_def valid_cap'_def
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (subgoal_tac "capFSize_CL (cap_frame_cap_lift cap) \<noteq> scast Kernel_C.ARMSmallPage")
|
|
|
|
apply simp
|
|
|
|
apply (clarsimp simp: c_valid_cap_def cl_valid_cap_def)
|
|
|
|
done
|
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemma Arch_finaliseCap_ccorres:
|
2017-06-06 06:49:45 +00:00
|
|
|
notes dc_simp[simp del] Collect_const[simp del]
|
|
|
|
shows
|
|
|
|
"ccorres ccap_relation ret__struct_cap_C_'
|
|
|
|
(invs' and valid_cap' (ArchObjectCap cp)
|
|
|
|
and (\<lambda>s. 2 ^ acapBits cp \<le> gsMaxObjectSize s))
|
|
|
|
(UNIV \<inter> {s. ccap_relation (ArchObjectCap cp) (cap_' s)}
|
|
|
|
\<inter> {s. final_' s = from_bool is_final}) []
|
|
|
|
(Arch.finaliseCap cp is_final) (Call Arch_finaliseCap_'proc)"
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (cinit lift: cap_' final_' cong: call_ignore_cong)
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (simp add: ARM_H.finaliseCap_def cap_get_tag_isCap_ArchObject)
|
|
|
|
apply (simp add: split_def)
|
|
|
|
apply (rule ccorres_cases[where P=is_final]; clarsimp)
|
|
|
|
prefer 2
|
|
|
|
apply (subgoal_tac "isPageCap cp \<longrightarrow> \<not> isPageTableCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageDirectoryCap cp")
|
|
|
|
apply (rule ccorres_cases[where P="isPageCap cp"]; clarsimp)
|
|
|
|
prefer 2
|
|
|
|
apply (rule ccorres_inst[where P=\<top> and P'=UNIV])
|
|
|
|
apply (cases cp; clarsimp simp: isCap_simps; ccorres_rewrite)
|
|
|
|
apply (rule return_Null_ccorres)+
|
|
|
|
apply (subst ccorres_cond_seq2_seq[symmetric])
|
|
|
|
apply (rule ccorres_guard_imp)
|
|
|
|
apply (rule ccorres_rhs_assoc)
|
|
|
|
apply csymbr
|
|
|
|
apply clarsimp
|
|
|
|
apply ccorres_rewrite
|
|
|
|
apply (rule return_Null_ccorres, simp+)
|
|
|
|
apply (subst ccorres_cond_seq2_seq[symmetric])
|
|
|
|
apply (rule ccorres_guard_imp)
|
|
|
|
apply (rule ccorres_rhs_assoc)
|
|
|
|
apply csymbr
|
|
|
|
apply clarsimp
|
|
|
|
apply ccorres_rewrite
|
|
|
|
apply (rule return_Null_ccorres, simp+)
|
|
|
|
apply ccorres_rewrite
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "isPageCap cp \<longrightarrow> \<not> isPageDirectoryCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageTableCap cp")
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule small_frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (simp add: split_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply csymbr
|
|
|
|
apply (ctac (no_vcg) add: unmapPage_ccorres)
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp = None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule small_frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (simp add: split_def)
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "isPageCap cp \<longrightarrow> \<not> isPageDirectoryCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageTableCap cp")
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply simp
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (ctac (no_vcg) add: unmapPage_ccorres)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule return_Null_ccorres)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp = None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply ccorres_rewrite
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq; clarsimp)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (ctac (no_vcg) add: deleteASIDPool_ccorres)
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq; clarsimp)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply clarsimp
|
|
|
|
apply ccorres_rewrite
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (simp add: if_1_0_0)
|
|
|
|
apply (subgoal_tac "isPageDirectoryCap cp \<longrightarrow> \<not> isPageTableCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageCap cp")
|
|
|
|
apply clarsimp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (subgoal_tac "capPDMappedASID cp \<noteq> None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp add: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_directory_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_directory_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply csymbr
|
|
|
|
apply (ctac (no_vcg) add: deleteASID_ccorres)
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply (subgoal_tac "capPDMappedASID cp = None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp add: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_directory_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_directory_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply simp
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (clarsimp simp add: isCap_simps)
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "isPageTableCap cp \<longrightarrow> \<not> isPageDirectoryCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageCap cp")
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
2014-07-14 19:32:44 +00:00
|
|
|
apply simp
|
2017-06-06 06:49:45 +00:00
|
|
|
apply ccorres_rewrite
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply csymbr
|
|
|
|
apply (simp add: if_1_0_0)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "capPTMappedAddress cp \<noteq> None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp add: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_table_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_table_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
2017-06-06 06:49:45 +00:00
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (simp add: split_def)
|
|
|
|
apply (ctac (no_vcg) add: unmapPageTable_ccorres)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule return_Null_ccorres)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply clarsimp
|
|
|
|
apply (subgoal_tac "capPTMappedAddress cp = None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp add: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_table_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_table_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule return_Null_ccorres)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "isPageCap cp \<longrightarrow> \<not> isPageDirectoryCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageTableCap cp")
|
|
|
|
apply clarsimp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply clarsimp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule small_frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (simp add: split_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (ctac (no_vcg) add: unmapPage_ccorres)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule return_Null_ccorres)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp = None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule small_frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (simp add: split_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule return_Null_ccorres)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (clarsimp simp: isCap_simps)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (subgoal_tac "isPageCap cp \<longrightarrow> \<not> isPageDirectoryCap cp \<and> \<not> isASIDPoolCap cp \<and> \<not> isPageTableCap cp")
|
|
|
|
apply clarsimp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
2017-06-06 06:49:45 +00:00
|
|
|
apply clarsimp
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply simp
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (ctac (no_vcg) add: unmapPage_ccorres)
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (rule wp_post_taut)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp = None")
|
|
|
|
prefer 2
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply clarsimp
|
|
|
|
apply (rule return_Null_ccorres)
|
|
|
|
apply (clarsimp simp: isCap_simps)
|
|
|
|
apply clarsimp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule return_Null_ccorres)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (cases cp ; clarsimp simp: isCap_simps)
|
|
|
|
apply (cases is_final; clarsimp simp: isCap_simps)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (frule cap_lift_asid_pool_cap)
|
|
|
|
apply (clarsimp simp: valid_cap'_def)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def
|
|
|
|
cap_asid_pool_cap_lift_def asid_bits_def)
|
|
|
|
apply (intro conjI; clarsimp)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
apply (clarsimp simp: valid_cap'_def asid_bits_def mask_def word_less_sub_1)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule small_frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
apply (clarsimp simp: valid_cap'_def asid_bits_def mask_def word_less_sub_1)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE)
|
|
|
|
apply (rule conjI, clarsimp)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (frule small_frame_cap_is_mapped_alt)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if gen_framesize_to_H_def
|
|
|
|
Kernel_C.ARMSmallPage_def ARM_H.kernelBase_def
|
|
|
|
if_split
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (clarsimp simp: cap_small_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp, simp)
|
|
|
|
apply (rule conjI, clarsimp)
|
|
|
|
apply (subgoal_tac "capVPMappedAddress cp \<noteq> None")
|
|
|
|
apply clarsimp
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (frule capFSize_eq, simp)
|
|
|
|
apply simp
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule capFSize_range)
|
|
|
|
apply (rule order_le_less_trans, assumption, simp)
|
|
|
|
apply (clarsimp simp: word_less_sub_1)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if gen_framesize_to_H_def
|
|
|
|
if_split
|
|
|
|
elim!: ccap_relationE)
|
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule frame_cap_is_mapped_alt)
|
|
|
|
apply (clarsimp simp: cap_frame_cap_lift cap_to_H_def
|
|
|
|
case_option_over_if
|
2014-07-14 19:32:44 +00:00
|
|
|
elim!: ccap_relationE simp del: Collect_const)
|
2017-06-06 06:49:45 +00:00
|
|
|
apply (frule (1) cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (cases is_final; clarsimp)
|
|
|
|
apply (intro conjI; clarsimp?)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_table_cap)
|
|
|
|
apply (subgoal_tac "x42 \<noteq> None")
|
|
|
|
apply (clarsimp simp: valid_cap'_def asid_bits_def mask_def word_less_sub_1)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_table_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_table_cap)
|
|
|
|
apply (subgoal_tac "x42 \<noteq> None")
|
|
|
|
apply ((clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_table_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)+)[2]
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
|
|
|
apply (cases is_final; clarsimp)
|
|
|
|
apply (intro conjI; clarsimp?)
|
|
|
|
apply (subgoal_tac "x52 \<noteq> None")
|
|
|
|
apply (clarsimp simp: valid_cap'_def)
|
|
|
|
apply (clarsimp simp: asid_bits_def mask_def word_less_sub_1)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_directory_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_directory_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply (subgoal_tac "x52 \<noteq> None")
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_directory_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_directory_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap)
|
|
|
|
apply (frule cap_lift_page_directory_cap)
|
|
|
|
apply (clarsimp simp: ccap_relation_def cap_to_H_def capAligned_def
|
|
|
|
to_bool_def cap_page_directory_cap_lift_def
|
|
|
|
asid_bits_def
|
|
|
|
split: if_split_asm)
|
|
|
|
apply (frule cap_get_tag_isCap_unfolded_H_cap, simp)
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
lemma ccte_relation_ccap_relation:
|
|
|
|
"ccte_relation cte cte' \<Longrightarrow> ccap_relation (cteCap cte) (cte_C.cap_C cte')"
|
|
|
|
by (clarsimp simp: ccte_relation_def ccap_relation_def
|
2016-04-18 20:25:44 +00:00
|
|
|
cte_to_H_def map_option_Some_eq2
|
2014-07-14 19:32:44 +00:00
|
|
|
c_valid_cte_def)
|
|
|
|
|
|
|
|
lemma isFinalCapability_ccorres:
|
|
|
|
"ccorres (op = \<circ> from_bool) ret__unsigned_long_'
|
|
|
|
(cte_wp_at' (op = cte) slot and invs')
|
|
|
|
(UNIV \<inter> {s. cte_' s = Ptr slot}) []
|
|
|
|
(isFinalCapability cte) (Call isFinalCapability_'proc)"
|
|
|
|
apply (cinit lift: cte_')
|
|
|
|
apply (rule ccorres_Guard_Seq)
|
|
|
|
apply (simp add: Let_def del: Collect_const)
|
|
|
|
apply (rule ccorres_symb_exec_r)
|
|
|
|
apply (rule_tac xf'="mdb_'" in ccorres_abstract)
|
|
|
|
apply ceqv
|
|
|
|
apply (rule_tac P="mdb_node_to_H (mdb_node_lift rv') = cteMDBNode cte" in ccorres_gen_asm2)
|
|
|
|
apply csymbr
|
|
|
|
apply (rule_tac r'="op = \<circ> from_bool" and xf'="prevIsSameObject_'"
|
|
|
|
in ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
|
|
apply (clarsimp simp: Collect_const_mem nullPointer_def)
|
|
|
|
apply (simp add: mdbPrev_to_H[symmetric])
|
|
|
|
apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (simp add: return_def from_bool_def false_def)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply (rule ccorres_symb_exec_l[OF _ getCTE_inv getCTE_wp empty_fail_getCTE])
|
|
|
|
apply (rule_tac P="cte_wp_at' (op = cte) slot
|
|
|
|
and cte_wp_at' (op = rv) (mdbPrev (cteMDBNode cte))
|
|
|
|
and valid_cap' (cteCap rv)
|
|
|
|
and K (capAligned (cteCap cte) \<and> capAligned (cteCap rv))"
|
|
|
|
and P'=UNIV in ccorres_from_vcg)
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def mdbPrev_to_H[symmetric])
|
|
|
|
apply (simp add: rf_sr_cte_at_validD)
|
|
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
|
|
apply (rule cmap_relationE1 [OF cmap_relation_cte], assumption+,
|
|
|
|
simp?, simp add: typ_heap_simps)+
|
|
|
|
apply (drule ccte_relation_ccap_relation)+
|
|
|
|
apply (rule exI, rule conjI, assumption)+
|
|
|
|
apply (auto)[1]
|
|
|
|
apply ceqv
|
|
|
|
apply (clarsimp simp del: Collect_const)
|
|
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
|
|
apply (simp add: from_bool_0 Collect_const_mem)
|
|
|
|
apply (rule ccorres_return_C, simp+)[1]
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
|
|
apply (simp add: nullPointer_def Collect_const_mem mdbNext_to_H[symmetric])
|
|
|
|
apply (rule ccorres_return_C, simp+)[1]
|
|
|
|
apply (rule ccorres_symb_exec_l[OF _ getCTE_inv getCTE_wp empty_fail_getCTE])
|
|
|
|
apply (rule_tac P="cte_wp_at' (op = cte) slot
|
|
|
|
and cte_wp_at' (op = rva) (mdbNext (cteMDBNode cte))
|
|
|
|
and K (capAligned (cteCap rva) \<and> capAligned (cteCap cte))
|
|
|
|
and valid_cap' (cteCap cte)"
|
|
|
|
and P'=UNIV in ccorres_from_vcg_throws)
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def from_bool_eq_if from_bool_0
|
|
|
|
mdbNext_to_H[symmetric] rf_sr_cte_at_validD)
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (clarsimp simp: cte_wp_at_ctes_of split: if_split)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule cmap_relationE1 [OF cmap_relation_cte], assumption+,
|
|
|
|
simp?, simp add: typ_heap_simps)+
|
|
|
|
apply (drule ccte_relation_ccap_relation)+
|
|
|
|
apply (auto simp: false_def true_def from_bool_def split: bool.splits)[1]
|
|
|
|
apply (wp getCTE_wp')
|
|
|
|
apply (clarsimp simp add: guard_is_UNIV_def Collect_const_mem false_def
|
|
|
|
from_bool_0 true_def from_bool_def)
|
|
|
|
apply vcg
|
|
|
|
apply (rule conseqPre, vcg)
|
|
|
|
apply clarsimp
|
|
|
|
apply (clarsimp simp: Collect_const_mem)
|
|
|
|
apply (frule(1) rf_sr_cte_at_validD, simp add: typ_heap_simps)
|
|
|
|
apply (clarsimp simp: cte_wp_at_ctes_of)
|
|
|
|
apply (erule(1) cmap_relationE1 [OF cmap_relation_cte])
|
|
|
|
apply (simp add: typ_heap_simps)
|
2016-04-18 20:25:44 +00:00
|
|
|
apply (clarsimp simp add: ccte_relation_def map_option_Some_eq2)
|
2016-01-20 03:42:36 +00:00
|
|
|
by (auto,
|
2014-07-14 19:32:44 +00:00
|
|
|
auto dest!: ctes_of_valid' [OF _ invs_valid_objs']
|
|
|
|
elim!: valid_capAligned)
|
|
|
|
|
2015-09-10 07:06:45 +00:00
|
|
|
lemma cteDeleteOne_ccorres:
|
2014-07-14 19:32:44 +00:00
|
|
|
"ccorres dc xfdc
|
2015-05-22 03:55:35 +00:00
|
|
|
(invs' and cte_wp_at' (\<lambda>ct. w = -1 \<or> cteCap ct = NullCap
|
|
|
|
\<or> (\<forall>cap'. ccap_relation (cteCap ct) cap' \<longrightarrow> cap_get_tag cap' = w)) slot)
|
|
|
|
({s. gs_get_assn cteDeleteOne_'proc (ghost'state_' (globals s)) = w}
|
|
|
|
\<inter> {s. slot_' s = Ptr slot}) []
|
|
|
|
(cteDeleteOne slot) (Call cteDeleteOne_'proc)"
|
2014-07-14 19:32:44 +00:00
|
|
|
unfolding cteDeleteOne_def
|
|
|
|
apply (rule ccorres_symb_exec_l'
|
|
|
|
[OF _ getCTE_inv getCTE_sp empty_fail_getCTE])
|
|
|
|
apply (cinit' lift: slot_' cong: call_ignore_cong)
|
|
|
|
apply (rule ccorres_move_c_guard_cte)
|
2015-05-22 03:55:35 +00:00
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_abstract_cleanup)
|
|
|
|
apply (rule ccorres_gen_asm2,
|
|
|
|
erule_tac t="cap_type = scast cap_null_cap"
|
|
|
|
and s="cteCap cte = NullCap"
|
|
|
|
in ssubst)
|
|
|
|
apply (clarsimp simp only: when_def unless_def dc_def[symmetric])
|
|
|
|
apply (rule ccorres_cond2[where R=\<top>])
|
|
|
|
apply (clarsimp simp: Collect_const_mem)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_Guard_Seq)
|
|
|
|
apply (rule ccorres_basic_srnoop)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (ctac(no_vcg) add: isFinalCapability_ccorres[where slot=slot])
|
|
|
|
apply (rule_tac A="invs' and cte_wp_at' (op = cte) slot"
|
|
|
|
in ccorres_guard_imp2[where A'=UNIV])
|
|
|
|
apply (simp add: split_def dc_def[symmetric]
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_move_c_guard_cte)
|
|
|
|
apply (ctac(no_vcg) add: finaliseCap_True_standin_ccorres)
|
|
|
|
apply (rule ccorres_assert)
|
|
|
|
apply (simp add: dc_def[symmetric])
|
|
|
|
apply (ctac add: emptySlot_ccorres)
|
|
|
|
apply (simp add: pred_conj_def finaliseCapTrue_standin_simple_def)
|
2017-07-12 05:13:51 +00:00
|
|
|
apply (strengthen invs_mdb_strengthen' invs_urz)
|
2016-09-21 00:33:03 +00:00
|
|
|
apply (wp typ_at_lifts isFinalCapability_inv
|
|
|
|
| strengthen invs_valid_objs')+
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: from_bool_def true_def irq_opt_relation_def
|
|
|
|
invs_pspace_aligned' cte_wp_at_ctes_of)
|
|
|
|
apply (erule(1) cmap_relationE1 [OF cmap_relation_cte])
|
|
|
|
apply (clarsimp simp: typ_heap_simps ccte_relation_ccap_relation)
|
2017-07-12 05:13:51 +00:00
|
|
|
apply (wp isFinalCapability_inv)
|
2015-05-22 03:55:35 +00:00
|
|
|
apply simp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp del: Collect_const add: false_def)
|
2015-05-22 03:55:35 +00:00
|
|
|
apply (rule ccorres_return_Skip)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: Collect_const_mem cte_wp_at_ctes_of)
|
|
|
|
apply (erule(1) cmap_relationE1 [OF cmap_relation_cte])
|
|
|
|
apply (clarsimp simp: typ_heap_simps cap_get_tag_isCap
|
|
|
|
dest!: ccte_relation_ccap_relation)
|
2015-05-22 03:55:35 +00:00
|
|
|
apply (auto simp: o_def)
|
2015-09-02 05:43:39 +00:00
|
|
|
done
|
2014-07-14 19:32:44 +00:00
|
|
|
|
|
|
|
(* FIXME : move *)
|
|
|
|
lemma of_int_uint_ucast:
|
|
|
|
"of_int (uint (x :: 'a::len word)) = (ucast x :: 'b::len word)"
|
|
|
|
by (metis ucast_def word_of_int)
|
|
|
|
|
|
|
|
lemma getIRQSlot_ccorres_stuff:
|
|
|
|
"\<lbrakk> (s, s') \<in> rf_sr \<rbrakk> \<Longrightarrow>
|
2016-02-05 05:16:16 +00:00
|
|
|
CTypesDefs.ptr_add (intStateIRQNode_' (globals s')) (uint (irq :: 10 word))
|
2015-11-16 03:12:37 +00:00
|
|
|
= Ptr (irq_node' s + 2 ^ cte_level_bits * ucast irq)"
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp add: rf_sr_def cstate_relation_def Let_def
|
|
|
|
cinterrupt_relation_def)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (simp add: objBits_simps cte_level_bits_def
|
|
|
|
size_of_def mult.commute mult.left_commute of_int_uint_ucast )
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
lemma deletingIRQHandler_ccorres:
|
2015-09-02 05:43:39 +00:00
|
|
|
"ccorres dc xfdc (invs' and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s))
|
2014-07-14 19:32:44 +00:00
|
|
|
(UNIV \<inter> {s. irq_opt_relation (Some irq) (irq_' s)}) []
|
|
|
|
(deletingIRQHandler irq) (Call deletingIRQHandler_'proc)"
|
|
|
|
apply (cinit lift: irq_' cong: call_ignore_cong)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (clarsimp simp: irq_opt_relation_def ptr_add_assertion_def dc_def[symmetric]
|
|
|
|
cong: call_ignore_cong )
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule_tac r'="\<lambda>rv rv'. rv' = Ptr rv"
|
|
|
|
and xf'="slot_'" in ccorres_split_nothrow)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (simp add: sint_ucast_eq_uint is_down)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (rule ccorres_move_array_assertion_irq)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_from_vcg[where P=\<top> and P'=UNIV])
|
2016-01-29 04:45:07 +00:00
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: getIRQSlot_def liftM_def getInterruptState_def
|
2015-11-16 03:12:37 +00:00
|
|
|
locateSlot_conv)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: bind_def simpler_gets_def return_def
|
|
|
|
ucast_nat_def uint_up_ucast is_up)
|
|
|
|
apply (erule getIRQSlot_ccorres_stuff)
|
|
|
|
apply ceqv
|
2015-07-16 04:44:56 +00:00
|
|
|
apply (rule ccorres_symb_exec_l)
|
|
|
|
apply (rule ccorres_symb_exec_l)
|
|
|
|
apply (rule ccorres_symb_exec_r)
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (ctac add: cteDeleteOne_ccorres[where w="scast cap_notification_cap"])
|
2015-07-16 04:44:56 +00:00
|
|
|
apply vcg
|
|
|
|
apply (rule conseqPre, vcg, clarsimp simp: rf_sr_def
|
|
|
|
gs_set_assn_Delete_cstate_relation[unfolded o_def])
|
|
|
|
apply (wp getCTE_wp' | simp add: getSlotCap_def getIRQSlot_def locateSlot_conv
|
|
|
|
getInterruptState_def)+
|
2014-07-14 19:32:44 +00:00
|
|
|
apply vcg
|
2015-05-22 03:55:35 +00:00
|
|
|
apply (clarsimp simp: cap_get_tag_isCap ghost_assertion_data_get_def
|
|
|
|
ghost_assertion_data_set_def)
|
|
|
|
apply (simp add: cap_tag_defs)
|
2015-11-16 03:12:37 +00:00
|
|
|
apply (clarsimp simp: cte_wp_at_ctes_of Collect_const_mem
|
2016-05-03 04:01:20 +00:00
|
|
|
irq_opt_relation_def Kernel_C.maxIRQ_def)
|
2016-02-05 05:16:16 +00:00
|
|
|
apply (drule word_le_nat_alt[THEN iffD1])
|
|
|
|
apply (clarsimp simp:uint_0_iff unat_gt_0 uint_up_ucast is_up unat_def[symmetric])
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
|
|
|
|
|
|
|
lemma Zombie_new_spec:
|
|
|
|
"\<forall>s. \<Gamma>\<turnstile> ({s} \<inter> {s. type_' s = 32 \<or> type_' s < 31}) Call Zombie_new_'proc
|
|
|
|
{s'. cap_zombie_cap_lift (ret__struct_cap_C_' s') =
|
|
|
|
\<lparr> capZombieID_CL = \<^bsup>s\<^esup>ptr && ~~ mask (if \<^bsup>s\<^esup>type = (1 << 5) then 5 else unat (\<^bsup>s\<^esup>type + 1))
|
2015-12-08 06:29:42 +00:00
|
|
|
|| \<^bsup>s\<^esup>number___unsigned_long && mask (if \<^bsup>s\<^esup>type = (1 << 5) then 5 else unat (\<^bsup>s\<^esup>type + 1)),
|
2014-07-14 19:32:44 +00:00
|
|
|
capZombieType_CL = \<^bsup>s\<^esup>type && mask 6 \<rparr>
|
|
|
|
\<and> cap_get_tag (ret__struct_cap_C_' s') = scast cap_zombie_cap}"
|
|
|
|
apply vcg
|
|
|
|
apply (clarsimp simp: word_sle_def)
|
|
|
|
apply (simp add: mask_def word_log_esimps[where 'a=32, simplified])
|
|
|
|
apply clarsimp
|
|
|
|
apply (simp add: word_add_less_mono1[where k=1 and j="0x1F", simplified])
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma mod_mask_drop:
|
|
|
|
"\<lbrakk> m = 2 ^ n; 0 < m; mask n && msk = mask n \<rbrakk> \<Longrightarrow>
|
|
|
|
(x mod m) && msk = x mod m"
|
|
|
|
by (simp add: word_mod_2p_is_mask
|
|
|
|
word_bw_assocs)
|
|
|
|
|
|
|
|
lemma irq_opt_relation_Some_ucast:
|
2016-02-05 05:16:16 +00:00
|
|
|
"\<lbrakk> x && mask 10 = x; ucast x \<le> (scast Kernel_C.maxIRQ :: 10 word) \<or> x \<le> (scast Kernel_C.maxIRQ :: word32) \<rbrakk>
|
|
|
|
\<Longrightarrow> irq_opt_relation (Some (ucast x)) (ucast ((ucast x):: 10 word))"
|
|
|
|
using ucast_ucast_mask[where x=x and 'a=10, symmetric]
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (simp add: irq_opt_relation_def)
|
|
|
|
apply (rule conjI, clarsimp simp: irqInvalid_def Kernel_C.maxIRQ_def)
|
2016-02-05 05:16:16 +00:00
|
|
|
apply (simp only: unat_arith_simps )
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: word_le_nat_alt Kernel_C.maxIRQ_def)
|
|
|
|
done
|
|
|
|
|
2016-01-29 04:45:07 +00:00
|
|
|
lemma upcast_ucast_id:
|
2017-07-12 05:13:51 +00:00
|
|
|
"len_of TYPE('a) \<le> len_of TYPE('b) \<Longrightarrow>
|
2016-01-29 04:45:07 +00:00
|
|
|
((ucast (a :: 'a::len word) :: 'b ::len word) = ucast b) \<Longrightarrow> (a = b)"
|
|
|
|
apply (rule word_eqI)
|
|
|
|
apply (simp add:word_size)
|
|
|
|
apply (drule_tac f = "%x. (x !! n)" in arg_cong)
|
|
|
|
apply (simp add:nth_ucast)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma mask_eq_ucast_eq:
|
2017-07-12 05:13:51 +00:00
|
|
|
"\<lbrakk> x && mask (len_of TYPE('a)) = (x :: ('c :: len word));
|
2016-01-29 04:45:07 +00:00
|
|
|
len_of TYPE('a) \<le> len_of TYPE('b)\<rbrakk>
|
|
|
|
\<Longrightarrow> ucast (ucast x :: ('a :: len word)) = (ucast x :: ('b :: len word))"
|
|
|
|
apply (rule word_eqI)
|
|
|
|
apply (drule_tac f = "\<lambda>x. (x !! n)" in arg_cong)
|
|
|
|
apply (auto simp:nth_ucast word_size)
|
|
|
|
done
|
|
|
|
|
|
|
|
lemma irq_opt_relation_Some_ucast':
|
2016-02-05 05:16:16 +00:00
|
|
|
"\<lbrakk> x && mask 10 = x; ucast x \<le> (scast Kernel_C.maxIRQ :: 10 word) \<or> x \<le> (scast Kernel_C.maxIRQ :: word32) \<rbrakk>
|
2016-01-29 04:45:07 +00:00
|
|
|
\<Longrightarrow> irq_opt_relation (Some (ucast x)) (ucast x)"
|
|
|
|
apply (rule_tac P = "%y. irq_opt_relation (Some (ucast x)) y" in subst[rotated])
|
|
|
|
apply (rule irq_opt_relation_Some_ucast[rotated])
|
|
|
|
apply simp+
|
|
|
|
apply (rule word_eqI)
|
|
|
|
apply (drule_tac f = "%x. (x !! n)" in arg_cong)
|
|
|
|
apply (simp add:nth_ucast and_bang word_size)
|
|
|
|
done
|
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemma ccap_relation_IRQHandler_mask:
|
|
|
|
"\<lbrakk> ccap_relation acap ccap; isIRQHandlerCap acap \<rbrakk>
|
2016-02-05 05:16:16 +00:00
|
|
|
\<Longrightarrow> capIRQ_CL (cap_irq_handler_cap_lift ccap) && mask 10
|
2014-07-14 19:32:44 +00:00
|
|
|
= capIRQ_CL (cap_irq_handler_cap_lift ccap)"
|
|
|
|
apply (simp only: cap_get_tag_isCap[symmetric])
|
|
|
|
apply (drule ccap_relation_c_valid_cap)
|
|
|
|
apply (simp add: c_valid_cap_def cap_irq_handler_cap_lift cl_valid_cap_def)
|
|
|
|
done
|
|
|
|
|
2017-02-16 01:00:00 +00:00
|
|
|
lemma prepare_thread_delete_ccorres:
|
|
|
|
"ccorres dc xfdc \<top> UNIV []
|
|
|
|
(prepareThreadDelete thread) (Call Arch_prepareThreadDelete_'proc)"
|
|
|
|
unfolding prepareThreadDelete_def
|
|
|
|
apply (rule ccorres_Call)
|
|
|
|
apply (rule Arch_prepareThreadDelete_impl[unfolded Arch_prepareThreadDelete_body_def])
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
done
|
|
|
|
|
2014-07-14 19:32:44 +00:00
|
|
|
lemma finaliseCap_ccorres:
|
|
|
|
"\<And>final.
|
|
|
|
ccorres (\<lambda>rv rv'. ccap_relation (fst rv) (finaliseCap_ret_C.remainder_C rv')
|
|
|
|
\<and> irq_opt_relation (snd rv) (finaliseCap_ret_C.irq_C rv'))
|
|
|
|
ret__struct_finaliseCap_ret_C_'
|
2015-05-22 03:55:35 +00:00
|
|
|
(invs' and sch_act_simple and valid_cap' cap and (\<lambda>s. ksIdleThread s \<notin> capRange cap)
|
|
|
|
and (\<lambda>s. 2 ^ capBits cap \<le> gsMaxObjectSize s))
|
2014-07-14 19:32:44 +00:00
|
|
|
(UNIV \<inter> {s. ccap_relation cap (cap_' s)} \<inter> {s. final_' s = from_bool final}
|
|
|
|
\<inter> {s. exposed_' s = from_bool flag (* dave has name wrong *)}) []
|
|
|
|
(finaliseCap cap final flag) (Call finaliseCap_'proc)"
|
|
|
|
apply (rule_tac F="capAligned cap" in Corres_UL_C.ccorres_req)
|
|
|
|
apply (clarsimp simp: valid_capAligned)
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (case_tac "P :: bool" for P)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_guard_imp2, erule finaliseCap_True_cases_ccorres)
|
|
|
|
apply simp
|
|
|
|
apply (subgoal_tac "\<exists>acap. (0 <=s (-1 :: word8)) \<or> acap = capCap cap")
|
|
|
|
prefer 2 apply simp
|
|
|
|
apply (erule exE)
|
|
|
|
apply (cinit lift: cap_' final_' exposed_' cong: call_ignore_cong)
|
|
|
|
apply csymbr
|
|
|
|
apply (simp del: Collect_const)
|
|
|
|
apply (rule ccorres_Cond_rhs_Seq)
|
|
|
|
apply (clarsimp simp: cap_get_tag_isCap isCap_simps from_bool_neq_0
|
|
|
|
cong: if_cong simp del: Collect_const)
|
|
|
|
apply (clarsimp simp: word_sle_def)
|
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply (rule ccorres_fail)
|
|
|
|
apply (simp add: liftM_def del: Collect_const)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply (rule ccorres_split_nothrow_novcg)
|
|
|
|
apply (rule ccorres_call[where xf'="finaliseCap_ret_C.remainder_C \<circ> fc_ret_'"],
|
|
|
|
rule Arch_finaliseCap_ccorres)
|
|
|
|
apply simp+
|
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (rule ccorres_rhs_assoc2, rule ccorres_split_throws)
|
|
|
|
apply (rule_tac P'="{s. rv' = finaliseCap_ret_C.remainder_C (fc_ret_' s)}"
|
|
|
|
in ccorres_from_vcg_throws[where P=\<top>])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def Collect_const_mem irq_opt_relation_def)
|
|
|
|
apply vcg
|
|
|
|
apply wp
|
|
|
|
apply (simp add: guard_is_UNIV_def Collect_const_mem)
|
|
|
|
apply (simp add: cap_get_tag_isCap Collect_False
|
|
|
|
del: Collect_const)
|
|
|
|
apply csymbr
|
|
|
|
apply (simp add: cap_get_tag_isCap Collect_False Collect_True
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply (simp, rule ccorres_fail)
|
|
|
|
apply (simp add: from_bool_0 Collect_True Collect_False false_def
|
|
|
|
del: Collect_const)
|
|
|
|
apply csymbr
|
|
|
|
apply (simp add: cap_get_tag_isCap Collect_False Collect_True
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply (simp add: Let_def)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: cap_get_tag_isCap word_sle_def
|
|
|
|
return_def word_mod_less_divisor
|
|
|
|
less_imp_neq [OF word_mod_less_divisor])
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
|
|
|
apply (clarsimp simp: isCap_simps capAligned_def
|
|
|
|
objBits_simps word_bits_conv
|
|
|
|
signed_shift_guard_simpler_32)
|
|
|
|
apply (rule conjI)
|
|
|
|
apply (simp add: word_less_nat_alt)
|
|
|
|
apply clarsimp
|
|
|
|
apply (simp add: ccap_relation_def cap_zombie_cap_lift)
|
|
|
|
apply (simp add: cap_to_H_def isZombieTCB_C_def ZombieTCB_C_def)
|
|
|
|
apply (simp add: less_mask_eq word_less_nat_alt less_imp_neq)
|
|
|
|
apply (simp add: mod_mask_drop[where n=5] mask_def[where n=5]
|
|
|
|
less_imp_neq [OF word_mod_less_divisor]
|
|
|
|
less_imp_neq Let_def)
|
2015-05-17 23:11:43 +00:00
|
|
|
apply (thin_tac "a = b" for a b)+
|
|
|
|
apply (subgoal_tac "P" for P)
|
2014-08-11 04:50:56 +00:00
|
|
|
apply (subst add.commute, subst unatSuc, assumption)+
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule conjI)
|
|
|
|
apply (rule word_eqI)
|
|
|
|
apply (simp add: word_size word_ops_nth_size nth_w2p
|
|
|
|
less_Suc_eq_le is_aligned_nth)
|
|
|
|
apply (safe, simp_all)[1]
|
|
|
|
apply (simp add: shiftL_nat irq_opt_relation_def)
|
|
|
|
apply (rule trans, rule unat_power_lower32[symmetric])
|
|
|
|
apply (simp add: word_bits_conv)
|
|
|
|
apply (rule unat_cong, rule word_eqI)
|
|
|
|
apply (simp add: word_size word_ops_nth_size nth_w2p
|
|
|
|
is_aligned_nth less_Suc_eq_le)
|
|
|
|
apply (safe, simp_all)[1]
|
2014-08-11 04:50:56 +00:00
|
|
|
apply (subst add.commute, subst eq_diff_eq[symmetric])
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (clarsimp simp: minus_one_norm)
|
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply (simp add: Let_def getThreadCSpaceRoot_def locateSlot_conv
|
|
|
|
Collect_True Collect_False
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_rhs_assoc)+
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply csymbr
|
|
|
|
apply (rule ccorres_Guard_Seq)+
|
2015-09-02 05:43:39 +00:00
|
|
|
apply csymbr
|
2015-11-02 00:00:32 +00:00
|
|
|
apply (ctac(no_vcg) add: unbindNotification_ccorres)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (ctac(no_vcg) add: suspend_ccorres[OF cteDeleteOne_ccorres])
|
2017-02-16 01:00:00 +00:00
|
|
|
apply (ctac(no_vcg) add: prepare_thread_delete_ccorres)
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: word_sle_def return_def)
|
|
|
|
apply (subgoal_tac "cap_get_tag capa = scast cap_thread_cap")
|
|
|
|
apply (drule(1) cap_get_tag_to_H)
|
|
|
|
apply (clarsimp simp: isCap_simps capAligned_def)
|
|
|
|
apply (simp add: ccap_relation_def cap_zombie_cap_lift)
|
|
|
|
apply (simp add: cap_to_H_def isZombieTCB_C_def ZombieTCB_C_def
|
|
|
|
mask_def)
|
|
|
|
apply (simp add: cte_level_bits_def tcbCTableSlot_def
|
|
|
|
Kernel_C.tcbCTable_def tcbCNodeEntries_def
|
|
|
|
word_bool_alg.conj_disj_distrib2
|
|
|
|
word_bw_assocs)
|
|
|
|
apply (simp add: objBits_simps ctcb_ptr_to_tcb_ptr_def)
|
2015-09-10 07:06:45 +00:00
|
|
|
apply (frule is_aligned_add_helper[where p="tcbptr - ctcb_offset" and d=ctcb_offset for tcbptr])
|
2015-09-02 05:43:39 +00:00
|
|
|
apply (simp add: ctcb_offset_def)
|
|
|
|
apply (simp add: mask_def irq_opt_relation_def)
|
|
|
|
apply (simp add: cap_get_tag_isCap)
|
2017-01-13 12:58:40 +00:00
|
|
|
apply wp+
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply (simp add: Let_def)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def irq_opt_relation_def)
|
|
|
|
apply (simp add: isArchCap_T_isArchObjectCap[symmetric]
|
|
|
|
del: Collect_const)
|
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply (simp add: Collect_False Collect_True Let_def true_def
|
|
|
|
del: Collect_const)
|
2016-05-01 03:35:49 +00:00
|
|
|
apply (rule_tac P="(capIRQ cap) \<le> ARM.maxIRQ" in ccorres_gen_asm)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_rhs_assoc)+
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (rule ccorres_symb_exec_r)
|
|
|
|
apply (rule_tac xf'=irq_' in ccorres_abstract,ceqv)
|
|
|
|
apply (rule_tac P="rv' = ucast (capIRQ cap)" in ccorres_gen_asm2)
|
|
|
|
apply (ctac(no_vcg) add: deletingIRQHandler_ccorres)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> ])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def)
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
2016-10-25 06:01:30 +00:00
|
|
|
apply (simp add: ccap_relation_NullCap_iff split: if_split)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (frule(1) ccap_relation_IRQHandler_mask)
|
|
|
|
apply (erule irq_opt_relation_Some_ucast)
|
2016-05-01 03:35:49 +00:00
|
|
|
apply (simp add: ARM.maxIRQ_def Kernel_C.maxIRQ_def)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply wp
|
|
|
|
apply vcg
|
|
|
|
apply (rule conseqPre,vcg)
|
|
|
|
apply clarsimp
|
2014-07-14 19:32:44 +00:00
|
|
|
apply (rule ccorres_if_lhs)
|
|
|
|
apply simp
|
|
|
|
apply (rule ccorres_fail)
|
|
|
|
apply (rule ccorres_add_return, rule ccorres_split_nothrow_novcg[where r'=dc and xf'=xfdc])
|
|
|
|
apply (rule ccorres_Cond_rhs)
|
|
|
|
apply (simp add: ccorres_cond_iffs dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (rule ccorres_Cond_rhs)
|
|
|
|
apply (simp add: ccorres_cond_iffs dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (rule ccorres_Cond_rhs)
|
|
|
|
apply (rule ccorres_inst[where P=\<top> and P'=UNIV])
|
|
|
|
apply simp
|
|
|
|
apply (rule ccorres_Cond_rhs)
|
|
|
|
apply (simp add: ccorres_cond_iffs dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (simp add: ccorres_cond_iffs dc_def[symmetric])
|
|
|
|
apply (rule ccorres_return_Skip)
|
|
|
|
apply (rule ceqv_refl)
|
|
|
|
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
|
|
|
apply (rule allI, rule conseqPre, vcg)
|
|
|
|
apply (clarsimp simp: return_def ccap_relation_NullCap_iff
|
|
|
|
irq_opt_relation_def)
|
|
|
|
apply wp
|
|
|
|
apply (simp add: guard_is_UNIV_def)
|
|
|
|
apply (clarsimp simp: cap_get_tag_isCap word_sle_def Collect_const_mem
|
|
|
|
false_def from_bool_def)
|
|
|
|
apply (intro impI conjI)
|
2017-02-16 01:00:00 +00:00
|
|
|
apply (clarsimp split: bool.splits)
|
|
|
|
apply (clarsimp split: bool.splits)
|
|
|
|
apply (clarsimp simp: valid_cap'_def isCap_simps)
|
|
|
|
apply (clarsimp simp: isCap_simps capRange_def capAligned_def)
|
|
|
|
apply (clarsimp simp: isCap_simps valid_cap'_def)
|
|
|
|
apply (clarsimp simp: isCap_simps capRange_def capAligned_def)
|
|
|
|
apply (clarsimp simp: isCap_simps valid_cap'_def )
|
|
|
|
apply clarsimp
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (clarsimp simp: isCap_simps valid_cap'_def )
|
2017-02-16 01:00:00 +00:00
|
|
|
apply (clarsimp simp: tcb_ptr_to_ctcb_ptr_def ccap_relation_def isCap_simps
|
|
|
|
c_valid_cap_def cap_thread_cap_lift_def cap_to_H_def
|
|
|
|
ctcb_ptr_to_tcb_ptr_def Let_def
|
|
|
|
split: option.splits cap_CL.splits if_splits)
|
|
|
|
apply clarsimp
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (clarsimp simp: isCap_simps from_bool_def false_def)
|
|
|
|
apply (clarsimp simp: tcb_cnode_index_defs ptr_add_assertion_def)
|
2014-07-14 19:32:44 +00:00
|
|
|
apply clarsimp
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (frule(1) ccap_relation_IRQHandler_mask)
|
|
|
|
apply (clarsimp simp: isCap_simps irqInvalid_def
|
2016-05-01 03:35:49 +00:00
|
|
|
valid_cap'_def ARM.maxIRQ_def
|
2016-05-03 04:01:20 +00:00
|
|
|
Kernel_C.maxIRQ_def)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (rule irq_opt_relation_Some_ucast', simp)
|
|
|
|
apply (clarsimp simp: isCap_simps irqInvalid_def
|
2016-05-01 03:35:49 +00:00
|
|
|
valid_cap'_def ARM.maxIRQ_def
|
2016-05-03 04:01:20 +00:00
|
|
|
Kernel_C.maxIRQ_def)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply fastforce
|
2014-07-14 19:32:44 +00:00
|
|
|
apply clarsimp
|
|
|
|
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
|
|
|
apply (frule(1) ccap_relation_IRQHandler_mask)
|
2016-01-29 04:45:07 +00:00
|
|
|
apply (clarsimp simp add:mask_eq_ucast_eq)
|
2014-07-14 19:32:44 +00:00
|
|
|
done
|
2016-01-29 04:45:07 +00:00
|
|
|
end
|
2017-01-13 12:58:40 +00:00
|
|
|
|
2015-10-12 13:11:13 +00:00
|
|
|
end
|