SELFOUR-1198: update proofs for correct restart PC
Fixes a case where a thread can go from Running->Inactive->Restart and use a restart PC that is out of date. An out of date restart PC occurs when a thread was transitioned to running after being in a blocked state, but was never scheduled and so did not execute the traps code that updates the restart PC. This also renames relevant register names for consistency across architectures (FaultIP and NextIP).
This commit is contained in:
parent
4a07af9d9d
commit
4463e9750e
|
@ -1176,8 +1176,8 @@ inductive integrity_obj_atomic for aag activate subjects l ko ko'
|
||||||
| troa_tcb_activate:
|
| troa_tcb_activate:
|
||||||
"\<lbrakk>ko = Some (TCB tcb); ko' = Some (TCB tcb');
|
"\<lbrakk>ko = Some (TCB tcb); ko' = Some (TCB tcb');
|
||||||
tcb' = tcb\<lparr>tcb_arch := arch_tcb_context_set
|
tcb' = tcb\<lparr>tcb_arch := arch_tcb_context_set
|
||||||
((arch_tcb_context_get (tcb_arch tcb))(LR_svc :=
|
((arch_tcb_context_get (tcb_arch tcb))(NextIP :=
|
||||||
(arch_tcb_context_get (tcb_arch tcb)) FaultInstruction)
|
(arch_tcb_context_get (tcb_arch tcb)) FaultIP)
|
||||||
) (tcb_arch tcb),
|
) (tcb_arch tcb),
|
||||||
tcb_state := Running\<rparr>;
|
tcb_state := Running\<rparr>;
|
||||||
tcb_state tcb = Restart;
|
tcb_state tcb = Restart;
|
||||||
|
@ -1416,7 +1416,7 @@ where
|
||||||
(tcb_state tcb' = Running \<and>
|
(tcb_state tcb' = Running \<and>
|
||||||
arch_tcb_context_get (tcb_arch tcb')
|
arch_tcb_context_get (tcb_arch tcb')
|
||||||
= (arch_tcb_context_get (tcb_arch tcb))
|
= (arch_tcb_context_get (tcb_arch tcb))
|
||||||
(LR_svc := arch_tcb_context_get (tcb_arch tcb) FaultInstruction));
|
(NextIP := arch_tcb_context_get (tcb_arch tcb) FaultIP));
|
||||||
tcb_bound_notification_reset_integrity (tcb_bound_notification tcb) ntfn' subjects aag;
|
tcb_bound_notification_reset_integrity (tcb_bound_notification tcb) ntfn' subjects aag;
|
||||||
reply_cap_deletion_integrity subjects aag (tcb_caller tcb) cap';
|
reply_cap_deletion_integrity subjects aag (tcb_caller tcb) cap';
|
||||||
reply_cap_deletion_integrity subjects aag (tcb_ctable tcb) ccap';
|
reply_cap_deletion_integrity subjects aag (tcb_ctable tcb) ccap';
|
||||||
|
@ -1437,8 +1437,8 @@ where
|
||||||
| tro_alt_tcb_activate:
|
| tro_alt_tcb_activate:
|
||||||
"\<lbrakk>tro_tag TCBActivate; ko = Some (TCB tcb); ko' = Some (TCB tcb');
|
"\<lbrakk>tro_tag TCBActivate; ko = Some (TCB tcb); ko' = Some (TCB tcb');
|
||||||
tcb' = tcb \<lparr> tcb_arch := arch_tcb_context_set
|
tcb' = tcb \<lparr> tcb_arch := arch_tcb_context_set
|
||||||
((arch_tcb_context_get (tcb_arch tcb))(LR_svc :=
|
((arch_tcb_context_get (tcb_arch tcb))(NextIP :=
|
||||||
(arch_tcb_context_get (tcb_arch tcb)) FaultInstruction)
|
(arch_tcb_context_get (tcb_arch tcb)) FaultIP)
|
||||||
) (tcb_arch tcb),
|
) (tcb_arch tcb),
|
||||||
tcb_caller := cap', tcb_ctable := ccap',
|
tcb_caller := cap', tcb_ctable := ccap',
|
||||||
tcb_state := Running, tcb_bound_notification := ntfn'\<rparr>;
|
tcb_state := Running, tcb_bound_notification := ntfn'\<rparr>;
|
||||||
|
|
|
@ -463,6 +463,11 @@ lemma set_asid_pool_neg_cte_wp_at[wp]:
|
||||||
crunch domain_sep_inv[wp]: set_asid_pool "domain_sep_inv irqs st"
|
crunch domain_sep_inv[wp]: set_asid_pool "domain_sep_inv irqs st"
|
||||||
(wp: domain_sep_inv_triv)
|
(wp: domain_sep_inv_triv)
|
||||||
|
|
||||||
|
lemma as_user_domain_sep_inv[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. domain_sep_inv irqs st s\<rbrace> as_user a b \<lbrace>\<lambda>_ s. domain_sep_inv irqs st s\<rbrace>"
|
||||||
|
by (wpsimp simp: domain_sep_inv_def
|
||||||
|
wp: as_user_cte_wp_at as_user_interrupt_states hoare_vcg_conj_lift
|
||||||
|
hoare_vcg_all_lift hoare_vcg_disj_lift)
|
||||||
|
|
||||||
crunch domain_sep_inv[wp]: finalise_cap "domain_sep_inv irqs st"
|
crunch domain_sep_inv[wp]: finalise_cap "domain_sep_inv irqs st"
|
||||||
(wp: crunch_wps dxo_wp_weak simp: crunch_simps ignore: set_object tcb_sched_action)
|
(wp: crunch_wps dxo_wp_weak simp: crunch_simps ignore: set_object tcb_sched_action)
|
||||||
|
|
|
@ -538,13 +538,24 @@ lemma cancel_ipc_respects[wp]:
|
||||||
apply (fastforce simp: obj_at_def is_ep_def dest: pas_refined_mem[OF sta_ts_mem])
|
apply (fastforce simp: obj_at_def is_ep_def dest: pas_refined_mem[OF sta_ts_mem])
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma update_restart_pc_integrity_autarch[wp]:
|
||||||
|
"\<lbrace>integrity aag X st and K (is_subject aag t)\<rbrace> update_restart_pc t
|
||||||
|
\<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
|
||||||
|
apply (simp add: get_thread_state_def thread_get_def)
|
||||||
|
unfolding update_restart_pc_def
|
||||||
|
apply (wp as_user_integrity_autarch)
|
||||||
|
apply simp
|
||||||
|
done
|
||||||
|
|
||||||
lemma suspend_respects[wp]:
|
lemma suspend_respects[wp]:
|
||||||
"\<lbrace>integrity aag X st and pas_refined aag and einvs and tcb_at t and
|
"\<lbrace>integrity aag X st and pas_refined aag and einvs and tcb_at t and
|
||||||
K (is_subject aag t)\<rbrace>
|
K (is_subject aag t)\<rbrace>
|
||||||
suspend t \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
|
suspend t \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp set_thread_state_integrity_autarch set_thread_state_pas_refined)
|
apply (wp set_thread_state_integrity_autarch set_thread_state_pas_refined)
|
||||||
apply simp_all
|
apply (rule hoare_conjI)
|
||||||
|
apply (wp hoare_drop_imps)+
|
||||||
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma finalise_is_fast_finalise:
|
lemma finalise_is_fast_finalise:
|
||||||
|
|
|
@ -1279,13 +1279,35 @@ lemma set_asid_pool_current_ipc_buffer_register[wp]:
|
||||||
split: kernel_object.splits)
|
split: kernel_object.splits)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma set_tcb_context_current_ipc_buffer_register:
|
||||||
|
"\<lbrace>\<lambda>s. (f = cur_thread s \<longrightarrow> (P (cxt TPIDRURW) = P (arch_tcb_context_get (tcb_arch tcb) TPIDRURW) \<and>
|
||||||
|
obj_at (\<lambda>obj. obj = TCB tcb) f s)) \<and> P (current_ipc_buffer_register s)\<rbrace>
|
||||||
|
set_object f (TCB (tcb\<lparr>tcb_arch := arch_tcb_context_set cxt (tcb_arch tcb)\<rparr>))
|
||||||
|
\<lbrace>\<lambda>_ s. P (current_ipc_buffer_register s)\<rbrace>"
|
||||||
|
apply (wpsimp wp: set_object_wp)
|
||||||
|
by (auto simp: current_ipc_buffer_register_def get_tcb_def obj_at_def)
|
||||||
|
|
||||||
|
lemma as_user_current_ipc_buffer_register[wp]:
|
||||||
|
assumes uc: "\<And>P. \<lbrace>\<lambda>s. P (s TPIDRURW)\<rbrace> a \<lbrace>\<lambda>r s. P (s TPIDRURW)\<rbrace>"
|
||||||
|
shows "\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> as_user f a
|
||||||
|
\<lbrace>\<lambda>_ s. P (current_ipc_buffer_register s)\<rbrace>"
|
||||||
|
apply (simp add: as_user_def)
|
||||||
|
apply (wp select_f_wp set_tcb_context_current_ipc_buffer_register | wpc | simp)+
|
||||||
|
apply (clarsimp dest!: get_tcb_SomeD)
|
||||||
|
apply (simp add: obj_at_def get_tcb_def)
|
||||||
|
apply (drule use_valid[OF _ uc])
|
||||||
|
apply (clarsimp simp: current_ipc_buffer_register_def get_tcb_def)
|
||||||
|
apply assumption
|
||||||
|
apply (clarsimp simp: current_ipc_buffer_register_def get_tcb_def)
|
||||||
|
done
|
||||||
|
|
||||||
crunch current_ipc_buffer_register [wp]: finalise_cap "\<lambda>s. P (current_ipc_buffer_register s)"
|
crunch current_ipc_buffer_register [wp]: finalise_cap "\<lambda>s. P (current_ipc_buffer_register s)"
|
||||||
(wp: crunch_wps without_preemption_wp syscall_valid do_machine_op_arch
|
(wp: crunch_wps without_preemption_wp syscall_valid do_machine_op_arch
|
||||||
hoare_unless_wp select_wp
|
hoare_unless_wp select_wp
|
||||||
simp: crunch_simps
|
simp: crunch_simps setRegister_def getRegister_def
|
||||||
|
ARM.faultRegister_def ARM.nextInstructionRegister_def
|
||||||
ignore: do_machine_op clearMemory empty_slot_ext reschedule_required
|
ignore: do_machine_op clearMemory empty_slot_ext reschedule_required
|
||||||
tcb_sched_action)
|
tcb_sched_action set_object as_user)
|
||||||
|
|
||||||
|
|
||||||
lemma rec_del_current_ipc_buffer_register [wp]:
|
lemma rec_del_current_ipc_buffer_register [wp]:
|
||||||
"invariant (rec_del call) (\<lambda>s. P (current_ipc_buffer_register s))"
|
"invariant (rec_del call) (\<lambda>s. P (current_ipc_buffer_register s))"
|
||||||
|
@ -1325,28 +1347,6 @@ lemma transfer_caps_loop_current_ipc_buffer_register:
|
||||||
|
|
||||||
crunch current_ipc_buffer_register [wp]: transfer_caps "\<lambda>s. P (current_ipc_buffer_register s)"
|
crunch current_ipc_buffer_register [wp]: transfer_caps "\<lambda>s. P (current_ipc_buffer_register s)"
|
||||||
|
|
||||||
lemma set_tcb_context_current_ipc_buffer_register:
|
|
||||||
"\<lbrace>\<lambda>s. (f = cur_thread s \<longrightarrow> (P (cxt TPIDRURW) = P (arch_tcb_context_get (tcb_arch tcb) TPIDRURW) \<and>
|
|
||||||
obj_at (\<lambda>obj. obj = TCB tcb) f s)) \<and> P (current_ipc_buffer_register s)\<rbrace>
|
|
||||||
set_object f (TCB (tcb\<lparr>tcb_arch := arch_tcb_context_set cxt (tcb_arch tcb)\<rparr>))
|
|
||||||
\<lbrace>\<lambda>_ s. P (current_ipc_buffer_register s)\<rbrace>"
|
|
||||||
apply (wpsimp wp: set_object_wp)
|
|
||||||
by (auto simp: current_ipc_buffer_register_def get_tcb_def obj_at_def)
|
|
||||||
|
|
||||||
lemma as_user_current_ipc_buffer_register[wp]:
|
|
||||||
assumes uc: "\<And>P. \<lbrace>\<lambda>s. P (s TPIDRURW)\<rbrace> a \<lbrace>\<lambda>r s. P (s TPIDRURW)\<rbrace>"
|
|
||||||
shows "\<lbrace>\<lambda>s. P (current_ipc_buffer_register s)\<rbrace> as_user f a
|
|
||||||
\<lbrace>\<lambda>_ s. P (current_ipc_buffer_register s)\<rbrace>"
|
|
||||||
apply (simp add: as_user_def)
|
|
||||||
apply (wp select_f_wp set_tcb_context_current_ipc_buffer_register | wpc | simp)+
|
|
||||||
apply (clarsimp dest!: get_tcb_SomeD)
|
|
||||||
apply (simp add: obj_at_def get_tcb_def)
|
|
||||||
apply (drule use_valid[OF _ uc])
|
|
||||||
apply (clarsimp simp: current_ipc_buffer_register_def get_tcb_def)
|
|
||||||
apply assumption
|
|
||||||
apply (clarsimp simp: current_ipc_buffer_register_def get_tcb_def)
|
|
||||||
done
|
|
||||||
|
|
||||||
lemma set_register_tpidrurw_inv[wp]:
|
lemma set_register_tpidrurw_inv[wp]:
|
||||||
"r \<noteq> TPIDRURW \<Longrightarrow> \<lbrace>\<lambda>s. P (s TPIDRURW)\<rbrace> setRegister r v\<lbrace>\<lambda>r s. P (s TPIDRURW)\<rbrace>"
|
"r \<noteq> TPIDRURW \<Longrightarrow> \<lbrace>\<lambda>s. P (s TPIDRURW)\<rbrace> setRegister r v\<lbrace>\<lambda>r s. P (s TPIDRURW)\<rbrace>"
|
||||||
by (simp add: setRegister_def simpler_modify_def valid_def)
|
by (simp add: setRegister_def simpler_modify_def valid_def)
|
||||||
|
@ -1415,7 +1415,8 @@ crunch current_ipc_buffer_register [wp]: set_message_info "\<lambda>s. P (curren
|
||||||
(wp: crunch_wps simp: crunch_simps )
|
(wp: crunch_wps simp: crunch_simps )
|
||||||
|
|
||||||
crunch current_ipc_buffer_register [wp]: do_ipc_transfer "\<lambda>s. P (current_ipc_buffer_register s)"
|
crunch current_ipc_buffer_register [wp]: do_ipc_transfer "\<lambda>s. P (current_ipc_buffer_register s)"
|
||||||
(wp: crunch_wps simp: crunch_simps msg_registers_def)
|
(wp: crunch_wps simp: crunch_simps msg_registers_def
|
||||||
|
ignore: set_object as_user)
|
||||||
|
|
||||||
crunch current_ipc_buffer_register [wp]: send_ipc "\<lambda>s. P (current_ipc_buffer_register s)"
|
crunch current_ipc_buffer_register [wp]: send_ipc "\<lambda>s. P (current_ipc_buffer_register s)"
|
||||||
(wp: crunch_wps simp: crunch_simps )
|
(wp: crunch_wps simp: crunch_simps )
|
||||||
|
|
|
@ -550,6 +550,25 @@ lemma setThreadState_ccorres_valid_queues'_simple:
|
||||||
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma updateRestartPC_ccorres:
|
||||||
|
"ccorres dc xfdc (tcb_at' thread) \<lbrace> \<acute>tcb = tcb_ptr_to_ctcb_ptr thread \<rbrace> hs
|
||||||
|
(updateRestartPC thread) (Call updateRestartPC_'proc)"
|
||||||
|
apply (cinit lift: tcb_')
|
||||||
|
apply (subst asUser_bind_distrib; (wp add: empty_fail_getRegister)?)
|
||||||
|
apply (ctac (no_vcg) add: getRegister_ccorres)
|
||||||
|
apply (ctac (no_vcg) add: setRegister_ccorres)
|
||||||
|
apply wpsimp+
|
||||||
|
apply (simp add: ARM_H.faultRegister_def ARM_H.nextInstructionRegister_def
|
||||||
|
ARM.faultRegister_def ARM.nextInstructionRegister_def)
|
||||||
|
done
|
||||||
|
|
||||||
|
crunches updateRestartPC
|
||||||
|
for valid_queues'[wp]: valid_queues'
|
||||||
|
and sch_act_simple[wp]: sch_act_simple
|
||||||
|
and valid_queues[wp]: Invariants_H.valid_queues
|
||||||
|
and valid_objs'[wp]: valid_objs'
|
||||||
|
and tcb_at'[wp]: "tcb_at' p"
|
||||||
|
|
||||||
lemma suspend_ccorres:
|
lemma suspend_ccorres:
|
||||||
assumes cteDeleteOne_ccorres:
|
assumes cteDeleteOne_ccorres:
|
||||||
"\<And>w slot. ccorres dc xfdc
|
"\<And>w slot. ccorres dc xfdc
|
||||||
|
@ -565,6 +584,31 @@ lemma suspend_ccorres:
|
||||||
(suspend thread) (Call suspend_'proc)"
|
(suspend thread) (Call suspend_'proc)"
|
||||||
apply (cinit lift: target_')
|
apply (cinit lift: target_')
|
||||||
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
||||||
|
apply (rule getThreadState_ccorres_foo)
|
||||||
|
apply (rename_tac threadState)
|
||||||
|
apply (rule ccorres_move_c_guard_tcb)
|
||||||
|
apply (rule_tac xf'=ret__unsigned_'
|
||||||
|
and val="thread_state_to_tsType threadState"
|
||||||
|
and R="st_tcb_at' ((=) threadState) thread"
|
||||||
|
and R'=UNIV
|
||||||
|
in
|
||||||
|
ccorres_symb_exec_r_known_rv)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg)
|
||||||
|
apply (clarsimp simp: st_tcb_at'_def)
|
||||||
|
apply (frule (1) obj_at_cslift_tcb)
|
||||||
|
apply (clarsimp simp: typ_heap_simps ctcb_relation_thread_state_to_tsType)
|
||||||
|
apply ceqv
|
||||||
|
supply Collect_const[simp del]
|
||||||
|
apply (rule ccorres_split_nothrow)
|
||||||
|
apply (rule ccorres_cond[where R=\<top> and xf=xfdc])
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule iffI)
|
||||||
|
apply simp
|
||||||
|
apply (erule thread_state_to_tsType.elims; simp add: StrictC'_thread_state_defs)
|
||||||
|
apply (ctac (no_vcg) add: updateRestartPC_ccorres)
|
||||||
|
apply (rule ccorres_return_Skip)
|
||||||
|
apply ceqv
|
||||||
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
||||||
apply (ctac add: tcbSchedDequeue_ccorres')
|
apply (ctac add: tcbSchedDequeue_ccorres')
|
||||||
apply (rule_tac Q="\<lambda>_.
|
apply (rule_tac Q="\<lambda>_.
|
||||||
|
@ -580,6 +624,14 @@ lemma suspend_ccorres:
|
||||||
apply (drule_tac x=p in spec)
|
apply (drule_tac x=p in spec)
|
||||||
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
||||||
apply (wp_trace sts_valid_queues_partial)[1]
|
apply (wp_trace sts_valid_queues_partial)[1]
|
||||||
|
apply clarsimp
|
||||||
|
apply (wpsimp simp: valid_tcb_state'_def)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg exspec=updateRestartPC_modifies)
|
||||||
|
apply (rule subset_refl)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg)
|
||||||
|
apply (rule subset_refl)
|
||||||
apply (rule hoare_strengthen_post)
|
apply (rule hoare_strengthen_post)
|
||||||
apply (rule hoare_vcg_conj_lift)
|
apply (rule hoare_vcg_conj_lift)
|
||||||
apply (rule hoare_vcg_conj_lift)
|
apply (rule hoare_vcg_conj_lift)
|
||||||
|
@ -588,6 +640,7 @@ lemma suspend_ccorres:
|
||||||
apply (rule delete_one_conc_fr.cancelIPC_invs)
|
apply (rule delete_one_conc_fr.cancelIPC_invs)
|
||||||
apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
|
apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
|
||||||
valid_tcb_state'_def)
|
valid_tcb_state'_def)
|
||||||
|
apply clarsimp
|
||||||
apply (auto simp: "StrictC'_thread_state_defs")
|
apply (auto simp: "StrictC'_thread_state_defs")
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
|
@ -53,6 +53,7 @@ lemma suspend_st_tcb_at':
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
|
\<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def unless_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (cases "t=t'")
|
apply (cases "t=t'")
|
||||||
apply (simp|wp cancelIPC_st_tcb_at' sts_st_tcb')+
|
apply (simp|wp cancelIPC_st_tcb_at' sts_st_tcb')+
|
||||||
done
|
done
|
||||||
|
|
|
@ -234,11 +234,11 @@ fun
|
||||||
| "register_from_H ARM.IP = scast Kernel_C.R12"
|
| "register_from_H ARM.IP = scast Kernel_C.R12"
|
||||||
| "register_from_H ARM.SP = scast Kernel_C.SP"
|
| "register_from_H ARM.SP = scast Kernel_C.SP"
|
||||||
| "register_from_H ARM.LR = scast Kernel_C.LR"
|
| "register_from_H ARM.LR = scast Kernel_C.LR"
|
||||||
| "register_from_H ARM.LR_svc = scast Kernel_C.NextIP"
|
| "register_from_H ARM.NextIP = scast Kernel_C.NextIP"
|
||||||
| "register_from_H ARM.CPSR = scast Kernel_C.CPSR"
|
| "register_from_H ARM.CPSR = scast Kernel_C.CPSR"
|
||||||
| "register_from_H ARM.TLS_BASE = scast Kernel_C.TLS_BASE"
|
| "register_from_H ARM.TLS_BASE = scast Kernel_C.TLS_BASE"
|
||||||
| "register_from_H ARM.TPIDRURW = scast Kernel_C.TPIDRURW"
|
| "register_from_H ARM.TPIDRURW = scast Kernel_C.TPIDRURW"
|
||||||
| "register_from_H ARM.FaultInstruction = scast Kernel_C.FaultIP"
|
| "register_from_H ARM.FaultIP = scast Kernel_C.FaultIP"
|
||||||
|
|
||||||
definition
|
definition
|
||||||
ccontext_relation :: "(MachineTypes.register \<Rightarrow> word32) \<Rightarrow> user_context_C \<Rightarrow> bool"
|
ccontext_relation :: "(MachineTypes.register \<Rightarrow> word32) \<Rightarrow> user_context_C \<Rightarrow> bool"
|
||||||
|
|
|
@ -584,6 +584,25 @@ lemma setThreadState_ccorres_valid_queues'_simple:
|
||||||
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma updateRestartPC_ccorres:
|
||||||
|
"ccorres dc xfdc (tcb_at' thread) \<lbrace> \<acute>tcb = tcb_ptr_to_ctcb_ptr thread \<rbrace> hs
|
||||||
|
(updateRestartPC thread) (Call updateRestartPC_'proc)"
|
||||||
|
apply (cinit lift: tcb_')
|
||||||
|
apply (subst asUser_bind_distrib; (wp add: empty_fail_getRegister)?)
|
||||||
|
apply (ctac (no_vcg) add: getRegister_ccorres)
|
||||||
|
apply (ctac (no_vcg) add: setRegister_ccorres)
|
||||||
|
apply wpsimp+
|
||||||
|
apply (simp add: ARM_HYP_H.faultRegister_def ARM_HYP_H.nextInstructionRegister_def
|
||||||
|
ARM_HYP.faultRegister_def ARM_HYP.nextInstructionRegister_def)
|
||||||
|
done
|
||||||
|
|
||||||
|
crunches updateRestartPC
|
||||||
|
for valid_queues'[wp]: valid_queues'
|
||||||
|
and sch_act_simple[wp]: sch_act_simple
|
||||||
|
and valid_queues[wp]: Invariants_H.valid_queues
|
||||||
|
and valid_objs'[wp]: valid_objs'
|
||||||
|
and tcb_at'[wp]: "tcb_at' p"
|
||||||
|
|
||||||
lemma suspend_ccorres:
|
lemma suspend_ccorres:
|
||||||
assumes cteDeleteOne_ccorres:
|
assumes cteDeleteOne_ccorres:
|
||||||
"\<And>w slot. ccorres dc xfdc
|
"\<And>w slot. ccorres dc xfdc
|
||||||
|
@ -599,6 +618,31 @@ lemma suspend_ccorres:
|
||||||
(suspend thread) (Call suspend_'proc)"
|
(suspend thread) (Call suspend_'proc)"
|
||||||
apply (cinit lift: target_')
|
apply (cinit lift: target_')
|
||||||
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
||||||
|
apply (rule getThreadState_ccorres_foo)
|
||||||
|
apply (rename_tac threadState)
|
||||||
|
apply (rule ccorres_move_c_guard_tcb)
|
||||||
|
apply (rule_tac xf'=ret__unsigned_'
|
||||||
|
and val="thread_state_to_tsType threadState"
|
||||||
|
and R="st_tcb_at' ((=) threadState) thread"
|
||||||
|
and R'=UNIV
|
||||||
|
in
|
||||||
|
ccorres_symb_exec_r_known_rv)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg)
|
||||||
|
apply (clarsimp simp: st_tcb_at'_def)
|
||||||
|
apply (frule (1) obj_at_cslift_tcb)
|
||||||
|
apply (clarsimp simp: typ_heap_simps ctcb_relation_thread_state_to_tsType)
|
||||||
|
apply ceqv
|
||||||
|
supply Collect_const[simp del]
|
||||||
|
apply (rule ccorres_split_nothrow)
|
||||||
|
apply (rule ccorres_cond[where R=\<top> and xf=xfdc])
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule iffI)
|
||||||
|
apply simp
|
||||||
|
apply (erule thread_state_to_tsType.elims; simp add: StrictC'_thread_state_defs)
|
||||||
|
apply (ctac (no_vcg) add: updateRestartPC_ccorres)
|
||||||
|
apply (rule ccorres_return_Skip)
|
||||||
|
apply ceqv
|
||||||
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
||||||
apply (ctac add: tcbSchedDequeue_ccorres')
|
apply (ctac add: tcbSchedDequeue_ccorres')
|
||||||
apply (rule_tac Q="\<lambda>_.
|
apply (rule_tac Q="\<lambda>_.
|
||||||
|
@ -614,6 +658,14 @@ lemma suspend_ccorres:
|
||||||
apply (drule_tac x=p in spec)
|
apply (drule_tac x=p in spec)
|
||||||
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
||||||
apply (wp_trace sts_valid_queues_partial)[1]
|
apply (wp_trace sts_valid_queues_partial)[1]
|
||||||
|
apply clarsimp
|
||||||
|
apply (wpsimp simp: valid_tcb_state'_def)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg exspec=updateRestartPC_modifies)
|
||||||
|
apply (rule subset_refl)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg)
|
||||||
|
apply (rule subset_refl)
|
||||||
apply (rule hoare_strengthen_post)
|
apply (rule hoare_strengthen_post)
|
||||||
apply (rule hoare_vcg_conj_lift)
|
apply (rule hoare_vcg_conj_lift)
|
||||||
apply (rule hoare_vcg_conj_lift)
|
apply (rule hoare_vcg_conj_lift)
|
||||||
|
@ -622,6 +674,7 @@ lemma suspend_ccorres:
|
||||||
apply (rule delete_one_conc_fr.cancelIPC_invs)
|
apply (rule delete_one_conc_fr.cancelIPC_invs)
|
||||||
apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
|
apply (fastforce simp: invs_valid_queues' invs_queues invs_valid_objs'
|
||||||
valid_tcb_state'_def)
|
valid_tcb_state'_def)
|
||||||
|
apply clarsimp
|
||||||
apply (auto simp: "StrictC'_thread_state_defs")
|
apply (auto simp: "StrictC'_thread_state_defs")
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
|
@ -1631,7 +1631,7 @@ declare zipWithM_x_Nil2[simp]
|
||||||
lemma getRestartPC_ccorres [corres]:
|
lemma getRestartPC_ccorres [corres]:
|
||||||
"ccorres (=) ret__unsigned_long_' \<top>
|
"ccorres (=) ret__unsigned_long_' \<top>
|
||||||
(UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>) hs
|
(UNIV \<inter> \<lbrace>\<acute>thread = tcb_ptr_to_ctcb_ptr thread\<rbrace>) hs
|
||||||
(asUser thread (getRegister register.FaultInstruction))
|
(asUser thread (getRegister register.FaultIP))
|
||||||
(Call getRestartPC_'proc)"
|
(Call getRestartPC_'proc)"
|
||||||
apply (cinit' lift: thread_')
|
apply (cinit' lift: thread_')
|
||||||
apply (rule ccorres_trim_return, simp, simp)
|
apply (rule ccorres_trim_return, simp, simp)
|
||||||
|
|
|
@ -56,7 +56,8 @@ lemma suspend_st_tcb_at':
|
||||||
"\<lbrace>\<lambda>s. (t\<noteq>t' \<longrightarrow> st_tcb_at' P t' s) \<and> (t=t' \<longrightarrow> P Inactive)\<rbrace>
|
"\<lbrace>\<lambda>s. (t\<noteq>t' \<longrightarrow> st_tcb_at' P t' s) \<and> (t=t' \<longrightarrow> P Inactive)\<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
|
\<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (cases "t=t'")
|
apply (cases "t=t'")
|
||||||
apply (simp|wp cancelIPC_st_tcb_at' sts_st_tcb')+
|
apply (simp|wp cancelIPC_st_tcb_at' sts_st_tcb')+
|
||||||
done
|
done
|
||||||
|
|
|
@ -248,11 +248,11 @@ fun
|
||||||
| "register_from_H ARM_HYP.IP = scast Kernel_C.R12"
|
| "register_from_H ARM_HYP.IP = scast Kernel_C.R12"
|
||||||
| "register_from_H ARM_HYP.SP = scast Kernel_C.SP"
|
| "register_from_H ARM_HYP.SP = scast Kernel_C.SP"
|
||||||
| "register_from_H ARM_HYP.LR = scast Kernel_C.LR"
|
| "register_from_H ARM_HYP.LR = scast Kernel_C.LR"
|
||||||
| "register_from_H ARM_HYP.LR_svc = scast Kernel_C.NextIP"
|
| "register_from_H ARM_HYP.NextIP = scast Kernel_C.NextIP"
|
||||||
| "register_from_H ARM_HYP.CPSR = scast Kernel_C.CPSR"
|
| "register_from_H ARM_HYP.CPSR = scast Kernel_C.CPSR"
|
||||||
| "register_from_H ARM_HYP.TLS_BASE = scast Kernel_C.TLS_BASE"
|
| "register_from_H ARM_HYP.TLS_BASE = scast Kernel_C.TLS_BASE"
|
||||||
| "register_from_H ARM_HYP.TPIDRURW = scast Kernel_C.TPIDRURW"
|
| "register_from_H ARM_HYP.TPIDRURW = scast Kernel_C.TPIDRURW"
|
||||||
| "register_from_H ARM_HYP.FaultInstruction = scast Kernel_C.FaultIP"
|
| "register_from_H ARM_HYP.FaultIP = scast Kernel_C.FaultIP"
|
||||||
|
|
||||||
definition
|
definition
|
||||||
ccontext_relation :: "(MachineTypes.register \<Rightarrow> word32) \<Rightarrow> user_context_C \<Rightarrow> bool"
|
ccontext_relation :: "(MachineTypes.register \<Rightarrow> word32) \<Rightarrow> user_context_C \<Rightarrow> bool"
|
||||||
|
|
|
@ -590,6 +590,25 @@ lemma setThreadState_ccorres_valid_queues'_simple:
|
||||||
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
apply (clarsimp simp: weak_sch_act_wf_def valid_queues'_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma updateRestartPC_ccorres:
|
||||||
|
"ccorres dc xfdc (tcb_at' thread) \<lbrace>\<acute>tcb = tcb_ptr_to_ctcb_ptr thread \<rbrace> hs
|
||||||
|
(updateRestartPC thread) (Call updateRestartPC_'proc)"
|
||||||
|
apply (cinit lift: tcb_')
|
||||||
|
apply (subst asUser_bind_distrib; (wp add: empty_fail_getRegister)?)
|
||||||
|
apply (ctac (no_vcg) add: getRegister_ccorres)
|
||||||
|
apply (ctac (no_vcg) add: setRegister_ccorres)
|
||||||
|
apply wpsimp+
|
||||||
|
apply (simp add: X64_H.faultRegister_def X64_H.nextInstructionRegister_def
|
||||||
|
X64.faultRegister_def X64.nextInstructionRegister_def)
|
||||||
|
done
|
||||||
|
|
||||||
|
crunches updateRestartPC
|
||||||
|
for valid_queues'[wp]: valid_queues'
|
||||||
|
and sch_act_simple[wp]: sch_act_simple
|
||||||
|
and valid_queues[wp]: Invariants_H.valid_queues
|
||||||
|
and valid_objs'[wp]: valid_objs'
|
||||||
|
and tcb_at'[wp]: "tcb_at' p"
|
||||||
|
|
||||||
lemma suspend_ccorres:
|
lemma suspend_ccorres:
|
||||||
assumes cteDeleteOne_ccorres:
|
assumes cteDeleteOne_ccorres:
|
||||||
"\<And>w slot. ccorres dc xfdc
|
"\<And>w slot. ccorres dc xfdc
|
||||||
|
@ -605,6 +624,31 @@ lemma suspend_ccorres:
|
||||||
(suspend thread) (Call suspend_'proc)"
|
(suspend thread) (Call suspend_'proc)"
|
||||||
apply (cinit lift: target_')
|
apply (cinit lift: target_')
|
||||||
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
apply (ctac(no_vcg) add: cancelIPC_ccorres1 [OF cteDeleteOne_ccorres])
|
||||||
|
apply (rule getThreadState_ccorres_foo)
|
||||||
|
apply (rename_tac threadState)
|
||||||
|
apply (rule ccorres_move_c_guard_tcb)
|
||||||
|
apply (rule_tac xf'=ret__unsigned_longlong_'
|
||||||
|
and val="thread_state_to_tsType threadState"
|
||||||
|
and R="st_tcb_at' ((=) threadState) thread"
|
||||||
|
and R'=UNIV
|
||||||
|
in
|
||||||
|
ccorres_symb_exec_r_known_rv)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg)
|
||||||
|
apply (clarsimp simp: st_tcb_at'_def)
|
||||||
|
apply (frule (1) obj_at_cslift_tcb)
|
||||||
|
apply (clarsimp simp: typ_heap_simps ctcb_relation_thread_state_to_tsType)
|
||||||
|
apply ceqv
|
||||||
|
supply Collect_const[simp del]
|
||||||
|
apply (rule ccorres_split_nothrow)
|
||||||
|
apply (rule ccorres_cond[where R=\<top> and xf=xfdc])
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule iffI)
|
||||||
|
apply simp
|
||||||
|
apply (erule thread_state_to_tsType.elims; simp add: StrictC'_thread_state_defs)
|
||||||
|
apply (ctac (no_vcg) add: updateRestartPC_ccorres)
|
||||||
|
apply (rule ccorres_return_Skip)
|
||||||
|
apply ceqv
|
||||||
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
apply (ctac(no_vcg) add: setThreadState_ccorres_valid_queues'_simple)
|
||||||
apply (ctac add: tcbSchedDequeue_ccorres')
|
apply (ctac add: tcbSchedDequeue_ccorres')
|
||||||
apply (rule_tac Q="\<lambda>_.
|
apply (rule_tac Q="\<lambda>_.
|
||||||
|
@ -620,6 +664,14 @@ lemma suspend_ccorres:
|
||||||
apply (drule_tac x=p in spec)
|
apply (drule_tac x=p in spec)
|
||||||
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
apply (clarsimp elim!: obj_at'_weakenE simp: inQ_def)
|
||||||
apply (wp_trace sts_valid_queues_partial)[1]
|
apply (wp_trace sts_valid_queues_partial)[1]
|
||||||
|
apply clarsimp
|
||||||
|
apply (wpsimp simp: valid_tcb_state'_def)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg exspec=updateRestartPC_modifies)
|
||||||
|
apply (rule subset_refl)
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule conseqPre, vcg)
|
||||||
|
apply (rule subset_refl)
|
||||||
apply (rule hoare_strengthen_post)
|
apply (rule hoare_strengthen_post)
|
||||||
apply (rule hoare_vcg_conj_lift)
|
apply (rule hoare_vcg_conj_lift)
|
||||||
apply (rule hoare_vcg_conj_lift)
|
apply (rule hoare_vcg_conj_lift)
|
||||||
|
|
|
@ -53,6 +53,7 @@ lemma suspend_st_tcb_at':
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
|
\<lbrace>\<lambda>_. st_tcb_at' P t'\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def unless_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (cases "t=t'")
|
apply (cases "t=t'")
|
||||||
apply (simp|wp cancelIPC_st_tcb_at' sts_st_tcb')+
|
apply (simp|wp cancelIPC_st_tcb_at' sts_st_tcb')+
|
||||||
done
|
done
|
||||||
|
|
|
@ -2583,6 +2583,23 @@ lemma prepare_thread_delete_dcorres: "dcorres dc P P' (CSpace_D.prepare_thread_d
|
||||||
apply (clarsimp simp: CSpace_D.prepare_thread_delete_def prepare_thread_delete_def)
|
apply (clarsimp simp: CSpace_D.prepare_thread_delete_def prepare_thread_delete_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma update_restart_pc_dcorres: "dcorres dc P P' (return ()) (update_restart_pc t)"
|
||||||
|
apply (monad_eq simp: update_restart_pc_def as_user_def gets_the_def
|
||||||
|
getRegister_def setRegister_def set_object_def get_object_def
|
||||||
|
corres_underlying_def return_def select_f_def)
|
||||||
|
apply (clarsimp simp: get_tcb_def split: option.splits kernel_object.splits)
|
||||||
|
apply (clarsimp simp: transform_def transform_objects_def)
|
||||||
|
apply (intro impI conjI)
|
||||||
|
apply (rule ext)
|
||||||
|
apply (clarsimp simp: map_add_def restrict_map_def transform_tcb_def
|
||||||
|
transform_full_intent_def cap_register_def capRegister_def
|
||||||
|
get_tcb_message_info_def msg_info_register_def msgInfoRegister_def
|
||||||
|
get_tcb_mrs_def msgRegisters_A_unfold
|
||||||
|
get_ipc_buffer_words_def transform_current_thread_def
|
||||||
|
ARM.faultRegister_def ARM.nextInstructionRegister_def
|
||||||
|
split: option.splits)+
|
||||||
|
done
|
||||||
|
|
||||||
lemma dcorres_finalise_cap:
|
lemma dcorres_finalise_cap:
|
||||||
"cdlcap = transform_cap cap \<Longrightarrow>
|
"cdlcap = transform_cap cap \<Longrightarrow>
|
||||||
dcorres (\<lambda>r r'. fst r = transform_cap (fst r'))
|
dcorres (\<lambda>r r'. fst r = transform_cap (fst r'))
|
||||||
|
@ -2605,6 +2622,11 @@ lemma dcorres_finalise_cap:
|
||||||
apply (rule corres_guard_imp)
|
apply (rule corres_guard_imp)
|
||||||
apply (rule corres_split[OF _ dcorres_unbind_notification])
|
apply (rule corres_split[OF _ dcorres_unbind_notification])
|
||||||
apply (rule corres_split[OF _ finalise_cancel_ipc])
|
apply (rule corres_split[OF _ finalise_cancel_ipc])
|
||||||
|
apply (rule dcorres_symb_exec_r[OF _ gts_inv gts_inv])
|
||||||
|
apply (rule dcorres_rhs_noop_above)
|
||||||
|
apply (case_tac "rv = Running"; simp)
|
||||||
|
apply (rule update_restart_pc_dcorres)
|
||||||
|
apply simp
|
||||||
apply (rule corres_split)
|
apply (rule corres_split)
|
||||||
unfolding K_bind_def
|
unfolding K_bind_def
|
||||||
apply (rule dcorres_rhs_noop_above_True[OF tcb_sched_action_dcorres[where P=\<top> and P'=\<top>]])
|
apply (rule dcorres_rhs_noop_above_True[OF tcb_sched_action_dcorres[where P=\<top> and P'=\<top>]])
|
||||||
|
@ -2615,6 +2637,8 @@ lemma dcorres_finalise_cap:
|
||||||
apply (rule set_cap_set_thread_state_inactive)
|
apply (rule set_cap_set_thread_state_inactive)
|
||||||
apply wp+
|
apply wp+
|
||||||
apply (simp add:not_idle_thread_def)
|
apply (simp add:not_idle_thread_def)
|
||||||
|
apply (case_tac "rv = Running"; simp)
|
||||||
|
apply (wp update_restart_pc_dcorres)
|
||||||
apply (wp unbind_notification_invs | simp add: not_idle_thread_def)+
|
apply (wp unbind_notification_invs | simp add: not_idle_thread_def)+
|
||||||
apply clarsimp
|
apply clarsimp
|
||||||
apply (drule(1) thread_in_thread_cap_not_idle[OF invs_valid_global_refs])
|
apply (drule(1) thread_in_thread_cap_not_idle[OF invs_valid_global_refs])
|
||||||
|
|
|
@ -592,11 +592,11 @@ lemma schedule_dcorres:
|
||||||
done
|
done
|
||||||
|
|
||||||
(*
|
(*
|
||||||
* The next few lemmas show that updating the register LR_svc in the
|
* The next few lemmas show that updating the register NextIP in the
|
||||||
* tcb context of a thread does affect the state translation to capDL
|
* tcb context of a thread does affect the state translation to capDL
|
||||||
*)
|
*)
|
||||||
lemma get_tcb_message_info_nextPC [simp]:
|
lemma get_tcb_message_info_nextPC [simp]:
|
||||||
"get_tcb_message_info (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(LR_svc := pc))) tcb) =
|
"get_tcb_message_info (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP := pc))) tcb) =
|
||||||
get_tcb_message_info tcb"
|
get_tcb_message_info tcb"
|
||||||
by (simp add: get_tcb_message_info_def
|
by (simp add: get_tcb_message_info_def
|
||||||
arch_tcb_context_get_def
|
arch_tcb_context_get_def
|
||||||
|
@ -604,23 +604,23 @@ lemma get_tcb_message_info_nextPC [simp]:
|
||||||
ARM.msgInfoRegister_def)
|
ARM.msgInfoRegister_def)
|
||||||
|
|
||||||
lemma map_msg_registers_nextPC [simp]:
|
lemma map_msg_registers_nextPC [simp]:
|
||||||
"map ((tcb_context tcb)(LR_svc := pc)) msg_registers =
|
"map ((tcb_context tcb)(NextIP := pc)) msg_registers =
|
||||||
map (tcb_context tcb) msg_registers"
|
map (tcb_context tcb) msg_registers"
|
||||||
by (simp add: msg_registers_def ARM.msgRegisters_def
|
by (simp add: msg_registers_def ARM.msgRegisters_def
|
||||||
upto_enum_red fromEnum_def toEnum_def enum_register)
|
upto_enum_red fromEnum_def toEnum_def enum_register)
|
||||||
|
|
||||||
lemma get_ipc_buffer_words_nextPC [simp]:
|
lemma get_ipc_buffer_words_nextPC [simp]:
|
||||||
"get_ipc_buffer_words m (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(LR_svc := pc))) tcb) =
|
"get_ipc_buffer_words m (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP := pc))) tcb) =
|
||||||
get_ipc_buffer_words m tcb"
|
get_ipc_buffer_words m tcb"
|
||||||
by (rule ext) (simp add: get_ipc_buffer_words_def)
|
by (rule ext) (simp add: get_ipc_buffer_words_def)
|
||||||
|
|
||||||
lemma get_tcb_mrs_nextPC [simp]:
|
lemma get_tcb_mrs_nextPC [simp]:
|
||||||
"get_tcb_mrs m (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(LR_svc := pc))) tcb) =
|
"get_tcb_mrs m (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP := pc))) tcb) =
|
||||||
get_tcb_mrs m tcb"
|
get_tcb_mrs m tcb"
|
||||||
by (simp add: get_tcb_mrs_def Let_def arch_tcb_context_get_def)
|
by (simp add: get_tcb_mrs_def Let_def arch_tcb_context_get_def)
|
||||||
|
|
||||||
lemma transform_tcb_LR_svc:
|
lemma transform_tcb_NextIP:
|
||||||
"transform_tcb m t (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(LR_svc := pc))) tcb)
|
"transform_tcb m t (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP:= pc))) tcb)
|
||||||
= transform_tcb m t tcb"
|
= transform_tcb m t tcb"
|
||||||
by (auto simp add: transform_tcb_def transform_full_intent_def Let_def
|
by (auto simp add: transform_tcb_def transform_full_intent_def Let_def
|
||||||
cap_register_def ARM.capRegister_def
|
cap_register_def ARM.capRegister_def
|
||||||
|
@ -640,7 +640,7 @@ lemma as_user_setNextPC_corres:
|
||||||
apply (subst tcb_context_update_aux)
|
apply (subst tcb_context_update_aux)
|
||||||
apply (simp add: transform_def transform_current_thread_def)
|
apply (simp add: transform_def transform_current_thread_def)
|
||||||
apply (clarsimp simp: transform_objects_update_kheap_same_caps
|
apply (clarsimp simp: transform_objects_update_kheap_same_caps
|
||||||
transform_tcb_LR_svc transform_objects_update_same
|
transform_tcb_NextIP transform_objects_update_same
|
||||||
arch_tcb_update_aux3)
|
arch_tcb_update_aux3)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
|
@ -442,15 +442,17 @@ lemma suspend_corres:
|
||||||
apply (rule corres_guard_imp)
|
apply (rule corres_guard_imp)
|
||||||
apply (clarsimp simp: IpcCancel_A.suspend_def Tcb_D.suspend_def)
|
apply (clarsimp simp: IpcCancel_A.suspend_def Tcb_D.suspend_def)
|
||||||
apply (rule corres_split[OF _ finalise_cancel_ipc])
|
apply (rule corres_split[OF _ finalise_cancel_ipc])
|
||||||
|
apply (rule dcorres_symb_exec_r[OF _ gts_inv gts_inv])
|
||||||
|
apply (rule dcorres_rhs_noop_above)
|
||||||
|
apply (case_tac "rv = Running"; simp)
|
||||||
|
apply (rule update_restart_pc_dcorres)
|
||||||
|
apply simp
|
||||||
apply (rule dcorres_rhs_noop_below_True[OF tcb_sched_action_dcorres])
|
apply (rule dcorres_rhs_noop_below_True[OF tcb_sched_action_dcorres])
|
||||||
apply (rule set_thread_state_corres)
|
apply (rule set_thread_state_corres)
|
||||||
apply wp
|
apply wp
|
||||||
apply (clarsimp simp:not_idle_thread_def conj_comms)
|
apply (case_tac "rv = Running"; simp)
|
||||||
apply wp
|
apply wp+
|
||||||
apply simp
|
apply (wpsimp simp: not_idle_thread_def conj_comms)+
|
||||||
apply (clarsimp simp:st_tcb_at_def not_idle_thread_def
|
|
||||||
obj_at_def generates_pending_def
|
|
||||||
split:Structures_A.thread_state.split_asm)
|
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma dcorres_setup_reply_master:
|
lemma dcorres_setup_reply_master:
|
||||||
|
|
|
@ -980,6 +980,13 @@ lemma as_user_set_register_reads_respects':
|
||||||
apply(simp add: labels_are_invisible_def)
|
apply(simp add: labels_are_invisible_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma as_user_get_register_reads_respects:
|
||||||
|
"reads_respects aag l (K (is_subject aag thread)) (as_user thread (getRegister reg))"
|
||||||
|
apply (simp add: as_user_def split_def)
|
||||||
|
apply (wp set_object_reads_respects select_f_ev gets_the_ev)
|
||||||
|
apply (auto intro: reads_affects_equiv_get_tcb_eq det_getRegister)[1]
|
||||||
|
done
|
||||||
|
|
||||||
lemma set_message_info_reads_respects:
|
lemma set_message_info_reads_respects:
|
||||||
assumes domains_distinct: "pas_domains_distinct aag"
|
assumes domains_distinct: "pas_domains_distinct aag"
|
||||||
shows
|
shows
|
||||||
|
|
|
@ -1432,6 +1432,18 @@ lemma is_subject_not_silc_inv:
|
||||||
"\<lbrakk>silc_inv aag st s; is_subject aag ptr\<rbrakk> \<Longrightarrow> pasObjectAbs aag ptr \<noteq> SilcLabel"
|
"\<lbrakk>silc_inv aag st s; is_subject aag ptr\<rbrakk> \<Longrightarrow> pasObjectAbs aag ptr \<noteq> SilcLabel"
|
||||||
using silc_inv_not_subject by fastforce
|
using silc_inv_not_subject by fastforce
|
||||||
|
|
||||||
|
lemma update_restart_pc_silc_inv[wp]:
|
||||||
|
"\<lbrace>silc_inv aag st\<rbrace> update_restart_pc t \<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
|
||||||
|
unfolding update_restart_pc_def
|
||||||
|
apply(rule silc_inv_pres)
|
||||||
|
apply (simp add: as_user_def)
|
||||||
|
apply(wpsimp simp: set_object_wp)
|
||||||
|
apply(wp set_object_wp)+
|
||||||
|
apply clarsimp+
|
||||||
|
apply (fastforce simp: silc_inv_def dest: get_tcb_SomeD simp: obj_at_def is_cap_table_def)
|
||||||
|
apply wp+
|
||||||
|
done
|
||||||
|
|
||||||
lemma finalise_cap_silc_inv:
|
lemma finalise_cap_silc_inv:
|
||||||
"\<lbrace>silc_inv aag st and valid_mdb and pas_refined aag and K (pas_cap_cur_auth aag cap)\<rbrace>
|
"\<lbrace>silc_inv aag st and valid_mdb and pas_refined aag and K (pas_cap_cur_auth aag cap)\<rbrace>
|
||||||
finalise_cap cap final
|
finalise_cap cap final
|
||||||
|
|
|
@ -1208,6 +1208,15 @@ lemma cancel_ipc_reads_respects_f:
|
||||||
apply (simp add: st_tcb_at_def obj_at_def | blast)+
|
apply (simp add: st_tcb_at_def obj_at_def | blast)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma update_restart_pc_reads_respects[wp]:
|
||||||
|
assumes domains_distinct[wp]: "pas_domains_distinct aag"
|
||||||
|
shows
|
||||||
|
"reads_respects aag l (silc_inv aag s and K (is_subject aag thread))
|
||||||
|
(update_restart_pc thread)"
|
||||||
|
unfolding update_restart_pc_def
|
||||||
|
apply (subst as_user_bind)
|
||||||
|
apply (wpsimp wp: as_user_set_register_reads_respects' as_user_get_register_reads_respects)
|
||||||
|
done
|
||||||
|
|
||||||
lemma suspend_reads_respects_f:
|
lemma suspend_reads_respects_f:
|
||||||
assumes domains_distinct[wp]: "pas_domains_distinct aag"
|
assumes domains_distinct[wp]: "pas_domains_distinct aag"
|
||||||
|
@ -1215,9 +1224,19 @@ lemma suspend_reads_respects_f:
|
||||||
"reads_respects_f aag l (silc_inv aag st and pas_refined aag and invs and tcb_at thread and
|
"reads_respects_f aag l (silc_inv aag st and pas_refined aag and invs and tcb_at thread and
|
||||||
(K (is_subject aag thread))) (suspend thread)"
|
(K (is_subject aag thread))) (suspend thread)"
|
||||||
unfolding suspend_def
|
unfolding suspend_def
|
||||||
apply(wp reads_respects_f[OF set_thread_state_owned_reads_respects, where st=st and Q="\<top>"] reads_respects_f[OF tcb_sched_action_reads_respects, where st=st and Q=\<top>] set_thread_state_pas_refined| simp)+
|
apply(wp reads_respects_f[OF set_thread_state_owned_reads_respects, where st=st and Q="\<top>"]
|
||||||
|
reads_respects_f[OF tcb_sched_action_reads_respects, where st=st and Q=\<top>]
|
||||||
|
reads_respects_f[OF get_thread_state_rev, where st=st and Q="\<top>"]
|
||||||
|
reads_respects_f[OF update_restart_pc_reads_respects, where st=st and Q="\<top>"]
|
||||||
|
gts_wp
|
||||||
|
set_thread_state_pas_refined| simp)+
|
||||||
apply(wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv)+
|
apply(wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv)+
|
||||||
by force
|
apply clarsimp
|
||||||
|
apply (wp hoare_allI hoare_drop_imps)
|
||||||
|
apply clarsimp
|
||||||
|
apply(wp cancel_ipc_silc_inv)+
|
||||||
|
apply auto
|
||||||
|
done
|
||||||
|
|
||||||
lemma prepare_thread_delete_reads_respects_f:
|
lemma prepare_thread_delete_reads_respects_f:
|
||||||
"reads_respects_f aag l \<top> (prepare_thread_delete thread)"
|
"reads_respects_f aag l \<top> (prepare_thread_delete thread)"
|
||||||
|
|
|
@ -116,11 +116,37 @@ lemma flush_space_valid_arch_state[wp]: "\<lbrace>valid_arch_state \<rbrace> flu
|
||||||
apply (wp load_hw_asid_wp | wpc | simp)+
|
apply (wp load_hw_asid_wp | wpc | simp)+
|
||||||
done
|
done
|
||||||
|
|
||||||
crunch globals_equiv[wp]: suspend,prepare_thread_delete "globals_equiv st"
|
lemma get_thread_state_globals_equiv[wp]:
|
||||||
|
"\<lbrace>globals_equiv s and valid_ko_at_arm\<rbrace> get_thread_state ref \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
|
||||||
|
unfolding get_thread_state_def
|
||||||
|
apply(wp set_object_globals_equiv dxo_wp_weak |simp)+
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma suspend_globals_equiv[wp]:
|
||||||
|
"\<lbrace>globals_equiv st and (\<lambda>s. t \<noteq> idle_thread s) and valid_ko_at_arm\<rbrace> suspend t \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||||
|
unfolding suspend_def
|
||||||
|
apply (wp tcb_sched_action_extended.globals_equiv dxo_wp_weak)
|
||||||
|
apply simp
|
||||||
|
apply (wp set_thread_state_globals_equiv)
|
||||||
|
apply wp+
|
||||||
|
unfolding update_restart_pc_def
|
||||||
|
apply wp+
|
||||||
|
apply clarsimp
|
||||||
|
apply (rule hoare_vcg_conj_lift)
|
||||||
|
prefer 2
|
||||||
|
apply (rule hoare_drop_imps)
|
||||||
|
apply wp+
|
||||||
|
apply (rule hoare_drop_imps)
|
||||||
|
apply wp+
|
||||||
|
apply auto
|
||||||
|
done
|
||||||
|
|
||||||
|
crunch globals_equiv[wp]: prepare_thread_delete "globals_equiv st"
|
||||||
(wp: dxo_wp_weak)
|
(wp: dxo_wp_weak)
|
||||||
|
|
||||||
lemma finalise_cap_globals_equiv:
|
lemma finalise_cap_globals_equiv:
|
||||||
"\<lbrace>globals_equiv st and valid_global_objs and valid_arch_state and pspace_aligned and valid_vspace_objs and valid_global_refs and valid_vs_lookup\<rbrace>
|
"\<lbrace>globals_equiv st and (\<lambda>s. \<forall>p. cap = ThreadCap p \<longrightarrow> p \<noteq> idle_thread s)
|
||||||
|
and valid_global_objs and valid_arch_state and pspace_aligned and valid_vspace_objs and valid_global_refs and valid_vs_lookup\<rbrace>
|
||||||
finalise_cap cap b
|
finalise_cap cap b
|
||||||
\<lbrace>\<lambda> _. globals_equiv st\<rbrace>"
|
\<lbrace>\<lambda> _. globals_equiv st\<rbrace>"
|
||||||
apply (induct cap)
|
apply (induct cap)
|
||||||
|
@ -129,14 +155,14 @@ lemma finalise_cap_globals_equiv:
|
||||||
cancel_all_signals_globals_equiv cancel_all_signals_valid_global_objs
|
cancel_all_signals_globals_equiv cancel_all_signals_valid_global_objs
|
||||||
arch_finalise_cap_globals_equiv unbind_maybe_notification_globals_equiv
|
arch_finalise_cap_globals_equiv unbind_maybe_notification_globals_equiv
|
||||||
unbind_notification_globals_equiv
|
unbind_notification_globals_equiv
|
||||||
| simp add: valid_arch_state_ko_at_arm | intro impI conjI)+
|
| clarsimp simp add: valid_arch_state_ko_at_arm | intro impI conjI)+
|
||||||
done
|
done
|
||||||
|
|
||||||
crunch valid_ko_at_arm[wp]: cap_swap_for_delete, restart "valid_ko_at_arm"
|
crunch valid_ko_at_arm[wp]: cap_swap_for_delete, restart "valid_ko_at_arm"
|
||||||
(wp: dxo_wp_weak ignore: cap_swap_ext)
|
(wp: dxo_wp_weak ignore: cap_swap_ext)
|
||||||
|
|
||||||
lemma rec_del_preservation2':
|
lemma rec_del_preservation2':
|
||||||
assumes finalise_cap_P: "\<And>cap final. \<lbrace>R and P\<rbrace> finalise_cap cap final \<lbrace>\<lambda>_.P\<rbrace>"
|
assumes finalise_cap_P: "\<And>cap final. \<lbrace>R cap and P\<rbrace> finalise_cap cap final \<lbrace>\<lambda>_.P\<rbrace>"
|
||||||
assumes set_cap_P : "\<And> cap b. \<lbrace>Q and P\<rbrace> set_cap cap b \<lbrace>\<lambda>_.P\<rbrace>"
|
assumes set_cap_P : "\<And> cap b. \<lbrace>Q and P\<rbrace> set_cap cap b \<lbrace>\<lambda>_.P\<rbrace>"
|
||||||
assumes set_cap_Q : "\<And> cap b. \<lbrace>Q\<rbrace> set_cap cap b \<lbrace>\<lambda>_.Q\<rbrace>"
|
assumes set_cap_Q : "\<And> cap b. \<lbrace>Q\<rbrace> set_cap cap b \<lbrace>\<lambda>_.Q\<rbrace>"
|
||||||
assumes empty_slot_P: "\<And> slot free. \<lbrace>Q and P\<rbrace> empty_slot slot free \<lbrace>\<lambda>_. P\<rbrace>"
|
assumes empty_slot_P: "\<And> slot free. \<lbrace>Q and P\<rbrace> empty_slot slot free \<lbrace>\<lambda>_. P\<rbrace>"
|
||||||
|
@ -146,7 +172,7 @@ lemma rec_del_preservation2':
|
||||||
assumes preemption_point_Q: "\<And> a b. \<lbrace>Q\<rbrace> preemption_point \<lbrace>\<lambda>_. Q\<rbrace>"
|
assumes preemption_point_Q: "\<And> a b. \<lbrace>Q\<rbrace> preemption_point \<lbrace>\<lambda>_. Q\<rbrace>"
|
||||||
assumes preemption_point_P: "\<And> a b. \<lbrace>Q and P\<rbrace> preemption_point \<lbrace>\<lambda>_. P\<rbrace>"
|
assumes preemption_point_P: "\<And> a b. \<lbrace>Q and P\<rbrace> preemption_point \<lbrace>\<lambda>_. P\<rbrace>"
|
||||||
assumes invs_Q: "\<And> s. invs s \<Longrightarrow> Q s"
|
assumes invs_Q: "\<And> s. invs s \<Longrightarrow> Q s"
|
||||||
assumes invs_R: "\<And> s. invs s \<Longrightarrow> R s"
|
assumes invs_R: " \<And>s slot cap. invs s \<Longrightarrow> caps_of_state s slot = Some cap \<Longrightarrow> R cap s"
|
||||||
shows
|
shows
|
||||||
"s \<turnstile> \<lbrace>\<lambda>s. invs s \<and> P s \<and> Q s \<and> emptyable (slot_rdcall call) s \<and> valid_rec_del_call call s\<rbrace>
|
"s \<turnstile> \<lbrace>\<lambda>s. invs s \<and> P s \<and> Q s \<and> emptyable (slot_rdcall call) s \<and> valid_rec_del_call call s\<rbrace>
|
||||||
rec_del call
|
rec_del call
|
||||||
|
@ -248,10 +274,11 @@ done
|
||||||
qed
|
qed
|
||||||
|
|
||||||
lemma rec_del_preservation2:
|
lemma rec_del_preservation2:
|
||||||
"\<lbrakk>\<And>cap final. \<lbrace>R and P\<rbrace> finalise_cap cap final \<lbrace>\<lambda>_. P\<rbrace>; \<And>cap b. \<lbrace>Q and P\<rbrace> set_cap cap b \<lbrace>\<lambda>_. P\<rbrace>;
|
"\<lbrakk>\<And>cap final. \<lbrace>R cap and P\<rbrace> finalise_cap cap final \<lbrace>\<lambda>_. P\<rbrace>; \<And>cap b. \<lbrace>Q and P\<rbrace> set_cap cap b \<lbrace>\<lambda>_. P\<rbrace>;
|
||||||
\<And>cap b. invariant (set_cap cap b) Q; \<And>slot free. \<lbrace>Q and P\<rbrace> empty_slot slot free \<lbrace>\<lambda>_. P\<rbrace>;
|
\<And>cap b. invariant (set_cap cap b) Q; \<And>slot free. \<lbrace>Q and P\<rbrace> empty_slot slot free \<lbrace>\<lambda>_. P\<rbrace>;
|
||||||
\<And>slot free. invariant (empty_slot slot free) Q; \<And>a b. invariant (cap_swap_for_delete a b) Q;
|
\<And>slot free. invariant (empty_slot slot free) Q; \<And>a b. invariant (cap_swap_for_delete a b) Q;
|
||||||
\<And>a b. \<lbrace>Q and P\<rbrace> cap_swap_for_delete a b \<lbrace>\<lambda>_. P\<rbrace>; \<And>s. invs s \<Longrightarrow> Q s; \<And>s. invs s \<Longrightarrow> R s;
|
\<And>a b. \<lbrace>Q and P\<rbrace> cap_swap_for_delete a b \<lbrace>\<lambda>_. P\<rbrace>; \<And>s. invs s \<Longrightarrow> Q s;
|
||||||
|
\<And>s slot cap. invs s \<Longrightarrow> caps_of_state s slot = Some cap \<Longrightarrow> R cap s;
|
||||||
invariant preemption_point Q; \<lbrace>Q and P\<rbrace> preemption_point \<lbrace>\<lambda>_. P\<rbrace>\<rbrakk>
|
invariant preemption_point Q; \<lbrace>Q and P\<rbrace> preemption_point \<lbrace>\<lambda>_. P\<rbrace>\<rbrakk>
|
||||||
\<Longrightarrow> \<lbrace>\<lambda>s. invs s \<and> P s \<and> emptyable (slot_rdcall call) s \<and> valid_rec_del_call call s\<rbrace> rec_del call
|
\<Longrightarrow> \<lbrace>\<lambda>s. invs s \<and> P s \<and> emptyable (slot_rdcall call) s \<and> valid_rec_del_call call s\<rbrace> rec_del call
|
||||||
\<lbrace>\<lambda>r. P\<rbrace>"
|
\<lbrace>\<lambda>r. P\<rbrace>"
|
||||||
|
@ -273,13 +300,24 @@ lemma valid_ko_at_arm_irq_state_independent_A[simp, intro!]:
|
||||||
apply(auto simp: irq_state_independent_A_def valid_ko_at_arm_def)
|
apply(auto simp: irq_state_independent_A_def valid_ko_at_arm_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma no_cap_to_idle_thread'': "valid_global_refs s \<Longrightarrow> caps_of_state s ref \<noteq> Some (ThreadCap (idle_thread s))"
|
||||||
|
apply (clarsimp simp add: valid_global_refs_def valid_refs_def cte_wp_at_caps_of_state)
|
||||||
|
apply (drule_tac x="fst ref" in spec)
|
||||||
|
apply (drule_tac x="snd ref" in spec)
|
||||||
|
apply (simp add: cap_range_def global_refs_def)
|
||||||
|
done
|
||||||
|
|
||||||
lemma rec_del_globals_equiv:
|
lemma rec_del_globals_equiv:
|
||||||
"\<lbrace>\<lambda>s. invs s \<and> globals_equiv st s \<and> emptyable (slot_rdcall call) s \<and> valid_rec_del_call call s\<rbrace>
|
"\<lbrace>\<lambda>s. invs s \<and> globals_equiv st s \<and> emptyable (slot_rdcall call) s
|
||||||
|
\<and> valid_rec_del_call call s\<rbrace>
|
||||||
rec_del call
|
rec_del call
|
||||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||||
apply (wp rec_del_preservation2[where Q="valid_ko_at_arm" and R="valid_global_objs and valid_arch_state and pspace_aligned and valid_vspace_objs and
|
apply (wp rec_del_preservation2[where Q="valid_ko_at_arm"
|
||||||
valid_global_refs and
|
and R="\<lambda>cap s. valid_global_objs s \<and> valid_arch_state s
|
||||||
valid_vs_lookup"] finalise_cap_globals_equiv)
|
\<and> pspace_aligned s \<and> valid_vspace_objs s
|
||||||
|
\<and> valid_global_refs s \<and> valid_vs_lookup s
|
||||||
|
\<and> (\<forall>p. cap = ThreadCap p \<longrightarrow> p \<noteq> idle_thread s)
|
||||||
|
"] finalise_cap_globals_equiv)
|
||||||
apply simp
|
apply simp
|
||||||
apply (wp set_cap_globals_equiv'')
|
apply (wp set_cap_globals_equiv'')
|
||||||
apply simp
|
apply simp
|
||||||
|
@ -288,7 +326,7 @@ lemma rec_del_globals_equiv:
|
||||||
apply (wp empty_slot_valid_ko_at_arm)+
|
apply (wp empty_slot_valid_ko_at_arm)+
|
||||||
apply simp
|
apply simp
|
||||||
apply (simp add: invs_valid_ko_at_arm)
|
apply (simp add: invs_valid_ko_at_arm)
|
||||||
apply (simp add: invs_def valid_state_def valid_arch_caps_def valid_pspace_def)
|
apply (clarsimp simp: invs_def valid_state_def valid_arch_caps_def valid_pspace_def no_cap_to_idle_thread'')
|
||||||
apply (wp preemption_point_inv | simp)+
|
apply (wp preemption_point_inv | simp)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
|
@ -514,11 +514,17 @@ lemma suspend_unlive':
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live) t\<rbrace>"
|
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live) t\<rbrace>"
|
||||||
apply (simp add: suspend_def set_thread_state_def set_object_def get_object_def)
|
apply (simp add: suspend_def set_thread_state_def set_object_def get_object_def)
|
||||||
|
supply hoare_vcg_if_split[wp_split del] if_splits[split del]
|
||||||
apply (wp | simp only: obj_at_exst_update)+
|
apply (wp | simp only: obj_at_exst_update)+
|
||||||
apply (simp add: obj_at_def)
|
apply (simp add: obj_at_def live_def hyp_live_def)
|
||||||
apply (rule_tac Q="\<lambda>_. bound_tcb_at ((=) None) t" in hoare_strengthen_post)
|
apply (rule_tac Q="\<lambda>_. bound_tcb_at ((=) None) t" in hoare_strengthen_post)
|
||||||
|
supply hoare_vcg_if_split[wp_split]
|
||||||
apply wp
|
apply wp
|
||||||
apply (auto simp: pred_tcb_def2 live_def hyp_live_def dest: refs_of_live)
|
apply (auto simp: pred_tcb_def2)[1]
|
||||||
|
apply (simp flip: if_split)
|
||||||
|
apply wp
|
||||||
|
apply wp
|
||||||
|
apply simp
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (* finalise_cap_replaceable *) [Finalise_AI_asms]:
|
lemma (* finalise_cap_replaceable *) [Finalise_AI_asms]:
|
||||||
|
|
|
@ -2398,8 +2398,19 @@ lemma valid_arch_mdb_eqI:
|
||||||
shows "valid_arch_mdb (is original_cap s') (caps_of_state s')"
|
shows "valid_arch_mdb (is original_cap s') (caps_of_state s')"
|
||||||
by (clarsimp simp: valid_arch_mdb_def)
|
by (clarsimp simp: valid_arch_mdb_def)
|
||||||
|
|
||||||
|
lemma arch_tcb_context_absorbs[simp]:
|
||||||
|
"arch_tcb_context_set uc2 (arch_tcb_context_set uc1 a_tcb) \<equiv> arch_tcb_context_set uc2 a_tcb"
|
||||||
|
by (simp add: arch_tcb_context_set_def)
|
||||||
|
|
||||||
|
lemma arch_tcb_context_get_set[simp]:
|
||||||
|
"arch_tcb_context_get (arch_tcb_context_set uc a_tcb) = uc"
|
||||||
|
by (simp add: arch_tcb_context_get_def arch_tcb_context_set_def)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
declare ARM.arch_tcb_context_absorbs[simp]
|
||||||
|
declare ARM.arch_tcb_context_get_set[simp]
|
||||||
|
|
||||||
setup {* Add_Locale_Code_Defs.setup "ARM" *}
|
setup {* Add_Locale_Code_Defs.setup "ARM" *}
|
||||||
setup {* Add_Locale_Code_Defs.setup "ARM_A" *}
|
setup {* Add_Locale_Code_Defs.setup "ARM_A" *}
|
||||||
|
|
||||||
|
|
|
@ -766,6 +766,14 @@ lemma empty_fail_clearMemory [simp, intro!]:
|
||||||
by (simp add: clearMemory_def mapM_x_mapM ef_storeWord)
|
by (simp add: clearMemory_def mapM_x_mapM ef_storeWord)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
lemmas msgRegisters_A_unfold
|
||||||
|
= msg_registers_def
|
||||||
|
msgRegisters_def
|
||||||
|
[unfolded upto_enum_def, simplified,
|
||||||
|
unfolded fromEnum_def enum_register, simplified,
|
||||||
|
unfolded toEnum_def enum_register, simplified]
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
|
@ -2513,9 +2513,22 @@ lemma valid_arch_mdb_eqI:
|
||||||
shows "valid_arch_mdb (is original_cap s') (caps_of_state s')"
|
shows "valid_arch_mdb (is original_cap s') (caps_of_state s')"
|
||||||
by (clarsimp simp: valid_arch_mdb_def)
|
by (clarsimp simp: valid_arch_mdb_def)
|
||||||
|
|
||||||
end
|
lemma arch_tcb_context_absorbs[simp]:
|
||||||
|
"arch_tcb_context_set uc2 (arch_tcb_context_set uc1 a_tcb) \<equiv> arch_tcb_context_set uc2 a_tcb"
|
||||||
|
apply (simp add: arch_tcb_context_set_def)
|
||||||
|
done
|
||||||
|
|
||||||
setup {* Add_Locale_Code_Defs.setup "ARM" *}
|
lemma arch_tcb_context_get_set[simp]:
|
||||||
setup {* Add_Locale_Code_Defs.setup "ARM_A" *}
|
"arch_tcb_context_get (arch_tcb_context_set uc a_tcb) = uc"
|
||||||
|
apply (simp add: arch_tcb_context_get_def arch_tcb_context_set_def)
|
||||||
|
done
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
declare ARM_HYP.arch_tcb_context_absorbs[simp]
|
||||||
|
declare ARM_HYP.arch_tcb_context_get_set[simp]
|
||||||
|
|
||||||
|
setup {* Add_Locale_Code_Defs.setup "ARM_HYP" *}
|
||||||
|
setup {* Add_Locale_Code_Defs.setup "ARM_HYP_A" *}
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
|
@ -33,13 +33,16 @@ locale BCorres2_AI =
|
||||||
"bcorres (arch_switch_to_idle_thread :: 'a state \<Rightarrow> _)
|
"bcorres (arch_switch_to_idle_thread :: 'a state \<Rightarrow> _)
|
||||||
arch_switch_to_idle_thread"
|
arch_switch_to_idle_thread"
|
||||||
|
|
||||||
crunch (bcorres)bcorres[wp]: "IpcCancel_A.suspend",deleting_irq_handler truncate_state
|
crunch (bcorres)bcorres[wp]: deleting_irq_handler truncate_state
|
||||||
(simp: gets_the_def swp_def)
|
(simp: gets_the_def swp_def)
|
||||||
|
|
||||||
lemma finalise_cap_bcorres[wp]: "bcorres (finalise_cap a b) (finalise_cap a b)"
|
lemma update_restart_pc_bcorres[wp]:
|
||||||
apply (cases a)
|
"bcorres (update_restart_pc t) (update_restart_pc t)"
|
||||||
apply (wp | wpc | simp | intro impI allI conjI)+
|
by (wp
|
||||||
done
|
| clarsimp simp: update_restart_pc_def as_user_def bind_select_f_bind'
|
||||||
|
split: prod.splits)+
|
||||||
|
|
||||||
|
crunch (bcorres)bcorres[wp]: suspend, finalise_cap truncate_state
|
||||||
|
|
||||||
definition all_but_exst where
|
definition all_but_exst where
|
||||||
"all_but_exst P \<equiv> (\<lambda>s. P (kheap s) (cdt s) (is_original_cap s)
|
"all_but_exst P \<equiv> (\<lambda>s. P (kheap s) (cdt s) (is_original_cap s)
|
||||||
|
@ -274,8 +277,7 @@ global_interpretation cap_move_ext: is_extended "cap_move_ext a b c d"
|
||||||
lemmas rec_del_simps_ext =
|
lemmas rec_del_simps_ext =
|
||||||
rec_del.simps [THEN ext[where f="rec_del args" for args]]
|
rec_del.simps [THEN ext[where f="rec_del args" for args]]
|
||||||
|
|
||||||
|
lemma rec_del_s_bcorres[wp]:
|
||||||
lemma rec_del_s_bcorres:
|
|
||||||
notes rec_del.simps[simp del]
|
notes rec_del.simps[simp del]
|
||||||
shows
|
shows
|
||||||
"s_bcorres (rec_del c) (rec_del c) s"
|
"s_bcorres (rec_del c) (rec_del c) s"
|
||||||
|
@ -311,9 +313,17 @@ shows
|
||||||
qed
|
qed
|
||||||
|
|
||||||
|
|
||||||
lemmas rec_del_bcorres = use_sbcorres_underlying[OF rec_del_s_bcorres]
|
lemmas rec_del_bcorres[wp] = use_sbcorres_underlying[OF rec_del_s_bcorres]
|
||||||
|
|
||||||
crunch (bcorres)bcorres[wp]: cap_delete truncate_state
|
lemma cap_delete_bcorres'[wp]:
|
||||||
|
assumes finalise_cap_bcorres[wp]:
|
||||||
|
"\<And>r ra. bcorres (finalise_cap r ra :: 'a::state_ext state \<Rightarrow> _) (finalise_cap r ra)"
|
||||||
|
shows "bcorres (cap_delete slot :: 'a state \<Rightarrow> _) (cap_delete slot)"
|
||||||
|
unfolding cap_delete_def
|
||||||
|
apply wp
|
||||||
|
apply (simp add: returnOk_bcorres_underlying)
|
||||||
|
apply (wp rec_del_bcorres)
|
||||||
|
done
|
||||||
|
|
||||||
lemma cap_revoke_s_bcorres:
|
lemma cap_revoke_s_bcorres:
|
||||||
shows
|
shows
|
||||||
|
@ -332,7 +342,7 @@ proof (induct rule: cap_revoke.induct[where ?a1.0=s])
|
||||||
done
|
done
|
||||||
qed
|
qed
|
||||||
|
|
||||||
lemmas cap_revoke_bcorres = use_sbcorres_underlying[OF cap_revoke_s_bcorres]
|
lemmas cap_revoke_bcorres[wp] = use_sbcorres_underlying[OF cap_revoke_s_bcorres]
|
||||||
|
|
||||||
crunch (bcorres)bcorres[wp]: "Tcb_A.restart",as_user,option_update_thread truncate_state (simp: gets_the_def ignore: clearMemory check_cap_at gets_the getRegister setRegister getRestartPC setNextPC)
|
crunch (bcorres)bcorres[wp]: "Tcb_A.restart",as_user,option_update_thread truncate_state (simp: gets_the_def ignore: clearMemory check_cap_at gets_the getRegister setRegister getRestartPC setNextPC)
|
||||||
|
|
||||||
|
|
|
@ -2393,16 +2393,17 @@ lemma reply_cancel_ipc_emptyable[wp]:
|
||||||
|
|
||||||
crunch emptyable[wp]: cancel_ipc "emptyable sl"
|
crunch emptyable[wp]: cancel_ipc "emptyable sl"
|
||||||
|
|
||||||
|
crunch emptyable[wp]: update_restart_pc "emptyable sl"
|
||||||
|
(rule: emptyable_lift)
|
||||||
|
|
||||||
lemma suspend_emptyable[wp]:
|
lemma suspend_emptyable[wp]:
|
||||||
"\<lbrace>invs and emptyable sl and valid_mdb\<rbrace> IpcCancel_A.suspend l \<lbrace>\<lambda>_. emptyable sl\<rbrace>"
|
"\<lbrace>invs and emptyable sl and valid_mdb\<rbrace> suspend l \<lbrace>\<lambda>_. emptyable sl\<rbrace>"
|
||||||
apply (simp add: IpcCancel_A.suspend_def)
|
apply (simp add: IpcCancel_A.suspend_def)
|
||||||
apply (wp|simp)+
|
apply (wp|simp)+
|
||||||
apply (wp emptyable_lift sts_st_tcb_at_cases)+
|
apply (wp emptyable_lift sts_st_tcb_at_cases)+
|
||||||
apply simp
|
apply (wpsimp wp: set_thread_state_cte_wp_at)+
|
||||||
apply (wp set_thread_state_cte_wp_at | simp)+
|
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
||||||
crunch emptyable[wp]: do_machine_op "emptyable sl"
|
crunch emptyable[wp]: do_machine_op "emptyable sl"
|
||||||
(rule: emptyable_lift)
|
(rule: emptyable_lift)
|
||||||
|
|
||||||
|
|
|
@ -97,6 +97,10 @@ locale DetSchedDomainTime_AI =
|
||||||
assumes arch_post_cap_deletion_domain_list_inv'[wp]:
|
assumes arch_post_cap_deletion_domain_list_inv'[wp]:
|
||||||
"\<And>P ft. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_post_cap_deletion ft \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
|
"\<And>P ft. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> arch_post_cap_deletion ft \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
|
||||||
|
|
||||||
|
crunches update_restart_pc
|
||||||
|
for domain_list[wp]: "\<lambda>s. P (domain_list s)"
|
||||||
|
and domain_time[wp]: "\<lambda>s. P (domain_time s)"
|
||||||
|
|
||||||
locale DetSchedDomainTime_AI_2 = DetSchedDomainTime_AI +
|
locale DetSchedDomainTime_AI_2 = DetSchedDomainTime_AI +
|
||||||
assumes handle_hypervisor_fault_domain_list_inv'[wp]:
|
assumes handle_hypervisor_fault_domain_list_inv'[wp]:
|
||||||
"\<And>P t f. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_hypervisor_fault t f \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
|
"\<And>P t f. \<lbrace>\<lambda>s. P (domain_list s)\<rbrace> handle_hypervisor_fault t f \<lbrace>\<lambda>_ s. P (domain_list s)\<rbrace>"
|
||||||
|
|
|
@ -1356,6 +1356,13 @@ lemma schedule_valid_sched:
|
||||||
st_tcb_at_def obj_at_def)?)
|
st_tcb_at_def obj_at_def)?)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
crunch ct_not_in_q[wp]: as_user ct_not_in_q
|
||||||
|
(wp: ct_not_in_q_lift)
|
||||||
|
|
||||||
|
crunches update_restart_pc
|
||||||
|
for ct_not_in_q[wp]: "\<lambda>s. ct_not_in_q s"
|
||||||
|
|
||||||
|
|
||||||
crunch ct_not_in_q[wp]: finalise_cap ct_not_in_q
|
crunch ct_not_in_q[wp]: finalise_cap ct_not_in_q
|
||||||
(wp: crunch_wps hoare_drop_imps hoare_unless_wp select_inv mapM_wp
|
(wp: crunch_wps hoare_drop_imps hoare_unless_wp select_inv mapM_wp
|
||||||
subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action)
|
subset_refl if_fun_split simp: crunch_simps ignore: tcb_sched_action)
|
||||||
|
@ -1454,6 +1461,9 @@ lemma unbind_notification_valid_sched[wp]:
|
||||||
apply (wp set_bound_notification_valid_sched, clarsimp)
|
apply (wp set_bound_notification_valid_sched, clarsimp)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
crunches update_restart_pc
|
||||||
|
for valid_etcbs[wp]: "valid_etcbs"
|
||||||
|
|
||||||
context DetSchedSchedule_AI begin
|
context DetSchedSchedule_AI begin
|
||||||
|
|
||||||
crunch valid_etcbs[wp]: finalise_cap valid_etcbs
|
crunch valid_etcbs[wp]: finalise_cap valid_etcbs
|
||||||
|
@ -1594,15 +1604,25 @@ crunch simple_sched_action[wp]: tcb_sched_action, update_cdt_list simple_sched_a
|
||||||
|
|
||||||
context DetSchedSchedule_AI begin
|
context DetSchedSchedule_AI begin
|
||||||
|
|
||||||
|
crunches update_restart_pc
|
||||||
|
for simple_sched_action[wp]: "simple_sched_action"
|
||||||
|
and valid_sched[wp]: "valid_sched"
|
||||||
|
(simp: crunch_simps ignore: set_object)
|
||||||
|
|
||||||
crunch simple_sched_action[wp]: finalise_cap simple_sched_action
|
crunch simple_sched_action[wp]: finalise_cap simple_sched_action
|
||||||
(wp: hoare_drop_imps mapM_x_wp mapM_wp select_wp subset_refl
|
(wp: hoare_drop_imps mapM_x_wp mapM_wp select_wp subset_refl
|
||||||
simp: unless_def if_fun_split)
|
simp: unless_def if_fun_split)
|
||||||
|
|
||||||
lemma suspend_valid_sched[wp]:
|
lemma suspend_valid_sched[wp]:
|
||||||
"\<lbrace>valid_sched and simple_sched_action\<rbrace> suspend t \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
|
notes seq_ext_inv = seq_ext[where A=I and B="\<lambda>_. I" for I]
|
||||||
|
shows "\<lbrace>valid_sched and simple_sched_action\<rbrace> suspend t \<lbrace>\<lambda>rv. valid_sched\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
apply (simp add: suspend_def)
|
||||||
apply (rule seq_ext)
|
apply (rule seq_ext_inv)
|
||||||
apply (rule_tac R="K $ valid_sched and simple_sched_action" in hoare_strengthen_post[rotated])
|
apply wpsimp
|
||||||
|
apply (rule seq_ext_inv)
|
||||||
|
apply wp
|
||||||
|
apply (rule seq_ext_inv)
|
||||||
|
apply wpsimp
|
||||||
apply (wp tcb_sched_action_dequeue_strong_valid_sched
|
apply (wp tcb_sched_action_dequeue_strong_valid_sched
|
||||||
| simp)+
|
| simp)+
|
||||||
apply (simp add: set_thread_state_def)
|
apply (simp add: set_thread_state_def)
|
||||||
|
@ -1958,9 +1978,6 @@ crunch valid_sched[wp]: store_word_offs valid_sched
|
||||||
crunch exst[wp]: set_mrs, as_user "\<lambda>s. P (exst s)"
|
crunch exst[wp]: set_mrs, as_user "\<lambda>s. P (exst s)"
|
||||||
(simp: crunch_simps wp: crunch_wps)
|
(simp: crunch_simps wp: crunch_wps)
|
||||||
|
|
||||||
crunch ct_not_in_q[wp]: as_user ct_not_in_q
|
|
||||||
(wp: ct_not_in_q_lift)
|
|
||||||
|
|
||||||
crunch valid_sched[wp]: set_mrs valid_sched
|
crunch valid_sched[wp]: set_mrs valid_sched
|
||||||
(wp: valid_sched_lift)
|
(wp: valid_sched_lift)
|
||||||
|
|
||||||
|
|
|
@ -3979,6 +3979,8 @@ crunch (empty_fail) empty_fail[wp]: dec_domain_time
|
||||||
global_interpretation dec_domain_time_extended: is_extended "dec_domain_time"
|
global_interpretation dec_domain_time_extended: is_extended "dec_domain_time"
|
||||||
by (unfold_locales; wp)
|
by (unfold_locales; wp)
|
||||||
|
|
||||||
|
crunch valid_list[wp]: update_restart_pc "valid_list"
|
||||||
|
|
||||||
context Deterministic_AI_1 begin
|
context Deterministic_AI_1 begin
|
||||||
crunch valid_list[wp]: invoke_tcb valid_list
|
crunch valid_list[wp]: invoke_tcb valid_list
|
||||||
(wp: mapM_x_wp' ignore: check_cap_at simp: check_cap_at_def)
|
(wp: mapM_x_wp' ignore: check_cap_at simp: check_cap_at_def)
|
||||||
|
|
|
@ -51,6 +51,10 @@ definition
|
||||||
| ArchObjectCap acap \<Rightarrow> arch_post_cap_delete_pre cap cs
|
| ArchObjectCap acap \<Rightarrow> arch_post_cap_delete_pre cap cs
|
||||||
| _ \<Rightarrow> False"
|
| _ \<Rightarrow> False"
|
||||||
|
|
||||||
|
lemma update_restart_pc_caps_of_state[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> update_restart_pc t \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
|
||||||
|
by (simp add: update_restart_pc_def as_user_caps)
|
||||||
|
|
||||||
locale Finalise_AI_1 =
|
locale Finalise_AI_1 =
|
||||||
fixes state_ext_type1 :: "('a :: state_ext) itself"
|
fixes state_ext_type1 :: "('a :: state_ext) itself"
|
||||||
fixes state_ext_type2 :: "('b :: state_ext) itself"
|
fixes state_ext_type2 :: "('b :: state_ext) itself"
|
||||||
|
@ -143,6 +147,7 @@ locale Finalise_AI_1 =
|
||||||
assumes prepare_thread_delete_caps_of_state:
|
assumes prepare_thread_delete_caps_of_state:
|
||||||
"\<And>P t. \<lbrace>\<lambda>(s :: 'a state). P (caps_of_state s)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
|
"\<And>P t. \<lbrace>\<lambda>(s :: 'a state). P (caps_of_state s)\<rbrace> prepare_thread_delete t \<lbrace>\<lambda>_ s. P (caps_of_state s)\<rbrace>"
|
||||||
|
|
||||||
|
|
||||||
text {* Properties about empty_slot *}
|
text {* Properties about empty_slot *}
|
||||||
|
|
||||||
definition
|
definition
|
||||||
|
@ -511,16 +516,13 @@ lemma cancel_ipc_caps_of_state:
|
||||||
apply (clarsimp simp: fun_upd_def[symmetric] cte_wp_at_caps_of_state)
|
apply (clarsimp simp: fun_upd_def[symmetric] cte_wp_at_caps_of_state)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
||||||
lemma suspend_caps_of_state:
|
lemma suspend_caps_of_state:
|
||||||
"\<lbrace>\<lambda>s. (\<forall>p. cte_wp_at can_fast_finalise p s
|
"\<lbrace>\<lambda>s. (\<forall>p. cte_wp_at can_fast_finalise p s
|
||||||
\<longrightarrow> P ((caps_of_state s) (p \<mapsto> cap.NullCap)))
|
\<longrightarrow> P ((caps_of_state s) (p \<mapsto> cap.NullCap)))
|
||||||
\<and> P (caps_of_state s)\<rbrace>
|
\<and> P (caps_of_state s)\<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
|
\<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
|
||||||
unfolding suspend_def
|
by (wpsimp wp: cancel_ipc_caps_of_state simp: suspend_def fun_upd_def[symmetric])+
|
||||||
by (wpsimp wp: cancel_ipc_caps_of_state simp: fun_upd_def[symmetric])
|
|
||||||
|
|
||||||
|
|
||||||
lemma suspend_final_cap:
|
lemma suspend_final_cap:
|
||||||
"\<lbrace>\<lambda>s. is_final_cap' cap s \<and> \<not> can_fast_finalise cap
|
"\<lbrace>\<lambda>s. is_final_cap' cap s \<and> \<not> can_fast_finalise cap
|
||||||
|
@ -821,7 +823,7 @@ lemma cap_delete_one_cte_wp_at_preserved:
|
||||||
done
|
done
|
||||||
|
|
||||||
interpretation delete_one_pre
|
interpretation delete_one_pre
|
||||||
by (unfold_locales, wp cap_delete_one_cte_wp_at_preserved)
|
by (unfold_locales; wpsimp wp: cap_delete_one_cte_wp_at_preserved)
|
||||||
|
|
||||||
lemma (in Finalise_AI_1) finalise_cap_equal_cap[wp]:
|
lemma (in Finalise_AI_1) finalise_cap_equal_cap[wp]:
|
||||||
"\<lbrace>cte_wp_at ((=) cap) sl\<rbrace>
|
"\<lbrace>cte_wp_at ((=) cap) sl\<rbrace>
|
||||||
|
@ -1038,7 +1040,8 @@ locale Finalise_AI_3 = Finalise_AI_2 a b
|
||||||
prepare_thread_delete t
|
prepare_thread_delete t
|
||||||
\<lbrace>\<lambda>_ s. P (interrupt_irq_node s)\<rbrace>"
|
\<lbrace>\<lambda>_ s. P (interrupt_irq_node s)\<rbrace>"
|
||||||
|
|
||||||
crunch irq_node[wp]: suspend, unbind_maybe_notification, unbind_notification "\<lambda>s. P (interrupt_irq_node s)"
|
crunches suspend, unbind_maybe_notification, unbind_notification
|
||||||
|
for irq_node[wp]: "\<lambda>s. P (interrupt_irq_node s)"
|
||||||
(wp: crunch_wps select_wp simp: crunch_simps)
|
(wp: crunch_wps select_wp simp: crunch_simps)
|
||||||
|
|
||||||
crunch irq_node[wp]: deleting_irq_handler "\<lambda>s. P (interrupt_irq_node s)"
|
crunch irq_node[wp]: deleting_irq_handler "\<lambda>s. P (interrupt_irq_node s)"
|
||||||
|
|
|
@ -180,9 +180,23 @@ lemma fast_finalise_misc[wp]:
|
||||||
locale IpcCancel_AI =
|
locale IpcCancel_AI =
|
||||||
fixes state_ext :: "('a::state_ext) itself"
|
fixes state_ext :: "('a::state_ext) itself"
|
||||||
assumes arch_post_cap_deletion_typ_at[wp]:
|
assumes arch_post_cap_deletion_typ_at[wp]:
|
||||||
"\<And>P T p. \<lbrace>\<lambda>(s :: 'a state). P (typ_at T p s)\<rbrace> arch_post_cap_deletion acap \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
"\<And>P T p acap. \<lbrace>\<lambda>(s :: 'a state). P (typ_at T p s)\<rbrace> arch_post_cap_deletion acap \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
||||||
assumes arch_post_cap_deletion_idle_thread[wp]:
|
assumes arch_post_cap_deletion_idle_thread[wp]:
|
||||||
"\<And>P. \<lbrace>\<lambda>(s :: 'a state). P (idle_thread s)\<rbrace> arch_post_cap_deletion acap \<lbrace>\<lambda>rv s. P (idle_thread s)\<rbrace>"
|
"\<And>P acap. \<lbrace>\<lambda>(s :: 'a state). P (idle_thread s)\<rbrace> arch_post_cap_deletion acap \<lbrace>\<lambda>rv s. P (idle_thread s)\<rbrace>"
|
||||||
|
|
||||||
|
crunches update_restart_pc
|
||||||
|
for typ_at[wp]: "\<lambda>s. P (typ_at ty ptr s)"
|
||||||
|
(* NB: Q needed for following has_reply_cap proof *)
|
||||||
|
and cte_wp_at[wp]: "\<lambda>s. Q (cte_wp_at P cte s)"
|
||||||
|
and idle_thread[wp]: "\<lambda>s. P (idle_thread s)"
|
||||||
|
and pred_tcb_at[wp]: "\<lambda>s. pred_tcb_at P proj tcb s"
|
||||||
|
and invs[wp]: "\<lambda>s. invs s"
|
||||||
|
|
||||||
|
lemma update_restart_pc_has_reply_cap[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. \<not> has_reply_cap t s\<rbrace> update_restart_pc t \<lbrace>\<lambda>_ s. \<not> has_reply_cap t s\<rbrace>"
|
||||||
|
apply (simp add: has_reply_cap_def)
|
||||||
|
apply (wp hoare_vcg_all_lift)
|
||||||
|
done
|
||||||
|
|
||||||
crunch st_tcb_at_simple[wp]: reply_cancel_ipc "st_tcb_at simple t"
|
crunch st_tcb_at_simple[wp]: reply_cancel_ipc "st_tcb_at simple t"
|
||||||
(wp: crunch_wps select_wp sts_st_tcb_at_cases thread_set_no_change_tcb_state
|
(wp: crunch_wps select_wp sts_st_tcb_at_cases thread_set_no_change_tcb_state
|
||||||
|
@ -587,27 +601,24 @@ lemma (in delete_one_abs) cancel_ipc_no_reply_cap[wp]:
|
||||||
elim!: pred_tcb_weakenE)+
|
elim!: pred_tcb_weakenE)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
||||||
lemma (in delete_one_abs) suspend_invs[wp]:
|
lemma (in delete_one_abs) suspend_invs[wp]:
|
||||||
"\<lbrace>invs and tcb_at t and (\<lambda>s. t \<noteq> idle_thread s)\<rbrace>
|
"\<lbrace>invs and tcb_at t and (\<lambda>s. t \<noteq> idle_thread s)\<rbrace>
|
||||||
(suspend t :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. invs\<rbrace>"
|
(suspend t :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. invs\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
by (wp sts_invs_minor user_getreg_inv as_user_invs sts_invs_minor cancel_ipc_invs
|
||||||
apply (wp sts_invs_minor cancel_ipc_invs cancel_ipc_no_reply_cap
|
cancel_ipc_no_reply_cap
|
||||||
| strengthen no_refs_simple_strg | simp)+
|
| strengthen no_refs_simple_strg
|
||||||
done
|
| simp add: suspend_def)+
|
||||||
|
|
||||||
context IpcCancel_AI begin
|
context IpcCancel_AI begin
|
||||||
|
|
||||||
lemma suspend_typ_at [wp]:
|
lemma suspend_typ_at [wp]:
|
||||||
"\<lbrace>\<lambda>(s::'a state). P (typ_at T p s)\<rbrace> suspend t \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
"\<lbrace>\<lambda>(s::'a state). P (typ_at T p s)\<rbrace> suspend t \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>"
|
||||||
by (simp add: suspend_def | wp)+
|
by (wpsimp simp: suspend_def)
|
||||||
|
|
||||||
|
|
||||||
lemma suspend_valid_cap:
|
lemma suspend_valid_cap:
|
||||||
"\<lbrace>valid_cap c\<rbrace> suspend tcb \<lbrace>\<lambda>_. (valid_cap c) :: 'a state \<Rightarrow> bool\<rbrace>"
|
"\<lbrace>valid_cap c\<rbrace> suspend tcb \<lbrace>\<lambda>_. (valid_cap c) :: 'a state \<Rightarrow> bool\<rbrace>"
|
||||||
by (wp valid_cap_typ)
|
by (wp valid_cap_typ)
|
||||||
|
|
||||||
|
|
||||||
lemma suspend_tcb[wp]:
|
lemma suspend_tcb[wp]:
|
||||||
"\<lbrace>tcb_at t'\<rbrace> suspend t \<lbrace>\<lambda>rv. (tcb_at t') :: 'a state \<Rightarrow> bool\<rbrace>"
|
"\<lbrace>tcb_at t'\<rbrace> suspend t \<lbrace>\<lambda>rv. (tcb_at t') :: 'a state \<Rightarrow> bool\<rbrace>"
|
||||||
by (simp add: tcb_at_typ) wp
|
by (simp add: tcb_at_typ) wp
|
||||||
|
@ -629,7 +640,6 @@ locale delete_one_pre =
|
||||||
"(\<And>cap. P cap \<Longrightarrow> \<not> can_fast_finalise cap) \<Longrightarrow>
|
"(\<And>cap. P cap \<Longrightarrow> \<not> can_fast_finalise cap) \<Longrightarrow>
|
||||||
\<lbrace>cte_wp_at P sl\<rbrace> (cap_delete_one sl' :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. cte_wp_at P sl\<rbrace>"
|
\<lbrace>cte_wp_at P sl\<rbrace> (cap_delete_one sl' :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. cte_wp_at P sl\<rbrace>"
|
||||||
|
|
||||||
|
|
||||||
lemma (in delete_one_pre) reply_cancel_ipc_cte_wp_at_preserved:
|
lemma (in delete_one_pre) reply_cancel_ipc_cte_wp_at_preserved:
|
||||||
"(\<And>cap. P cap \<Longrightarrow> \<not> can_fast_finalise cap) \<Longrightarrow>
|
"(\<And>cap. P cap \<Longrightarrow> \<not> can_fast_finalise cap) \<Longrightarrow>
|
||||||
\<lbrace>cte_wp_at P p\<rbrace> (reply_cancel_ipc t :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. cte_wp_at P p\<rbrace>"
|
\<lbrace>cte_wp_at P p\<rbrace> (reply_cancel_ipc t :: (unit,'a) s_monad) \<lbrace>\<lambda>rv. cte_wp_at P p\<rbrace>"
|
||||||
|
@ -649,11 +659,10 @@ lemma (in delete_one_pre) cancel_ipc_cte_wp_at_preserved:
|
||||||
apply (wp reply_cancel_ipc_cte_wp_at_preserved | wpcw | simp)+
|
apply (wp reply_cancel_ipc_cte_wp_at_preserved | wpcw | simp)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
||||||
lemma (in delete_one_pre) suspend_cte_wp_at_preserved:
|
lemma (in delete_one_pre) suspend_cte_wp_at_preserved:
|
||||||
"(\<And>cap. P cap \<Longrightarrow> \<not> can_fast_finalise cap) \<Longrightarrow>
|
"(\<And>cap. P cap \<Longrightarrow> \<not> can_fast_finalise cap) \<Longrightarrow>
|
||||||
\<lbrace>cte_wp_at P p\<rbrace> (suspend tcb :: (unit,'a) s_monad) \<lbrace>\<lambda>_. cte_wp_at P p\<rbrace>"
|
\<lbrace>cte_wp_at P p\<rbrace> (suspend tcb :: (unit,'a) s_monad) \<lbrace>\<lambda>_. cte_wp_at P p\<rbrace>"
|
||||||
by (simp add: suspend_def) (wpsimp wp: cancel_ipc_cte_wp_at_preserved)
|
by (simp add: suspend_def) (wpsimp wp: cancel_ipc_cte_wp_at_preserved)+
|
||||||
|
|
||||||
|
|
||||||
(* FIXME - eliminate *)
|
(* FIXME - eliminate *)
|
||||||
|
@ -758,17 +767,26 @@ lemma reply_cancel_ipc_bound_tcb_at[wp]:
|
||||||
crunch bound_tcb_at[wp]: cancel_ipc "bound_tcb_at P t"
|
crunch bound_tcb_at[wp]: cancel_ipc "bound_tcb_at P t"
|
||||||
(ignore: set_object thread_set wp: mapM_x_wp_inv)
|
(ignore: set_object thread_set wp: mapM_x_wp_inv)
|
||||||
|
|
||||||
|
context IpcCancel_AI begin
|
||||||
lemma suspend_unlive:
|
lemma suspend_unlive:
|
||||||
"\<lbrace>bound_tcb_at ((=) None) t and valid_mdb and valid_objs and tcb_at t \<rbrace>
|
"\<lbrace>\<lambda>(s::'a state).
|
||||||
|
(bound_tcb_at ((=) None) t and valid_mdb and valid_objs) s \<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live0) t\<rbrace>"
|
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live0) t\<rbrace>"
|
||||||
apply (simp add: suspend_def set_thread_state_def set_object_def get_object_def)
|
apply (simp add: suspend_def set_thread_state_def set_object_def get_object_def)
|
||||||
|
(* avoid creating two copies of obj_at *)
|
||||||
|
supply hoare_vcg_if_split[wp_split del] if_splits[split del]
|
||||||
apply (wp | simp only: obj_at_exst_update)+
|
apply (wp | simp only: obj_at_exst_update)+
|
||||||
apply (simp add: obj_at_def)
|
apply (simp add: obj_at_def)
|
||||||
apply (rule_tac Q="\<lambda>_. bound_tcb_at ((=) None) t" in hoare_strengthen_post)
|
apply (rule_tac Q="\<lambda>_. bound_tcb_at ((=) None) t" in hoare_strengthen_post)
|
||||||
|
supply hoare_vcg_if_split[wp_split]
|
||||||
apply wp
|
apply wp
|
||||||
apply (auto simp: pred_tcb_def2 dest: refs_of_live)
|
apply (auto simp: pred_tcb_def2)[1]
|
||||||
|
apply (simp flip: if_split)
|
||||||
|
apply wpsimp+
|
||||||
|
apply (simp add: pred_tcb_at_tcb_at)
|
||||||
done
|
done
|
||||||
|
end
|
||||||
|
|
||||||
definition bound_refs_of_tcb :: "'a state \<Rightarrow> machine_word \<Rightarrow> (machine_word \<times> reftype) set"
|
definition bound_refs_of_tcb :: "'a state \<Rightarrow> machine_word \<Rightarrow> (machine_word \<times> reftype) set"
|
||||||
where
|
where
|
||||||
|
|
|
@ -151,15 +151,15 @@ lemma restart_tcb[wp]:
|
||||||
"\<lbrace>tcb_at t'\<rbrace> Tcb_A.restart t \<lbrace>\<lambda>rv. tcb_at t'\<rbrace>"
|
"\<lbrace>tcb_at t'\<rbrace> Tcb_A.restart t \<lbrace>\<lambda>rv. tcb_at t'\<rbrace>"
|
||||||
by (wpsimp simp: tcb_at_typ wp: restart_typ_at)
|
by (wpsimp simp: tcb_at_typ wp: restart_typ_at)
|
||||||
|
|
||||||
lemmas suspend_tcb_at[wp] = tcb_at_typ_at [OF suspend_typ_at]
|
crunch ex_nonz_cap_to[wp]: update_restart_pc "ex_nonz_cap_to t"
|
||||||
|
|
||||||
lemma suspend_nonz_cap_to_tcb:
|
lemma suspend_nonz_cap_to_tcb[wp]:
|
||||||
"\<lbrace>\<lambda>s. ex_nonz_cap_to t s \<and> tcb_at t s \<and> valid_objs s\<rbrace>
|
"\<lbrace>\<lambda>s. ex_nonz_cap_to t s \<and> tcb_at t s \<and> valid_objs s\<rbrace>
|
||||||
suspend t'
|
suspend t'
|
||||||
\<lbrace>\<lambda>rv s. ex_nonz_cap_to t s\<rbrace>"
|
\<lbrace>\<lambda>rv s. ex_nonz_cap_to t s\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
by (wp cancel_ipc_ex_nonz_cap_to_tcb | simp add: suspend_def)+
|
||||||
apply (wp cancel_ipc_ex_nonz_cap_to_tcb|simp)+
|
|
||||||
done
|
lemmas suspend_tcb_at[wp] = tcb_at_typ_at [OF suspend_typ_at]
|
||||||
|
|
||||||
lemma readreg_invs:
|
lemma readreg_invs:
|
||||||
"\<lbrace>invs and tcb_at src and ex_nonz_cap_to src\<rbrace>
|
"\<lbrace>invs and tcb_at src and ex_nonz_cap_to src\<rbrace>
|
||||||
|
@ -182,7 +182,7 @@ lemma (in Tcb_AI_1) copyreg_invs:
|
||||||
\<lbrace>\<lambda>rv. invs\<rbrace>"
|
\<lbrace>\<lambda>rv. invs\<rbrace>"
|
||||||
apply (wpsimp simp: if_apply_def2
|
apply (wpsimp simp: if_apply_def2
|
||||||
wp: mapM_x_wp' suspend_nonz_cap_to_tcb static_imp_wp)
|
wp: mapM_x_wp' suspend_nonz_cap_to_tcb static_imp_wp)
|
||||||
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
|
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def suspend_def
|
||||||
dest!: idle_no_ex_cap)
|
dest!: idle_no_ex_cap)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
|
@ -28,7 +28,7 @@ crunch weak_valid_sched_action [wp, DetSchedSchedule_AI_assms]:
|
||||||
switch_to_idle_thread, switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers "weak_valid_sched_action"
|
switch_to_idle_thread, switch_to_thread, arch_get_sanitise_register_info, arch_post_modify_registers "weak_valid_sched_action"
|
||||||
(simp: crunch_simps ignore: )
|
(simp: crunch_simps ignore: )
|
||||||
|
|
||||||
crunch ct_not_in_q[wp]: set_vm_root "ct_not_in_q"
|
crunch ct_not_in_q[wp, DetSchedSchedule_AI_assms]: set_vm_root "ct_not_in_q"
|
||||||
(wp: crunch_wps simp: crunch_simps)
|
(wp: crunch_wps simp: crunch_simps)
|
||||||
|
|
||||||
crunch ct_not_in_q'[wp]: set_vm_root "\<lambda>s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) t"
|
crunch ct_not_in_q'[wp]: set_vm_root "\<lambda>s. ct_not_in_q_2 (ready_queues s) (scheduler_action s) t"
|
||||||
|
|
|
@ -513,12 +513,16 @@ lemma suspend_unlive':
|
||||||
"\<lbrace>bound_tcb_at ((=) None) t and valid_mdb and valid_objs and tcb_at t \<rbrace>
|
"\<lbrace>bound_tcb_at ((=) None) t and valid_mdb and valid_objs and tcb_at t \<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live) t\<rbrace>"
|
\<lbrace>\<lambda>rv. obj_at (Not \<circ> live) t\<rbrace>"
|
||||||
apply (simp add: suspend_def set_thread_state_def)
|
apply (simp add: suspend_def set_thread_state_def set_object_def get_object_def)
|
||||||
apply (wpsimp wp: set_object_wp | simp only: obj_at_exst_update)+
|
supply hoare_vcg_if_split[wp_split del] if_splits[split del]
|
||||||
apply (simp add: obj_at_def)
|
apply (wp | simp only: obj_at_exst_update)+
|
||||||
|
apply (simp add: obj_at_def live_def hyp_live_def)
|
||||||
apply (rule_tac Q="\<lambda>_. bound_tcb_at ((=) None) t" in hoare_strengthen_post)
|
apply (rule_tac Q="\<lambda>_. bound_tcb_at ((=) None) t" in hoare_strengthen_post)
|
||||||
|
supply hoare_vcg_if_split[wp_split]
|
||||||
apply wp
|
apply wp
|
||||||
apply (auto simp: pred_tcb_def2 live_def hyp_live_def dest: refs_of_live)
|
apply (auto simp: pred_tcb_def2)[1]
|
||||||
|
apply (simp flip: if_split)
|
||||||
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
crunch obj_at[wp]: fpu_thread_delete
|
crunch obj_at[wp]: fpu_thread_delete
|
||||||
|
@ -1256,6 +1260,9 @@ lemma (* finalise_cap_invs *)[Finalise_AI_asms]:
|
||||||
apply (auto dest: cte_wp_at_valid_objs_valid_cap)
|
apply (auto dest: cte_wp_at_valid_objs_valid_cap)
|
||||||
done
|
done
|
||||||
|
|
||||||
|
crunch irq_node[wp, Finalise_AI_asms]: suspend "\<lambda>s. P (interrupt_irq_node s)"
|
||||||
|
(wp: crunch_wps select_wp simp: crunch_simps)
|
||||||
|
|
||||||
lemma (* finalise_cap_irq_node *)[Finalise_AI_asms]:
|
lemma (* finalise_cap_irq_node *)[Finalise_AI_asms]:
|
||||||
"\<lbrace>\<lambda>s. P (interrupt_irq_node s)\<rbrace> finalise_cap a b \<lbrace>\<lambda>_ s. P (interrupt_irq_node s)\<rbrace>"
|
"\<lbrace>\<lambda>s. P (interrupt_irq_node s)\<rbrace> finalise_cap a b \<lbrace>\<lambda>_ s. P (interrupt_irq_node s)\<rbrace>"
|
||||||
apply (case_tac a,simp_all)
|
apply (case_tac a,simp_all)
|
||||||
|
|
|
@ -3346,8 +3346,21 @@ lemma asid_low_bits_of_mask_eq:
|
||||||
lemmas asid_low_bits_of_p2m1_eq =
|
lemmas asid_low_bits_of_p2m1_eq =
|
||||||
asid_low_bits_of_mask_eq[simplified mask_2pm1]
|
asid_low_bits_of_mask_eq[simplified mask_2pm1]
|
||||||
|
|
||||||
|
lemma arch_tcb_context_absorbs[simp]:
|
||||||
|
"arch_tcb_context_set uc2 (arch_tcb_context_set uc1 a_tcb) \<equiv> arch_tcb_context_set uc2 a_tcb"
|
||||||
|
apply (simp add: arch_tcb_context_set_def)
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma arch_tcb_context_get_set[simp]:
|
||||||
|
"arch_tcb_context_get (arch_tcb_context_set uc a_tcb) = uc"
|
||||||
|
apply (simp add: arch_tcb_context_get_def arch_tcb_context_set_def)
|
||||||
|
done
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
declare X64.arch_tcb_context_absorbs[simp]
|
||||||
|
declare X64.arch_tcb_context_get_set[simp]
|
||||||
|
|
||||||
setup {* Add_Locale_Code_Defs.setup "X64" *}
|
setup {* Add_Locale_Code_Defs.setup "X64" *}
|
||||||
setup {* Add_Locale_Code_Defs.setup "X64_A" *}
|
setup {* Add_Locale_Code_Defs.setup "X64_A" *}
|
||||||
|
|
||||||
|
|
|
@ -637,6 +637,7 @@ lemma suspend_not_recursive_ctes:
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
|
\<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
|
||||||
apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def)
|
apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
|
apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
|
||||||
apply (fold cteCaps_of_def)
|
apply (fold cteCaps_of_def)
|
||||||
apply (wp cancelIPC_cteCaps_of)
|
apply (wp cancelIPC_cteCaps_of)
|
||||||
|
|
|
@ -169,10 +169,7 @@ lemma ignoreFailure_empty_fail[intro!, wp, simp]:
|
||||||
crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isBlocked, possibleSwitchTo, tcbSchedAppend
|
crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isBlocked, possibleSwitchTo, tcbSchedAppend
|
||||||
(simp: Let_def)
|
(simp: Let_def)
|
||||||
|
|
||||||
crunch (empty_fail) "_H_empty_fail": "ThreadDecls_H.suspend"
|
crunch (empty_fail) "_H_empty_fail"[intro!, wp, simp]: "ThreadDecls_H.suspend"
|
||||||
lemma ThreadDecls_H_suspend_empty_fail[intro!, wp, simp]:
|
|
||||||
"empty_fail (ThreadDecls_H.suspend target)"
|
|
||||||
by (simp add:suspend_def)
|
|
||||||
|
|
||||||
lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
|
lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
|
||||||
"empty_fail (ThreadDecls_H.restart target)"
|
"empty_fail (ThreadDecls_H.restart target)"
|
||||||
|
|
|
@ -2840,7 +2840,8 @@ lemma suspend_cte_wp_at':
|
||||||
shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
|
shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
|
\<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (rule hoare_pre)
|
apply (rule hoare_pre)
|
||||||
apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
|
apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
|
||||||
| simp add: x)+
|
| simp add: x)+
|
||||||
|
|
|
@ -1392,16 +1392,56 @@ lemma valid_queues_inQ_queues:
|
||||||
by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
|
by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
|
||||||
valid_queues_no_bitmap_def)
|
valid_queues_no_bitmap_def)
|
||||||
|
|
||||||
|
lemma asUser_tcbQueued_inv[wp]:
|
||||||
|
"\<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace> asUser t m \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
|
||||||
|
apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
|
||||||
|
apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | wpc | simp | clarsimp simp: obj_at'_def)+
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma asUser_valid_inQ_queues[wp]:
|
||||||
|
"\<lbrace> valid_inQ_queues \<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues \<rbrace>"
|
||||||
|
unfolding valid_inQ_queues_def Ball_def
|
||||||
|
apply (wpsimp wp: hoare_vcg_all_lift)
|
||||||
|
defer
|
||||||
|
apply (wp asUser_ksQ)
|
||||||
|
apply assumption
|
||||||
|
apply (simp add: inQ_def[abs_def] obj_at'_conj)
|
||||||
|
apply (rule hoare_convert_imp)
|
||||||
|
apply (wp asUser_ksQ)
|
||||||
|
apply wp
|
||||||
|
done
|
||||||
|
|
||||||
lemma (in delete_one) suspend_corres:
|
lemma (in delete_one) suspend_corres:
|
||||||
"corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
|
"corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
|
||||||
(IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
|
(IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
|
||||||
apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
|
apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
|
||||||
apply (rule corres_guard_imp)
|
apply (rule corres_guard_imp)
|
||||||
apply (rule corres_split_nor [OF _ cancel_ipc_corres])
|
apply (rule corres_split_nor [OF _ cancel_ipc_corres])
|
||||||
|
apply (rule corres_split [OF _ gts_corres])
|
||||||
|
apply (rule corres_split_nor)
|
||||||
apply (rule corres_split_nor [OF _ sts_corres])
|
apply (rule corres_split_nor [OF _ sts_corres])
|
||||||
apply (rule tcbSchedDequeue_corres')
|
apply (rule tcbSchedDequeue_corres')
|
||||||
|
apply wpsimp
|
||||||
|
apply wp
|
||||||
|
apply wpsimp
|
||||||
|
apply (rule corres_if)
|
||||||
|
apply (case_tac state; simp)
|
||||||
|
apply (simp add: update_restart_pc_def updateRestartPC_def)
|
||||||
|
apply (rule corres_as_user')
|
||||||
|
apply (simp add: ARM.nextInstructionRegister_def ARM.faultRegister_def
|
||||||
|
ARM_H.nextInstructionRegister_def ARM_H.faultRegister_def)
|
||||||
|
apply (simp add: ARM_H.Register_def)
|
||||||
|
apply (subst unit_dc_is_eq)
|
||||||
|
apply (rule corres_underlying_trivial)
|
||||||
|
apply (wpsimp simp: ARM.setRegister_def ARM.getRegister_def)
|
||||||
|
apply (rule corres_return_trivial)
|
||||||
|
apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
|
||||||
|
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
|
||||||
apply simp
|
apply simp
|
||||||
apply (wp | simp)+
|
apply wp
|
||||||
|
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at' t s \<and> valid_inQ_queues s"])
|
||||||
|
apply (wpsimp simp: valid_queues_inQ_queues)
|
||||||
|
apply wp+
|
||||||
apply (force simp: valid_sched_def tcb_at_is_etcb_at)
|
apply (force simp: valid_sched_def tcb_at_is_etcb_at)
|
||||||
apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
|
apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
|
||||||
done
|
done
|
||||||
|
@ -1672,30 +1712,40 @@ lemmas sts_tcbSchedDequeue_invs' =
|
||||||
sts_invs_minor'_no_valid_queues
|
sts_invs_minor'_no_valid_queues
|
||||||
tcbSchedDequeue_invs'_no_valid_queues
|
tcbSchedDequeue_invs'_no_valid_queues
|
||||||
|
|
||||||
|
lemma asUser_sch_act_simple[wp]:
|
||||||
|
"\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
|
||||||
|
unfolding sch_act_simple_def
|
||||||
|
apply (rule asUser_nosch)
|
||||||
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc) suspend_invs'[wp]:
|
lemma (in delete_one_conc) suspend_invs'[wp]:
|
||||||
"\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
|
"\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
|
||||||
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
|
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp_trace sts_tcbSchedDequeue_invs')
|
apply (wp_trace sts_tcbSchedDequeue_invs')
|
||||||
apply (simp | strengthen no_refs_simple_strg')+
|
apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
|
||||||
apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift
|
prefer 2
|
||||||
cancelIPC_simple [simplified] cancelIPC_invs
|
apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
|
||||||
cancelIPC_it cancelIPC_tcb_at' cancelIPC_sch_act_simple)
|
| strengthen no_refs_simple_strg')+
|
||||||
apply simp+
|
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
|
lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
|
||||||
"\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
|
"\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def unless_def)
|
||||||
|
apply wp
|
||||||
|
apply (wpsimp simp: updateRestartPC_def)
|
||||||
apply (wp hoare_drop_imps |clarsimp|rule conjI)+
|
apply (wp hoare_drop_imps |clarsimp|rule conjI)+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
|
lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
|
||||||
"\<lbrace>sch_act_simple\<rbrace>
|
"\<lbrace>sch_act_simple\<rbrace>
|
||||||
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
|
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
|
||||||
apply (simp add: suspend_def when_def)
|
apply (simp add: suspend_def when_def updateRestartPC_def)
|
||||||
apply (wp cancelIPC_sch_act_simple | simp add: unless_def
|
apply (wp cancelIPC_sch_act_simple | simp add: unless_def
|
||||||
| rule sch_act_simple_lift)+
|
| rule sch_act_simple_lift)+
|
||||||
|
apply (simp add: updateRestartPC_def)
|
||||||
|
apply (rule asUser_nosch)
|
||||||
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc) suspend_objs':
|
lemma (in delete_one_conc) suspend_objs':
|
||||||
|
@ -1711,9 +1761,9 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
|
||||||
"\<lbrace>st_tcb_at' P t\<rbrace>
|
"\<lbrace>st_tcb_at' P t\<rbrace>
|
||||||
suspend thread
|
suspend thread
|
||||||
\<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
|
\<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
unfolding suspend_def updateRestartPC_def
|
||||||
apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
|
apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
|
||||||
cancelIPC_st_tcb_at hoare_drop_imps
|
cancelIPC_st_tcb_at hoare_drop_imps asUser_pred_tcb_at' x
|
||||||
| simp)+
|
| simp)+
|
||||||
apply clarsimp
|
apply clarsimp
|
||||||
done
|
done
|
||||||
|
@ -1819,8 +1869,9 @@ lemma (in delete_one_conc_pre) suspend_nonq:
|
||||||
\<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
|
\<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
|
||||||
apply (rule hoare_gen_asm)
|
apply (rule hoare_gen_asm)
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def unless_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
|
apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
|
||||||
apply (clarsimp)
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma suspend_makes_inactive:
|
lemma suspend_makes_inactive:
|
||||||
|
@ -2624,7 +2675,7 @@ lemma suspend_unqueued:
|
||||||
apply (rule hoare_strengthen_post, rule hoare_post_taut)
|
apply (rule hoare_strengthen_post, rule hoare_post_taut)
|
||||||
apply (fastforce simp: obj_at'_def projectKOs)
|
apply (fastforce simp: obj_at'_def projectKOs)
|
||||||
apply (rule hoare_post_taut)
|
apply (rule hoare_post_taut)
|
||||||
apply (rule TrueI)
|
apply wp+
|
||||||
done
|
done
|
||||||
|
|
||||||
crunch unqueued: prepareThreadDelete "obj_at' (Not \<circ> tcbQueued) t"
|
crunch unqueued: prepareThreadDelete "obj_at' (Not \<circ> tcbQueued) t"
|
||||||
|
|
|
@ -1686,6 +1686,26 @@ lemma handleInterrupt_no_orphans [wp]:
|
||||||
handleReservedIRQ_def)+
|
handleReservedIRQ_def)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma updateRestartPC_no_orphans[wp]:
|
||||||
|
"\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<rbrace>
|
||||||
|
updateRestartPC t
|
||||||
|
\<lbrace> \<lambda>rv s. no_orphans s \<rbrace>"
|
||||||
|
by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
|
||||||
|
|
||||||
|
lemma updateRestartPC_valid_queues'[wp]:
|
||||||
|
"\<lbrace> \<lambda>s. valid_queues' s \<rbrace>
|
||||||
|
updateRestartPC t
|
||||||
|
\<lbrace> \<lambda>rv s. valid_queues' s \<rbrace>"
|
||||||
|
unfolding updateRestartPC_def
|
||||||
|
apply (rule asUser_valid_queues')
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma updateRestartPC_no_orphans_invs'_valid_queues'[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. no_orphans s \<and> invs' s \<and> valid_queues' s \<rbrace>
|
||||||
|
updateRestartPC t
|
||||||
|
\<lbrace>\<lambda>rv s. no_orphans s \<and> valid_queues' s \<rbrace>"
|
||||||
|
by (wpsimp simp: updateRestartPC_def asUser_no_orphans)
|
||||||
|
|
||||||
lemma suspend_no_orphans [wp]:
|
lemma suspend_no_orphans [wp]:
|
||||||
"\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' t s \<rbrace>
|
"\<lbrace> \<lambda>s. no_orphans s \<and> invs' s \<and> sch_act_simple s \<and> tcb_at' t s \<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
|
@ -1695,6 +1715,7 @@ lemma suspend_no_orphans [wp]:
|
||||||
apply (clarsimp simp: is_active_tcb_ptr_def is_active_thread_state_def st_tcb_at_neg2)
|
apply (clarsimp simp: is_active_tcb_ptr_def is_active_thread_state_def st_tcb_at_neg2)
|
||||||
apply (wp setThreadState_not_active_no_orphans hoare_disjI1 setThreadState_st_tcb
|
apply (wp setThreadState_not_active_no_orphans hoare_disjI1 setThreadState_st_tcb
|
||||||
| clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def)+
|
| clarsimp simp: is_active_thread_state_def isRunning_def isRestart_def)+
|
||||||
|
apply (wp hoare_drop_imp)+
|
||||||
apply auto
|
apply auto
|
||||||
done
|
done
|
||||||
|
|
||||||
|
|
|
@ -262,9 +262,15 @@ lemma restart_tcb'[wp]:
|
||||||
lemma no_fail_setRegister: "no_fail \<top> (setRegister r v)"
|
lemma no_fail_setRegister: "no_fail \<top> (setRegister r v)"
|
||||||
by (simp add: setRegister_def)
|
by (simp add: setRegister_def)
|
||||||
|
|
||||||
|
lemma updateRestartPC_ex_nonz_cap_to'[wp]:
|
||||||
|
"\<lbrace>ex_nonz_cap_to' p\<rbrace> updateRestartPC t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
||||||
|
unfolding updateRestartPC_def
|
||||||
|
apply (rule asUser_cap_to')
|
||||||
|
done
|
||||||
|
|
||||||
lemma suspend_cap_to'[wp]:
|
lemma suspend_cap_to'[wp]:
|
||||||
"\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
"\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp threadSet_cap_to' | simp)+
|
apply (wp threadSet_cap_to' | simp)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
@ -364,6 +370,26 @@ lemma writereg_corres:
|
||||||
|
|
||||||
crunch it[wp]: suspend "\<lambda>s. P (ksIdleThread s)"
|
crunch it[wp]: suspend "\<lambda>s. P (ksIdleThread s)"
|
||||||
|
|
||||||
|
lemma tcbSchedDequeue_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
tcbSchedDequeue t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
by (wp hoare_convert_imp)
|
||||||
|
|
||||||
|
lemma updateRestartPC_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
updateRestartPC t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
unfolding updateRestartPC_def
|
||||||
|
apply (wp hoare_convert_imp)
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma suspend_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
suspend t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
by (wpsimp simp: suspend_def)
|
||||||
|
|
||||||
lemma copyreg_corres:
|
lemma copyreg_corres:
|
||||||
"corres (intr \<oplus> (=))
|
"corres (intr \<oplus> (=))
|
||||||
(einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
|
(einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
|
||||||
|
|
|
@ -641,6 +641,7 @@ lemma suspend_not_recursive_ctes:
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
|
\<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
|
||||||
apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def)
|
apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
|
apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
|
||||||
apply (fold cteCaps_of_def)
|
apply (fold cteCaps_of_def)
|
||||||
apply (wp cancelIPC_cteCaps_of)
|
apply (wp cancelIPC_cteCaps_of)
|
||||||
|
|
|
@ -173,10 +173,7 @@ lemma ignoreFailure_empty_fail[intro!, wp, simp]:
|
||||||
crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isBlocked, possibleSwitchTo, tcbSchedAppend
|
crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isBlocked, possibleSwitchTo, tcbSchedAppend
|
||||||
(simp: Let_def)
|
(simp: Let_def)
|
||||||
|
|
||||||
crunch (empty_fail) "_H_empty_fail": "ThreadDecls_H.suspend"
|
crunch (empty_fail) "_H_empty_fail"[intro!, wp, simp]: "ThreadDecls_H.suspend"
|
||||||
lemma ThreadDecls_H_suspend_empty_fail[intro!, wp, simp]:
|
|
||||||
"empty_fail (ThreadDecls_H.suspend target)"
|
|
||||||
by (simp add:suspend_def)
|
|
||||||
|
|
||||||
lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
|
lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
|
||||||
"empty_fail (ThreadDecls_H.restart target)"
|
"empty_fail (ThreadDecls_H.restart target)"
|
||||||
|
|
|
@ -3277,7 +3277,8 @@ lemma suspend_cte_wp_at':
|
||||||
shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
|
shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
|
\<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (rule hoare_pre)
|
apply (rule hoare_pre)
|
||||||
apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
|
apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
|
||||||
| simp add: x)+
|
| simp add: x)+
|
||||||
|
@ -4042,9 +4043,11 @@ lemmas getCTE_no_0_obj'_helper
|
||||||
= getCTE_inv
|
= getCTE_inv
|
||||||
hoare_strengthen_post[where Q="\<lambda>_. no_0_obj'" and P=no_0_obj' and a="getCTE slot" for slot]
|
hoare_strengthen_post[where Q="\<lambda>_. no_0_obj'" and P=no_0_obj' and a="getCTE slot" for slot]
|
||||||
|
|
||||||
|
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||||
crunches ThreadDecls_H.suspend, unbindNotification
|
crunches ThreadDecls_H.suspend, unbindNotification
|
||||||
for no_0_obj'[wp]: no_0_obj'
|
for no_0_obj'[wp]: no_0_obj'
|
||||||
(simp: crunch_simps wp: crunch_wps getCTE_no_0_obj'_helper)
|
(simp: crunch_simps wp: crunch_wps getCTE_no_0_obj'_helper)
|
||||||
|
end
|
||||||
|
|
||||||
lemma finalise_cap_corres:
|
lemma finalise_cap_corres:
|
||||||
"\<lbrakk> final_matters' cap' \<Longrightarrow> final = final'; cap_relation cap cap';
|
"\<lbrakk> final_matters' cap' \<Longrightarrow> final = final'; cap_relation cap cap';
|
||||||
|
|
|
@ -1403,16 +1403,56 @@ lemma valid_queues_inQ_queues:
|
||||||
by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
|
by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
|
||||||
valid_queues_no_bitmap_def)
|
valid_queues_no_bitmap_def)
|
||||||
|
|
||||||
|
lemma asUser_tcbQueued_inv[wp]:
|
||||||
|
"\<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace> asUser t m \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
|
||||||
|
apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
|
||||||
|
apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | wpc | simp | clarsimp simp: obj_at'_def)+
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma asUser_valid_inQ_queues[wp]:
|
||||||
|
"\<lbrace> valid_inQ_queues \<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues \<rbrace>"
|
||||||
|
unfolding valid_inQ_queues_def Ball_def
|
||||||
|
apply (wpsimp wp: hoare_vcg_all_lift)
|
||||||
|
defer
|
||||||
|
apply (wp asUser_ksQ)
|
||||||
|
apply assumption
|
||||||
|
apply (simp add: inQ_def[abs_def] obj_at'_conj)
|
||||||
|
apply (rule hoare_convert_imp)
|
||||||
|
apply (wp asUser_ksQ)
|
||||||
|
apply wp
|
||||||
|
done
|
||||||
|
|
||||||
lemma (in delete_one) suspend_corres:
|
lemma (in delete_one) suspend_corres:
|
||||||
"corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
|
"corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
|
||||||
(IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
|
(IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
|
||||||
apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
|
apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
|
||||||
apply (rule corres_guard_imp)
|
apply (rule corres_guard_imp)
|
||||||
apply (rule corres_split_nor [OF _ cancel_ipc_corres])
|
apply (rule corres_split_nor [OF _ cancel_ipc_corres])
|
||||||
|
apply (rule corres_split [OF _ gts_corres])
|
||||||
|
apply (rule corres_split_nor)
|
||||||
apply (rule corres_split_nor [OF _ sts_corres])
|
apply (rule corres_split_nor [OF _ sts_corres])
|
||||||
apply (rule tcbSchedDequeue_corres')
|
apply (rule tcbSchedDequeue_corres')
|
||||||
|
apply wpsimp
|
||||||
|
apply wp
|
||||||
|
apply wpsimp
|
||||||
|
apply (rule corres_if)
|
||||||
|
apply (case_tac state; simp)
|
||||||
|
apply (simp add: update_restart_pc_def updateRestartPC_def)
|
||||||
|
apply (rule corres_as_user')
|
||||||
|
apply (simp add: ARM_HYP.nextInstructionRegister_def ARM_HYP.faultRegister_def
|
||||||
|
ARM_HYP_H.nextInstructionRegister_def ARM_HYP_H.faultRegister_def)
|
||||||
|
apply (simp add: ARM_HYP_H.Register_def)
|
||||||
|
apply (subst unit_dc_is_eq)
|
||||||
|
apply (rule corres_underlying_trivial)
|
||||||
|
apply (wpsimp simp: ARM_HYP.setRegister_def ARM_HYP.getRegister_def)
|
||||||
|
apply (rule corres_return_trivial)
|
||||||
|
apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
|
||||||
|
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
|
||||||
apply simp
|
apply simp
|
||||||
apply (wp | simp)+
|
apply wp
|
||||||
|
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at' t s \<and> valid_inQ_queues s"])
|
||||||
|
apply (wpsimp simp: valid_queues_inQ_queues)
|
||||||
|
apply wp+
|
||||||
apply (force simp: valid_sched_def tcb_at_is_etcb_at)
|
apply (force simp: valid_sched_def tcb_at_is_etcb_at)
|
||||||
apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
|
apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
|
||||||
done
|
done
|
||||||
|
@ -1840,30 +1880,40 @@ lemmas sts_tcbSchedDequeue_invs' =
|
||||||
sts_invs_minor'_no_valid_queues
|
sts_invs_minor'_no_valid_queues
|
||||||
tcbSchedDequeue_invs'_no_valid_queues
|
tcbSchedDequeue_invs'_no_valid_queues
|
||||||
|
|
||||||
|
lemma asUser_sch_act_simple[wp]:
|
||||||
|
"\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
|
||||||
|
unfolding sch_act_simple_def
|
||||||
|
apply (rule asUser_nosch)
|
||||||
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc) suspend_invs'[wp]:
|
lemma (in delete_one_conc) suspend_invs'[wp]:
|
||||||
"\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
|
"\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
|
||||||
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
|
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp sts_tcbSchedDequeue_invs')
|
apply (wp_trace sts_tcbSchedDequeue_invs')
|
||||||
apply (simp | strengthen no_refs_simple_strg')+
|
apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
|
||||||
apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift
|
prefer 2
|
||||||
cancelIPC_simple [simplified] cancelIPC_invs
|
apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
|
||||||
cancelIPC_it cancelIPC_tcb_at' cancelIPC_sch_act_simple)
|
| strengthen no_refs_simple_strg')+
|
||||||
apply simp+
|
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
|
lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
|
||||||
"\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
|
"\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
apply wp
|
||||||
|
apply (wpsimp simp: updateRestartPC_def)
|
||||||
apply (wp hoare_drop_imps |clarsimp|rule conjI)+
|
apply (wp hoare_drop_imps |clarsimp|rule conjI)+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
|
lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
|
||||||
"\<lbrace>sch_act_simple\<rbrace>
|
"\<lbrace>sch_act_simple\<rbrace>
|
||||||
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
|
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
|
||||||
apply (simp add: suspend_def when_def)
|
apply (simp add: suspend_def when_def updateRestartPC_def)
|
||||||
apply (wp cancelIPC_sch_act_simple | simp add: unless_def
|
apply (wp cancelIPC_sch_act_simple | simp add: unless_def
|
||||||
| rule sch_act_simple_lift)+
|
| rule sch_act_simple_lift)+
|
||||||
|
apply (simp add: updateRestartPC_def)
|
||||||
|
apply (rule asUser_nosch)
|
||||||
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc) suspend_objs':
|
lemma (in delete_one_conc) suspend_objs':
|
||||||
|
@ -1879,9 +1929,9 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
|
||||||
"\<lbrace>st_tcb_at' P t\<rbrace>
|
"\<lbrace>st_tcb_at' P t\<rbrace>
|
||||||
suspend thread
|
suspend thread
|
||||||
\<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
|
\<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
unfolding suspend_def updateRestartPC_def
|
||||||
apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
|
apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
|
||||||
cancelIPC_st_tcb_at hoare_drop_imps
|
cancelIPC_st_tcb_at hoare_drop_imps asUser_pred_tcb_at' x
|
||||||
| simp)+
|
| simp)+
|
||||||
apply clarsimp
|
apply clarsimp
|
||||||
done
|
done
|
||||||
|
@ -1987,8 +2037,9 @@ lemma (in delete_one_conc_pre) suspend_nonq:
|
||||||
\<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
|
\<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
|
||||||
apply (rule hoare_gen_asm)
|
apply (rule hoare_gen_asm)
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def unless_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
|
apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
|
||||||
apply (clarsimp)
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma suspend_makes_inactive:
|
lemma suspend_makes_inactive:
|
||||||
|
@ -2801,7 +2852,7 @@ lemma suspend_unqueued:
|
||||||
apply (rule hoare_strengthen_post, rule hoare_post_taut)
|
apply (rule hoare_strengthen_post, rule hoare_post_taut)
|
||||||
apply (fastforce simp: obj_at'_def projectKOs)
|
apply (fastforce simp: obj_at'_def projectKOs)
|
||||||
apply (rule hoare_post_taut)
|
apply (rule hoare_post_taut)
|
||||||
apply (rule TrueI)
|
apply wp+
|
||||||
done
|
done
|
||||||
|
|
||||||
crunch no_vcpu[wp]: vcpuInvalidateActive "obj_at' (P::'a:: no_vcpu \<Rightarrow> bool) t"
|
crunch no_vcpu[wp]: vcpuInvalidateActive "obj_at' (P::'a:: no_vcpu \<Rightarrow> bool) t"
|
||||||
|
|
|
@ -259,9 +259,15 @@ lemma restart_tcb'[wp]:
|
||||||
apply wpsimp
|
apply wpsimp
|
||||||
done
|
done
|
||||||
|
|
||||||
|
lemma updateRestartPC_ex_nonz_cap_to'[wp]:
|
||||||
|
"\<lbrace>ex_nonz_cap_to' p\<rbrace> updateRestartPC t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
||||||
|
unfolding updateRestartPC_def
|
||||||
|
apply (rule asUser_cap_to')
|
||||||
|
done
|
||||||
|
|
||||||
lemma suspend_cap_to'[wp]:
|
lemma suspend_cap_to'[wp]:
|
||||||
"\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
"\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp threadSet_cap_to' | simp)+
|
apply (wp threadSet_cap_to' | simp)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
@ -368,6 +374,20 @@ lemma tcbSchedDequeue_ResumeCurrentThread_imp_notct[wp]:
|
||||||
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
by (wp hoare_convert_imp)
|
by (wp hoare_convert_imp)
|
||||||
|
|
||||||
|
lemma updateRestartPC_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
updateRestartPC t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
unfolding updateRestartPC_def
|
||||||
|
apply (wp hoare_convert_imp)
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma suspend_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
suspend t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
by (wpsimp simp: suspend_def)
|
||||||
|
|
||||||
lemma copyreg_corres:
|
lemma copyreg_corres:
|
||||||
"corres (intr \<oplus> (=))
|
"corres (intr \<oplus> (=))
|
||||||
(einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
|
(einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
|
||||||
|
|
|
@ -637,7 +637,7 @@ lemma suspend_not_recursive_ctes:
|
||||||
"\<lbrace>\<lambda>s. P (not_recursive_ctes s)\<rbrace>
|
"\<lbrace>\<lambda>s. P (not_recursive_ctes s)\<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
|
\<lbrace>\<lambda>rv s. P (not_recursive_ctes s)\<rbrace>"
|
||||||
apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def)
|
apply (simp only: suspend_def not_recursive_ctes_def cteCaps_of_def updateRestartPC_def)
|
||||||
apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
|
apply (wp threadSet_ctes_of | simp add: unless_def del: o_apply)+
|
||||||
apply (fold cteCaps_of_def)
|
apply (fold cteCaps_of_def)
|
||||||
apply (wp cancelIPC_cteCaps_of)
|
apply (wp cancelIPC_cteCaps_of)
|
||||||
|
|
|
@ -176,10 +176,7 @@ lemma ignoreFailure_empty_fail[intro!, wp, simp]:
|
||||||
crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isBlocked, possibleSwitchTo, tcbSchedAppend
|
crunch (empty_fail) empty_fail[intro!, wp, simp]: cancelIPC, setThreadState, tcbSchedDequeue, setupReplyMaster, isBlocked, possibleSwitchTo, tcbSchedAppend
|
||||||
(simp: Let_def)
|
(simp: Let_def)
|
||||||
|
|
||||||
crunch (empty_fail) "_H_empty_fail": "ThreadDecls_H.suspend"
|
crunch (empty_fail) "_H_empty_fail"[intro!, wp, simp]: "ThreadDecls_H.suspend"
|
||||||
lemma ThreadDecls_H_suspend_empty_fail[intro!, wp, simp]:
|
|
||||||
"empty_fail (ThreadDecls_H.suspend target)"
|
|
||||||
by (simp add:suspend_def)
|
|
||||||
|
|
||||||
lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
|
lemma ThreadDecls_H_restart_empty_fail[intro!, wp, simp]:
|
||||||
"empty_fail (ThreadDecls_H.restart target)"
|
"empty_fail (ThreadDecls_H.restart target)"
|
||||||
|
|
|
@ -3033,7 +3033,7 @@ lemma suspend_cte_wp_at':
|
||||||
shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
|
shows "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
|
\<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def updateRestartPC_def)
|
||||||
apply (rule hoare_pre)
|
apply (rule hoare_pre)
|
||||||
apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
|
apply (wp threadSet_cte_wp_at' cancelIPC_cte_wp_at'
|
||||||
| simp add: x)+
|
| simp add: x)+
|
||||||
|
|
|
@ -1390,16 +1390,56 @@ lemma valid_queues_inQ_queues:
|
||||||
by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
|
by (force simp: Invariants_H.valid_queues_def valid_inQ_queues_def obj_at'_def
|
||||||
valid_queues_no_bitmap_def)
|
valid_queues_no_bitmap_def)
|
||||||
|
|
||||||
|
lemma asUser_tcbQueued_inv[wp]:
|
||||||
|
"\<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace> asUser t m \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t'\<rbrace>"
|
||||||
|
apply (simp add: asUser_def tcb_in_cur_domain'_def threadGet_def)
|
||||||
|
apply (wp threadSet_obj_at'_strongish getObject_tcb_wp | wpc | simp | clarsimp simp: obj_at'_def)+
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma asUser_valid_inQ_queues[wp]:
|
||||||
|
"\<lbrace>valid_inQ_queues\<rbrace> asUser t f \<lbrace>\<lambda>rv. valid_inQ_queues\<rbrace>"
|
||||||
|
unfolding valid_inQ_queues_def Ball_def
|
||||||
|
apply (wpsimp wp: hoare_vcg_all_lift)
|
||||||
|
defer
|
||||||
|
apply (wp asUser_ksQ)
|
||||||
|
apply assumption
|
||||||
|
apply (simp add: inQ_def[abs_def] obj_at'_conj)
|
||||||
|
apply (rule hoare_convert_imp)
|
||||||
|
apply (wp asUser_ksQ)
|
||||||
|
apply wp
|
||||||
|
done
|
||||||
|
|
||||||
lemma (in delete_one) suspend_corres:
|
lemma (in delete_one) suspend_corres:
|
||||||
"corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
|
"corres dc (einvs and tcb_at t) (invs' and tcb_at' t)
|
||||||
(IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
|
(IpcCancel_A.suspend t) (ThreadDecls_H.suspend t)"
|
||||||
apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
|
apply (simp add: IpcCancel_A.suspend_def Thread_H.suspend_def)
|
||||||
apply (rule corres_guard_imp)
|
apply (rule corres_guard_imp)
|
||||||
apply (rule corres_split_nor [OF _ cancel_ipc_corres])
|
apply (rule corres_split_nor [OF _ cancel_ipc_corres])
|
||||||
|
apply (rule corres_split [OF _ gts_corres])
|
||||||
|
apply (rule corres_split_nor)
|
||||||
apply (rule corres_split_nor [OF _ sts_corres])
|
apply (rule corres_split_nor [OF _ sts_corres])
|
||||||
apply (rule tcbSchedDequeue_corres')
|
apply (rule tcbSchedDequeue_corres')
|
||||||
|
apply wpsimp
|
||||||
|
apply wp
|
||||||
|
apply wpsimp
|
||||||
|
apply (rule corres_if)
|
||||||
|
apply (case_tac state; simp)
|
||||||
|
apply (simp add: update_restart_pc_def updateRestartPC_def)
|
||||||
|
apply (rule corres_as_user')
|
||||||
|
apply (simp add: X64.nextInstructionRegister_def X64.faultRegister_def
|
||||||
|
X64_H.nextInstructionRegister_def X64_H.faultRegister_def)
|
||||||
|
apply (simp add: X64_H.Register_def)
|
||||||
|
apply (subst unit_dc_is_eq)
|
||||||
|
apply (rule corres_underlying_trivial)
|
||||||
|
apply (wpsimp simp: X64.setRegister_def X64.getRegister_def)
|
||||||
|
apply (rule corres_return_trivial)
|
||||||
|
apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
|
||||||
|
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
|
||||||
apply simp
|
apply simp
|
||||||
apply (wp | simp)+
|
apply (wp | simp)+
|
||||||
|
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at' t s \<and> valid_inQ_queues s"])
|
||||||
|
apply (wpsimp simp: valid_queues_inQ_queues)
|
||||||
|
apply wp+
|
||||||
apply (force simp: valid_sched_def tcb_at_is_etcb_at)
|
apply (force simp: valid_sched_def tcb_at_is_etcb_at)
|
||||||
apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
|
apply (clarsimp simp add: invs'_def valid_state'_def valid_queues_inQ_queues)
|
||||||
done
|
done
|
||||||
|
@ -1715,30 +1755,38 @@ lemmas sts_tcbSchedDequeue_invs' =
|
||||||
sts_invs_minor'_no_valid_queues
|
sts_invs_minor'_no_valid_queues
|
||||||
tcbSchedDequeue_invs'_no_valid_queues
|
tcbSchedDequeue_invs'_no_valid_queues
|
||||||
|
|
||||||
|
lemma asUser_sch_act_simple[wp]:
|
||||||
|
"\<lbrace>sch_act_simple\<rbrace> asUser s t \<lbrace>\<lambda>_. sch_act_simple\<rbrace>"
|
||||||
|
unfolding sch_act_simple_def
|
||||||
|
apply (rule asUser_nosch)
|
||||||
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc) suspend_invs'[wp]:
|
lemma (in delete_one_conc) suspend_invs'[wp]:
|
||||||
"\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
|
"\<lbrace>invs' and sch_act_simple and tcb_at' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
|
||||||
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
|
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. invs'\<rbrace>"
|
||||||
apply (simp add: suspend_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp_trace sts_tcbSchedDequeue_invs')
|
apply (wp_trace sts_tcbSchedDequeue_invs')
|
||||||
apply (simp | strengthen no_refs_simple_strg')+
|
apply (simp add: updateRestartPC_def | strengthen no_refs_simple_strg')+
|
||||||
apply (wp hoare_vcg_all_lift hoare_vcg_imp_lift
|
prefer 2
|
||||||
cancelIPC_simple [simplified] cancelIPC_invs
|
apply (wpsimp wp: hoare_drop_imps hoare_vcg_imp_lift'
|
||||||
cancelIPC_it cancelIPC_tcb_at' cancelIPC_sch_act_simple)
|
| strengthen no_refs_simple_strg')+
|
||||||
apply simp+
|
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
|
lemma (in delete_one_conc_pre) suspend_tcb'[wp]:
|
||||||
"\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
|
"\<lbrace>tcb_at' t'\<rbrace> ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. tcb_at' t'\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
apply (wp hoare_drop_imps |clarsimp|rule conjI)+
|
apply (wpsimp simp: updateRestartPC_def)
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
|
lemma (in delete_one_conc_pre) suspend_sch_act_simple[wp]:
|
||||||
"\<lbrace>sch_act_simple\<rbrace>
|
"\<lbrace>sch_act_simple\<rbrace>
|
||||||
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
|
ThreadDecls_H.suspend t \<lbrace>\<lambda>rv. sch_act_simple\<rbrace>"
|
||||||
apply (simp add: suspend_def when_def)
|
apply (simp add: suspend_def when_def updateRestartPC_def)
|
||||||
apply (wp cancelIPC_sch_act_simple | simp add: unless_def
|
apply (wp cancelIPC_sch_act_simple | simp add: unless_def
|
||||||
| rule sch_act_simple_lift)+
|
| rule sch_act_simple_lift)+
|
||||||
|
apply (simp add: updateRestartPC_def)
|
||||||
|
apply (rule asUser_nosch)
|
||||||
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma (in delete_one_conc) suspend_objs':
|
lemma (in delete_one_conc) suspend_objs':
|
||||||
|
@ -1754,7 +1802,8 @@ lemma (in delete_one_conc_pre) suspend_st_tcb_at':
|
||||||
"\<lbrace>st_tcb_at' P t\<rbrace>
|
"\<lbrace>st_tcb_at' P t\<rbrace>
|
||||||
suspend thread
|
suspend thread
|
||||||
\<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
|
\<lbrace>\<lambda>rv. st_tcb_at' P t\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
|
apply (wp sts_st_tcb_at'_cases threadSet_pred_tcb_no_state
|
||||||
cancelIPC_st_tcb_at hoare_drop_imps
|
cancelIPC_st_tcb_at hoare_drop_imps
|
||||||
| simp)+
|
| simp)+
|
||||||
|
@ -1861,9 +1910,10 @@ lemma (in delete_one_conc_pre) suspend_nonq:
|
||||||
suspend t
|
suspend t
|
||||||
\<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
|
\<lbrace>\<lambda>rv s. \<forall>d p. t' \<notin> set (ksReadyQueues s (d, p))\<rbrace>"
|
||||||
apply (rule hoare_gen_asm)
|
apply (rule hoare_gen_asm)
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
|
apply (wp hoare_allI tcbSchedDequeue_t_notksQ sts_ksQ_oaQ)
|
||||||
apply (clarsimp)
|
apply wpsimp+
|
||||||
done
|
done
|
||||||
|
|
||||||
lemma suspend_makes_inactive:
|
lemma suspend_makes_inactive:
|
||||||
|
@ -2676,7 +2726,7 @@ lemma suspend_unqueued:
|
||||||
apply (rule hoare_strengthen_post, rule hoare_post_taut)
|
apply (rule hoare_strengthen_post, rule hoare_post_taut)
|
||||||
apply (fastforce simp: obj_at'_def projectKOs)
|
apply (fastforce simp: obj_at'_def projectKOs)
|
||||||
apply (rule hoare_post_taut)
|
apply (rule hoare_post_taut)
|
||||||
apply (rule TrueI)
|
apply wp+
|
||||||
done
|
done
|
||||||
|
|
||||||
crunch unqueued: prepareThreadDelete "obj_at' (\<lambda>a. \<not> tcbQueued a) t"
|
crunch unqueued: prepareThreadDelete "obj_at' (\<lambda>a. \<not> tcbQueued a) t"
|
||||||
|
|
|
@ -264,7 +264,8 @@ lemma no_fail_setRegister: "no_fail \<top> (setRegister r v)"
|
||||||
|
|
||||||
lemma suspend_cap_to'[wp]:
|
lemma suspend_cap_to'[wp]:
|
||||||
"\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
"\<lbrace>ex_nonz_cap_to' p\<rbrace> suspend t \<lbrace>\<lambda>rv. ex_nonz_cap_to' p\<rbrace>"
|
||||||
apply (simp add: suspend_def unless_def)
|
apply (simp add: suspend_def)
|
||||||
|
unfolding updateRestartPC_def
|
||||||
apply (wp threadSet_cap_to' | simp)+
|
apply (wp threadSet_cap_to' | simp)+
|
||||||
done
|
done
|
||||||
|
|
||||||
|
@ -377,6 +378,20 @@ lemma tcbSchedDequeue_ResumeCurrentThread_imp_notct[wp]:
|
||||||
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
by (wp hoare_convert_imp)
|
by (wp hoare_convert_imp)
|
||||||
|
|
||||||
|
lemma updateRestartPC_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
updateRestartPC t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
unfolding updateRestartPC_def
|
||||||
|
apply (wp hoare_convert_imp)
|
||||||
|
done
|
||||||
|
|
||||||
|
lemma suspend_ResumeCurrentThread_imp_notct[wp]:
|
||||||
|
"\<lbrace>\<lambda>s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>
|
||||||
|
suspend t
|
||||||
|
\<lbrace>\<lambda>rv s. ksSchedulerAction s = ResumeCurrentThread \<longrightarrow> ksCurThread s \<noteq> t'\<rbrace>"
|
||||||
|
by (wpsimp simp: suspend_def)
|
||||||
|
|
||||||
lemma copyreg_corres:
|
lemma copyreg_corres:
|
||||||
"corres (intr \<oplus> (=))
|
"corres (intr \<oplus> (=))
|
||||||
(einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
|
(einvs and simple_sched_action and tcb_at dest and tcb_at src and ex_nonz_cap_to src and
|
||||||
|
|
|
@ -25,6 +25,8 @@ requalify_consts
|
||||||
arch_post_cap_deletion
|
arch_post_cap_deletion
|
||||||
arch_gen_obj_refs
|
arch_gen_obj_refs
|
||||||
arch_cap_cleanup_opt
|
arch_cap_cleanup_opt
|
||||||
|
faultRegister
|
||||||
|
nextInstructionRegister
|
||||||
|
|
||||||
requalify_types
|
requalify_types
|
||||||
arch_gen_obj_ref
|
arch_gen_obj_ref
|
||||||
|
@ -358,6 +360,15 @@ where
|
||||||
| _ \<Rightarrow> return ()
|
| _ \<Rightarrow> return ()
|
||||||
od"
|
od"
|
||||||
|
|
||||||
|
text {* Currently, @{text update_restart_pc} can be defined generically up to
|
||||||
|
the actual register numbers. *}
|
||||||
|
definition
|
||||||
|
update_restart_pc :: "obj_ref \<Rightarrow> (unit, 'z::state_ext) s_monad"
|
||||||
|
where
|
||||||
|
"update_restart_pc thread_ptr =
|
||||||
|
as_user thread_ptr (getRegister nextInstructionRegister
|
||||||
|
>>= setRegister faultRegister)"
|
||||||
|
|
||||||
text {* Suspend a thread, cancelling any pending operations and preventing it
|
text {* Suspend a thread, cancelling any pending operations and preventing it
|
||||||
from further execution by setting it to the Inactive state. *}
|
from further execution by setting it to the Inactive state. *}
|
||||||
definition
|
definition
|
||||||
|
@ -365,6 +376,8 @@ definition
|
||||||
where
|
where
|
||||||
"suspend thread \<equiv> do
|
"suspend thread \<equiv> do
|
||||||
cancel_ipc thread;
|
cancel_ipc thread;
|
||||||
|
state \<leftarrow> get_thread_state thread;
|
||||||
|
(if state = Running then update_restart_pc thread else return ());
|
||||||
set_thread_state thread Inactive;
|
set_thread_state thread Inactive;
|
||||||
do_extended_op (tcb_sched_action (tcb_sched_dequeue) thread)
|
do_extended_op (tcb_sched_action (tcb_sched_dequeue) thread)
|
||||||
od"
|
od"
|
||||||
|
|
|
@ -73,8 +73,8 @@ fun handle_vm_fault :: "obj_ref \<Rightarrow> vmfault_type \<Rightarrow> (unit,'
|
||||||
storef = (\<lambda>a. throwError $ ArchFault $ VMFault a [0, vmFaultTypeFSR RISCVStoreAccessFault]);
|
storef = (\<lambda>a. throwError $ ArchFault $ VMFault a [0, vmFaultTypeFSR RISCVStoreAccessFault]);
|
||||||
instrf = (\<lambda>a. throwError $ ArchFault $ VMFault a [1, vmFaultTypeFSR RISCVInstructionAccessFault]);
|
instrf = (\<lambda>a. throwError $ ArchFault $ VMFault a [1, vmFaultTypeFSR RISCVInstructionAccessFault]);
|
||||||
set_pc = do
|
set_pc = do
|
||||||
sepc \<leftarrow> as_user thread $ getRegister SEPC;
|
faultip \<leftarrow> as_user thread $ getRegister FaultIP;
|
||||||
as_user thread $ setRegister NEXTPC sepc
|
as_user thread $ setRegister NextIP faultip
|
||||||
od
|
od
|
||||||
in
|
in
|
||||||
case fault_type of
|
case fault_type of
|
||||||
|
|
|
@ -42,6 +42,8 @@ context begin interpretation Arch .
|
||||||
|
|
||||||
requalify_consts
|
requalify_consts
|
||||||
capRegister
|
capRegister
|
||||||
|
faultRegister
|
||||||
|
nextInstructionRegister
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -120,9 +120,16 @@ Note that the idle thread is not considered runnable; this is to prevent it bein
|
||||||
|
|
||||||
When a thread is suspended, either explicitly by a TCB invocation or implicitly when it is being destroyed, any operation that it is currently performing must be cancelled.
|
When a thread is suspended, either explicitly by a TCB invocation or implicitly when it is being destroyed, any operation that it is currently performing must be cancelled.
|
||||||
|
|
||||||
|
> updateRestartPC :: PPtr TCB -> Kernel ()
|
||||||
|
> updateRestartPC tcb =
|
||||||
|
> asUser tcb (getRegister nextInstructionRegister
|
||||||
|
> >>= setRegister faultRegister)
|
||||||
|
|
||||||
> suspend :: PPtr TCB -> Kernel ()
|
> suspend :: PPtr TCB -> Kernel ()
|
||||||
> suspend target = do
|
> suspend target = do
|
||||||
> cancelIPC target
|
> cancelIPC target
|
||||||
|
> state <- getThreadState target
|
||||||
|
> if state == Running then updateRestartPC target else return ()
|
||||||
> setThreadState Inactive target
|
> setThreadState Inactive target
|
||||||
> tcbSchedDequeue target
|
> tcbSchedDequeue target
|
||||||
|
|
||||||
|
|
|
@ -47,7 +47,7 @@ The ARM idle thread runs in system mode with interrupts enabled, with the PC poi
|
||||||
> configureIdleThread tcb = do
|
> configureIdleThread tcb = do
|
||||||
> doKernelOp $ asUser tcb $ do
|
> doKernelOp $ asUser tcb $ do
|
||||||
> setRegister (Register CPSR) 0x1f
|
> setRegister (Register CPSR) 0x1f
|
||||||
> setRegister (Register LR_svc) $ fromVPtr idleThreadStart
|
> setRegister (Register NextIP) $ fromVPtr idleThreadStart
|
||||||
|
|
||||||
When switching to the idle thread, we ensure that it runs in the address space of the kernel to prevent the possibility of a user-level address space being deleted whilst the idle thread is running (which is possible in a multi-core scenario).
|
When switching to the idle thread, we ensure that it runs in the address space of the kernel to prevent the possibility of a user-level address space being deleted whilst the idle thread is running (which is possible in a multi-core scenario).
|
||||||
|
|
||||||
|
|
|
@ -182,8 +182,8 @@ handleVMFault thread f = do
|
||||||
storef a = ArchFault $ VMFault a [0, vmFaultTypeFSR RISCVStoreAccessFault]
|
storef a = ArchFault $ VMFault a [0, vmFaultTypeFSR RISCVStoreAccessFault]
|
||||||
instrf a = ArchFault $ VMFault a [1, vmFaultTypeFSR RISCVInstructionAccessFault]
|
instrf a = ArchFault $ VMFault a [1, vmFaultTypeFSR RISCVInstructionAccessFault]
|
||||||
setPC = do
|
setPC = do
|
||||||
sepc <- asUser thread $ getRegister (Register SEPC)
|
faultip <- asUser thread $ getRegister (Register FaultIP)
|
||||||
asUser thread $ setRegister (Register NEXTPC) sepc
|
asUser thread $ setRegister (Register NextIP) faultip
|
||||||
|
|
||||||
{- Unmapping and Deletion -}
|
{- Unmapping and Deletion -}
|
||||||
|
|
||||||
|
|
|
@ -182,8 +182,8 @@ The following functions define the ARM-specific interface between the kernel and
|
||||||
> debugPrint :: String -> MachineMonad ()
|
> debugPrint :: String -> MachineMonad ()
|
||||||
> debugPrint str = liftIO $ putStrLn str
|
> debugPrint str = liftIO $ putStrLn str
|
||||||
|
|
||||||
> getRestartPC = getRegister (Register ARM.FaultInstruction)
|
> getRestartPC = getRegister (Register ARM.FaultIP)
|
||||||
> setNextPC = setRegister (Register ARM.LR_svc)
|
> setNextPC = setRegister (Register ARM.NextIP)
|
||||||
|
|
||||||
\subsection{ARM Memory Management}
|
\subsection{ARM Memory Management}
|
||||||
|
|
||||||
|
|
|
@ -132,8 +132,8 @@ resetTimer = do
|
||||||
cbptr <- ask
|
cbptr <- ask
|
||||||
liftIO $ Platform.resetTimer cbptr
|
liftIO $ Platform.resetTimer cbptr
|
||||||
|
|
||||||
getRestartPC = getRegister (Register RISCV64.SEPC)
|
getRestartPC = getRegister (Register RISCV64.FaultIP)
|
||||||
setNextPC = setRegister (Register RISCV64.NEXTPC)
|
setNextPC = setRegister (Register RISCV64.NextIP)
|
||||||
|
|
||||||
{- Memory Management -}
|
{- Memory Management -}
|
||||||
|
|
||||||
|
|
|
@ -136,6 +136,16 @@ This list may be empty, though it should contain as many registers as possible.
|
||||||
> tlsBaseRegister :: Register
|
> tlsBaseRegister :: Register
|
||||||
> tlsBaseRegister = Register Arch.tlsBaseRegister
|
> tlsBaseRegister = Register Arch.tlsBaseRegister
|
||||||
|
|
||||||
|
\item[The fault register] holds the instruction which was being executed when the fault occured.
|
||||||
|
|
||||||
|
> faultRegister :: Register
|
||||||
|
> faultRegister = Register Arch.faultRegister
|
||||||
|
|
||||||
|
\item[The next instruction register] holds the instruction that will be executed upon resumption.
|
||||||
|
|
||||||
|
> nextInstructionRegister :: Register
|
||||||
|
> nextInstructionRegister = Register Arch.nextInstructionRegister
|
||||||
|
|
||||||
\end{description}
|
\end{description}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -30,7 +30,7 @@ This module defines the ARM register set.
|
||||||
|
|
||||||
> data Register =
|
> data Register =
|
||||||
> R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | SL | FP | IP | SP |
|
> R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | SL | FP | IP | SP |
|
||||||
> LR | LR_svc | FaultInstruction | CPSR | TLS_BASE | TPIDRURW
|
> LR | NextIP | FaultIP | CPSR | TLS_BASE | TPIDRURW
|
||||||
> deriving (Eq, Enum, Bounded, Ord, Ix, Show)
|
> deriving (Eq, Enum, Bounded, Ord, Ix, Show)
|
||||||
|
|
||||||
> type Word = Data.Word.Word32
|
> type Word = Data.Word.Word32
|
||||||
|
@ -39,14 +39,16 @@ This module defines the ARM register set.
|
||||||
> msgInfoRegister = R1
|
> msgInfoRegister = R1
|
||||||
> msgRegisters = [R2 .. R5]
|
> msgRegisters = [R2 .. R5]
|
||||||
> badgeRegister = R0
|
> badgeRegister = R0
|
||||||
> frameRegisters = FaultInstruction : SP : CPSR : [R0, R1] ++ [R8 .. IP]
|
> faultRegister = FaultIP
|
||||||
|
> nextInstructionRegister = NextIP
|
||||||
|
> frameRegisters = FaultIP : SP : CPSR : [R0, R1] ++ [R8 .. IP]
|
||||||
> gpRegisters = [R2, R3, R4, R5, R6, R7, LR]
|
> gpRegisters = [R2, R3, R4, R5, R6, R7, LR]
|
||||||
> exceptionMessage = [FaultInstruction, SP, CPSR]
|
> exceptionMessage = [FaultIP, SP, CPSR]
|
||||||
> syscallMessage = [R0 .. R7] ++ [FaultInstruction, SP, LR, CPSR]
|
> syscallMessage = [R0 .. R7] ++ [FaultIP, SP, LR, CPSR]
|
||||||
> tlsBaseRegister = TLS_BASE
|
> tlsBaseRegister = TLS_BASE
|
||||||
|
|
||||||
#ifdef CONFIG_ARM_HYPERVISOR_SUPPORT
|
#ifdef CONFIG_ARM_HYPERVISOR_SUPPORT
|
||||||
> elr_hyp = LR_svc
|
> elr_hyp = NextIP
|
||||||
|
|
||||||
\subsection{VCPU-saved Registers}
|
\subsection{VCPU-saved Registers}
|
||||||
|
|
||||||
|
|
|
@ -25,7 +25,7 @@ data Register
|
||||||
| A0 | A1 | A2 | A3 | A4 | A5 | A6 | A7
|
| A0 | A1 | A2 | A3 | A4 | A5 | A6 | A7
|
||||||
| S2 | S3 | S4 | S5 | S6 | S7 | S8 | S9 | S10 | S11
|
| S2 | S3 | S4 | S5 | S6 | S7 | S8 | S9 | S10 | S11
|
||||||
| T3 | T4 | T5 | T6
|
| T3 | T4 | T5 | T6
|
||||||
| SCAUSE | SSTATUS | SEPC | NEXTPC
|
| SCAUSE | SSTATUS | FaultIP | NextIP
|
||||||
deriving (Eq, Enum, Bounded, Ord, Ix, Show)
|
deriving (Eq, Enum, Bounded, Ord, Ix, Show)
|
||||||
|
|
||||||
type Word = Data.Word.Word64
|
type Word = Data.Word.Word64
|
||||||
|
@ -43,16 +43,16 @@ badgeRegister :: Register
|
||||||
badgeRegister = A0
|
badgeRegister = A0
|
||||||
|
|
||||||
frameRegisters :: [Register]
|
frameRegisters :: [Register]
|
||||||
frameRegisters = SEPC : [LR .. A6]
|
frameRegisters = FaultIP : [LR .. A6]
|
||||||
|
|
||||||
gpRegisters :: [Register]
|
gpRegisters :: [Register]
|
||||||
gpRegisters = []
|
gpRegisters = []
|
||||||
|
|
||||||
exceptionMessage :: [Register]
|
exceptionMessage :: [Register]
|
||||||
exceptionMessage = [SEPC, SP, A7]
|
exceptionMessage = [FaultIP, SP, A7]
|
||||||
|
|
||||||
syscallMessage :: [Register]
|
syscallMessage :: [Register]
|
||||||
syscallMessage = SEPC : SP : LR : [A0 .. A6]
|
syscallMessage = FaultIP : SP : LR : [A0 .. A6]
|
||||||
|
|
||||||
tlsBaseRegister :: Register
|
tlsBaseRegister :: Register
|
||||||
tlsBaseRegister = TP -- note: used for IPC buffer until TLS is used
|
tlsBaseRegister = TP -- note: used for IPC buffer until TLS is used
|
||||||
|
@ -63,6 +63,12 @@ sstatusSPIE = 0x20
|
||||||
initContext :: [(Register, Word)]
|
initContext :: [(Register, Word)]
|
||||||
initContext = [ (SSTATUS , sstatusSPIE) ]
|
initContext = [ (SSTATUS , sstatusSPIE) ]
|
||||||
|
|
||||||
|
faultRegister :: Register
|
||||||
|
faultRegister = FaultIP
|
||||||
|
|
||||||
|
nextInstructionRegister :: Register
|
||||||
|
nextInstructionRegister = NextIP
|
||||||
|
|
||||||
{- User-level Context -}
|
{- User-level Context -}
|
||||||
|
|
||||||
-- On RISC-V the representation of the user-level context of a thread is an array
|
-- On RISC-V the representation of the user-level context of a thread is an array
|
||||||
|
|
|
@ -39,6 +39,8 @@ This module defines the x86 64-bit register set.
|
||||||
> msgInfoRegister = RSI
|
> msgInfoRegister = RSI
|
||||||
> msgRegisters = [R10, R8, R9, R15]
|
> msgRegisters = [R10, R8, R9, R15]
|
||||||
> badgeRegister = capRegister
|
> badgeRegister = capRegister
|
||||||
|
> faultRegister = FaultIP
|
||||||
|
> nextInstructionRegister = NextIP
|
||||||
> frameRegisters = FaultIP : RSP : FLAGS : [RAX .. R15]
|
> frameRegisters = FaultIP : RSP : FLAGS : [RAX .. R15]
|
||||||
> gpRegisters = [TLS_BASE]
|
> gpRegisters = [TLS_BASE]
|
||||||
> exceptionMessage = [FaultIP, RSP, FLAGS]
|
> exceptionMessage = [FaultIP, RSP, FLAGS]
|
||||||
|
|
|
@ -238,8 +238,8 @@ seL4SaveContext breakFlag errorFlag errorString
|
||||||
asUser thread $ do
|
asUser thread $ do
|
||||||
zipWithM_ setRegister [Register R.R0 .. Register R.LR] regs
|
zipWithM_ setRegister [Register R.R0 .. Register R.LR] regs
|
||||||
setRegister (Register R.CPSR) cpsr
|
setRegister (Register R.CPSR) cpsr
|
||||||
setRegister (Register R.LR_svc) lr
|
setRegister (Register R.NextIP) lr
|
||||||
setRegister (Register R.FaultInstruction) fault
|
setRegister (Register R.FaultIP) fault
|
||||||
|
|
||||||
---- seL4RestoreContext ----
|
---- seL4RestoreContext ----
|
||||||
-- Restore the CPU exception context from the current thread's TCB. This
|
-- Restore the CPU exception context from the current thread's TCB. This
|
||||||
|
@ -260,7 +260,7 @@ seL4RestoreContext breakFlag errorFlag errorString
|
||||||
regs <- asUser thread $
|
regs <- asUser thread $
|
||||||
mapM getRegister [Register R.R0 .. Register R.LR]
|
mapM getRegister [Register R.R0 .. Register R.LR]
|
||||||
cpsr <- asUser thread $ getRegister $ Register R.CPSR
|
cpsr <- asUser thread $ getRegister $ Register R.CPSR
|
||||||
lr <- asUser thread $ getRegister $ Register R.LR_svc
|
lr <- asUser thread $ getRegister $ Register R.NextIP
|
||||||
return (regs, cpsr, lr)
|
return (regs, cpsr, lr)
|
||||||
zipWithM_ (pokeElemOff regptr) [0,1..] regs
|
zipWithM_ (pokeElemOff regptr) [0,1..] regs
|
||||||
poke cpsrptr cpsr
|
poke cpsrptr cpsr
|
||||||
|
|
|
@ -514,10 +514,10 @@ where
|
||||||
"setRegister r v \<equiv> modify (\<lambda>uc. uc (r := v))"
|
"setRegister r v \<equiv> modify (\<lambda>uc. uc (r := v))"
|
||||||
|
|
||||||
definition
|
definition
|
||||||
"getRestartPC \<equiv> getRegister FaultInstruction"
|
"getRestartPC \<equiv> getRegister FaultIP"
|
||||||
|
|
||||||
definition
|
definition
|
||||||
"setNextPC \<equiv> setRegister LR_svc"
|
"setNextPC \<equiv> setRegister NextIP"
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -689,10 +689,10 @@ where
|
||||||
"setRegister r v \<equiv> modify (\<lambda>uc. uc (r := v))"
|
"setRegister r v \<equiv> modify (\<lambda>uc. uc (r := v))"
|
||||||
|
|
||||||
definition
|
definition
|
||||||
"getRestartPC \<equiv> getRegister FaultInstruction"
|
"getRestartPC \<equiv> getRegister FaultIP"
|
||||||
|
|
||||||
definition
|
definition
|
||||||
"setNextPC \<equiv> setRegister LR_svc"
|
"setNextPC \<equiv> setRegister NextIP"
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -192,11 +192,11 @@ definition setRegister :: "register \<Rightarrow> machine_word \<Rightarrow> uni
|
||||||
|
|
||||||
definition getRestartPC :: "machine_word user_monad"
|
definition getRestartPC :: "machine_word user_monad"
|
||||||
where
|
where
|
||||||
"getRestartPC \<equiv> getRegister SEPC"
|
"getRestartPC \<equiv> getRegister FaultIP"
|
||||||
|
|
||||||
definition setNextPC :: "machine_word \<Rightarrow> unit user_monad"
|
definition setNextPC :: "machine_word \<Rightarrow> unit user_monad"
|
||||||
where
|
where
|
||||||
"setNextPC \<equiv> setRegister NEXTPC"
|
"setNextPC \<equiv> setRegister NextIP"
|
||||||
|
|
||||||
|
|
||||||
subsection "Caches, Barriers, and Flushing"
|
subsection "Caches, Barriers, and Flushing"
|
||||||
|
|
Loading…
Reference in New Issue