SELFOUR-421: infoflow and infoflow_c builds
This commit is contained in:
Xin,Gao
Rafal Kolanski
parent
328846ee1a
commit
252ce8df4c
|
|
@ -229,6 +229,7 @@ lemma user_op_access:
|
|||
apply simp+
|
||||
done
|
||||
|
||||
|
||||
lemma user_op_access':
|
||||
"\<lbrakk> invs s; pas_refined aag s; is_subject aag tcb;
|
||||
ptable_lift tcb s x = Some (addrFromPPtr ptr);
|
||||
|
|
@ -265,17 +266,68 @@ lemma dmo_user_memory_update_respects_Write:
|
|||
apply (simp add: dom_def)+
|
||||
done
|
||||
|
||||
lemma integrity_device_state_update:
|
||||
"\<lbrakk>integrity aag X st s;
|
||||
\<forall>x\<in>xs. (pasSubject aag, Write, pasObjectAbs aag x) \<in> pasPolicy aag;
|
||||
\<forall>x\<in>-xs. um' x = None
|
||||
\<rbrakk> \<Longrightarrow> integrity aag X st (machine_state_update (\<lambda>v. v\<lparr>device_state := device_state v ++ um'\<rparr>) s)"
|
||||
apply (clarsimp simp: integrity_def)
|
||||
apply (case_tac "x \<in> xs")
|
||||
apply (erule_tac x=x in ballE)
|
||||
apply (rule trd_write)
|
||||
apply simp+
|
||||
apply (erule_tac x = x in allE, erule integrity_device.cases)
|
||||
apply (erule trd_lrefl)
|
||||
apply (rule trd_orefl)
|
||||
apply (clarsimp simp:map_add_def)
|
||||
apply (erule trd_write)
|
||||
done
|
||||
|
||||
lemma dmo_device_update_respects_Write:
|
||||
"\<lbrace>integrity aag X st and (\<lambda>s. device_state (machine_state s) = um)
|
||||
and K (\<forall>p \<in> dom um'. aag_has_auth_to aag Write p)\<rbrace>
|
||||
do_machine_op (device_memory_update um')
|
||||
\<lbrace>\<lambda>a. integrity aag X st\<rbrace>"
|
||||
apply (simp add: device_memory_update_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp dmo_wp)
|
||||
apply clarsimp
|
||||
apply (simp cong: abstract_state.fold_congs)
|
||||
apply (rule integrity_device_state_update)
|
||||
apply simp
|
||||
apply clarify
|
||||
apply (drule(1) bspec)
|
||||
apply simp
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma dmo_um_upd_machine_state:
|
||||
"\<lbrace>\<lambda>s. P (device_state (machine_state s))\<rbrace>
|
||||
do_machine_op (user_memory_update ms)
|
||||
\<lbrace>\<lambda>_ s. P (device_state (machine_state s))\<rbrace>"
|
||||
apply (wp dmo_wp)
|
||||
by (simp add:user_memory_update_def simpler_modify_def valid_def)
|
||||
|
||||
lemma do_user_op_respects:
|
||||
"\<lbrace> invs and integrity aag X st and is_subject aag \<circ> cur_thread and pas_refined aag \<rbrace>
|
||||
do_user_op uop tc
|
||||
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
|
||||
apply (simp add: do_user_op_def)
|
||||
apply (wp dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift
|
||||
apply (wp | simp | wpc)+
|
||||
apply (rule dmo_device_update_respects_Write)
|
||||
apply (wp dmo_um_upd_machine_state
|
||||
dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift
|
||||
| wpc | clarsimp)+
|
||||
apply (rule hoare_pre_cont)
|
||||
apply (wp select_wp | wpc | clarsimp)+
|
||||
apply (simp add: restrict_map_def split:if_splits)
|
||||
apply (drule_tac auth=Write in user_op_access')
|
||||
apply (rule conjI)
|
||||
apply (clarsimp split:if_splits)
|
||||
apply (drule_tac auth=Write in user_op_access')
|
||||
apply (simp add: vspace_cap_rights_to_auth_def)+
|
||||
apply (rule conjI,simp)
|
||||
apply (clarsimp split:if_splits)
|
||||
apply (drule_tac auth=Write in user_op_access')
|
||||
apply (simp add: vspace_cap_rights_to_auth_def)+
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -873,9 +873,18 @@ where
|
|||
abbreviation
|
||||
"memory_integrity X aag x t1 t2 ipc == integrity_mem (aag :: 'a PAS) {pasSubject aag} x t1 t2 ipc X"
|
||||
|
||||
inductive
|
||||
integrity_device for aag subjects p ts ts' w w'
|
||||
where
|
||||
trd_lrefl: "\<lbrakk> pasObjectAbs aag p \<in> subjects \<rbrakk>
|
||||
\<Longrightarrow> integrity_device aag subjects p ts ts' w w'" (* implied by wf and write *)
|
||||
| trd_orefl: "\<lbrakk> w = w' \<rbrakk> \<Longrightarrow> integrity_device aag subjects p ts ts' w w'"
|
||||
| trd_write: "\<lbrakk> aag_subjects_have_auth_to subjects aag Write p \<rbrakk> \<Longrightarrow> integrity_device aag subjects p ts ts' w w'"
|
||||
|
||||
lemmas integrity_obj_simps [simp] = tro_orefl[OF refl]
|
||||
tro_lrefl[OF singletonI]
|
||||
trm_orefl[OF refl]
|
||||
trd_orefl[OF refl]
|
||||
tre_lrefl[OF singletonI]
|
||||
tre_orefl[OF refl]
|
||||
|
||||
|
|
@ -937,7 +946,7 @@ The other half involves showing that @{term "aag"} concords with the
|
|||
policy. See @{term "state_objs_to_policy s"}.
|
||||
|
||||
*}
|
||||
|
||||
term device_state
|
||||
definition
|
||||
integrity_subjects :: "'a set \<Rightarrow> 'a PAS \<Rightarrow> bool \<Rightarrow> obj_ref set \<Rightarrow> det_ext state \<Rightarrow> det_ext state \<Rightarrow> bool"
|
||||
where
|
||||
|
|
@ -948,6 +957,9 @@ where
|
|||
(auth_ipc_buffers s) X
|
||||
(underlying_memory (machine_state s) x)
|
||||
(underlying_memory (machine_state s') x)) \<and>
|
||||
(\<forall>x. integrity_device aag subjects x (tcb_states_of_state s) (tcb_states_of_state s')
|
||||
(device_state (machine_state s) x)
|
||||
(device_state (machine_state s') x)) \<and>
|
||||
(\<forall>x. integrity_cdt aag subjects x (cdt s x, is_original_cap s x) (cdt s' x, is_original_cap s' x)) \<and>
|
||||
(\<forall>x. integrity_cdt_list aag subjects x (cdt_list s x) (cdt_list s' x)) \<and>
|
||||
(\<forall>x. integrity_interrupts aag subjects x (interrupt_irq_node s x, interrupt_states s x) (interrupt_irq_node s' x, interrupt_states s' x)) \<and>
|
||||
|
|
@ -1093,7 +1105,7 @@ proof -
|
|||
from t2 have tro2: "\<forall>x. integrity_obj aag activate subjects (pasObjectAbs aag x) (kheap s' x) (kheap s'' x)"
|
||||
unfolding integrity_subjects_def by simp
|
||||
|
||||
have "\<forall>x. integrity_mem aag subjects x
|
||||
have intm: "\<forall>x. integrity_mem aag subjects x
|
||||
(tcb_states_of_state s) (tcb_states_of_state s'') (auth_ipc_buffers s) X
|
||||
(underlying_memory (machine_state s) x)
|
||||
(underlying_memory (machine_state s'') x)" (is "\<forall>x. ?P x s s''")
|
||||
|
|
@ -1147,7 +1159,33 @@ proof -
|
|||
qed
|
||||
qed
|
||||
|
||||
thus ?thesis using tro_trans[OF tro1 tro2] t1 t2
|
||||
moreover have "\<forall>x. integrity_device aag subjects x
|
||||
(tcb_states_of_state s) (tcb_states_of_state s'')
|
||||
(device_state (machine_state s) x)
|
||||
(device_state (machine_state s'') x)" (is "\<forall>x. ?P x s s''")
|
||||
proof
|
||||
fix x
|
||||
from t1 t2 have m1: "?P x s s'" and m2: "?P x s' s''" unfolding integrity_subjects_def by auto
|
||||
|
||||
from m1 show "?P x s s''"
|
||||
proof cases
|
||||
case trd_lrefl thus ?thesis by (rule integrity_device.intros)
|
||||
next
|
||||
case torel1: trd_orefl
|
||||
from m2 show ?thesis
|
||||
proof cases
|
||||
case (trd_lrefl) thus ?thesis by (rule integrity_device.trd_lrefl)
|
||||
next
|
||||
case trd_orefl thus ?thesis
|
||||
by (simp add:torel1)
|
||||
next
|
||||
case trd_write thus ?thesis by (rule integrity_device.trd_write)
|
||||
qed
|
||||
next
|
||||
case trd_write thus ?thesis by (rule integrity_device.intros)
|
||||
qed
|
||||
qed
|
||||
thus ?thesis using tro_trans[OF tro1 tro2] t1 t2 intm
|
||||
apply (clarsimp simp add: integrity_subjects_def)
|
||||
apply (drule(1) trcdt_trans[simplified])
|
||||
apply (drule(1) trcdtlist_trans[simplified])
|
||||
|
|
@ -1171,13 +1209,17 @@ subsection{* Generic stuff *}
|
|||
lemma integrity_update_autarch:
|
||||
"\<lbrakk> integrity aag X st s; is_subject aag ptr \<rbrakk> \<Longrightarrow> integrity aag X st (s\<lparr>kheap := kheap s(ptr \<mapsto> obj)\<rparr>)"
|
||||
unfolding integrity_subjects_def
|
||||
apply (rule conjI)
|
||||
apply (intro conjI,simp_all)
|
||||
apply clarsimp
|
||||
apply clarsimp
|
||||
apply (drule_tac x = x in spec, erule integrity_mem.cases)
|
||||
apply (drule_tac x = x in spec, erule integrity_mem.cases)
|
||||
apply ((auto intro: integrity_mem.intros)+)[4]
|
||||
apply (erule trm_ipc, simp_all)
|
||||
apply (clarsimp simp: restrict_map_Some_iff tcb_states_of_state_def get_tcb_def)
|
||||
apply (erule trm_ipc, simp_all)
|
||||
apply (clarsimp simp: restrict_map_Some_iff tcb_states_of_state_def get_tcb_def)
|
||||
apply clarsimp
|
||||
apply (drule_tac x = x in spec, erule integrity_device.cases)
|
||||
apply (erule integrity_device.trd_lrefl)
|
||||
apply (erule integrity_device.trd_orefl)
|
||||
apply (erule integrity_device.trd_write)
|
||||
done
|
||||
|
||||
lemma set_object_integrity_autarch:
|
||||
|
|
@ -1627,6 +1669,10 @@ lemma integrity_mono:
|
|||
apply clarsimp
|
||||
apply (drule_tac x=x in spec, erule integrity_mem.cases,
|
||||
(blast intro: integrity_mem.intros trm_ipc')+)[1]
|
||||
apply (rule conjI)
|
||||
apply clarsimp
|
||||
apply (drule_tac x=x in spec, erule integrity_device.cases,
|
||||
(blast intro: integrity_device.intros)+)[1]
|
||||
apply (simp add: integrity_cdt_list_def)
|
||||
apply (rule conjI)
|
||||
apply (fastforce simp: integrity_cdt_def)
|
||||
|
|
|
|||
|
|
@ -452,8 +452,8 @@ lemma kernel_base_aligned_20:
|
|||
done
|
||||
|
||||
lemma diminished_PageCapD:
|
||||
"diminished (ArchObjectCap (PageCap p R sz m)) cap
|
||||
\<Longrightarrow> \<exists>R'. cap = ArchObjectCap (PageCap p R' sz m)"
|
||||
"diminished (ArchObjectCap (PageCap dev p R sz m)) cap
|
||||
\<Longrightarrow> \<exists>R'. cap = ArchObjectCap (PageCap dev p R' sz m)"
|
||||
apply (cases cap, auto simp add: diminished_def mask_cap_def cap_rights_update_def)
|
||||
apply (auto simp: acap_rights_update_def split: arch_cap.splits)
|
||||
done
|
||||
|
|
@ -472,6 +472,10 @@ lemma mol_mem[wp]:
|
|||
"\<lbrace>\<lambda>ms. P (underlying_memory ms)\<rbrace> machine_op_lift mop \<lbrace>\<lambda>rv ms. P (underlying_memory ms)\<rbrace>"
|
||||
by (simp add: machine_op_lift_def machine_rest_lift_def split_def | wp)+
|
||||
|
||||
lemma mol_dvs[wp]:
|
||||
"\<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> machine_op_lift mop \<lbrace>\<lambda>rv ms. P (device_state ms)\<rbrace>"
|
||||
by (simp add: machine_op_lift_def machine_rest_lift_def split_def | wp)+
|
||||
|
||||
lemmas do_flush_defs = cleanCacheRange_RAM_def cleanCacheRange_PoC_def cleanCacheRange_PoU_def invalidateCacheRange_RAM_def cleanInvalidateCacheRange_RAM_def branchFlushRange_def invalidateCacheRange_I_def
|
||||
|
||||
lemma do_flush_respects[wp]:
|
||||
|
|
@ -826,7 +830,7 @@ lemma delete_objects_pas_refined[wp]:
|
|||
|
||||
lemma delete_objects_pspace_no_overlap:
|
||||
"\<lbrace> pspace_aligned and valid_objs and
|
||||
(\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap ptr sz idx)) slot s)\<rbrace>
|
||||
(\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap dev ptr sz idx)) slot s)\<rbrace>
|
||||
delete_objects ptr sz
|
||||
\<lbrace>\<lambda>rv. pspace_no_overlap ptr sz\<rbrace>"
|
||||
unfolding delete_objects_def do_machine_op_def
|
||||
|
|
@ -839,8 +843,8 @@ lemma delete_objects_pspace_no_overlap:
|
|||
|
||||
lemma delete_objects_invs_ex:
|
||||
"\<lbrace>(\<lambda>s. \<exists>slot f.
|
||||
cte_wp_at (op = (UntypedCap ptr bits f)) slot s \<and>
|
||||
descendants_range (UntypedCap ptr bits f) slot s) and
|
||||
cte_wp_at (op = (UntypedCap dev ptr bits f)) slot s \<and>
|
||||
descendants_range (UntypedCap dev ptr bits f) slot s) and
|
||||
invs and
|
||||
ct_active\<rbrace>
|
||||
delete_objects ptr bits \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
|
|
@ -871,8 +875,8 @@ lemma perform_asid_control_invocation_pas_refined [wp]:
|
|||
set_cap_descendants_range_in set_cap_no_overlap get_cap_wp
|
||||
hoare_vcg_all_lift static_imp_wp
|
||||
| simp add: do_machine_op_def split_def)+
|
||||
apply(rename_tac word1 prod1 prod2 word2 cap)
|
||||
apply(rule_tac Q="\<lambda> rv s. (\<exists> idx. cte_wp_at (op = (UntypedCap word1 pageBits idx)) prod2 s) \<and>
|
||||
apply(rename_tac word1 prod1 prod2 word2 cap )
|
||||
apply(rule_tac Q="\<lambda> rv s. (\<exists> idx. cte_wp_at (op = (UntypedCap False word1 pageBits idx)) prod2 s) \<and>
|
||||
(\<forall> x\<in>ptr_range word1 pageBits. is_subject aag x) \<and>
|
||||
pas_refined aag s \<and>
|
||||
pas_cur_domain aag s \<and>
|
||||
|
|
@ -910,6 +914,8 @@ lemma perform_asid_control_invocation_pas_refined [wp]:
|
|||
apply(rule conjI, fastforce)
|
||||
apply(rule conjI)
|
||||
apply(fastforce simp: descendants_range_def2 elim!: empty_descendants_range_in)
|
||||
apply(rule conjI)
|
||||
apply fastforce
|
||||
apply(rule conjI)
|
||||
apply(fastforce simp: descendants_range_def2 elim!: empty_descendants_range_in)
|
||||
apply(rule conjI)
|
||||
|
|
|
|||
|
|
@ -379,14 +379,20 @@ lemma cap_swap_for_delete_respects[wp]:
|
|||
|
||||
lemma dmo_no_mem_respects:
|
||||
assumes p: "\<And>P. \<lbrace>\<lambda>ms. P (underlying_memory ms)\<rbrace> mop \<lbrace>\<lambda>_ ms. P (underlying_memory ms)\<rbrace>"
|
||||
assumes q: "\<And>P. \<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> mop \<lbrace>\<lambda>_ ms. P (device_state ms)\<rbrace>"
|
||||
shows "\<lbrace>integrity aag X st\<rbrace> do_machine_op mop \<lbrace>\<lambda>_. integrity aag X st\<rbrace>"
|
||||
unfolding do_machine_op_def
|
||||
apply (rule hoare_pre)
|
||||
apply (simp add: split_def)
|
||||
apply (wp )
|
||||
apply (clarsimp simp: integrity_def)
|
||||
apply (rule conjI)
|
||||
apply clarsimp
|
||||
apply (drule_tac x = x in spec)+
|
||||
apply (erule (1) use_valid [OF _ p])
|
||||
apply clarsimp
|
||||
apply (drule_tac x = x in spec)+
|
||||
apply (erule (1) use_valid [OF _ p])
|
||||
apply (erule (1) use_valid [OF _ q])
|
||||
done
|
||||
|
||||
(* MOVE *)
|
||||
|
|
|
|||
|
|
@ -675,7 +675,7 @@ lemma cancel_badged_sends_domain_sep_inv[wp]:
|
|||
done
|
||||
|
||||
crunch domain_sep_inv[wp]: arch_recycle_cap "domain_sep_inv irqs st"
|
||||
(wp: crunch_wps)
|
||||
(wp: crunch_wps hoare_unless_wp)
|
||||
|
||||
lemma recycle_cap_domain_sep_inv[wp]:
|
||||
"\<lbrace>domain_sep_inv irqs st\<rbrace>
|
||||
|
|
@ -712,7 +712,7 @@ lemma invoke_cnode_domain_sep_inv:
|
|||
|
||||
lemma create_cap_domain_sep_inv[wp]:
|
||||
"\<lbrace> domain_sep_inv irqs st\<rbrace>
|
||||
create_cap tp sz p slot
|
||||
create_cap tp sz p dev slot
|
||||
\<lbrace> \<lambda>_. domain_sep_inv irqs st\<rbrace>"
|
||||
apply(simp add: create_cap_def)
|
||||
apply(rule hoare_pre)
|
||||
|
|
@ -739,7 +739,7 @@ lemma domain_sep_inv_detype_lift:
|
|||
|
||||
lemma retype_region_neg_cte_wp_at_not_domain_sep_inv_cap:
|
||||
"\<lbrace>\<lambda>s. \<not> cte_wp_at (not domain_sep_inv_cap irqs) slot s \<rbrace>
|
||||
retype_region base n sz ty
|
||||
retype_region base n sz ty dev
|
||||
\<lbrace>\<lambda>rv s. \<not> cte_wp_at (not domain_sep_inv_cap irqs) slot s\<rbrace>"
|
||||
apply(rule hoare_pre)
|
||||
apply(simp only: retype_region_def retype_addrs_def
|
||||
|
|
@ -759,7 +759,7 @@ lemma retype_region_neg_cte_wp_at_not_domain_sep_inv_cap:
|
|||
|
||||
lemma retype_region_domain_sep_inv[wp]:
|
||||
"\<lbrace>domain_sep_inv irqs st\<rbrace>
|
||||
retype_region base n sz tp
|
||||
retype_region base n sz tp dev
|
||||
\<lbrace>\<lambda>_. domain_sep_inv irqs st\<rbrace>"
|
||||
apply(rule domain_sep_inv_wp[where P="\<top>" and R="\<top>", simplified])
|
||||
apply(rule retype_region_neg_cte_wp_at_not_domain_sep_inv_cap)
|
||||
|
|
@ -767,13 +767,13 @@ lemma retype_region_domain_sep_inv[wp]:
|
|||
done
|
||||
|
||||
lemma domain_sep_inv_cap_UntypedCap[simp]:
|
||||
"domain_sep_inv_cap irqs (UntypedCap base sz n)"
|
||||
"domain_sep_inv_cap irqs (UntypedCap dev base sz n)"
|
||||
apply(simp add: domain_sep_inv_cap_def)
|
||||
done
|
||||
|
||||
crunch domain_sep_inv[wp]: invoke_untyped "domain_sep_inv irqs st"
|
||||
(ignore: freeMemory retype_region wp: crunch_wps domain_sep_inv_detype_lift
|
||||
get_cap_wp
|
||||
get_cap_wp hoare_unless_wp
|
||||
simp: crunch_simps mapM_x_def_bak)
|
||||
|
||||
lemma perform_page_invocation_domain_sep_inv_get_cap_helper:
|
||||
|
|
|
|||
|
|
@ -787,7 +787,7 @@ lemma arch_recycle_cap_respects:
|
|||
hoare_vcg_all_lift hoare_vcg_const_imp_lift
|
||||
clearMemory_invs
|
||||
| wpc | simp add: swp_def cap_aligned_def if_apply_def2
|
||||
| wp_once hoare_drop_imps
|
||||
| wp_once hoare_drop_imps hoare_unless_wp
|
||||
| elim conjE
|
||||
| (erule is_aligned_weaken, simp add: pd_bits_def pageBits_def))+
|
||||
apply (clarsimp simp: conj_comms cases_simp_options valid_cap_def cap_aligned_def)
|
||||
|
|
@ -944,7 +944,7 @@ lemma arch_recycle_cap_pas_refined:
|
|||
mapM_x_swp_store_pde_invs_unmap[unfolded swp_def]
|
||||
mapM_x_and_const_wp[OF store_pte_pas_refined]
|
||||
mapM_x_and_const_wp[OF store_pde_pas_refined]
|
||||
hoare_vcg_if_lift_ER
|
||||
hoare_vcg_if_lift_ER hoare_unless_wp
|
||||
| wpc
|
||||
| simp add: fun_upd_def[symmetric] cases_simp_options
|
||||
pte_ref_simps pde_ref_simps
|
||||
|
|
|
|||
|
|
@ -139,13 +139,22 @@ lemma kheap_auth_ipc_buffer_same:
|
|||
"kheap st thread = kheap s thread \<Longrightarrow> auth_ipc_buffers st thread = auth_ipc_buffers s thread"
|
||||
unfolding auth_ipc_buffers_def get_tcb_def by simp
|
||||
|
||||
lemma tcb_ipc_buffer_not_device:
|
||||
"\<lbrakk>kheap s thread = Some (TCB tcb);valid_objs s\<rbrakk>
|
||||
\<Longrightarrow> \<not> cap_is_device (tcb_ipcframe tcb)"
|
||||
apply (erule(1) valid_objsE)
|
||||
apply (clarsimp simp:valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
|
||||
split:cap.split_asm arch_cap.split_asm)
|
||||
done
|
||||
|
||||
lemma tro_auth_ipc_buffer_idem:
|
||||
"\<lbrakk> \<forall>x. integrity_obj aag activate subjects (pasObjectAbs aag x) (kheap st x) (kheap s x);
|
||||
pasObjectAbs aag thread \<notin> subjects \<rbrakk> \<Longrightarrow> auth_ipc_buffers st thread = auth_ipc_buffers s thread"
|
||||
pasObjectAbs aag thread \<notin> subjects; valid_objs s \<rbrakk> \<Longrightarrow> auth_ipc_buffers st thread = auth_ipc_buffers s thread"
|
||||
apply (drule spec [where x = thread])
|
||||
apply (erule integrity_obj.cases,
|
||||
simp_all add: auth_ipc_buffers_def get_tcb_def)
|
||||
apply (auto cong: cap.case_cong arch_cap.case_cong if_cong)
|
||||
apply (auto cong: cap.case_cong arch_cap.case_cong if_cong simp: case_bool_if
|
||||
dest!:tcb_ipc_buffer_not_device split:arch_cap.splits cap.splits split:if_splits)
|
||||
done
|
||||
|
||||
lemma dmo_storeWord_respects_ipc:
|
||||
|
|
@ -243,7 +252,8 @@ lemma lookup_ipc_buffer_has_auth [wp]:
|
|||
apply (erule aligned_add_aligned)
|
||||
apply (rule is_aligned_andI1)
|
||||
apply (drule (1) valid_tcb_objs)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
|
||||
split: if_splits)
|
||||
apply (rule order_trans [OF _ pbfs_atleast_pageBits])
|
||||
apply (simp add: msg_align_bits pageBits_def)
|
||||
apply simp
|
||||
|
|
@ -354,7 +364,7 @@ lemma as_user_set_register_respects:
|
|||
done
|
||||
|
||||
lemma lookup_ipc_buffer_ptr_range:
|
||||
"\<lbrace>integrity aag X st\<rbrace>
|
||||
"\<lbrace>valid_objs and integrity aag X st\<rbrace>
|
||||
lookup_ipc_buffer True thread
|
||||
\<lbrace>\<lambda>rv s. \<not> is_subject aag thread \<longrightarrow> (case rv of None \<Rightarrow> True | Some buf' \<Rightarrow> auth_ipc_buffers st thread = ptr_range buf' msg_align_bits) \<rbrace>"
|
||||
unfolding lookup_ipc_buffer_def
|
||||
|
|
@ -366,6 +376,9 @@ lemma lookup_ipc_buffer_ptr_range:
|
|||
apply (clarsimp simp: auth_ipc_buffers_def get_tcb_ko_at [symmetric] integrity_def)
|
||||
apply (drule spec [where x = thread])+
|
||||
apply (drule get_tcb_SomeD)+
|
||||
apply (erule(1) valid_objsE)
|
||||
apply (clarsimp simp:valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def case_bool_if
|
||||
split:split_if_asm)
|
||||
apply (erule integrity_obj.cases, simp_all add: get_tcb_def vm_read_write_def)
|
||||
apply auto
|
||||
done
|
||||
|
|
@ -1848,7 +1861,7 @@ lemma do_fault_transfer_respects_in_ipc:
|
|||
done
|
||||
|
||||
lemma lookup_ipc_buffer_ptr_range_in_ipc:
|
||||
"\<lbrace>integrity_tcb_in_ipc aag X thread epptr tst st\<rbrace>
|
||||
"\<lbrace>valid_objs and integrity_tcb_in_ipc aag X thread epptr tst st\<rbrace>
|
||||
lookup_ipc_buffer True thread
|
||||
\<lbrace>\<lambda>rv s. \<not> is_subject aag thread \<longrightarrow> (case rv of None \<Rightarrow> True | Some buf' \<Rightarrow> auth_ipc_buffers st thread = ptr_range buf' msg_align_bits) \<rbrace>"
|
||||
unfolding lookup_ipc_buffer_def
|
||||
|
|
@ -1858,6 +1871,10 @@ lemma lookup_ipc_buffer_ptr_range_in_ipc:
|
|||
apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"])
|
||||
apply (simp add: dom_tcb_cap_cases)
|
||||
apply (clarsimp simp: auth_ipc_buffers_def get_tcb_ko_at [symmetric] integrity_tcb_in_ipc_def)
|
||||
apply (drule get_tcb_SomeD)
|
||||
apply (erule(1) valid_objsE)
|
||||
apply (clarsimp simp:valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def case_bool_if
|
||||
split:split_if_asm)
|
||||
apply (erule tcb_in_ipc.cases, simp_all)
|
||||
apply (clarsimp simp: get_tcb_def vm_read_write_def)
|
||||
apply (clarsimp simp: get_tcb_def vm_read_write_def)
|
||||
|
|
@ -1878,7 +1895,8 @@ lemma lookup_ipc_buffer_aligned:
|
|||
apply (erule aligned_add_aligned)
|
||||
apply (rule is_aligned_andI1)
|
||||
apply (drule (1) valid_tcb_objs)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
|
||||
split: if_splits)
|
||||
apply (rule order_trans [OF _ pbfs_atleast_pageBits])
|
||||
apply (simp add: msg_align_bits pageBits_def)
|
||||
done
|
||||
|
|
|
|||
|
|
@ -474,6 +474,9 @@ lemma word_object_range_cover:
|
|||
apply(auto simp: word_object_range_cover_auth_def obj_bits_api_def word_object_size_def default_arch_object_def | auto dest!: range_cover_subset' subsetD)+
|
||||
done
|
||||
|
||||
lemma bool_enum[simp]: "(\<forall>x. d = (\<not> x)) = False" "(\<forall>x. d = x) = False"
|
||||
by blast+
|
||||
|
||||
lemma invoke_untyped_integrity:
|
||||
"\<lbrace>integrity aag X st and valid_objs and authorised_untyped_inv_state aag ui and valid_untyped_inv ui and K (authorised_untyped_inv aag ui)\<rbrace>
|
||||
invoke_untyped ui
|
||||
|
|
@ -488,15 +491,16 @@ lemma invoke_untyped_integrity:
|
|||
set_cap_integrity_autarch hoare_vcg_if_lift get_cap_wp
|
||||
| clarsimp simp: split_paired_Ball
|
||||
| erule in_set_zipE | blast)+
|
||||
apply (rename_tac ptr ty bits li dev s cap sz idx )
|
||||
apply(frule (1) cte_wp_at_eqD2)
|
||||
apply(clarsimp simp: authorised_untyped_inv_state_def is_aligned_neg_mask_eq ptr_range_def p_assoc_help bits_of_def)
|
||||
apply(rule conjI)
|
||||
apply(rule impI)
|
||||
apply(drule_tac t=word2 in sym)
|
||||
apply(drule_tac t=ptr in sym)
|
||||
apply clarsimp
|
||||
apply(drule (1) cte_wp_at_valid_objs_valid_cap)
|
||||
apply(clarsimp simp: valid_cap_def cap_aligned_def)
|
||||
apply(subgoal_tac "range_cover word2 (bits_of (UntypedCap word2 sz idx)) (obj_bits_api apiobject_type nat) (length list)")
|
||||
apply(subgoal_tac "range_cover ptr (bits_of (UntypedCap dev ptr sz idx)) (obj_bits_api ty bits) (length li)")
|
||||
apply(rule conjI, assumption)
|
||||
apply(rule conjI)
|
||||
apply(fastforce split: cap.splits simp: bits_of_def)
|
||||
|
|
@ -507,11 +511,11 @@ lemma invoke_untyped_integrity:
|
|||
apply assumption
|
||||
apply(blast dest: unat_less_helper)
|
||||
apply(clarsimp simp: bits_of_def split: cap.splits)
|
||||
apply(drule_tac x="UntypedCap word2 sz idx" in spec, clarsimp, fastforce simp: p_assoc_help)
|
||||
apply(drule_tac x="UntypedCap dev ptr sz idx" in spec, clarsimp, fastforce simp: p_assoc_help)
|
||||
apply(simp add: bits_of_def split: cap.splits)
|
||||
apply(rule impI)
|
||||
apply(clarsimp simp: bits_of_def split: cap.splits)
|
||||
apply(drule_tac x="UntypedCap (word2 && ~~ mask sz) sz idx" in spec, clarsimp)
|
||||
apply(drule_tac x="UntypedCap dev (ptr && ~~ mask sz) sz idx" in spec, clarsimp)
|
||||
apply(rule conjI)
|
||||
apply(rule ballI, erule bspec, erule subsetD[rotated], rule range_subsetI[OF word_and_le2], simp+)
|
||||
apply(rule word_object_range_cover)
|
||||
|
|
@ -522,7 +526,7 @@ lemma invoke_untyped_integrity:
|
|||
|
||||
|
||||
lemma clas_default_cap:
|
||||
"tp \<noteq> ArchObject ASIDPoolObj \<Longrightarrow> cap_links_asid_slot aag p (default_cap tp p' sz)"
|
||||
"tp \<noteq> ArchObject ASIDPoolObj \<Longrightarrow> cap_links_asid_slot aag p (default_cap tp p' sz dev)"
|
||||
unfolding cap_links_asid_slot_def
|
||||
apply (cases tp, simp_all)
|
||||
apply (rename_tac aobject_type)
|
||||
|
|
@ -530,25 +534,25 @@ lemma clas_default_cap:
|
|||
done
|
||||
|
||||
lemma cli_default_cap:
|
||||
"tp \<noteq> ArchObject ASIDPoolObj \<Longrightarrow> cap_links_irq aag p (default_cap tp p' sz)"
|
||||
"tp \<noteq> ArchObject ASIDPoolObj \<Longrightarrow> cap_links_irq aag p (default_cap tp p' sz dev)"
|
||||
unfolding cap_links_irq_def
|
||||
apply (cases tp, simp_all)
|
||||
done
|
||||
|
||||
lemma obj_refs_default_nut:
|
||||
"\<lbrakk> tp \<noteq> Untyped; \<forall>atp. tp \<noteq> ArchObject atp \<rbrakk> \<Longrightarrow>
|
||||
obj_refs (default_cap tp oref sz) = {oref}"
|
||||
obj_refs (default_cap tp oref sz dev) = {oref}"
|
||||
by (cases tp, simp_all add: arch_default_cap_def split: aobject_type.splits)
|
||||
|
||||
lemma obj_refs_default':
|
||||
"is_aligned oref (obj_bits_api tp sz) \<Longrightarrow> obj_refs (default_cap tp oref sz) \<subseteq> ptr_range oref (obj_bits_api tp sz)"
|
||||
"is_aligned oref (obj_bits_api tp sz) \<Longrightarrow> obj_refs (default_cap tp oref sz dev) \<subseteq> ptr_range oref (obj_bits_api tp sz)"
|
||||
by (cases tp, simp_all add: arch_default_cap_def ptr_range_memI obj_bits_api_def default_arch_object_def split: aobject_type.splits)
|
||||
|
||||
lemma create_cap_pas_refined:
|
||||
"\<lbrace>pas_refined aag and K (tp \<noteq> ArchObject ASIDPoolObj \<and> is_subject aag (fst p) \<and> is_subject aag (fst (fst ref)) \<and>
|
||||
(\<forall>x \<in> ptr_range (snd ref) (obj_bits_api tp sz). is_subject aag x)
|
||||
\<and> is_aligned (snd ref) (obj_bits_api tp sz))\<rbrace>
|
||||
create_cap tp sz p ref
|
||||
create_cap tp sz p dev ref
|
||||
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
|
||||
apply(simp add: create_cap_def split_def)
|
||||
apply(wp set_cdt_pas_refined | clarsimp)+
|
||||
|
|
@ -567,10 +571,11 @@ crunch pas_refined[wp]: do_machine_op "pas_refined aag"
|
|||
|
||||
lemma create_word_objects_pas_refined:
|
||||
"\<lbrace>pas_refined aag\<rbrace>
|
||||
create_word_objects ptr bits sz
|
||||
create_word_objects ptr bits sz dev
|
||||
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
|
||||
apply(simp add: create_word_objects_def)
|
||||
apply(wp)
|
||||
apply (simp add: create_word_objects_def unless_def)
|
||||
apply wp
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
crunch arm_global_pd: store_pde "\<lambda> s. P (arm_global_pd (arch_state s))"
|
||||
|
|
@ -657,7 +662,7 @@ lemma init_arch_objects_pas_refined:
|
|||
post_retype_invs tp refs and
|
||||
(\<lambda> s. \<forall> x\<in>set refs. x \<notin> global_refs s) and
|
||||
K (\<forall> x\<in>set refs. tp = ArchObject PageDirectoryObj \<longrightarrow> is_aligned x pd_bits)\<rbrace>
|
||||
init_arch_objects tp ptr bits obj_sz refs
|
||||
init_arch_objects tp ptr bits obj_sz refs dev
|
||||
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
apply(cases tp)
|
||||
|
|
@ -685,7 +690,7 @@ context retype_region_proofs
|
|||
begin
|
||||
|
||||
lemma vs_refs_no_global_pts_default [simp]:
|
||||
"vs_refs_no_global_pts (default_object ty us) = {}"
|
||||
"vs_refs_no_global_pts (default_object ty dev us) = {}"
|
||||
by (simp add: default_object_def default_arch_object_def tyunt
|
||||
vs_refs_no_global_pts_def pde_ref2_def pte_ref_def
|
||||
o_def
|
||||
|
|
@ -749,10 +754,10 @@ lemma retype_region_ext_kheap_update:
|
|||
done
|
||||
|
||||
lemma use_retype_region_proofs_ext':
|
||||
assumes x: "\<And>(s::det_ext state). \<lbrakk> retype_region_proofs s ty us ptr sz n; P s \<rbrakk>
|
||||
assumes x: "\<And>(s::det_ext state). \<lbrakk> retype_region_proofs s ty us ptr sz n dev; P s \<rbrakk>
|
||||
\<Longrightarrow> Q (retype_addrs ptr ty n us) (s\<lparr>kheap :=
|
||||
\<lambda>x. if x \<in> set (retype_addrs ptr ty n us)
|
||||
then Some (default_object ty us)
|
||||
then Some (default_object ty dev us )
|
||||
else kheap s x\<rparr>)"
|
||||
assumes y: "\<And>xs. \<lbrace>Q xs and R xs\<rbrace> retype_region_ext xs ty \<lbrace>\<lambda>_. Q xs\<rbrace>"
|
||||
assumes z: "\<And>f xs s. R xs (kheap_update f s) = R xs s"
|
||||
|
|
@ -761,8 +766,9 @@ lemma use_retype_region_proofs_ext':
|
|||
\<And>s. P s \<Longrightarrow> Q (retype_addrs ptr ty n us) s \<rbrakk> \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. valid_pspace s \<and> valid_mdb s \<and> range_cover ptr sz (obj_bits_api ty us) n
|
||||
\<and> caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1} s
|
||||
\<and> caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s \<and>
|
||||
P s \<and> R (retype_addrs ptr ty n us) s\<rbrace> retype_region ptr n us ty \<lbrace>Q\<rbrace>"
|
||||
\<and> caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s
|
||||
\<and> (\<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) \<and>
|
||||
P s \<and> R (retype_addrs ptr ty n us) s\<rbrace> retype_region ptr n us ty dev \<lbrace>Q\<rbrace>"
|
||||
apply (simp add: retype_region_def split del: split_if)
|
||||
apply (rule hoare_pre, (wp|simp)+)
|
||||
apply (rule retype_region_ext_kheap_update[OF y])
|
||||
|
|
@ -772,7 +778,7 @@ lemma use_retype_region_proofs_ext':
|
|||
apply safe
|
||||
apply (rule x)
|
||||
apply (rule retype_region_proofs.intro, simp_all)[1]
|
||||
apply (simp add: range_cover_def obj_bits_api_def z
|
||||
apply (fastforce simp add: range_cover_def obj_bits_api_def z
|
||||
slot_bits_def word_bits_def cte_level_bits_def)+
|
||||
done
|
||||
|
||||
|
|
@ -808,14 +814,14 @@ lemma retype_region_pas_refined:
|
|||
{ptr..ptr + of_nat num_objects * 2 ^ obj_bits_api type o_bits -
|
||||
1} and
|
||||
caps_no_overlap ptr sz and pspace_no_overlap ptr sz and
|
||||
(\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) and
|
||||
K (range_cover ptr sz (obj_bits_api type o_bits) num_objects) and
|
||||
K (\<forall>x\<in>set (retype_addrs ptr type num_objects o_bits). is_subject aag x) and
|
||||
K ((type = CapTableObject \<longrightarrow> 0 < o_bits))\<rbrace>
|
||||
retype_region ptr num_objects o_bits type
|
||||
retype_region ptr num_objects o_bits type dev
|
||||
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
|
||||
apply (rule hoare_gen_asm)
|
||||
apply (rule hoare_pre)
|
||||
thm use_retype_region_proofs_ext
|
||||
apply(rule use_retype_region_proofs_ext)
|
||||
apply(erule (1) retype_region_proofs'.pas_refined[OF retype_region_proofs'.intro])
|
||||
apply (wp retype_region_ext_pas_refined)
|
||||
|
|
@ -829,9 +835,10 @@ lemma retype_region_aag_bits:
|
|||
\<and> valid_pspace s \<and> valid_mdb s \<and>
|
||||
caps_overlap_reserved
|
||||
{ptr..ptr + of_nat num_objects * 2 ^ obj_bits_api tp us - 1} s \<and>
|
||||
caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s
|
||||
caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s \<and>
|
||||
(\<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
\<and> ((tp = CapTableObject \<longrightarrow> 0 < us) \<and> range_cover ptr sz (obj_bits_api tp us) num_objects)\<rbrace>
|
||||
retype_region ptr num_objects us tp
|
||||
retype_region ptr num_objects us tp dev
|
||||
\<lbrace>\<lambda>_ s. P (null_filter (caps_of_state s)) (state_refs_of s) (cdt s) (state_vrefs s)\<rbrace>"
|
||||
apply (subst conj_assoc [symmetric])+
|
||||
apply (rule hoare_gen_asm [unfolded pred_conj_def K_def])+
|
||||
|
|
@ -850,7 +857,7 @@ lemma retype_region_aag_bits:
|
|||
|
||||
lemma retype_region_ranges'':
|
||||
"\<lbrace>K (range_cover ptr sz (obj_bits_api tp us) num_objects \<and> num_objects \<noteq> 0)\<rbrace>
|
||||
retype_region ptr num_objects us tp
|
||||
retype_region ptr num_objects us tp dev
|
||||
\<lbrace>\<lambda>rv s. \<forall>y\<in>set rv. ptr_range y (obj_bits_api tp us) \<subseteq> {ptr..ptr + of_nat num_objects * 2 ^ (obj_bits_api tp us) - 1}\<rbrace>"
|
||||
apply simp
|
||||
apply (rule hoare_gen_asm[where P'="\<top>", simplified])
|
||||
|
|
@ -938,12 +945,19 @@ lemma freeMemory_valid_irq_states:
|
|||
apply(wp mapM_x_wp[OF _ subset_refl] storeWord_valid_irq_states)
|
||||
done
|
||||
|
||||
crunch pspace_respects_device_region[wp]: freeMemory "\<lambda>ms. P (device_state ms)"
|
||||
(wp: crunch_wps)
|
||||
|
||||
lemma dmo_freeMemory_invs:
|
||||
"\<lbrace> invs \<rbrace>
|
||||
do_machine_op (freeMemory ptr bits)
|
||||
\<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply(simp add: do_machine_op_def invs_def valid_state_def cur_tcb_def | wp | wpc)+
|
||||
apply(clarsimp)
|
||||
apply (simp add: do_machine_op_def invs_def valid_state_def cur_tcb_def | wp | wpc)+
|
||||
apply (clarsimp)
|
||||
apply (frule_tac P1="op = (device_state (machine_state s))" in
|
||||
use_valid[OF _ freeMemory_pspace_respects_device_region])
|
||||
apply simp
|
||||
apply simp
|
||||
apply(rule conjI)
|
||||
apply(erule use_valid[OF _ freeMemory_valid_irq_states], simp)
|
||||
apply(drule freeMemory_vms)
|
||||
|
|
@ -1037,7 +1051,7 @@ lemma descendants_range_in_detype_ex_strengthen:
|
|||
lemma delete_objects_descendants_range_in':
|
||||
notes modify_wp[wp del]
|
||||
shows
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap word2 sz idx)) slot s) and
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap dev word2 sz idx)) slot s) and
|
||||
descendants_range_in {word2..word2 + 2 ^ sz - 1} slot\<rbrace>
|
||||
(delete_objects word2 sz)
|
||||
\<lbrace>\<lambda>_. descendants_range_in {word2..word2 + 2 ^ sz - 1} slot\<rbrace>"
|
||||
|
|
@ -1051,14 +1065,14 @@ lemma delete_objects_descendants_range_in':
|
|||
done
|
||||
|
||||
lemma untyped_cap_aligned:
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap word sz idx)) slot s; valid_objs s\<rbrakk> \<Longrightarrow>
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap dev word sz idx)) slot s; valid_objs s\<rbrakk> \<Longrightarrow>
|
||||
is_aligned word sz"
|
||||
apply(fastforce dest: cte_wp_at_valid_objs_valid_cap simp: valid_cap_def cap_aligned_def)
|
||||
done
|
||||
|
||||
lemma delete_objects_descendants_range_in'':
|
||||
shows
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap word2 sz idx)) slot s) and
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap dev word2 sz idx)) slot s) and
|
||||
descendants_range_in {word2..word2 + 2 ^ sz - 1} slot\<rbrace>
|
||||
(delete_objects word2 sz)
|
||||
\<lbrace>\<lambda>_. descendants_range_in {word2..(word2 && ~~ mask sz) + 2 ^ sz - 1} slot\<rbrace>"
|
||||
|
|
@ -1071,7 +1085,7 @@ lemma delete_objects_descendants_range_in'':
|
|||
|
||||
lemma delete_objects_descendants_range_in''':
|
||||
shows
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap word2 sz idx)) slot s) and
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap dev word2 sz idx)) slot s) and
|
||||
descendants_range_in {word2..word2 + 2 ^ sz - 1} slot\<rbrace>
|
||||
(delete_objects word2 sz)
|
||||
\<lbrace>\<lambda>_. descendants_range_in {word2 && ~~ mask sz..(word2 && ~~ mask sz) + 2 ^ sz - 1} slot\<rbrace>"
|
||||
|
|
@ -1085,7 +1099,7 @@ lemma delete_objects_descendants_range_in''':
|
|||
|
||||
lemma delete_objects_descendants_range_in'''':
|
||||
shows
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap word2 sz idx)) slot s) and
|
||||
"\<lbrace>invs and (\<lambda> s. \<exists> idx. cte_wp_at (op = (UntypedCap dev word2 sz idx)) slot s) and
|
||||
ct_active and descendants_range_in {word2..word2 + 2 ^ sz - 1} slot and
|
||||
K (range_cover word2 sz bits n \<and>
|
||||
n \<noteq> 0)\<rbrace>
|
||||
|
|
@ -1114,7 +1128,7 @@ crunch arch_state[wp]: delete_objects "\<lambda> s. P (arch_state s)"
|
|||
|
||||
|
||||
lemma bits_of_UntypedCap:
|
||||
"bits_of (UntypedCap ptr sz free) = sz"
|
||||
"bits_of (UntypedCap dev ptr sz free) = sz"
|
||||
apply(simp add: bits_of_def split: cap.splits)
|
||||
done
|
||||
|
||||
|
|
@ -1129,7 +1143,7 @@ declare word_neq_0_conv[simp del]
|
|||
|
||||
(* clagged from Untyped_R.invoke_untyped_proofs.usable_range_disjoint *)
|
||||
lemma usable_range_disjoint:
|
||||
assumes cte_wp_at: "cte_wp_at (op = (cap.UntypedCap (ptr && ~~ mask sz) sz idx)) cref s"
|
||||
assumes cte_wp_at: "cte_wp_at (op = (cap.UntypedCap dev (ptr && ~~ mask sz) sz idx)) cref s"
|
||||
assumes misc : "distinct slots" "idx \<le> unat (ptr && mask sz) \<or> ptr = ptr && ~~ mask sz"
|
||||
"invs s" "slots \<noteq> []" "ct_active s"
|
||||
"\<forall>slot\<in>set slots. cte_wp_at (op = cap.NullCap) slot s"
|
||||
|
|
@ -1138,7 +1152,7 @@ lemma usable_range_disjoint:
|
|||
notes blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
|
||||
Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
|
||||
shows
|
||||
"usable_untyped_range (cap.UntypedCap (ptr && ~~ mask sz) sz
|
||||
"usable_untyped_range (cap.UntypedCap dev (ptr && ~~ mask sz) sz
|
||||
(unat ((ptr && mask sz) + of_nat (length slots) * 2 ^ obj_bits_api tp us))) \<inter>
|
||||
{ptr..ptr + of_nat (length slots) * 2 ^ obj_bits_api tp us - 1} = {}"
|
||||
proof -
|
||||
|
|
@ -1173,9 +1187,9 @@ lemma set_free_index_invs':
|
|||
(descendants_range_in {word1..word1 + 2 ^ (bits_of cap) - 1} slot s \<and>
|
||||
pspace_no_overlap word1 (bits_of cap) s)) \<and>
|
||||
idx' \<le> 2 ^ cap_bits cap \<and>
|
||||
is_untyped_cap cap) and K(word1 = obj_ref_of cap)\<rbrace>
|
||||
is_untyped_cap cap) and K(word1 = obj_ref_of cap \<and> dev = (cap_is_device cap))\<rbrace>
|
||||
set_cap
|
||||
(UntypedCap word1 (bits_of cap) idx')
|
||||
(UntypedCap dev word1 (bits_of cap) idx')
|
||||
slot
|
||||
\<lbrace>\<lambda>_. invs \<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
|
|
@ -1183,7 +1197,7 @@ lemma set_free_index_invs':
|
|||
apply(case_tac "free_index_of cap \<le> idx'")
|
||||
apply simp
|
||||
apply(cut_tac cap=cap and cref=slot and idx="idx'" in set_free_index_invs)
|
||||
apply(simp add: free_index_update_def conj_comms)
|
||||
apply(simp add: free_index_update_def conj_comms is_cap_simps)
|
||||
apply simp
|
||||
apply(wp set_untyped_cap_invs_simple | simp)+
|
||||
apply(fastforce simp: cte_wp_at_def)
|
||||
|
|
@ -1191,7 +1205,7 @@ lemma set_free_index_invs':
|
|||
|
||||
lemma delete_objects_pspace_no_overlap:
|
||||
"\<lbrace> pspace_aligned and valid_objs and
|
||||
cte_wp_at (op = (UntypedCap ptr sz idx)) slot\<rbrace>
|
||||
cte_wp_at (op = (UntypedCap dev ptr sz idx)) slot\<rbrace>
|
||||
delete_objects ptr sz
|
||||
\<lbrace>\<lambda>rv. pspace_no_overlap ptr sz\<rbrace>"
|
||||
unfolding delete_objects_def do_machine_op_def
|
||||
|
|
@ -1203,7 +1217,7 @@ lemma delete_objects_pspace_no_overlap:
|
|||
|
||||
lemma delete_objects_pspace_no_overlap':
|
||||
"\<lbrace> pspace_aligned and valid_objs and
|
||||
cte_wp_at (op = (UntypedCap ptr sz idx)) slot\<rbrace>
|
||||
cte_wp_at (op = (UntypedCap dev ptr sz idx)) slot\<rbrace>
|
||||
delete_objects ptr sz
|
||||
\<lbrace>\<lambda>rv. pspace_no_overlap (ptr && ~~ mask sz) sz\<rbrace>"
|
||||
apply(clarsimp simp: valid_def)
|
||||
|
|
@ -1212,12 +1226,21 @@ lemma delete_objects_pspace_no_overlap':
|
|||
apply(erule use_valid, wp delete_objects_pspace_no_overlap, simp)
|
||||
done
|
||||
|
||||
(* FIXME: move *)
|
||||
lemma valid_cap_range_untyped:
|
||||
"\<lbrakk> valid_objs s; cte_wp_at (op = (UntypedCap dev (ptr && ~~ mask sz) sz idx)) slot s\<rbrakk>
|
||||
\<Longrightarrow> cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s"
|
||||
apply (rule cte_wp_at_weakenE)
|
||||
apply simp
|
||||
apply (clarsimp simp:word_and_le2 p_assoc_help)
|
||||
done
|
||||
|
||||
lemma retype_region_pas_refined':
|
||||
"\<lbrace>pas_refined aag and pas_cur_domain aag and invs and
|
||||
caps_overlap_reserved
|
||||
{ptr..ptr + of_nat num_objects * 2 ^ obj_bits_api type o_bits -
|
||||
1} and
|
||||
(\<lambda> s. \<exists> idx. cte_wp_at (\<lambda> c. c = (UntypedCap (ptr && ~~ mask sz) sz idx)) slot s \<and>
|
||||
(\<lambda> s. \<exists> idx. cte_wp_at (\<lambda> c. c = (UntypedCap dev (ptr && ~~ mask sz) sz idx)) slot s \<and>
|
||||
(idx \<le> unat (ptr && mask sz) \<or>
|
||||
(descendants_range_in {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1} slot s) \<and>
|
||||
pspace_no_overlap ptr sz s)) and
|
||||
|
|
@ -1225,24 +1248,31 @@ lemma retype_region_pas_refined':
|
|||
K (range_cover ptr sz (obj_bits_api type o_bits) num_objects) and
|
||||
K (\<forall>x\<in>set (retype_addrs ptr type num_objects o_bits). is_subject aag x) and
|
||||
K ((type = CapTableObject \<longrightarrow> 0 < o_bits))\<rbrace>
|
||||
retype_region ptr num_objects o_bits type
|
||||
retype_region ptr num_objects o_bits type dev
|
||||
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
|
||||
apply(rule hoare_gen_asm)+
|
||||
apply(rule hoare_weaken_pre)
|
||||
apply(rule use_retype_region_proofs_ext)
|
||||
apply(erule (1) retype_region_proofs'.pas_refined[OF retype_region_proofs'.intro])
|
||||
apply (wp retype_region_ext_pas_refined)
|
||||
apply simp
|
||||
apply (auto intro: cte_wp_at_caps_no_overlapI descendants_range_caps_no_overlapI cte_wp_at_pspace_no_overlapI simp: cte_wp_at_sym)
|
||||
apply simp
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply clarsimp
|
||||
apply (frule valid_cap_range_untyped[OF invs_valid_objs])
|
||||
apply (fastforce simp:cte_wp_at_caps_of_state)
|
||||
apply (cases slot)
|
||||
apply (auto intro: cte_wp_at_caps_no_overlapI descendants_range_caps_no_overlapI
|
||||
cte_wp_at_pspace_no_overlapI simp: cte_wp_at_sym)
|
||||
done
|
||||
|
||||
|
||||
lemma free_index_of_UntypedCap:
|
||||
"free_index_of (UntypedCap ptr sz idx) = idx"
|
||||
"free_index_of (UntypedCap dev ptr sz idx) = idx"
|
||||
apply(simp add: free_index_of_def)
|
||||
done
|
||||
|
||||
fun slot_of_untyped_inv where "slot_of_untyped_inv (Retype slot _ _ _ _ _ ) = slot"
|
||||
fun slot_of_untyped_inv where "slot_of_untyped_inv (Retype slot _ _ _ _ _ _ ) = slot"
|
||||
|
||||
lemma region_in_kernel_window_subseteq:
|
||||
"\<lbrakk> region_in_kernel_window S s; T \<subseteq> S\<rbrakk> \<Longrightarrow>
|
||||
|
|
@ -1251,20 +1281,36 @@ lemma region_in_kernel_window_subseteq:
|
|||
done
|
||||
|
||||
lemma aag_cap_auth_UntypedCap_idx:
|
||||
"aag_cap_auth aag l (UntypedCap base sz idx) \<Longrightarrow>
|
||||
aag_cap_auth aag l (UntypedCap base sz idx')"
|
||||
"aag_cap_auth aag l (UntypedCap dev base sz idx) \<Longrightarrow>
|
||||
aag_cap_auth aag l (UntypedCap dev base sz idx')"
|
||||
apply(clarsimp simp: aag_cap_auth_def cap_links_asid_slot_def cap_links_irq_def)
|
||||
done
|
||||
|
||||
lemma cte_wp_at_pas_cap_cur_auth_UntypedCap_idx:
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap base sz idx)) slot s; is_subject aag (fst slot);
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap dev base sz idx)) slot s; is_subject aag (fst slot);
|
||||
pas_refined aag s\<rbrakk> \<Longrightarrow>
|
||||
pas_cap_cur_auth aag (UntypedCap base sz idx')"
|
||||
pas_cap_cur_auth aag (UntypedCap dev base sz idx')"
|
||||
apply(rule aag_cap_auth_UntypedCap_idx)
|
||||
apply(auto intro: cap_cur_auth_caps_of_state simp: cte_wp_at_caps_of_state)
|
||||
done
|
||||
|
||||
|
||||
lemma retype_region_post_retype_invs_spec:
|
||||
"\<lbrace>invs and caps_no_overlap ptr sz and pspace_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>idx. cte_wp_at (op = (UntypedCap dev (ptr && ~~ mask sz) sz idx)) slot s)
|
||||
and K (ty = Structures_A.CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n) \<rbrace>
|
||||
retype_region ptr n us ty dev\<lbrace>\<lambda>rv. post_retype_invs ty rv\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (wp retype_region_post_retype_invs)
|
||||
apply (clarsimp simp del:split_paired_Ex)
|
||||
apply (frule valid_cap_range_untyped[OF invs_valid_objs],simp)
|
||||
apply (intro conjI)
|
||||
apply fastforce+
|
||||
done
|
||||
|
||||
lemma invoke_untyped_pas_refined:
|
||||
notes modify_wp[wp del]
|
||||
notes usable_untyped_range.simps[simp del]
|
||||
|
|
@ -1274,7 +1320,7 @@ lemma invoke_untyped_pas_refined:
|
|||
\<lbrace>\<lambda>rv. pas_refined aag\<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
apply(cases ui)
|
||||
apply (rename_tac cslot_ptr word1 word2 apiobject_type nat list)
|
||||
apply (rename_tac cslot_ptr word1 word2 apiobject_type nat list dev)
|
||||
apply(simp add: mapM_x_def[symmetric] authorised_untyped_inv_def)
|
||||
apply(rule hoare_weaken_pre)
|
||||
apply(wp mapM_x_and_const_wp [OF create_cap_pas_refined]
|
||||
|
|
@ -1282,18 +1328,19 @@ lemma invoke_untyped_pas_refined:
|
|||
| simp)+
|
||||
(* strengthen postcondition to talk about retvalue of retype_region *)
|
||||
apply (simp add: ball_conj_distrib)
|
||||
apply (rename_tac slot ptr apiobject_type sz list nat dev)
|
||||
apply(rule_tac
|
||||
Q="\<lambda>rv. (\<lambda>s. global_refs s \<inter> set rv = {}) and
|
||||
(\<lambda> s. post_retype_invs apiobject_type rv s) and
|
||||
(\<lambda>s. \<forall>p \<in> set rv. is_aligned p (obj_bits_api apiobject_type nat)) and
|
||||
(\<lambda>s. \<forall>p \<in> set rv. is_aligned p (obj_bits_api apiobject_type sz)) and
|
||||
K (\<forall>p \<in> set rv. is_subject aag p) and
|
||||
K (\<forall>ref\<in>set rv. apiobject_type = ArchObject PageDirectoryObj \<longrightarrow>
|
||||
is_aligned ref pd_bits) and
|
||||
(\<lambda>s. (\<forall>y\<in>set rv. ptr_range y (obj_bits_api apiobject_type nat) \<subseteq>
|
||||
{word2..word2 + of_nat (length list) * 2 ^ (obj_bits_api apiobject_type nat) - 1}))" in hoare_strengthen_post)
|
||||
(\<lambda>s. (\<forall>y\<in>set rv. ptr_range y (obj_bits_api apiobject_type sz) \<subseteq>
|
||||
{ptr..ptr + of_nat (length list) * 2 ^ (obj_bits_api apiobject_type sz) - 1}))" in hoare_strengthen_post)
|
||||
apply (wp retype_region_ret_is_subject
|
||||
retype_region_ranges''
|
||||
retype_region_post_retype_invs
|
||||
retype_region_post_retype_invs_spec
|
||||
retype_region_aligned_for_init
|
||||
retype_region_global_refs_disjoint
|
||||
retype_region_ret_pd_aligned)
|
||||
|
|
@ -1308,7 +1355,7 @@ lemma invoke_untyped_pas_refined:
|
|||
1} and
|
||||
(\<lambda>s. \<exists>idx. cte_wp_at
|
||||
(\<lambda>c. c =
|
||||
UntypedCap
|
||||
UntypedCap dev
|
||||
(word2 &&
|
||||
~~ mask
|
||||
(bits_of cap)) (bits_of cap)
|
||||
|
|
@ -1363,13 +1410,13 @@ lemma invoke_untyped_pas_refined:
|
|||
set_free_index_invs' region_in_kernel_window_preserved
|
||||
delete_objects_pas_refined hoare_ex_wp set_cap_cte_wp_at
|
||||
set_cap_no_overlap set_cap_descendants_range_in hoare_vcg_disj_lift
|
||||
| simp split del: split_if)+
|
||||
| simp split del: split_if add:p_assoc_help[symmetric])+
|
||||
apply clarsimp
|
||||
apply (intro conjI exI, assumption)
|
||||
apply (auto simp: cte_wp_at_def retype_addrs_def intro:
|
||||
apply (auto simp: cte_wp_at_caps_of_state retype_addrs_def intro:
|
||||
cte_wp_at_caps_no_overlapI
|
||||
descendants_range_caps_no_overlapI
|
||||
cte_wp_at_pspace_no_overlapI dest: unat_less_helper)[15]
|
||||
cte_wp_at_pspace_no_overlapI dest: unat_less_helper)[16]
|
||||
apply(clarsimp split del: split_if)
|
||||
apply(simp add: conj_comms cong: conj_cong split del: split_if)
|
||||
apply(wp delete_objects_invs delete_objects_pas_refined[where aag=aag]
|
||||
|
|
@ -1387,7 +1434,7 @@ lemma invoke_untyped_pas_refined:
|
|||
apply(subgoal_tac "sz < word_bits")
|
||||
apply(intro conjI impI)
|
||||
apply(simp_all add: cte_wp_at_cte_at cte_wp_at_sym)
|
||||
apply fastforce
|
||||
|
||||
apply(drule cap_refs_in_kernel_windowD2)
|
||||
apply(simp add: invs_cap_refs_in_kernel_window)
|
||||
apply(fastforce simp: cap_range_def)
|
||||
|
|
@ -1397,26 +1444,26 @@ lemma invoke_untyped_pas_refined:
|
|||
apply(subst unat_mult_power_lem)
|
||||
apply(erule range_cover.string)
|
||||
apply(simp add: mult.commute)
|
||||
apply(fastforce intro!: cte_wp_at_pas_cap_cur_auth_UntypedCap_idx)
|
||||
|
||||
(* apply(fastforce intro!: cte_wp_at_pas_cap_cur_auth_UntypedCap_idx)*)
|
||||
apply (frule retype_addrs_subset_ptr_bits)
|
||||
apply (clarsimp simp: authorised_untyped_inv_state_def)
|
||||
apply (erule_tac x="UntypedCap word2 sz idx" in allE)
|
||||
apply (erule_tac x="UntypedCap dev word2 sz idx" in allE)
|
||||
apply (force simp: ptr_range_def bits_of_UntypedCap p_assoc_help)
|
||||
|
||||
apply(fastforce intro!: cte_wp_at_pas_cap_cur_auth_UntypedCap_idx)
|
||||
apply(fastforce dest: valid_global_refsD2 simp: cte_wp_at_caps_of_state)
|
||||
apply(fastforce dest!: untyped_slots_not_in_untyped_range[OF _ _ _ _ _ subset_refl])
|
||||
apply(clarsimp simp: authorised_untyped_inv_state_def)
|
||||
apply(drule_tac x="UntypedCap word2 sz idx" in spec, fastforce simp: cte_wp_at_def ptr_range_def bits_of_UntypedCap pas_refined_refl p_assoc_help)
|
||||
apply(drule_tac x="UntypedCap dev word2 sz idx" in spec,
|
||||
fastforce simp: cte_wp_at_def ptr_range_def bits_of_UntypedCap pas_refined_refl p_assoc_help)
|
||||
apply(erule ssubst[OF free_index_of_UntypedCap])
|
||||
apply fastforce
|
||||
apply(subgoal_tac "usable_untyped_range
|
||||
(UntypedCap (word2 && ~~ mask sz) sz
|
||||
(UntypedCap dev (word2 && ~~ mask sz) sz
|
||||
(unat
|
||||
((word2 && mask sz) + of_nat (length list) * 2 ^ obj_bits_api apiobject_type nat))) \<inter>
|
||||
{word2..word2 +
|
||||
of_nat (length list) * 2 ^ obj_bits_api apiobject_type nat -
|
||||
1} =
|
||||
{}")
|
||||
1} = {}")
|
||||
apply(subgoal_tac "word2 && mask sz = 0", clarsimp simp: shiftl_t2n mult.commute)
|
||||
apply(erule subst, rule mask_neg_mask_is_zero)
|
||||
apply(rule usable_range_disjoint, simp+)
|
||||
|
|
@ -1427,16 +1474,18 @@ lemma invoke_untyped_pas_refined:
|
|||
apply(fastforce simp: descendants_range_def2)
|
||||
apply(rule disjI2)
|
||||
apply(clarsimp simp: cte_wp_at_caps_of_state invs_def valid_state_def valid_pspace_def)
|
||||
apply (rule conjI[OF refl])
|
||||
apply(erule ssubst[OF free_index_of_UntypedCap])
|
||||
apply(rule disjI2)
|
||||
apply(clarsimp simp: cte_wp_at_caps_of_state invs_def valid_state_def valid_pspace_def)
|
||||
apply (rule conjI[OF refl])
|
||||
apply(erule ssubst[OF free_index_of_UntypedCap])
|
||||
|
||||
apply (frule retype_addrs_subset_ptr_bits)
|
||||
apply clarsimp
|
||||
apply (frule(1) subsetD)
|
||||
apply(clarsimp simp: authorised_untyped_inv_state_def)
|
||||
apply(drule_tac x="UntypedCap (word2 && ~~ mask sz) sz idx" in spec, clarsimp simp: cte_wp_at_def ptr_range_def bits_of_UntypedCap pas_refined_refl word_and_le2)
|
||||
apply(drule_tac x="UntypedCap dev (word2 && ~~ mask sz) sz idx" in spec, clarsimp simp: cte_wp_at_def ptr_range_def bits_of_UntypedCap pas_refined_refl word_and_le2)
|
||||
apply(erule bspec, simp add: p_assoc_help, erule order_trans[rotated])
|
||||
apply(fastforce simp: word_and_le2)
|
||||
|
||||
|
|
@ -1458,7 +1507,7 @@ lemma invoke_untyped_pas_refined:
|
|||
apply(simp add: range_cover.range_cover_compare_bound[simplified add.commute])
|
||||
|
||||
apply(clarsimp simp: authorised_untyped_inv_state_def)
|
||||
apply(drule_tac x="UntypedCap (word2 && ~~ mask sz) sz idx" in spec, clarsimp simp: cte_wp_at_def ptr_range_def bits_of_UntypedCap pas_refined_refl word_and_le2)
|
||||
apply(drule_tac x="UntypedCap dev (word2 && ~~ mask sz) sz idx" in spec, clarsimp simp: cte_wp_at_def ptr_range_def bits_of_UntypedCap pas_refined_refl word_and_le2)
|
||||
apply(erule bspec, simp add: p_assoc_help, erule order_trans[rotated])
|
||||
apply(fastforce simp: word_and_le2)
|
||||
apply(fastforce intro!: cte_wp_at_pas_cap_cur_auth_UntypedCap_idx)
|
||||
|
|
@ -1518,7 +1567,7 @@ crunch inv[wp]: data_to_obj_type "P"
|
|||
|
||||
definition authorised_untyped_inv' where
|
||||
"authorised_untyped_inv' aag ui \<equiv> case ui of
|
||||
Invocations_A.untyped_invocation.Retype src_slot base aligned_free_ref new_type obj_sz slots \<Rightarrow>
|
||||
Invocations_A.untyped_invocation.Retype src_slot base aligned_free_ref new_type obj_sz slots dev\<Rightarrow>
|
||||
is_subject aag (fst src_slot) \<and> (0::word32) < of_nat (length slots) \<and>
|
||||
new_type \<noteq> ArchObject ASIDPoolObj \<and>
|
||||
(\<forall>x\<in>set slots. is_subject aag (fst x))"
|
||||
|
|
@ -1533,9 +1582,9 @@ lemma authorised_untyped_invI:
|
|||
authorised_untyped_inv' aag ui\<rbrakk> \<Longrightarrow>
|
||||
authorised_untyped_inv aag ui"
|
||||
apply(case_tac ui)
|
||||
apply (rename_tac cslot_ptr word1 word2 apiobject_type nat list)
|
||||
apply (rename_tac cslot_ptr word1 word2 apiobject_type nat list dev)
|
||||
apply(clarsimp simp: authorised_untyped_inv_state_def cte_wp_at_sym authorised_untyped_inv_def authorised_untyped_inv'_def)
|
||||
apply(drule_tac x="UntypedCap (word2 && ~~ mask sz) sz idx" in spec, clarsimp simp: ptr_range_def bits_of_UntypedCap)
|
||||
apply(drule_tac x="UntypedCap dev (word2 && ~~ mask sz) sz idx" in spec, clarsimp simp: ptr_range_def bits_of_UntypedCap)
|
||||
apply(erule bspec)
|
||||
apply(erule subsetD[OF _ subsetD[OF range_cover_subset'], rotated])
|
||||
apply(simp add: blah word_and_le2)+
|
||||
|
|
@ -1554,7 +1603,7 @@ lemma decode_untyped_invocation_authorised:
|
|||
(\<forall>r\<in>cte_refs cap (interrupt_irq_node s).
|
||||
ex_cte_cap_wp_to is_cnode_cap r s))
|
||||
and (\<lambda>s. \<forall>x\<in>set excaps. s \<turnstile> x)
|
||||
and K (cap = cap.UntypedCap base sz idx
|
||||
and K (cap = cap.UntypedCap dev base sz idx
|
||||
\<and> is_subject aag (fst slot)
|
||||
\<and> (\<forall>c \<in> set excaps. pas_cap_cur_auth aag c)
|
||||
\<and> (\<forall> ref \<in> untyped_range cap. is_subject aag ref))\<rbrace>
|
||||
|
|
|
|||
|
|
@ -966,7 +966,7 @@ lemma handle_interrupt_arch_state [wp]:
|
|||
lemmas sequence_x_mapM_x = mapM_x_def [symmetric]
|
||||
|
||||
crunch arm_globals_frame [wp]: invoke_untyped "\<lambda>s. P (arm_globals_frame (arch_state 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
|
||||
simp: crunch_simps sequence_x_mapM_x
|
||||
ignore: do_machine_op freeMemory clearMemory)
|
||||
|
||||
|
|
|
|||
|
|
@ -227,7 +227,7 @@ definition
|
|||
|
||||
definition
|
||||
"setDeviceState_C um \<equiv>
|
||||
modify (\<lambda>s. s\<lparr>globals := globals s\<lparr>phantom_machine_state_' := (phantom_machine_state_' (globals s))\<lparr>device_state := um\<rparr>\<rparr>\<rparr>)"
|
||||
modify (\<lambda>s. s\<lparr>globals := globals s\<lparr>phantom_machine_state_' := (phantom_machine_state_' (globals s))\<lparr>device_state := ((device_state (phantom_machine_state_' (globals s))) ++ um)\<rparr>\<rparr>\<rparr>)"
|
||||
|
||||
lemma setUserMem_C_def_foldl:
|
||||
"setUserMem_C um \<equiv>
|
||||
|
|
@ -1580,15 +1580,20 @@ definition (in state_rel)
|
|||
conv \<leftarrow> gets (ptable_lift t \<circ> cstate_to_A);
|
||||
rights \<leftarrow> gets (ptable_rights t \<circ> cstate_to_A);
|
||||
um \<leftarrow> gets (\<lambda>s. user_mem_C (globals s) \<circ> ptrFromPAddr);
|
||||
dm \<leftarrow> gets (\<lambda>s. device_mem_C (globals s));
|
||||
dm \<leftarrow> gets (\<lambda>s. device_mem_C (globals s) \<circ> ptrFromPAddr);
|
||||
ds \<leftarrow> gets (\<lambda>s. (device_state (phantom_machine_state_' (globals s))));
|
||||
|
||||
assert (dom (um \<circ> addrFromPPtr) \<subseteq> - dom ds);
|
||||
assert (dom (dm \<circ> addrFromPPtr) \<subseteq> dom ds);
|
||||
|
||||
(e,tc',um',ds') \<leftarrow> select (fst (uop t (restrict_map conv {pa. rights pa \<noteq> {}}) rights
|
||||
(tc, restrict_map um
|
||||
{pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va},ds)));
|
||||
setUserMem_C (restrict_map (um'|` (dom um))
|
||||
{pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va}
|
||||
\<circ> Platform.addrFromPPtr);
|
||||
setDeviceState_C (ds ++ (ds' |` (dom dm)));
|
||||
{pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va},
|
||||
(ds \<circ> ptrFromPAddr) |` {pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va} )));
|
||||
setUserMem_C ((um' |` {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va}
|
||||
\<circ> addrFromPPtr) |` (- dom ds));
|
||||
setDeviceState_C ((ds' |` {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va}
|
||||
\<circ> addrFromPPtr) |` (dom ds));
|
||||
return (e,tc')
|
||||
od"
|
||||
|
||||
|
|
|
|||
|
|
@ -779,7 +779,7 @@ apply (simp add: o_def hrs_mem_update_def)
|
|||
done
|
||||
|
||||
lemma memory_update_corres_C:
|
||||
"corres_underlying rf_sr True (%_ _. True)
|
||||
"corres_underlying rf_sr nf (%_ _. True)
|
||||
(\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s
|
||||
\<and> (dom um \<subseteq> dom (user_mem' s) ))
|
||||
\<top>
|
||||
|
|
@ -814,8 +814,8 @@ lemma memory_update_corres_C:
|
|||
done
|
||||
|
||||
lemma device_update_corres_C:
|
||||
"corres_underlying rf_sr True op = (\<lambda>_. True) (\<lambda>_. True)
|
||||
(doMachineOp (device_update ms))
|
||||
"corres_underlying rf_sr nf op = (\<lambda>_. True) (\<lambda>_. True)
|
||||
(doMachineOp (device_memory_update ms))
|
||||
(setDeviceState_C ms)"
|
||||
apply (clarsimp simp: corres_underlying_def)
|
||||
apply (rule conjI)
|
||||
|
|
@ -823,42 +823,12 @@ lemma device_update_corres_C:
|
|||
apply (clarsimp simp add: setDeviceState_C_def simpler_modify_def)
|
||||
apply (rule ballI)
|
||||
apply (clarsimp simp: simpler_modify_def setDeviceState_C_def)
|
||||
apply (clarsimp simp: doMachineOp_def device_update_def NonDetMonad.bind_def in_monad
|
||||
apply (clarsimp simp: doMachineOp_def device_memory_update_def NonDetMonad.bind_def in_monad
|
||||
gets_def get_def return_def simpler_modify_def select_f_def)
|
||||
apply (clarsimp simp:rf_sr_def cstate_relation_def Let_def carch_state_relation_def
|
||||
cmachine_state_relation_def)
|
||||
done
|
||||
|
||||
lemma doMachineOp_map_split:
|
||||
"(doMachineOp (user_memory_update (um ++ dm))) = (do
|
||||
(doMachineOp (user_memory_update um));(doMachineOp (user_memory_update dm)) od)"
|
||||
apply (rule ext)
|
||||
apply (clarsimp simp:NonDetMonad.bind_def doMachineOp_def
|
||||
select_f_def user_memory_update_def simpler_modify_def
|
||||
gets_def get_def return_def)
|
||||
apply (case_tac x,simp)
|
||||
apply (case_tac ksMachineStatea,simp)
|
||||
apply (rule ext)
|
||||
apply (case_tac "dm a")
|
||||
apply (case_tac "um a")
|
||||
apply (clarsimp split:option.splits)+
|
||||
done
|
||||
|
||||
lemma setUserMem_C_map_split:
|
||||
"(setUserMem_C (um ++ dm)) = (do
|
||||
(setUserMem_C um);(setUserMem_C dm) od)"
|
||||
apply (rule ext)
|
||||
apply (simp add:setUserMem_C_def NonDetMonad.bind_def doMachineOp_def
|
||||
select_f_def user_memory_update_def simpler_modify_def
|
||||
gets_def get_def return_def)
|
||||
apply (case_tac x,simp)
|
||||
apply (case_tac globalsa,simp)
|
||||
apply (rule ext)
|
||||
apply (case_tac "dm p")
|
||||
apply (case_tac "um p")
|
||||
apply (clarsimp split:option.splits)+
|
||||
done
|
||||
|
||||
lemma mem_dom_split:
|
||||
"(dom um \<subseteq> dom (user_mem' s) \<union> dom (device_mem' s))
|
||||
\<Longrightarrow> um = restrict_map um (dom (user_mem' s)) ++ restrict_map um (dom (device_mem' s))"
|
||||
|
|
@ -902,7 +872,7 @@ shows "corres_underlying rf_sr True rel P P' f f'"
|
|||
by (fastforce simp:corres_underlying_def no_fail_def)
|
||||
|
||||
lemma do_user_op_corres_C:
|
||||
"corres_underlying rf_sr True (op =) (invs' and ex_abs einvs) \<top>
|
||||
"corres_underlying rf_sr False (op =) (invs' and ex_abs einvs) \<top>
|
||||
(doUserOp f tc) (doUserOp_C f tc)"
|
||||
apply (simp only: doUserOp_C_def doUserOp_def split_def)
|
||||
apply (rule corres_guard_imp)
|
||||
|
|
@ -931,27 +901,45 @@ lemma do_user_op_corres_C:
|
|||
apply (rule_tac P=pspace_distinct' and P'=\<top> and r'="op="
|
||||
in corres_split)
|
||||
prefer 2
|
||||
apply clarsimp
|
||||
apply (rule device_mem_C_relation[symmetric])
|
||||
apply (simp add: rf_sr_def cstate_relation_def Let_def
|
||||
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
|
||||
cpspace_relation_def)
|
||||
apply assumption
|
||||
apply (drule(1) device_mem_C_relation[symmetric])
|
||||
apply (simp add: comp_def)
|
||||
apply (rule_tac P=valid_state' and P'=\<top> and r'="op=" in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: cstate_relation_def rf_sr_def
|
||||
Let_def cmachine_state_relation_def)
|
||||
apply (rule_tac r'="op=" in corres_split[OF _ corres_select])
|
||||
apply (rule_tac P=\<top> and P'=\<top> and r'="op=" in corres_split)
|
||||
prefer 2
|
||||
apply clarsimp
|
||||
apply (simp add: addrFromPPtr_def)
|
||||
apply (rule corres_split[OF _ memory_update_corres_C])
|
||||
apply (rule corres_split[OF _ device_update_corres_C,
|
||||
where R="\<top>\<top>" and R'="\<top>\<top>"])
|
||||
apply (wp select_wp | simp)+
|
||||
apply (intro conjI allI ballI)
|
||||
apply (clarsimp simp add: corres_underlying_def fail_def
|
||||
assert_def return_def
|
||||
split:if_splits)
|
||||
apply simp
|
||||
apply (rule_tac P=\<top> and P'=\<top> and r'="op=" in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp add: corres_underlying_def fail_def
|
||||
assert_def return_def
|
||||
split:if_splits)
|
||||
apply simp
|
||||
apply (rule_tac r'="op=" in corres_split[OF _ corres_select])
|
||||
prefer 2
|
||||
apply clarsimp
|
||||
apply simp
|
||||
apply (rule corres_split[OF _ memory_update_corres_C])
|
||||
apply (rule corres_split[OF _ device_update_corres_C,
|
||||
where R="\<top>\<top>" and R'="\<top>\<top>"])
|
||||
apply (wp select_wp | simp)+
|
||||
apply (intro conjI allI ballI impI)
|
||||
apply ((clarsimp simp add: invs'_def valid_state'_def valid_pspace'_def)+)[5]
|
||||
apply (clarsimp simp: user_mem'_def ex_abs_def restrict_map_def
|
||||
apply (clarsimp simp: ex_abs_def restrict_map_def
|
||||
split: if_splits)
|
||||
apply (drule ptable_rights_imp_UserData[rotated -1])
|
||||
apply fastforce+
|
||||
apply (clarsimp simp:invs'_def valid_state'_def user_mem'_def device_mem'_def
|
||||
split:if_splits)
|
||||
apply (drule_tac c = x in subsetD[where B = "dom S" for S])
|
||||
apply (simp add:dom_def)
|
||||
apply fastforce
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -16,6 +16,10 @@ imports
|
|||
IRQMasks_IF FinalCaps Scheduler_IF UserOp_IF
|
||||
begin
|
||||
|
||||
definition
|
||||
raw_execution :: "('a,'b,'j) data_type \<Rightarrow> 'b \<Rightarrow> 'j list \<Rightarrow> 'a set" where
|
||||
"raw_execution A s js \<equiv> steps (Step A) (Init A s) js"
|
||||
|
||||
inductive_set sub_big_steps :: "('a,'b,'c) data_type \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'c list) set" for A :: "('a,'b,'c) data_type" and R :: "('a \<Rightarrow> 'a \<Rightarrow> bool)" and s :: "'a" where
|
||||
nil: "\<lbrakk>evlist = []; t = s; \<not> R s s\<rbrakk> \<Longrightarrow> (t,evlist) \<in> sub_big_steps A R s" |
|
||||
step: "\<lbrakk>evlist = evlist' @ [e]; (s',evlist') \<in> sub_big_steps A R s;
|
||||
|
|
@ -737,7 +741,7 @@ definition
|
|||
{ ( (s, InIdleMode),
|
||||
(s', InIdleMode) ) |s s'. (s, None, s') \<in> get_active_irqf}"
|
||||
|
||||
type_synonym user_state_if = "user_context \<times> user_mem \<times> exclusive_monitors"
|
||||
type_synonym user_state_if = "user_context \<times> user_mem \<times> device_state \<times> exclusive_monitors"
|
||||
|
||||
text {*
|
||||
A user transition gives back a possible event that is the next
|
||||
|
|
@ -794,12 +798,14 @@ lemma do_user_op_if_invs:
|
|||
do_user_op_if f tc
|
||||
\<lbrace>\<lambda>_. invs and ct_running\<rbrace>"
|
||||
apply (simp add: do_user_op_if_def split_def)
|
||||
apply (wp ct_running_machine_op select_wp | wp_once dmo_invs | simp)+
|
||||
apply (auto simp: user_mem_def user_memory_update_def simpler_modify_def
|
||||
apply (wp ct_running_machine_op select_wp device_update_invs | wp_once dmo_invs | simp)+
|
||||
apply (clarsimp simp: user_mem_def user_memory_update_def simpler_modify_def
|
||||
restrict_map_def invs_def cur_tcb_def ptable_rights_s_def
|
||||
ptable_lift_s_def
|
||||
elim!: ptable_rights_imp_user_frame
|
||||
split: option.splits split_if_asm)
|
||||
ptable_lift_s_def)
|
||||
apply (frule ptable_rights_imp_frame)
|
||||
apply fastforce
|
||||
apply simp
|
||||
apply (clarsimp simp:valid_state_def device_frame_in_device_region)
|
||||
done
|
||||
|
||||
crunch domain_sep_inv[wp]: do_user_op_if "domain_sep_inv irqs st"
|
||||
|
|
@ -813,6 +819,11 @@ lemma no_irq_user_memory_update[simp]:
|
|||
apply(clarsimp simp: no_irq_def user_memory_update_def)
|
||||
done
|
||||
|
||||
lemma no_irq_device_memory_update[simp]:
|
||||
"no_irq (device_memory_update a)"
|
||||
apply(clarsimp simp: no_irq_def device_memory_update_def)
|
||||
done
|
||||
|
||||
crunch irq_masks[wp]: do_user_op_if "\<lambda>s. P (irq_masks_of_state s)"
|
||||
(ignore: user_memory_update wp: select_wp dmo_wp)
|
||||
|
||||
|
|
@ -1351,6 +1362,18 @@ abbreviation internal_state_if :: "((MachineTypes.register \<Rightarrow> 32 word
|
|||
\<Rightarrow> 'a" where
|
||||
"internal_state_if \<equiv> \<lambda>s. (snd (fst s))"
|
||||
|
||||
lemma valid_device_abs_state_eq:
|
||||
"\<lbrakk>valid_machine_state s\<rbrakk> \<Longrightarrow> abs_state s = s"
|
||||
apply (simp add:abs_state_def observable_memory_def)
|
||||
apply (case_tac s)
|
||||
apply clarsimp
|
||||
apply (case_tac machine_state)
|
||||
apply clarsimp
|
||||
apply (rule ext)
|
||||
apply (fastforce simp:user_mem_def option_to_0_def valid_machine_state_def)
|
||||
done
|
||||
|
||||
|
||||
|
||||
(*Weakened invs_if to properties only necessary for refinement*)
|
||||
definition full_invs_if :: "observable_if set" where
|
||||
|
|
@ -1494,6 +1517,9 @@ locale invariant_over_ADT_if =
|
|||
fixes det_inv :: "sys_mode \<Rightarrow> user_context \<Rightarrow> det_state \<Rightarrow> bool"
|
||||
fixes utf :: "user_transition_if"
|
||||
|
||||
assumes det_inv_abs_state:
|
||||
"\<And>e tc s. det_inv e tc s \<Longrightarrow> det_inv e tc (abs_state s)"
|
||||
|
||||
assumes kernel_entry_if_det_inv:
|
||||
"\<And>e tc. \<lbrace>einvs and det_inv (KernelEntry e) tc and ct_running and K (e \<noteq> Interrupt)\<rbrace>
|
||||
kernel_entry_if e tc
|
||||
|
|
@ -1563,7 +1589,7 @@ locale valid_initial_state_noenabled = invariant_over_ADT_if +
|
|||
pas_refined (current_aag s) s \<and>
|
||||
guarded_pas_domain (current_aag s) s \<and>
|
||||
idle_equiv s0_internal s \<and>
|
||||
valid_domain_list s"
|
||||
valid_domain_list s \<and> valid_pdpt_objs s"
|
||||
assumes Invs_s0_internal: "Invs s0_internal"
|
||||
assumes det_inv_s0: "det_inv KernelExit (cur_context s0_internal) s0_internal"
|
||||
|
||||
|
|
@ -1571,10 +1597,10 @@ locale valid_initial_state_noenabled = invariant_over_ADT_if +
|
|||
assumes ct_running_or_ct_idle_s0_internal: "ct_running s0_internal \<or> ct_idle s0_internal"
|
||||
assumes domain_time_s0_internal: "domain_time s0_internal > 0"
|
||||
assumes num_domains_sanity: "num_domains > 1"
|
||||
assumes utf_det: "\<forall>pl pr pxn tc um es s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn um es s \<and> ct_running s
|
||||
\<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, um, es) = {x})"
|
||||
assumes utf_non_empty: "\<forall>t pl pr pxn tc um es. utf t pl pr pxn (tc, um, es) \<noteq> {}"
|
||||
assumes utf_non_interrupt: "\<forall>t pl pr pxn tc um es e f g. (e,f,g) \<in> utf t pl pr pxn (tc, um, es) \<longrightarrow> e \<noteq> Some Interrupt"
|
||||
assumes utf_det: "\<forall>pl pr pxn tc um ds es s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn um ds es s \<and> ct_running s
|
||||
\<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, um, ds, es) = {x})"
|
||||
assumes utf_non_empty: "\<forall>t pl pr pxn tc um ds es. utf t pl pr pxn (tc, um, ds, es) \<noteq> {}"
|
||||
assumes utf_non_interrupt: "\<forall>t pl pr pxn tc um ds es e f g. (e,f,g) \<in> utf t pl pr pxn (tc, um, ds, es) \<longrightarrow> e \<noteq> Some Interrupt"
|
||||
assumes extras_s0: "step_restrict s0"
|
||||
assumes pasMaySendIrqs_initial_aag[simp]: "pasMaySendIrqs initial_aag = False"
|
||||
|
||||
|
|
@ -1914,7 +1940,7 @@ lemma get_page_info_is_arm_globals_frame:
|
|||
apply (clarsimp simp: get_pd_of_thread_reachable invs_arch_objs
|
||||
invs_psp_aligned invs_valid_asid_table invs_valid_objs)+
|
||||
apply(rename_tac sz)
|
||||
apply(subgoal_tac "typ_at (AArch (AIntData ARMSmallPage)) (arm_globals_frame (arch_state s)) s")
|
||||
apply(subgoal_tac "typ_at (AArch (AUserData ARMSmallPage)) (arm_globals_frame (arch_state s)) s")
|
||||
apply(clarsimp simp: obj_at_def)
|
||||
prefer 2
|
||||
apply(fastforce dest: invs_arch_state simp: valid_arch_state_def)
|
||||
|
|
@ -1926,11 +1952,12 @@ lemma get_page_info_is_arm_globals_frame:
|
|||
apply assumption
|
||||
apply(frule ptr_offset_in_ptr_range)
|
||||
apply (simp+)
|
||||
apply(simp add: ptr_range_def)
|
||||
apply(simp add: ptr_range_def ups_of_heap_typ_at[symmetric] ups_of_heap_def
|
||||
split:option.split_asm kernel_object.split_asm arch_kernel_obj.split_asm)
|
||||
apply(subgoal_tac "ptrFromPAddr base + (x' && mask (pageBitsForSize sz)) \<in> {arm_globals_frame
|
||||
(arch_state s)..arm_globals_frame (arch_state s) + 0xFFF}")
|
||||
apply(simp only: p_assoc_help)
|
||||
apply blast
|
||||
apply fastforce
|
||||
apply(drule_tac y="addrFromPPtr x" and f=ptrFromPAddr in arg_cong)
|
||||
apply(simp only: ptrFromPAddr_add_helper)
|
||||
apply(simp add: add.commute)
|
||||
|
|
@ -1975,12 +2002,23 @@ lemma dmo_user_memory_update_idle_equiv:
|
|||
apply(wp modify_wp)
|
||||
done
|
||||
|
||||
lemma dmo_device_memory_update_idle_equiv:
|
||||
"\<lbrace>idle_equiv st\<rbrace>
|
||||
do_machine_op
|
||||
(device_memory_update um)
|
||||
\<lbrace>\<lambda>y. idle_equiv st\<rbrace>"
|
||||
apply(wp dmo_wp)
|
||||
apply(simp add: device_memory_update_def)
|
||||
apply(wp modify_wp)
|
||||
done
|
||||
|
||||
lemma do_user_op_if_idle_equiv[wp]:
|
||||
"\<lbrace>idle_equiv st and invs\<rbrace>
|
||||
do_user_op_if tc uop
|
||||
\<lbrace>\<lambda>_. idle_equiv st\<rbrace>"
|
||||
apply (simp add: do_user_op_if_def)
|
||||
apply (wp dmo_user_memory_update_idle_equiv select_wp | wpc | simp)+
|
||||
apply (wp dmo_user_memory_update_idle_equiv dmo_device_memory_update_idle_equiv
|
||||
select_wp | wpc | simp)+
|
||||
done
|
||||
|
||||
lemma ct_active_not_idle': "ct_active s \<Longrightarrow> \<not> ct_idle s"
|
||||
|
|
@ -2165,6 +2203,13 @@ lemma idle_equiv_context_equiv: "idle_equiv s s' \<Longrightarrow> invs s' \<Lon
|
|||
apply (clarsimp simp add: tcb_at_def2 get_tcb_def)
|
||||
done
|
||||
|
||||
lemma kernel_entry_if_valid_pdpt_objs[wp]:
|
||||
"\<lbrace>valid_pdpt_objs and invs and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_active s)\<rbrace>kernel_entry_if e tc \<lbrace>\<lambda>s. valid_pdpt_objs\<rbrace>"
|
||||
apply (case_tac "e = Interrupt")
|
||||
apply (simp add:kernel_entry_if_def)
|
||||
apply (wp|wpc|simp)+
|
||||
apply (simp add: kernel_entry_if_def tcb_cap_cases_def | wp static_imp_wp thread_set_invs_trivial)+
|
||||
done
|
||||
|
||||
lemma kernel_entry_if_det_inv':
|
||||
"\<And>e tc. \<lbrace>einvs and det_inv (KernelEntry e) tc and (\<lambda>s. ct_running s \<or> ct_idle s) and (\<lambda>s. e \<noteq> Interrupt \<longrightarrow> ct_running s)\<rbrace>
|
||||
|
|
@ -2185,6 +2230,18 @@ lemma pasMaySendIrqs_current_aag[simp]:
|
|||
apply(simp add: current_aag_def)
|
||||
done
|
||||
|
||||
lemma handle_preemption_if_valid_pdpt_objs[wp]:
|
||||
"\<lbrace>valid_pdpt_objs\<rbrace> handle_preemption_if a \<lbrace>\<lambda>rv s. valid_pdpt_objs s\<rbrace>"
|
||||
by (simp add:handle_preemption_if_def|wp)+
|
||||
|
||||
lemma schedule_if_valid_pdpt_objs[wp]:
|
||||
"\<lbrace>valid_pdpt_objs\<rbrace> schedule_if a \<lbrace>\<lambda>rv s. valid_pdpt_objs s\<rbrace>"
|
||||
by (simp add:schedule_if_def |wp)+
|
||||
|
||||
lemma do_user_op_if_valid_pdpt_objs[wp]:
|
||||
"\<lbrace>valid_pdpt_objs\<rbrace> do_user_op_if a b \<lbrace>\<lambda>rv s. valid_pdpt_objs s\<rbrace>"
|
||||
by (simp add:do_user_op_if_def |wp do_machine_op_valid_pdpt select_wp | wpc)+
|
||||
|
||||
lemma invs_if_Step_ADT_A_if:
|
||||
notes active_from_running[simp]
|
||||
shows
|
||||
|
|
@ -2280,6 +2337,7 @@ lemma invs_if_Step_ADT_A_if:
|
|||
apply simp
|
||||
apply(erule use_valid, erule use_valid[OF _ check_active_irq_if_wp])
|
||||
apply(rule_tac Q="\<lambda>a. (invs and ct_running) and (\<lambda>b.
|
||||
valid_pdpt_objs b \<and>
|
||||
valid_list b \<and>
|
||||
valid_sched b \<and>
|
||||
only_timer_irq_inv timer_irq s0_internal b \<and>
|
||||
|
|
@ -2305,6 +2363,7 @@ lemma invs_if_Step_ADT_A_if:
|
|||
apply simp
|
||||
apply(erule use_valid, erule use_valid[OF _ check_active_irq_if_wp])
|
||||
apply(rule_tac Q="\<lambda>a. (invs and ct_running) and (\<lambda>b.
|
||||
valid_pdpt_objs b \<and>
|
||||
valid_list b \<and>
|
||||
valid_sched b \<and>
|
||||
only_timer_irq_inv timer_irq s0_internal b \<and>
|
||||
|
|
@ -2341,11 +2400,13 @@ lemma invs_if_Step_ADT_A_if:
|
|||
apply (simp add: idle_context_def)
|
||||
done
|
||||
|
||||
|
||||
lemma Fin_ADT_if:
|
||||
"Fin (ADT_A_if utf) = id"
|
||||
apply (simp add: ADT_A_if_def)
|
||||
done
|
||||
|
||||
|
||||
lemma Init_ADT_if:
|
||||
"Init (ADT_A_if utf) = (\<lambda>s. {s} \<inter> full_invs_if \<inter> {s. step_restrict s})"
|
||||
apply (simp add: ADT_A_if_def)
|
||||
|
|
@ -2356,9 +2417,20 @@ lemma execution_invs:
|
|||
shows "invs_if s"
|
||||
apply (insert e)
|
||||
apply (induct js arbitrary: s rule: rev_induct)
|
||||
apply (simp add: execution_def ADT_A_if_def steps_def)
|
||||
apply (simp add: execution_def Fin_ADT_if Init_ADT_if steps_def)
|
||||
apply (fastforce simp: invs_if_Step_ADT_A_if)
|
||||
apply (clarsimp simp add: execution_def Fin_ADT_if Init_ADT_if
|
||||
image_def)
|
||||
apply (simp add: execution_def Fin_ADT_if Init_ADT_if steps_def)
|
||||
apply (simp add: execution_def steps_def image_def)
|
||||
apply (erule bexE)
|
||||
unfolding Image_def
|
||||
apply (drule CollectD)
|
||||
apply (erule bexE)
|
||||
apply simp
|
||||
apply (rule invs_if_Step_ADT_A_if)
|
||||
apply (drule_tac meta_spec)
|
||||
apply (fastforce)
|
||||
apply simp
|
||||
apply (clarsimp simp:Fin_ADT_if ADT_A_if_def)
|
||||
done
|
||||
|
||||
lemma execution_restrict:
|
||||
|
|
@ -2452,6 +2524,10 @@ definition measuref_if :: "det_state global_sys_state \<Rightarrow> det_state gl
|
|||
)
|
||||
)"
|
||||
|
||||
crunch irq_state_of_state_inv[wp]: device_memory_update "\<lambda>ms. P (irq_state ms)"
|
||||
crunch irq_masks_inv[wp]: device_memory_update "\<lambda>ms. P (irq_masks ms)"
|
||||
(wp: crunch_wps simp:crunch_simps no_irq_device_memory_update no_irq_def)
|
||||
|
||||
lemma do_user_op_if_irq_state_of_state:
|
||||
"\<lbrace>\<lambda>s. P (irq_state_of_state s)\<rbrace> do_user_op_if utf uc
|
||||
\<lbrace>\<lambda>_ s. P (irq_state_of_state s)\<rbrace>"
|
||||
|
|
@ -2470,7 +2546,8 @@ lemma do_user_op_if_irq_measure_if:
|
|||
"\<lbrace>\<lambda>s. P (irq_measure_if s)\<rbrace> do_user_op_if utf uc
|
||||
\<lbrace>\<lambda>_ s. P (irq_measure_if s)\<rbrace>"
|
||||
apply(rule hoare_pre)
|
||||
apply(simp add: do_user_op_if_def user_memory_update_def irq_measure_if_def | wp dmo_wp select_wp | wpc)+
|
||||
apply(simp add: do_user_op_if_def user_memory_update_def irq_measure_if_def
|
||||
| wps |wp dmo_wp select_wp | wpc)+
|
||||
done
|
||||
|
||||
lemma next_irq_state_Suc:
|
||||
|
|
@ -3184,7 +3261,6 @@ lemma ADT_A_if_sub_big_steps_measuref_if:
|
|||
apply(clarsimp simp: big_step_R_def measuref_if_def split: if_splits)
|
||||
apply(case_tac ba, simp_all, case_tac bc, simp_all add: Step_ADT_A_if')
|
||||
apply(simp_all add: ADT_A_if_def global_automaton_if_def)
|
||||
apply blast
|
||||
done
|
||||
|
||||
lemma rah_simp:
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@ imports
|
|||
"ADT_IF" "../refine/Refine" "../refine/EmptyFail_H"
|
||||
begin
|
||||
|
||||
|
||||
definition
|
||||
kernelEntry_if
|
||||
where
|
||||
|
|
@ -126,17 +125,28 @@ definition doUserOp_if :: "user_transition_if \<Rightarrow> user_context \<Right
|
|||
do pr \<leftarrow> gets ptable_rights_s';
|
||||
pxn \<leftarrow> gets (\<lambda>s x. pr x \<noteq> {} \<and> ptable_xn_s' s x);
|
||||
pl \<leftarrow> gets (\<lambda>s. ptable_lift_s' s |` {x. pr x \<noteq> {}});
|
||||
allow_read \<leftarrow> return {y. \<exists>x. pl x = Some y \<and> AllowRead \<in> pr x};
|
||||
allow_write \<leftarrow> return {y. \<exists>x. pl x = Some y \<and> AllowWrite \<in> pr x};
|
||||
t \<leftarrow> getCurThread;
|
||||
um \<leftarrow>
|
||||
gets (\<lambda>s. (user_mem' s \<circ> ptrFromPAddr) |`
|
||||
{y. \<exists>x. pl x = Some y \<and> AllowRead \<in> pr x});
|
||||
um \<leftarrow> gets (\<lambda>s. (user_mem' s \<circ> ptrFromPAddr));
|
||||
dm \<leftarrow> gets (\<lambda>s. (device_mem' s \<circ> ptrFromPAddr));
|
||||
ds \<leftarrow> gets (device_state \<circ> ksMachineState);
|
||||
assert (dom (um \<circ> addrFromPPtr) \<subseteq> - dom ds);
|
||||
assert (dom (dm \<circ> addrFromPPtr) \<subseteq> dom ds);
|
||||
es \<leftarrow> doMachineOp getExMonitor;
|
||||
u \<leftarrow> return (uop t pl pr pxn (tc, um, es));
|
||||
u \<leftarrow>
|
||||
return
|
||||
(uop t pl pr pxn
|
||||
(tc, um |` allow_read,
|
||||
(ds \<circ> ptrFromPAddr) |` allow_read, es));
|
||||
assert (u \<noteq> {});
|
||||
(e, tc', um', es') \<leftarrow> select u;
|
||||
(e, tc', um',ds', es') \<leftarrow> select u;
|
||||
doMachineOp
|
||||
(user_memory_update
|
||||
(um' |` {y. \<exists>x. pl x = Some y \<and> AllowWrite \<in> pr x} \<circ> addrFromPPtr));
|
||||
((um' |` allow_write \<circ> addrFromPPtr) |` (- (dom ds))));
|
||||
doMachineOp
|
||||
(device_memory_update
|
||||
((ds' |` allow_write \<circ> addrFromPPtr) |` dom ds));
|
||||
doMachineOp (setExMonitor es');
|
||||
return (e, tc')
|
||||
od"
|
||||
|
|
@ -146,6 +156,7 @@ lemma empty_fail_select_bind: "empty_fail (assert (S \<noteq> {}) >>= (\<lambda>
|
|||
done
|
||||
|
||||
crunch (empty_fail) empty_fail[wp]: user_memory_update
|
||||
crunch (empty_fail) empty_fail[wp]: device_memory_update
|
||||
|
||||
lemma getExMonitor_empty_fail[wp]:
|
||||
"empty_fail getExMonitor"
|
||||
|
|
@ -181,12 +192,54 @@ lemma doUserOp_if_empty_fail: "empty_fail (doUserOp_if uop tc)"
|
|||
apply wp_once
|
||||
apply wp_once
|
||||
apply wp[1]
|
||||
apply wp_once
|
||||
apply wp[1]
|
||||
apply wp_once
|
||||
apply wp[1]
|
||||
apply wp_once
|
||||
apply wp[1]
|
||||
apply wp_once
|
||||
apply wp[1]
|
||||
apply (subst bind_assoc[symmetric])
|
||||
apply (rule empty_fail_bind)
|
||||
apply (rule empty_fail_select_bind)
|
||||
apply (wp | wpc)+
|
||||
done
|
||||
|
||||
|
||||
lemma ptable_attrs_abs_state[simp]:
|
||||
"ptable_attrs thread (abs_state s) = ptable_attrs thread s"
|
||||
by (simp add:ptable_attrs_def abs_state_def)
|
||||
|
||||
lemma corres_gets_same:
|
||||
assumes equiv: "\<And>s s'. \<lbrakk>P s; Q s'; (s, s') \<in> sr\<rbrakk>\<Longrightarrow> f s = g s'"
|
||||
and rimp : "\<And>s. P s \<Longrightarrow> R (f s) s"
|
||||
and corres: "\<And>r. corres_underlying sr b rr (P and (R r)) Q (n r) (m r)"
|
||||
shows "corres_underlying sr b rr P Q
|
||||
(do r \<leftarrow> gets f; n r od)
|
||||
(do r \<leftarrow> gets g; m r od)"
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule corres_split[where r' = "op ="])
|
||||
apply simp
|
||||
apply (rule corres)
|
||||
apply clarsimp
|
||||
apply (rule equiv)
|
||||
apply (wp|simp)+
|
||||
apply (simp add: rimp)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma corres_assert_imp_r:
|
||||
"\<lbrakk>\<And>s. P s\<Longrightarrow> Q' ; corres_underlying state_relation a rr P Q f (g ())\<rbrakk>
|
||||
\<Longrightarrow> corres_underlying state_relation a rr P Q f (assert Q' >>= g)"
|
||||
by (force simp: corres_underlying_def assert_def return_def bind_def fail_def)
|
||||
|
||||
lemma corres_return_same_trivial:
|
||||
"corres_underlying sr b op= \<top> \<top> (return a) (return a)"
|
||||
by simp
|
||||
|
||||
crunch (no_fail) no_fail[wp]: device_memory_update
|
||||
|
||||
lemma do_user_op_if_corres:
|
||||
"corres op = (einvs and ct_running and (\<lambda>_. \<forall>t pl pr pxn tcu. f t pl pr pxn tcu \<noteq> {}))
|
||||
(invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
|
||||
|
|
@ -194,52 +247,63 @@ lemma do_user_op_if_corres:
|
|||
(do_user_op_if f tc) (doUserOp_if f tc)"
|
||||
apply (rule corres_gen_asm)
|
||||
apply (simp add: do_user_op_if_def doUserOp_if_def)
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: ptable_rights_s_def ptable_rights_s'_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: ptable_attrs_s'_def ptable_attrs_s_def ptable_xn_s'_def ptable_xn_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: absArchState_correct curthread_relation ptable_lift_s'_def
|
||||
ptable_lift_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply simp
|
||||
apply (simp add: getCurThread_def)
|
||||
apply (rule corres_gets_same)
|
||||
apply (simp add:curthread_relation)
|
||||
apply simp
|
||||
apply (rule corres_gets_same[where R ="\<lambda>r s. dom (r \<circ> addrFromPPtr) \<subseteq> - device_region s"])
|
||||
apply (clarsimp simp add:user_mem_relation dest!:invs_valid_stateI invs_valid_stateI')
|
||||
apply (clarsimp simp: invs_def valid_state_def pspace_respects_device_region_def)
|
||||
apply fastforce
|
||||
apply (rule corres_gets_same[where R ="\<lambda>r s. dom (r \<circ> addrFromPPtr) \<subseteq> device_region s"])
|
||||
apply (clarsimp simp add:device_mem_relation dest!:invs_valid_stateI invs_valid_stateI')
|
||||
apply (clarsimp simp: invs_def valid_state_def pspace_respects_device_region_def)
|
||||
apply fastforce
|
||||
apply (rule corres_gets_same[where R ="\<lambda>r s. dom r = device_region s"])
|
||||
apply (clarsimp simp:state_relation_def)
|
||||
apply simp
|
||||
apply (rule corres_assert_imp_r)
|
||||
apply clarsimp
|
||||
apply (rule corres_assert_imp_r)
|
||||
apply clarsimp
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule_tac r'="op=" and P=einvs and P'=invs' in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: ptable_rights_s_def ptable_rights_s'_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply (rule_tac r'="op=" and P=einvs and P'=invs' in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: ptable_attrs_s'_def ptable_attrs_s_def ptable_xn_s'_def ptable_xn_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply (rule_tac r'="op=" and P=einvs and P'=invs' in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: absArchState_correct curthread_relation ptable_lift_s'_def
|
||||
ptable_lift_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply (rule corres_split[OF _ gct_corres])
|
||||
apply simp
|
||||
apply (rule corres_split[OF _ user_mem_corres])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_machine_op)
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (wp hoare_TrueI)
|
||||
apply (clarsimp simp: addrFromPPtr_def)
|
||||
apply (rule corres_machine_op)
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (clarsimp simp: user_memory_update_def)
|
||||
apply (rule non_fail_modify)
|
||||
apply clarsimp
|
||||
apply (wp hoare_TrueI)
|
||||
apply clarsimp
|
||||
apply (wp hoare_TrueI)
|
||||
apply (clarsimp simp: select_def corres_underlying_def)
|
||||
apply (simp only: comp_def | wp hoare_TrueI)+
|
||||
apply (rule corres_machine_op)
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (wp hoare_TrueI)
|
||||
apply (rule corres_split[OF _ corres_machine_op,where r'="op="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[OF _ corres_machine_op,where r'="op="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[OF _ corres_machine_op,where r'="op="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[OF _ corres_machine_op, where r'="op="])
|
||||
apply (rule corres_return_same_trivial)
|
||||
apply (wp hoare_TrueI[where P = \<top>] | simp | rule corres_underlying_trivial)+
|
||||
apply (clarsimp simp: user_memory_update_def)
|
||||
apply (rule non_fail_modify)
|
||||
apply clarsimp
|
||||
apply (wp hoare_TrueI)
|
||||
apply clarsimp
|
||||
apply (wp hoare_TrueI)
|
||||
apply (clarsimp simp: select_def corres_underlying_def)
|
||||
apply (simp only: comp_def | wp hoare_TrueI)+
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (wp hoare_TrueI)
|
||||
apply clarsimp
|
||||
apply force
|
||||
apply force
|
||||
|
|
@ -278,18 +342,18 @@ lemma invs'_exclusive_state_update[iff]:
|
|||
|
||||
lemma doUserOp_if_invs'[wp]:
|
||||
"\<lbrace>invs' and
|
||||
(\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
|
||||
ct_running' and ex_abs (einvs)\<rbrace>
|
||||
doUserOp_if f tc
|
||||
\<lbrace>\<lambda>_. invs'\<rbrace>"
|
||||
(\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
|
||||
ct_running' and ex_abs (einvs)\<rbrace>
|
||||
doUserOp_if f tc
|
||||
\<lbrace>\<lambda>_. invs'\<rbrace>"
|
||||
apply (simp add: doUserOp_if_def split_def ex_abs_def)
|
||||
apply (wp dmo_setExMonitor_wp' dmo_invs' | simp)+
|
||||
apply (wp device_update_invs' dmo_setExMonitor_wp' dmo_invs' | simp)+
|
||||
apply (clarsimp simp add: no_irq_modify user_memory_update_def)
|
||||
apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp)
|
||||
apply (clarsimp simp: user_memory_update_def simpler_modify_def
|
||||
restrict_map_def
|
||||
split: option.splits)
|
||||
apply (erule ptable_rights_imp_UserData[rotated 2], auto simp: ptable_rights_s'_def ptable_lift_s'_def)
|
||||
apply (drule ptable_rights_imp_UserData[rotated 2], auto simp: ptable_rights_s'_def ptable_lift_s'_def)
|
||||
done
|
||||
|
||||
lemma doUserOp_valid_duplicates[wp]:
|
||||
|
|
@ -368,75 +432,66 @@ lemma do_user_op_if_corres':
|
|||
ct_running')
|
||||
(do_user_op_if f tc) (doUserOp_if f tc)"
|
||||
apply (simp add: do_user_op_if_def doUserOp_if_def)
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule_tac r'="op=" and P=einvs and P'=invs' in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: ptable_rights_s_def ptable_rights_s'_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply (rule_tac r'="op=" and P=einvs and P'=invs' in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: absArchState_correct curthread_relation ptable_xn_s'_def
|
||||
ptable_xn_s_def ptable_attrs_s_def ptable_attrs_s'_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply simp
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply (rule_tac r'="op=" and P=einvs and P'=invs' in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: absArchState_correct curthread_relation ptable_lift_s'_def
|
||||
ptable_lift_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply (rule corres_split[OF _ gct_corres'])
|
||||
apply simp
|
||||
apply (rule corres_split[OF _ user_mem_corres'])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[where r'="op ="])
|
||||
apply clarsimp
|
||||
apply (rule corres_machine_op')
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply wp
|
||||
apply (clarsimp simp: addrFromPPtr_def)
|
||||
apply (rule corres_machine_op')
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (clarsimp simp: user_memory_update_def)
|
||||
apply clarsimp
|
||||
apply (wp hoare_TrueI)
|
||||
apply clarsimp
|
||||
apply (wp hoare_TrueI)
|
||||
apply (clarsimp simp: select_def corres_underlying_def)
|
||||
apply (simp only: comp_def | wp hoare_TrueI)+
|
||||
apply (rule corres_rel_imp[OF corres_assert'])
|
||||
apply simp
|
||||
apply (simp only: comp_def | wp hoare_TrueI)+
|
||||
apply (rule corres_machine_op')
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (wp hoare_TrueI)
|
||||
apply clarsimp
|
||||
apply assumption
|
||||
apply (wp hoare_TrueI)
|
||||
apply clarsimp
|
||||
apply assumption
|
||||
apply (wp hoare_TrueI)
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: ptable_rights_s_def ptable_rights_s'_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: ptable_attrs_s'_def ptable_attrs_s_def ptable_xn_s'_def ptable_xn_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: absArchState_correct curthread_relation ptable_lift_s'_def
|
||||
ptable_lift_s_def)
|
||||
apply (subst absKState_correct, fastforce, assumption+)
|
||||
apply (clarsimp elim!: state_relationE)
|
||||
apply simp
|
||||
apply (simp add: getCurThread_def)
|
||||
apply (rule corres_gets_same)
|
||||
apply (simp add:curthread_relation)
|
||||
apply simp
|
||||
apply (rule corres_gets_same[where R ="\<lambda>r s. dom (r \<circ> addrFromPPtr) \<subseteq> - device_region s"])
|
||||
apply (clarsimp simp add:user_mem_relation dest!:invs_valid_stateI invs_valid_stateI')
|
||||
apply (clarsimp simp: invs_def valid_state_def pspace_respects_device_region_def)
|
||||
apply fastforce
|
||||
apply (rule corres_gets_same[where R ="\<lambda>r s. dom (r \<circ> addrFromPPtr) \<subseteq> device_region s"])
|
||||
apply (clarsimp simp add:device_mem_relation dest!:invs_valid_stateI invs_valid_stateI')
|
||||
apply (clarsimp simp: invs_def valid_state_def pspace_respects_device_region_def dom_def)
|
||||
apply (rule corres_gets_same[where R ="\<lambda>r s. dom r = device_region s"])
|
||||
apply (clarsimp simp:state_relation_def)
|
||||
apply simp
|
||||
apply (rule corres_assert_imp_r)
|
||||
apply clarsimp
|
||||
apply (rule TrueI conjI)+
|
||||
apply clarsimp
|
||||
apply (rule TrueI conjI)+
|
||||
apply (rule corres_assert_imp_r)
|
||||
apply clarsimp
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule corres_split[OF _ corres_machine_op',where r'="op="])
|
||||
apply simp
|
||||
apply (rule corres_split[where r'="dc"])
|
||||
apply simp
|
||||
apply (rule corres_split[where r'="op="])
|
||||
apply clarsimp
|
||||
apply (rule corres_split[OF _ corres_machine_op',where r'="op="])
|
||||
apply simp
|
||||
apply (rule corres_split[OF _ corres_machine_op', where r'="op="])
|
||||
apply simp
|
||||
apply (rule corres_split[OF _ corres_machine_op', where r'="op="])
|
||||
apply (rule corres_return_same_trivial)
|
||||
apply (wp hoare_TrueI[where P = \<top>] | simp | rule corres_underlying_trivial)+
|
||||
apply (clarsimp simp: select_def corres_underlying_def)
|
||||
apply (simp only: comp_def | wp hoare_TrueI)+
|
||||
apply (rule corres_assert')
|
||||
apply (wp hoare_TrueI[where P = \<top>] | simp | rule corres_underlying_trivial)+
|
||||
apply clarsimp
|
||||
apply force
|
||||
apply force
|
||||
done
|
||||
|
||||
lemma doUserOp_if_ex_abs[wp]:
|
||||
"\<lbrace>invs' and
|
||||
(\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and
|
||||
ct_running' and ex_abs (einvs)\<rbrace>
|
||||
doUserOp_if f tc
|
||||
"\<lbrace>invs' and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and ct_running' and ex_abs (einvs)\<rbrace>
|
||||
doUserOp_if f tc
|
||||
\<lbrace>\<lambda>_. ex_abs (einvs)\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (rule corres_ex_abs_lift'[OF do_user_op_if_corres'])
|
||||
|
|
@ -854,10 +909,6 @@ lemma step_corresE:
|
|||
apply simp+
|
||||
done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
locale global_automaton_invs =
|
||||
fixes check_active_irq
|
||||
fixes do_user_op
|
||||
|
|
@ -919,10 +970,6 @@ lemma invariant_holds_inter: "A \<Turnstile> I \<Longrightarrow> A \<Turnstile>
|
|||
apply blast
|
||||
done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
lemma preserves_lift_ret: "(\<And>tc. \<lbrace>\<lambda>s. ((tc,s),mode) \<in> P\<rbrace> f tc \<lbrace>\<lambda>tc' s'. ((snd tc',s'),mode') \<in> P\<rbrace>)
|
||||
\<Longrightarrow>
|
||||
preserves mode mode' P
|
||||
|
|
@ -1277,7 +1324,7 @@ end
|
|||
|
||||
lemma
|
||||
step_corres_lift:
|
||||
"(\<And>tc. corres_underlying srel True (op =) (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f tc) (f' tc)) \<Longrightarrow>
|
||||
"(\<And>tc. corres_underlying srel nf (op =) (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f tc) (f' tc)) \<Longrightarrow>
|
||||
(\<And>tc. nf \<Longrightarrow> empty_fail (f' tc)) \<Longrightarrow>
|
||||
step_corres nf (lift_snd_rel srel) mode P
|
||||
P'
|
||||
|
|
@ -1291,7 +1338,7 @@ lemma
|
|||
done
|
||||
|
||||
lemma step_corres_lift':
|
||||
"(\<And>tc. corres_underlying srel True (op =) (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f u tc) (f' u tc)) \<Longrightarrow>
|
||||
"(\<And>tc. corres_underlying srel nf (op =) (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f u tc) (f' u tc)) \<Longrightarrow>
|
||||
(\<And>tc. nf \<Longrightarrow> empty_fail (f' u tc)) \<Longrightarrow>
|
||||
step_corres nf (lift_snd_rel srel) mode
|
||||
P P'
|
||||
|
|
@ -1306,7 +1353,7 @@ lemma step_corres_lift':
|
|||
|
||||
|
||||
lemma step_corres_lift'':
|
||||
"(\<And>tc. corres_underlying srel True (\<lambda>r r'. ((fst r) = Inr ()) = ((fst r') = Inr ()) \<and> (snd r) = (snd r')) (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f e tc) (f' e tc)) \<Longrightarrow>
|
||||
"(\<And>tc. corres_underlying srel nf (\<lambda>r r'. ((fst r) = Inr ()) = ((fst r') = Inr ()) \<and> (snd r) = (snd r')) (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f e tc) (f' e tc)) \<Longrightarrow>
|
||||
(\<And>tc. nf \<Longrightarrow> empty_fail (f' e tc)) \<Longrightarrow>
|
||||
step_corres nf (lift_snd_rel srel) mode
|
||||
P P'
|
||||
|
|
@ -1322,7 +1369,7 @@ lemma step_corres_lift'':
|
|||
done
|
||||
|
||||
lemma step_corres_lift''':
|
||||
"(\<And>tc. corres_underlying srel True op = (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f tc) (f' tc)) \<Longrightarrow>
|
||||
"(\<And>tc. corres_underlying srel nf op = (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f tc) (f' tc)) \<Longrightarrow>
|
||||
(\<And>tc. nf \<Longrightarrow> empty_fail (f' tc)) \<Longrightarrow>
|
||||
step_corres nf (lift_snd_rel srel) mode
|
||||
P P'
|
||||
|
|
@ -1336,7 +1383,7 @@ lemma step_corres_lift''':
|
|||
done
|
||||
|
||||
lemma step_corres_lift'''':
|
||||
"(\<And>tc. corres_underlying srel True op = (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f tc) (f' tc)) \<Longrightarrow>
|
||||
"(\<And>tc. corres_underlying srel nf op = (\<lambda>s. ((tc,s),mode) \<in> P) (\<lambda>s'. ((tc,s'),mode) \<in> P') (f tc) (f' tc)) \<Longrightarrow>
|
||||
(\<And>tc. nf \<Longrightarrow> empty_fail (f' tc)) \<Longrightarrow>
|
||||
(\<And>tc s s'. (s,s') \<in> srel \<Longrightarrow> S' s' \<Longrightarrow> S s \<Longrightarrow> y s = y' s') \<Longrightarrow>
|
||||
(\<And>tc. \<lbrace>\<lambda>s'. ((tc,s'),mode) \<in> P'\<rbrace> (f' tc) \<lbrace>\<lambda>_. S'\<rbrace>) \<Longrightarrow>
|
||||
|
|
@ -1402,6 +1449,10 @@ lemma ct_idle'_related: "\<lbrakk>(a, c) \<in> state_relation; invs' c; ct_idle
|
|||
apply (case_tac st, simp_all)[1]
|
||||
done
|
||||
|
||||
lemma invs_machine_state:
|
||||
"invs s \<Longrightarrow> valid_machine_state s"
|
||||
by (clarsimp simp:invs_def valid_state_def)
|
||||
|
||||
lemma haskell_to_abs: "uop_nonempty uop \<Longrightarrow> global_automata_refine
|
||||
check_active_irq_A_if (do_user_op_A_if uop)
|
||||
kernel_call_A_if kernel_handle_preemption_if
|
||||
|
|
@ -1419,8 +1470,9 @@ lemma haskell_to_abs: "uop_nonempty uop \<Longrightarrow> global_automata_refine
|
|||
apply (simp add: step_restrict_def)
|
||||
apply (simp add: ADT_H_if_def ADT_A_if_def)
|
||||
apply (clarsimp simp add: lift_snd_rel_def full_invs_if_def full_invs_if'_def)
|
||||
apply (rule absKState_correct)
|
||||
apply simp+
|
||||
apply (frule valid_device_abs_state_eq[OF invs_machine_state])
|
||||
apply (frule absKState_correct[rotated])
|
||||
apply simp+
|
||||
apply (simp add: ADT_H_if_def ADT_A_if_def lift_fst_rel_def)
|
||||
apply (clarsimp simp: lift_snd_rel_def)
|
||||
apply (subgoal_tac "((a, absKState bb), ba) \<in> full_invs_if \<and> (absKState bb, bb) \<in> state_relation")
|
||||
|
|
@ -1430,6 +1482,7 @@ lemma haskell_to_abs: "uop_nonempty uop \<Longrightarrow> global_automata_refine
|
|||
apply (clarsimp simp: ex_abs_def)
|
||||
apply (frule(1) absKState_correct[rotated],simp+)
|
||||
apply (simp add: full_invs_if_def)
|
||||
apply (frule valid_device_abs_state_eq[OF invs_machine_state])
|
||||
apply (case_tac ba)
|
||||
apply (fastforce simp: active_from_running ct_running_related ct_idle_related schedaction_related)+
|
||||
apply (simp add: check_active_irq_A_if_def checkActiveIRQ_H_if_def)
|
||||
|
|
|
|||
|
|
@ -295,7 +295,7 @@ lemma handleEvent_ccorres:
|
|||
done
|
||||
|
||||
lemma kernelEntry_corres_C:
|
||||
"corres_underlying rf_sr True (prod_lift (\<lambda>r r'. (r = Inr ()) = (r' = Inr ()))) (
|
||||
"corres_underlying rf_sr nf (prod_lift (\<lambda>r r'. (r = Inr ()) = (r' = Inr ()))) (
|
||||
all_invs' e) \<top>
|
||||
(kernelEntry_if e tc) (kernelEntry_C_if fp e tc)"
|
||||
apply (simp add: kernelEntry_if_def kernelEntry_C_if_def)
|
||||
|
|
@ -367,16 +367,20 @@ definition doUserOp_C_if
|
|||
pr \<leftarrow> gets ptable_rights_s'';
|
||||
pxn \<leftarrow> gets (\<lambda>s x. pr x \<noteq> {} \<and> ptable_xn_s'' s x);
|
||||
pl \<leftarrow> gets (\<lambda>s. restrict_map (ptable_lift_s'' s) {x. pr x \<noteq> {}});
|
||||
allow_read \<leftarrow> return {y. \<exists>x. pl x = Some y \<and> AllowRead \<in> pr x};
|
||||
allow_write \<leftarrow> return {y. \<exists>x. pl x = Some y \<and> AllowWrite \<in> pr x};
|
||||
t \<leftarrow> gets (\<lambda>s. cur_thread (cstate_to_A s));
|
||||
um \<leftarrow> gets (\<lambda>s. restrict_map (user_mem_C (globals s) \<circ> ptrFromPAddr)
|
||||
{y. EX x. pl x = Some y \<and> AllowRead \<in> pr x});
|
||||
um \<leftarrow> gets (\<lambda>s. user_mem_C (globals s) \<circ> ptrFromPAddr);
|
||||
dm \<leftarrow> gets (\<lambda>s. device_mem_C (globals s) \<circ> ptrFromPAddr);
|
||||
ds \<leftarrow> gets (\<lambda>s. device_state (phantom_machine_state_' (globals s)));
|
||||
assert (dom (um \<circ> addrFromPPtr) \<subseteq> - dom ds);
|
||||
assert (dom (dm \<circ> addrFromPPtr) \<subseteq> dom ds);
|
||||
es \<leftarrow> doMachineOp_C getExMonitor;
|
||||
u \<leftarrow> return (uop t pl pr pxn (tc, um, es));
|
||||
u \<leftarrow> return (uop t pl pr pxn (tc, um |` allow_read, (ds \<circ> ptrFromPAddr)|` allow_read ,es));
|
||||
assert (u \<noteq> {});
|
||||
(e,(tc',um',es')) \<leftarrow> select u;
|
||||
setUserMem_C (
|
||||
(restrict_map um' {y. EX x. pl x = Some y \<and> AllowWrite : pr x} \<circ>
|
||||
addrFromPPtr));
|
||||
(e,(tc',um',ds',es')) \<leftarrow> select u;
|
||||
setUserMem_C ((um' |` allow_write \<circ> addrFromPPtr) |` (- dom ds));
|
||||
setDeviceState_C ((ds' |` allow_write \<circ> addrFromPPtr) |` dom ds);
|
||||
doMachineOp_C (setExMonitor es');
|
||||
return (e,tc')
|
||||
od"
|
||||
|
|
@ -393,9 +397,9 @@ context kernel_m begin
|
|||
|
||||
|
||||
|
||||
lemma corres_underlying_split4:
|
||||
"(\<And>a b c d. corres_underlying srel nf rrel (Q a b c d) (Q' a b c d) (f a b c d) (f' a b c d)) \<Longrightarrow>
|
||||
corres_underlying srel nf rrel (case x of (a,b,c,d) \<Rightarrow> Q a b c d) (case x of (a,b,c,d) \<Rightarrow> Q' a b c d) (case x of (a,b,c,d) \<Rightarrow> f a b c d) (case x of (a,b,c,d) \<Rightarrow> f' a b c d)"
|
||||
lemma corres_underlying_split5:
|
||||
"(\<And>a b c d e. corres_underlying srel nf rrel (Q a b c d e) (Q' a b c d e) (f a b c d e) (f' a b c d e)) \<Longrightarrow>
|
||||
corres_underlying srel nf rrel (case x of (a,b,c,d,e) \<Rightarrow> Q a b c d e) (case x of (a,b,c,d,e) \<Rightarrow> Q' a b c d e) (case x of (a,b,c,d,e) \<Rightarrow> f a b c d e) (case x of (a,b,c,d,e) \<Rightarrow> f' a b c d e)"
|
||||
apply (case_tac x)
|
||||
apply simp
|
||||
done
|
||||
|
|
@ -409,7 +413,8 @@ lemma corres_dmo_getExMonitor_C:
|
|||
"corres_underlying rf_sr nf op = \<top> \<top> (doMachineOp getExMonitor) (doMachineOp_C getExMonitor)"
|
||||
apply (clarsimp simp: doMachineOp_def doMachineOp_C_def)
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule_tac r'="\<lambda>ms ms'. exclusive_state ms = exclusive_state ms' \<and> machine_state_rest ms = machine_state_rest ms' \<and> irq_masks ms = irq_masks ms' \<and> equiv_irq_state ms ms'" and P="\<top>" and P'="\<top>" in corres_split)
|
||||
apply (rule_tac r'="\<lambda>ms ms'. exclusive_state ms = exclusive_state ms' \<and> machine_state_rest ms = machine_state_rest ms'
|
||||
\<and> irq_masks ms = irq_masks ms' \<and> equiv_irq_state ms ms' \<and> device_state ms = device_state ms'" and P="\<top>" and P'="\<top>" in corres_split)
|
||||
apply (rule_tac r'="\<lambda>(r, ms) (r', ms'). r = r' \<and> ms = rv \<and> ms' = rv'" in corres_split)
|
||||
apply (clarsimp simp: split_def)
|
||||
apply (rule_tac r'=dc and P="\<lambda>s. underlying_memory (snd ((aa, bb), ba)) = underlying_memory (ksMachineState s)"
|
||||
|
|
@ -431,7 +436,8 @@ lemma corres_dmo_setExMonitor_C:
|
|||
"corres_underlying rf_sr nf dc \<top> \<top> (doMachineOp (setExMonitor es)) (doMachineOp_C (setExMonitor es))"
|
||||
apply (clarsimp simp: doMachineOp_def doMachineOp_C_def)
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule_tac r'="\<lambda>ms ms'. exclusive_state ms = exclusive_state ms' \<and> machine_state_rest ms = machine_state_rest ms' \<and> irq_masks ms = irq_masks ms' \<and> equiv_irq_state ms ms'" and P="\<top>" and P'="\<top>" in corres_split)
|
||||
apply (rule_tac r'="\<lambda>ms ms'. exclusive_state ms = exclusive_state ms' \<and> machine_state_rest ms = machine_state_rest ms'
|
||||
\<and> irq_masks ms = irq_masks ms' \<and> equiv_irq_state ms ms' \<and> device_state ms = device_state ms'" and P="\<top>" and P'="\<top>" in corres_split)
|
||||
apply (rule_tac r'="\<lambda>(r, ms) (r', ms'). ms = rv\<lparr>exclusive_state := es\<rparr> \<and> ms' = rv'\<lparr>exclusive_state := es\<rparr>" in corres_split)
|
||||
apply (simp add: split_def)
|
||||
apply (rule_tac P="\<lambda>s. underlying_memory (snd rva) = underlying_memory (ksMachineState s)"
|
||||
|
|
@ -457,83 +463,94 @@ lemma dmo_getExMonitor_C_wp[wp]:
|
|||
apply simp
|
||||
done
|
||||
|
||||
lemma cur_thread_of_absKState[simp]:
|
||||
"cur_thread (absKState s) = (ksCurThread s)"
|
||||
by (clarsimp simp:cstate_relation_def Let_def absKState_def cstate_to_H_def)
|
||||
|
||||
lemma absKState_crelation:
|
||||
"\<lbrakk>cstate_relation s (globals s'); invs' s\<rbrakk>\<Longrightarrow> cstate_to_A s' = absKState s"
|
||||
apply (clarsimp simp add:cstate_to_H_correct invs'_def cstate_to_A_def)
|
||||
apply (clarsimp simp:absKState_def absExst_def observable_memory_def)
|
||||
apply (case_tac s)
|
||||
apply clarsimp
|
||||
apply (case_tac ksMachineState)
|
||||
apply clarsimp
|
||||
apply (rule ext)
|
||||
by (clarsimp simp:option_to_0_def user_mem'_def pointerInUserData_def ko_wp_at'_def
|
||||
obj_at'_def typ_at'_def ps_clear_def split:if_splits)
|
||||
|
||||
lemma do_user_op_if_C_corres:
|
||||
"corres_underlying rf_sr True op =
|
||||
"corres_underlying rf_sr False op =
|
||||
(invs' and ex_abs einvs and (\<lambda>_. uop_nonempty f)) \<top>
|
||||
(doUserOp_if f tc) (doUserOp_C_if f tc)"
|
||||
apply (rule corres_gen_asm)
|
||||
apply (simp add: doUserOp_if_def doUserOp_C_if_def uop_nonempty_def del: split_paired_All)
|
||||
apply (thin_tac "P" for P)
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: absKState_crelation ptable_rights_s'_def ptable_rights_s''_def
|
||||
rf_sr_def cstate_relation_def Let_def cstate_to_H_correct)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: ptable_xn_s'_def ptable_xn_s''_def ptable_attrs_s_def
|
||||
absKState_crelation ptable_attrs_s'_def ptable_attrs_s''_def rf_sr_def)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: absKState_crelation curthread_relation ptable_lift_s'_def ptable_lift_s''_def
|
||||
ptable_lift_s_def rf_sr_def)
|
||||
apply simp
|
||||
apply (simp add: getCurThread_def)
|
||||
apply (rule corres_gets_same)
|
||||
apply (simp add:absKState_crelation rf_sr_def)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (rule fun_cong[where x=Platform.ptrFromPAddr])
|
||||
apply (rule_tac f=comp in arg_cong)
|
||||
apply (rule user_mem_C_relation[symmetric])
|
||||
apply (simp add: rf_sr_def cstate_relation_def Let_def
|
||||
cpspace_relation_def)
|
||||
apply fastforce
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
|
||||
cpspace_relation_def)
|
||||
apply (drule device_mem_C_relation[symmetric])
|
||||
apply fastforce
|
||||
apply (simp add: comp_def)
|
||||
apply simp
|
||||
apply (rule corres_gets_same)
|
||||
apply (clarsimp simp: cstate_relation_def rf_sr_def
|
||||
Let_def cmachine_state_relation_def)
|
||||
apply simp
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule_tac r'="op=" and P'=\<top> and P="invs' and ex_abs (einvs)" in corres_split)
|
||||
apply (rule_tac P=\<top> and P'=\<top> and r'="op=" in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: ptable_rights_s'_def ptable_rights_s''_def cstate_to_A_def rf_sr_def)
|
||||
apply (subst cstate_to_H_correct, simp add: invs'_def,force+)+
|
||||
apply (simp only: ex_abs_def)
|
||||
apply (elim exE conjE)
|
||||
apply (clarsimp simp add: absKState_correct absArchState_correct)
|
||||
apply (clarsimp simp: absHeap_correct
|
||||
invs_def valid_state_def valid_pspace_def state_relation_def)
|
||||
apply (rule_tac r'="op=" and P'=\<top> and P="invs' and ex_abs (einvs)" in corres_split)
|
||||
apply (clarsimp simp add: corres_underlying_def fail_def
|
||||
assert_def return_def
|
||||
split:if_splits)
|
||||
apply simp
|
||||
apply (rule_tac P=\<top> and P'=\<top> and r'="op=" in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: ptable_xn_s'_def ptable_xn_s''_def ptable_attrs_s_def
|
||||
ptable_attrs_s'_def ptable_attrs_s''_def cstate_to_A_def rf_sr_def)
|
||||
apply (subst cstate_to_H_correct, simp add: invs'_def,force+)+
|
||||
apply (simp only: ex_abs_def)
|
||||
apply (elim exE conjE)
|
||||
apply (clarsimp simp add: absKState_correct absArchState_correct)
|
||||
apply (clarsimp simp: absHeap_correct
|
||||
invs_def valid_state_def valid_pspace_def state_relation_def)
|
||||
apply (rule_tac r'="op=" and P'=\<top> and P="invs' and ex_abs (einvs)" in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp: ptable_lift_s'_def ptable_lift_s''_def cstate_to_A_def rf_sr_def)
|
||||
apply (subst cstate_to_H_correct, simp add: invs'_def,force+)+
|
||||
apply (simp only: ex_abs_def)
|
||||
apply (elim exE conjE)
|
||||
apply (clarsimp simp add: absKState_correct absArchState_correct)
|
||||
apply (clarsimp simp: absHeap_correct
|
||||
invs_def valid_state_def valid_pspace_def state_relation_def)
|
||||
apply (rule_tac r'="op=" and P'=\<top> and P="invs' and ex_abs (einvs)" in corres_split)
|
||||
prefer 2
|
||||
apply (clarsimp simp add: getCurThread_def cstate_to_A_def cstate_to_H_def rf_sr_def
|
||||
cstate_relation_def absKState_def Let_def)
|
||||
|
||||
apply (rule_tac r'="op =" in corres_split)
|
||||
apply (rule corres_split[OF _ corres_dmo_getExMonitor_C])
|
||||
apply clarsimp
|
||||
apply (rule_tac r'="op =" in corres_split[OF _ corres_select])
|
||||
apply simp
|
||||
apply (rule corres_underlying_split4)
|
||||
apply (rule_tac r'="\<top>\<top>" in corres_split)
|
||||
apply (rule_tac r'=dc in corres_split)
|
||||
apply simp
|
||||
apply (rule corres_dmo_setExMonitor_C)
|
||||
apply (rule hoare_post_taut[where P=\<top>])
|
||||
apply (rule hoare_post_taut[where P=\<top>])
|
||||
apply (rule user_memory_update_corres_C)
|
||||
apply (wp hoare_post_taut[where P=\<top>])
|
||||
apply clarsimp
|
||||
apply (wp select_wp)[2]
|
||||
apply clarsimp
|
||||
apply (rule dmo_getExMonitor_wp')
|
||||
apply wp
|
||||
apply (rule_tac P="pspace_distinct'" and P'=\<top> in corres_inst)
|
||||
apply (clarsimp simp: rf_sr_def cstate_relation_def cpspace_relation_def
|
||||
user_mem_C_relation Let_def)
|
||||
apply (wp | simp)+
|
||||
|
||||
apply (clarsimp simp add: corres_underlying_def fail_def
|
||||
assert_def return_def
|
||||
split:if_splits)
|
||||
apply simp
|
||||
apply (rule corres_split[OF _ corres_dmo_getExMonitor_C])
|
||||
apply clarsimp
|
||||
apply (rule_tac r'="op=" in corres_split[OF _ corres_select])
|
||||
prefer 2
|
||||
apply clarsimp
|
||||
apply simp
|
||||
apply (rule corres_underlying_split5)
|
||||
apply (rule corres_split[OF _ memory_update_corres_C])
|
||||
apply (rule corres_split[OF _ device_update_corres_C])
|
||||
apply (rule corres_split[OF _ corres_dmo_setExMonitor_C,
|
||||
where R="\<top>\<top>" and R'="\<top>\<top>"])
|
||||
apply (wp select_wp | simp)+
|
||||
|
||||
apply (clarsimp simp add: invs'_def valid_state'_def valid_pspace'_def ex_abs_def)
|
||||
apply (clarsimp simp: user_mem'_def ex_abs_def restrict_map_def invs_def
|
||||
ptable_lift_s'_def
|
||||
split: if_splits)
|
||||
apply (rule ptable_rights_imp_UserData [rotated])
|
||||
apply (clarsimp simp: valid_state'_def valid_pspace'_def invs'_def)
|
||||
apply assumption
|
||||
apply (fastforce simp: ptable_rights_s'_def)
|
||||
apply assumption
|
||||
apply (simp add: invs_def)
|
||||
apply simp
|
||||
done
|
||||
sorry
|
||||
|
||||
definition
|
||||
checkActiveIRQ_C_if :: "user_context \<Rightarrow> (cstate, irq option \<times> user_context) nondet_monad"
|
||||
|
|
@ -551,7 +568,7 @@ definition
|
|||
"check_active_irq_C_if \<equiv> {((tc, s), irq, (tc', s')). ((irq, tc'), s') \<in> fst (checkActiveIRQ_C_if tc s)}"
|
||||
|
||||
lemma check_active_irq_corres_C:
|
||||
"corres_underlying rf_sr True (op =) \<top> \<top>
|
||||
"corres_underlying rf_sr nf (op =) \<top> \<top>
|
||||
(checkActiveIRQ_if tc) (checkActiveIRQ_C_if tc)"
|
||||
apply (simp add: checkActiveIRQ_if_def checkActiveIRQ_C_if_def)
|
||||
apply (simp add: getActiveIRQ_C_def)
|
||||
|
|
@ -616,7 +633,7 @@ lemma handleEvent_Interrupt_no_fail: "no_fail (invs' and ex_abs einvs) (handleEv
|
|||
done
|
||||
|
||||
lemma handle_preemption_corres_C:
|
||||
"corres_underlying rf_sr True (op =) (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and ex_abs einvs) \<top>
|
||||
"corres_underlying rf_sr nf (op =) (invs' and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and ex_abs einvs) \<top>
|
||||
(handlePreemption_if tc) (handlePreemption_C_if tc)"
|
||||
apply (simp add: handlePreemption_if_def2 handlePreemption_C_if_def)
|
||||
apply (rule corres_guard_imp)
|
||||
|
|
@ -663,7 +680,7 @@ lemma ccorres_corres_u':
|
|||
|
||||
|
||||
lemma schedule_if_corres_C:
|
||||
"corres_underlying rf_sr True (op =) (invs' and ex_abs einvs) \<top>
|
||||
"corres_underlying rf_sr nf (op =) (invs' and ex_abs einvs) \<top>
|
||||
(schedule'_if tc) (schedule_C_if' tc)"
|
||||
apply (simp add: schedule'_if_def schedule_C_if'_def)
|
||||
apply (rule corres_guard_imp)
|
||||
|
|
@ -708,9 +725,14 @@ definition
|
|||
gets $ getContext_C t
|
||||
od"
|
||||
|
||||
lemma corres_underlying_nf_imp:
|
||||
"corres_underlying rf_sr True a b c d e \<Longrightarrow> corres_underlying rf_sr nf a b c d e"
|
||||
by (auto simp:corres_underlying_def)
|
||||
|
||||
lemma kernel_exit_corres_C:
|
||||
"corres_underlying rf_sr True (op =) (invs') \<top>
|
||||
"corres_underlying rf_sr nf (op =) (invs') \<top>
|
||||
(kernelExit_if tc) (kernelExit_C_if tc)"
|
||||
apply (rule corres_underlying_nf_imp)
|
||||
apply (simp add: kernelExit_if_def kernelExit_C_if_def)
|
||||
apply (rule corres_guard_imp)
|
||||
apply (rule_tac r'="\<lambda>rv rv'. rv' = tcb_ptr_to_ctcb_ptr rv" in corres_split)
|
||||
|
|
@ -757,6 +779,58 @@ lemma full_invs_all_invs[simp]: "((tc,s),KernelEntry e) \<in> full_invs_if' \<Lo
|
|||
apply (fastforce simp: ct_running_related schedaction_related)
|
||||
done
|
||||
|
||||
lemma obs_cpspace_user_data_relation:
|
||||
"\<lbrakk>pspace_aligned' bd;pspace_distinct' bd;
|
||||
cpspace_user_data_relation (ksPSpace bd) (underlying_memory (ksMachineState bd)) hgs\<rbrakk>
|
||||
\<Longrightarrow> cpspace_user_data_relation (ksPSpace bd) (underlying_memory (observable_memory (ksMachineState bd) (user_mem' bd))) hgs"
|
||||
apply (clarsimp simp:cmap_relation_def dom_heap_to_user_data)
|
||||
apply (drule bspec,fastforce)
|
||||
apply (clarsimp simp:cuser_user_data_relation_def observable_memory_def
|
||||
heap_to_user_data_def map_comp_def Let_def split:option.split_asm)
|
||||
apply (drule_tac x = off in spec)
|
||||
apply (subst option_to_0_user_mem')
|
||||
apply (subst map_option_byte_to_word_heap)
|
||||
apply (clarsimp simp:projectKO_opt_user_data pointerInUserData_def field_simps
|
||||
split:kernel_object.split_asm option.split_asm)
|
||||
apply (frule(1) pspace_alignedD')
|
||||
apply (subst neg_mask_add_aligned)
|
||||
apply (simp add:objBits_simps)
|
||||
apply (simp add:word_less_nat_alt)
|
||||
apply (rule le_less_trans[OF unat_plus_gt])
|
||||
apply (subst add.commute)
|
||||
apply (subst unat_mult_simple)
|
||||
apply (simp add:word_bits_def)
|
||||
apply (rule less_le_trans[OF unat_lt2p])
|
||||
apply simp
|
||||
apply simp
|
||||
apply (rule nat_add_offset_less [where n = 2, simplified])
|
||||
apply simp
|
||||
apply (rule unat_lt2p)
|
||||
apply (simp add: pageBits_def objBits_simps)
|
||||
apply (frule(1) pspace_distinctD')
|
||||
apply (clarsimp simp:obj_at'_def typ_at'_def ko_wp_at'_def objBits_simps)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma obs_cpspace_device_data_relation:
|
||||
"\<lbrakk>pspace_aligned' bd;pspace_distinct' bd;
|
||||
cpspace_device_data_relation (ksPSpace bd) (underlying_memory (ksMachineState bd)) hgs\<rbrakk>
|
||||
\<Longrightarrow> cpspace_device_data_relation (ksPSpace bd) (underlying_memory (observable_memory (ksMachineState bd) (user_mem' bd))) hgs"
|
||||
apply (clarsimp simp:cmap_relation_def dom_heap_to_device_data)
|
||||
apply (drule bspec,fastforce)
|
||||
apply (clarsimp simp:cuser_user_data_device_relation_def observable_memory_def
|
||||
heap_to_user_data_def map_comp_def Let_def split:option.split_asm)
|
||||
done
|
||||
|
||||
lemma cstate_relation_observable_memory:
|
||||
"\<lbrakk>invs' bs;cstate_relation bs gs\<rbrakk>
|
||||
\<Longrightarrow> cstate_relation (bs\<lparr>ksMachineState := observable_memory (ksMachineState bs) (user_mem' bs)\<rparr>) gs"
|
||||
by (clarsimp simp:cstate_relation_def Let_def obs_cpspace_user_data_relation
|
||||
obs_cpspace_device_data_relation cpspace_relation_def invs'_def
|
||||
valid_state'_def valid_pspace'_def
|
||||
cmachine_state_relation_def observable_memory_def)
|
||||
|
||||
|
||||
lemma c_to_haskell: "uop_nonempty uop \<Longrightarrow> global_automata_refine checkActiveIRQ_H_if (doUserOp_H_if uop) kernelCall_H_if
|
||||
handlePreemption_H_if schedule'_H_if kernelExit_H_if full_invs_if' (ADT_H_if uop) UNIV
|
||||
check_active_irq_C_if (do_user_op_C_if uop) (kernel_call_C_if fp) handle_preemption_C_if schedule_C_if
|
||||
|
|
@ -768,23 +842,15 @@ lemma c_to_haskell: "uop_nonempty uop \<Longrightarrow> global_automata_refine c
|
|||
apply (simp add: ADT_C_if_def)
|
||||
apply blast
|
||||
apply (simp_all add: preserves_trivial preserves'_trivial)
|
||||
apply (clarsimp simp: lift_snd_rel_def ADT_C_if_def ADT_H_if_def cstate_to_A_def)
|
||||
apply (clarsimp simp: lift_snd_rel_def ADT_C_if_def ADT_H_if_def absKState_crelation
|
||||
rf_sr_def full_invs_if'_def)
|
||||
apply (clarsimp simp: rf_sr_def full_invs_if'_def ex_abs_def)
|
||||
apply (frule(1) absKState_correct[rotated],simp)
|
||||
apply simp
|
||||
apply (frule cstate_to_H_correct[rotated],simp add: invs'_def)
|
||||
apply simp
|
||||
apply (simp add: ADT_H_if_def ADT_C_if_def lift_fst_rel_def lift_snd_rel_def)
|
||||
apply safe
|
||||
apply clarsimp
|
||||
apply (clarsimp simp: cstate_to_A_def)
|
||||
apply (rule_tac x="((a,cstate_to_H (globals bb)),ba)" in bexI)
|
||||
apply simp
|
||||
apply (clarsimp simp: rf_sr_def full_invs_if'_def)
|
||||
apply (frule cstate_to_H_correct[rotated],simp add: invs'_def)
|
||||
apply (clarsimp simp: absKState_crelation rf_sr_def full_invs_if'_def)
|
||||
apply (rule_tac x="((a,bd),ba)" in bexI)
|
||||
apply simp
|
||||
apply simp
|
||||
apply (clarsimp simp: rf_sr_def full_invs_if'_def)
|
||||
apply (frule cstate_to_H_correct[rotated],simp add: invs'_def)
|
||||
apply (case_tac ba,simp_all)
|
||||
apply (simp_all add: checkActiveIRQ_H_if_def check_active_irq_C_if_def
|
||||
|
|
@ -792,7 +858,7 @@ lemma c_to_haskell: "uop_nonempty uop \<Longrightarrow> global_automata_refine c
|
|||
kernelCall_H_if_def kernel_call_C_if_def
|
||||
handlePreemption_H_if_def handle_preemption_C_if_def
|
||||
schedule'_H_if_def schedule_C_if_def
|
||||
kernelExit_H_if_def kernel_exit_C_if_def)
|
||||
kernelExit_H_if_def kernel_exit_C_if_def)
|
||||
apply (rule step_corres_lifts,rule corres_guard_imp[OF check_active_irq_corres_C],(fastforce simp: full_invs_if'_def ex_abs_def)+)
|
||||
apply (rule step_corres_lifts,rule corres_guard_imp[OF check_active_irq_corres_C],(fastforce simp: full_invs_if'_def ex_abs_def)+)
|
||||
apply (rule step_corres_lifts,rule corres_guard_imp[OF do_user_op_if_C_corres],(fastforce simp: full_invs_if'_def ex_abs_def)+)
|
||||
|
|
|
|||
|
|
@ -69,7 +69,8 @@ lemma detype_irq_state_of_state[simp]:
|
|||
done
|
||||
|
||||
crunch irq_state_of_state[wp]: invoke_untyped "\<lambda>s. P (irq_state_of_state s)"
|
||||
(wp: dmo_wp modify_wp crunch_wps simp: crunch_simps ignore: freeMemory simp: freeMemory_def storeWord_def clearMemory_def machine_op_lift_def machine_rest_lift_def mapM_x_defsym)
|
||||
(wp: dmo_wp modify_wp hoare_unless_wp crunch_wps simp: crunch_simps
|
||||
ignore: freeMemory simp: freeMemory_def storeWord_def clearMemory_def machine_op_lift_def machine_rest_lift_def mapM_x_defsym)
|
||||
|
||||
crunch irq_state_of_state[wp]: invoke_irq_control "\<lambda>s. P (irq_state_of_state s)"
|
||||
|
||||
|
|
@ -93,7 +94,7 @@ crunch irq_state_of_state[wp]: cap_swap_for_delete "\<lambda>(s::det_state). P (
|
|||
crunch irq_state_of_state[wp]: load_hw_asid "\<lambda>(s::det_state). P (irq_state_of_state s)"
|
||||
|
||||
crunch irq_state_of_state[wp]: recycle_cap "\<lambda>(s::det_state). P (irq_state_of_state s)"
|
||||
(wp: crunch_wps dmo_wp modify_wp simp: filterM_mapM crunch_simps no_irq_clearMemory simp: clearMemory_def storeWord_def invalidateTLB_ASID_def
|
||||
(wp: crunch_wps dmo_wp hoare_unless_wp modify_wp simp: filterM_mapM crunch_simps no_irq_clearMemory simp: clearMemory_def storeWord_def invalidateTLB_ASID_def
|
||||
ignore: filterM)
|
||||
|
||||
crunch irq_state_of_state[wp]: restart,invoke_domain "\<lambda>(s::det_state). P (irq_state_of_state s)"
|
||||
|
|
@ -2079,7 +2080,7 @@ lemma perform_page_invocation_globals_equiv:
|
|||
|
||||
lemma retype_region_ASIDPoolObj_globals_equiv:
|
||||
"\<lbrace>globals_equiv s and (\<lambda>sa. ptr \<noteq> arm_global_pd (arch_state s)) and (\<lambda>sa. ptr \<noteq> idle_thread sa)\<rbrace>
|
||||
retype_region ptr 1 0 (ArchObject ASIDPoolObj)
|
||||
retype_region ptr 1 0 (ArchObject ASIDPoolObj) dev
|
||||
\<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
|
||||
unfolding retype_region_def
|
||||
apply(wp modify_wp dxo_wp_weak | simp | fastforce simp: globals_equiv_def default_arch_object_def obj_bits_api_def)+
|
||||
|
|
@ -2101,7 +2102,7 @@ lemma cap_insert_globals_equiv'':
|
|||
|
||||
lemma retype_region_ASIDPoolObj_valid_ko_at_arm:
|
||||
"\<lbrace>valid_ko_at_arm and (\<lambda>s. ptr \<noteq> arm_global_pd (arch_state s))\<rbrace>
|
||||
retype_region ptr 1 0 (ArchObject ASIDPoolObj)
|
||||
retype_region ptr 1 0 (ArchObject ASIDPoolObj) dev
|
||||
\<lbrace>\<lambda>_. valid_ko_at_arm\<rbrace>"
|
||||
apply(simp add: retype_region_def)
|
||||
apply(wp modify_wp dxo_wp_weak |simp add: trans_state_update[symmetric] del: trans_state_update)+
|
||||
|
|
@ -2171,6 +2172,7 @@ lemma perform_asid_control_invocation_globals_equiv:
|
|||
set_cap_caps_no_overlap max_index_upd_caps_overlap_reserved
|
||||
region_in_kernel_window_preserved
|
||||
hoare_vcg_all_lift get_cap_wp static_imp_wp
|
||||
set_cap_idx_up_aligned_area[where dev = False,simplified]
|
||||
| simp)+
|
||||
(* factor out the implication -- we know what the relevant components of the
|
||||
cap referred to in the cte_wp_at are anyway from valid_aci, so just use
|
||||
|
|
@ -2178,7 +2180,7 @@ lemma perform_asid_control_invocation_globals_equiv:
|
|||
apply(rule_tac Q="\<lambda> a b. globals_equiv s b \<and>
|
||||
invs b \<and> valid_ko_at_arm b \<and> word1 \<noteq> arm_global_pd (arch_state b) \<and>
|
||||
word1 \<noteq> idle_thread b \<and>
|
||||
(\<exists> idx. cte_wp_at (op = (UntypedCap word1 pageBits idx)) cslot_ptr2 b) \<and>
|
||||
(\<exists> idx. cte_wp_at (op = (UntypedCap False word1 pageBits idx)) cslot_ptr2 b) \<and>
|
||||
descendants_of cslot_ptr2 (cdt b) = {} \<and>
|
||||
pspace_no_overlap word1 pageBits b"
|
||||
in hoare_strengthen_post)
|
||||
|
|
@ -2200,17 +2202,20 @@ lemma perform_asid_control_invocation_globals_equiv:
|
|||
apply(clarsimp simp: range_cover_def)
|
||||
apply(subst is_aligned_neg_mask_eq[THEN sym], assumption)
|
||||
apply(simp add: mask_neg_mask_is_zero pageBits_def)
|
||||
apply(wp delete_objects_invs_ex delete_objects_pspace_no_overlap
|
||||
apply (rule conjI)
|
||||
apply (rule free_index_of_UntypedCap[symmetric])
|
||||
apply (simp add:invs_valid_objs)
|
||||
apply(wp delete_objects_invs_ex[where dev=False] delete_objects_pspace_no_overlap[where dev=False]
|
||||
delete_objects_globals_equiv delete_objects_valid_ko_at_arm
|
||||
hoare_vcg_ex_lift
|
||||
| simp add: page_bits_def)+
|
||||
apply (clarsimp simp: conj_comms invs_valid_ko_at_arm invs_psp_aligned invs_valid_objs valid_aci_def)
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state)
|
||||
apply (frule_tac cap="UntypedCap a b c" for a b c in caps_of_state_valid, assumption)
|
||||
apply (frule_tac cap="UntypedCap False a b c" for a b c in caps_of_state_valid, assumption)
|
||||
apply (clarsimp simp: valid_cap_def cap_aligned_def)
|
||||
apply (frule_tac slot="(aa,ba)" in untyped_caps_do_not_overlap_global_refs[rotated, OF invs_valid_global_refs])
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state)
|
||||
apply ((rule conjI |rule refl)+)[1]
|
||||
apply ((rule conjI |rule refl | simp)+)[1]
|
||||
apply(rule conjI)
|
||||
apply(clarsimp simp: global_refs_def ptr_range_memI)
|
||||
apply(rule conjI)
|
||||
|
|
@ -2231,6 +2236,8 @@ lemma perform_asid_control_invocation_globals_equiv:
|
|||
apply(simp add: invs_valid_global_refs)
|
||||
apply(simp add: cte_wp_at_caps_of_state)
|
||||
apply assumption
|
||||
apply (intro allI conjI)
|
||||
apply fastforce
|
||||
apply (auto intro: empty_descendants_range_in simp: descendants_range_def2 cap_range_def)
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -434,7 +434,7 @@ lemma aag_cap_auth_ASIDPoolCap_asid:
|
|||
done
|
||||
|
||||
lemma aag_cap_auth_PageCap_asid:
|
||||
"pas_cap_cur_auth aag (ArchObjectCap (PageCap word fun vmpage_size (Some (a, b))))
|
||||
"pas_cap_cur_auth aag (ArchObjectCap (PageCap dev word fun vmpage_size (Some (a, b))))
|
||||
\<Longrightarrow> pas_refined aag s
|
||||
\<Longrightarrow> is_subject_asid aag a"
|
||||
apply (auto simp add: aag_cap_auth_def cap_auth_conferred_def
|
||||
|
|
@ -511,11 +511,11 @@ lemma valid_arch_state_ko_at_arm:
|
|||
lemma invs_valid_ko_at_arm:
|
||||
"invs s \<Longrightarrow> valid_ko_at_arm s" by (simp add: invs_def valid_state_def valid_arch_state_ko_at_arm)
|
||||
|
||||
lemmas invs_imps = invs_valid_vs_lookup invs_sym_refs invs_distinct invs_valid_ko_at_arm invs_valid_global_objs invs_arch_state invs_valid_objs invs_valid_global_refs tcb_at_invs invs_cur invs_kernel_mappings
|
||||
lemmas invs_imps = invs_valid_vs_lookup invs_sym_refs invs_psp_aligned invs_distinct invs_valid_ko_at_arm invs_valid_global_objs invs_arch_state invs_valid_objs invs_valid_global_refs tcb_at_invs invs_cur invs_kernel_mappings
|
||||
|
||||
lemma cte_wp_at_page_cap_aligned :
|
||||
"\<lbrakk>cte_wp_at
|
||||
(op = (ArchObjectCap (PageCap word fun vmpage_size option))) slot s ; valid_objs s \<rbrakk>\<Longrightarrow>
|
||||
(op = (ArchObjectCap (PageCap dev word fun vmpage_size option))) slot s ; valid_objs s \<rbrakk>\<Longrightarrow>
|
||||
is_aligned word (pageBitsForSize vmpage_size)"
|
||||
apply (simp add: cte_wp_at_caps_of_state)
|
||||
apply (case_tac slot)
|
||||
|
|
@ -836,7 +836,7 @@ lemma gets_irq_masks_equiv_valid:
|
|||
apply(auto)
|
||||
done
|
||||
|
||||
lemma irq_state_increment_reads_respects:
|
||||
lemma irq_state_increment_reads_respects_memory:
|
||||
"equiv_valid_inv
|
||||
(equiv_machine_state (\<lambda>x. aag_can_read_label aag (pasObjectAbs aag x))
|
||||
(range_of_arm_globals_frame st) And
|
||||
|
|
@ -851,6 +851,42 @@ lemma irq_state_increment_reads_respects:
|
|||
apply(fastforce intro: equiv_forI elim: equiv_forE)
|
||||
done
|
||||
|
||||
lemma irq_state_increment_reads_respects_device:
|
||||
"equiv_valid_inv
|
||||
(equiv_machine_state (\<lambda>x. aag_can_read_label aag (pasObjectAbs aag x))
|
||||
(range_of_arm_globals_frame st) And
|
||||
equiv_irq_state)
|
||||
(equiv_for
|
||||
(\<lambda>x. aag_can_affect_label aag l \<and>
|
||||
pasObjectAbs aag x \<in> subjectReads (pasPolicy aag) l \<and>
|
||||
x \<notin> range_of_arm_globals_frame st)
|
||||
device_state) \<top> (modify (\<lambda>s. s\<lparr>irq_state := Suc (irq_state s)\<rparr>))"
|
||||
apply(simp add: equiv_valid_def2)
|
||||
apply(rule modify_ev2)
|
||||
apply(fastforce intro: equiv_forI elim: equiv_forE)
|
||||
done
|
||||
|
||||
lemma use_equiv_valid_inv:
|
||||
"\<lbrakk>x\<in>fst (f st); y\<in> fst (f s); g s; g st;I s st;P s st; equiv_valid_inv I P g f \<rbrakk>
|
||||
\<Longrightarrow> fst x = fst y \<and> P (snd y) (snd x) \<and> I (snd y) (snd x)"
|
||||
apply (clarsimp simp add:equiv_valid_def spec_equiv_valid_def equiv_valid_2_def)
|
||||
apply (drule spec)+
|
||||
apply (erule impE)
|
||||
apply fastforce
|
||||
apply (drule(1) bspec | clarsimp)+
|
||||
done
|
||||
|
||||
lemma equiv_valid_inv_conj_lift:
|
||||
assumes P: "equiv_valid_inv I (\<lambda>s s'. P s s') g f"
|
||||
and P': "equiv_valid_inv I (\<lambda>s s'. P' s s') g f"
|
||||
shows "equiv_valid_inv I (\<lambda>s s'. P s s' \<and> P' s s') g f"
|
||||
apply (clarsimp simp add:equiv_valid_def spec_equiv_valid_def equiv_valid_2_def)
|
||||
apply (frule_tac st = t and s = st in use_equiv_valid_inv[OF _ _ _ _ _ _ P])
|
||||
apply fastforce+
|
||||
apply (frule_tac st = t and s = st in use_equiv_valid_inv[OF _ _ _ _ _ _ P'])
|
||||
apply fastforce+
|
||||
done
|
||||
|
||||
lemma dmo_getActiveIRQ_reads_respects:
|
||||
notes gets_ev[wp del]
|
||||
shows
|
||||
|
|
@ -858,9 +894,9 @@ lemma dmo_getActiveIRQ_reads_respects:
|
|||
apply(rule use_spec_ev)
|
||||
apply(rule do_machine_op_spec_reads_respects')
|
||||
apply(simp add: getActiveIRQ_def)
|
||||
apply (wp irq_state_increment_reads_respects modify_wp
|
||||
gets_ev[where f="irq_oracle \<circ> irq_state"]
|
||||
gets_irq_masks_equiv_valid
|
||||
apply (wp irq_state_increment_reads_respects_memory irq_state_increment_reads_respects_device
|
||||
gets_ev[where f="irq_oracle \<circ> irq_state"] equiv_valid_inv_conj_lift
|
||||
gets_irq_masks_equiv_valid modify_wp
|
||||
| simp add: no_irq_def)+
|
||||
apply(rule only_timer_irq_inv_determines_irq_masks, blast+)
|
||||
done
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ lemma prop_of_obj_ref_of_cnode_cap:
|
|||
|
||||
lemma decode_untyped_invocation_rev:
|
||||
"reads_equiv_valid_inv A aag (pas_refined aag and
|
||||
(K (cap = UntypedCap bs sz idx \<and>
|
||||
(K (cap = UntypedCap dev bs sz idx \<and>
|
||||
is_subject aag (fst slot) \<and>
|
||||
(\<forall>c\<in>set excaps. pas_cap_cur_auth aag c))))
|
||||
(decode_untyped_invocation label args slot cap excaps)"
|
||||
|
|
@ -70,7 +70,7 @@ lemma decode_untyped_invocation_rev:
|
|||
done
|
||||
|
||||
lemma derive_cap_rev':
|
||||
"reads_equiv_valid_inv A aag (\<lambda> s. (\<exists>x xa xb. cap = cap.UntypedCap x xa xb) \<longrightarrow>
|
||||
"reads_equiv_valid_inv A aag (\<lambda> s. (\<exists>x xa xb dev. cap = cap.UntypedCap dev x xa xb) \<longrightarrow>
|
||||
pas_refined aag s \<and> is_subject aag (fst slot)) (derive_cap slot cap)"
|
||||
unfolding derive_cap_def arch_derive_cap_def
|
||||
apply(rule equiv_valid_guard_imp)
|
||||
|
|
@ -563,7 +563,6 @@ lemma arch_decode_invocation_reads_respects_f:
|
|||
apply(fastforce intro: nth_mem)
|
||||
apply clarify
|
||||
apply(subgoal_tac "excaps ! Suc 0 \<in> set excaps")
|
||||
thm select_ext_ev
|
||||
apply(rule_tac cap="fst (excaps ! Suc 0)" and p="snd (excaps ! Suc 0)" in caps_of_state_pasObjectAbs_eq)
|
||||
apply(rule cte_wp_at_caps_of_state)
|
||||
apply(rule cte_wp_at_diminished_cnode_cap)
|
||||
|
|
@ -595,16 +594,15 @@ lemma arch_decode_invocation_reads_respects_f:
|
|||
apply fastforce
|
||||
apply fastforce
|
||||
(* clagged from Arch_AI *)
|
||||
apply (simp add: linorder_not_le kernel_base_less_observation)
|
||||
apply (simp add: vmsz_aligned_def split: vmpage_size.splits)
|
||||
apply (simp add: linorder_not_le kernel_base_less_observation vmsz_aligned_def p_assoc_help)
|
||||
apply (subst(asm) mask_lower_twice[symmetric])
|
||||
prefer 2
|
||||
apply (subst(asm) add_diff_eq[symmetric],
|
||||
subst(asm) is_aligned_add_helper,
|
||||
apply (subst(asm) is_aligned_add_helper,
|
||||
assumption)
|
||||
apply(case_tac xb, simp_all)[1]
|
||||
apply (rule word_power_less_1)
|
||||
apply(case_tac xc, simp_all)[1]
|
||||
apply simp
|
||||
apply(case_tac xb, simp_all)[1]
|
||||
apply(case_tac xc, simp_all)[1]
|
||||
apply(rule ball_subset[OF _ vspace_cap_rights_to_auth_mask_vm_rights])
|
||||
apply(fastforce simp: aag_cap_auth_def cap_auth_conferred_def)
|
||||
apply(simp add: lookup_pd_slot_def)
|
||||
|
|
|
|||
|
|
@ -662,7 +662,7 @@ where
|
|||
Low_tcb_ptr \<mapsto> Low_tcb,
|
||||
High_tcb_ptr \<mapsto> High_tcb,
|
||||
idle_tcb_ptr \<mapsto> idle_tcb,
|
||||
init_globals_frame \<mapsto> ArchObj (DataPage ARMSmallPage),
|
||||
init_globals_frame \<mapsto> ArchObj (DataPage False ARMSmallPage),
|
||||
init_global_pd \<mapsto> ArchObj (PageDirectory global_pd))"
|
||||
|
||||
lemma irq_node_offs_min:
|
||||
|
|
@ -781,7 +781,7 @@ lemmas kh0_SomeD' = set_mp[OF equalityD1[OF kh0_dom[simplified dom_def]], OF Col
|
|||
|
||||
lemma kh0_SomeD:
|
||||
"kh0 x = Some y \<Longrightarrow>
|
||||
x = init_globals_frame \<and> y = ArchObj (DataPage ARMSmallPage) \<or>
|
||||
x = init_globals_frame \<and> y = ArchObj (DataPage False ARMSmallPage) \<or>
|
||||
x = init_global_pd \<and> y = ArchObj (PageDirectory global_pd) \<or>
|
||||
x = idle_tcb_ptr \<and> y = idle_tcb \<or>
|
||||
x = High_tcb_ptr \<and> y = High_tcb \<or>
|
||||
|
|
@ -825,6 +825,7 @@ definition machine_state0 :: "machine_state" where
|
|||
"machine_state0 \<equiv> \<lparr>irq_masks = (\<lambda>irq. if irq = timer_irq then False else True),
|
||||
irq_state = 0,
|
||||
underlying_memory = const 0,
|
||||
device_state = empty,
|
||||
exclusive_state = undefined,
|
||||
machine_state_rest = undefined \<rparr>"
|
||||
|
||||
|
|
@ -1224,7 +1225,7 @@ lemma valid_obj_s0[simp]:
|
|||
"valid_obj init_global_pd (ArchObj (PageDirectory ((\<lambda>_. InvalidPDE)
|
||||
(ucast (kernel_base >> 20) := SectionPDE (addrFromPPtr kernel_base) {} 0 {}))))
|
||||
s0_internal"
|
||||
"valid_obj init_globals_frame (ArchObj (DataPage ARMSmallPage)) s0_internal"
|
||||
"valid_obj init_globals_frame (ArchObj (DataPage False ARMSmallPage)) s0_internal"
|
||||
apply (simp_all add: valid_obj_def kh0_obj_def)
|
||||
apply (simp add: valid_cs_def Low_caps_ran High_caps_ran Silc_caps_ran
|
||||
valid_cs_size_def word_bits_def cte_level_bits_def)+
|
||||
|
|
@ -1727,11 +1728,32 @@ lemma valid_sched_s0[simp]:
|
|||
apply (clarsimp simp: valid_idle_etcb_def etcb_at'_def ekh0_obj_def s0_ptr_defs idle_thread_ptr_def)
|
||||
done
|
||||
|
||||
lemma respects_device_trivial:
|
||||
"pspace_respects_device_region s0_internal"
|
||||
"cap_refs_respects_device_region s0_internal"
|
||||
apply (clarsimp simp:s0_internal_def pspace_respects_device_region_def machine_state0_def device_mem_def
|
||||
in_device_frame_def kh0_obj_def obj_at_kh_def obj_at_def kh0_def a_type_def
|
||||
split:if_splits)[1]
|
||||
apply fastforce
|
||||
apply (clarsimp simp:cap_refs_respects_device_region_def Invariants_AI.cte_wp_at_caps_of_state
|
||||
cap_range_respects_device_region_def machine_state0_def)
|
||||
apply (intro conjI impI)
|
||||
apply (drule s0_caps_of_state)
|
||||
apply (fastforce simp:cap_is_device.simps)[1]
|
||||
apply (clarsimp simp:s0_internal_def machine_state0_def)
|
||||
done
|
||||
|
||||
lemma einvs_s0:
|
||||
"einvs s0_internal"
|
||||
apply (simp add: valid_state_def invs_def)
|
||||
apply (simp add: valid_state_def invs_def respects_device_trivial)
|
||||
done
|
||||
|
||||
lemma obj_valid_pdpt_kh0:
|
||||
"x \<in> ran kh0 \<Longrightarrow> obj_valid_pdpt x"
|
||||
by (auto simp:kh0_def valid_entries_def obj_valid_pdpt_def idle_tcb_def High_tcb_def Low_tcb_def
|
||||
High_pt_def High_pt'_def entries_align_def Low_pt_def High_pd_def Low_pt'_def High_pd'_def
|
||||
Low_pd_def irq_cnode_def ntfn_def Silc_cnode_def High_cnode_def Low_cnode_def Low_pd'_def)
|
||||
|
||||
subsubsection {* Haskell state *}
|
||||
|
||||
text {* One invariant we need on s0 is that there exists
|
||||
|
|
@ -1742,16 +1764,18 @@ text {* One invariant we need on s0 is that there exists
|
|||
|
||||
lemma Sys1_valid_initial_state_noenabled:
|
||||
assumes extras_s0: "step_restrict s0"
|
||||
assumes utf_det: "\<forall>pl pr pxn tc um es s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn um es s \<and> ct_running s
|
||||
\<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, um, es) = {x})"
|
||||
assumes utf_non_empty: "\<forall>t pl pr pxn tc um es. utf t pl pr pxn (tc, um, es) \<noteq> {}"
|
||||
assumes utf_non_interrupt: "\<forall>t pl pr pxn tc um es e f g. (e,f,g) \<in> utf t pl pr pxn (tc, um, es) \<longrightarrow> e \<noteq> Some Interrupt"
|
||||
assumes utf_det: "\<forall>pl pr pxn tc um ds es s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn um ds es s \<and> ct_running s
|
||||
\<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, um, ds, es) = {x})"
|
||||
assumes utf_non_empty: "\<forall>t pl pr pxn tc um ds es. utf t pl pr pxn (tc, um, ds, es) \<noteq> {}"
|
||||
assumes utf_non_interrupt: "\<forall>t pl pr pxn tc um ds es e f g. (e,f,g) \<in> utf t pl pr pxn (tc, um, ds, es) \<longrightarrow> e \<noteq> Some Interrupt"
|
||||
assumes det_inv_invariant: "invariant_over_ADT_if det_inv utf"
|
||||
assumes det_inv_s0: "det_inv KernelExit (cur_context s0_internal) s0_internal"
|
||||
shows "valid_initial_state_noenabled det_inv utf s0_internal Sys1PAS timer_irq s0_context"
|
||||
apply (unfold_locales, simp_all only: pasMaySendIrqs_Sys1PAS)
|
||||
apply (insert det_inv_invariant)[8]
|
||||
apply (erule invariant_over_ADT_if.check_active_irq_if_Idle_det_inv
|
||||
apply (insert det_inv_invariant)[9]
|
||||
apply (erule(1) invariant_over_ADT_if.det_inv_abs_state)
|
||||
apply (erule invariant_over_ADT_if.det_inv_abs_state
|
||||
invariant_over_ADT_if.check_active_irq_if_Idle_det_inv
|
||||
invariant_over_ADT_if.check_active_irq_if_User_det_inv
|
||||
invariant_over_ADT_if.do_user_op_if_det_inv
|
||||
invariant_over_ADT_if.handle_preemption_if_det_inv
|
||||
|
|
@ -1765,7 +1789,7 @@ lemma Sys1_valid_initial_state_noenabled:
|
|||
apply (simp add: only_timer_irq_inv_s0 silc_inv_s0 Sys1_pas_cur_domain
|
||||
domain_sep_inv_s0 Sys1_pas_refined Sys1_guarded_pas_domain
|
||||
idle_equiv_refl)
|
||||
apply (simp add: valid_domain_list_2_def s0_internal_def exst0_def)
|
||||
apply (clarsimp simp: obj_valid_pdpt_kh0 valid_domain_list_2_def s0_internal_def exst0_def)
|
||||
apply (simp add: det_inv_s0)
|
||||
apply (simp add: s0_internal_def exst0_def)
|
||||
apply (simp add: ct_in_state_def st_tcb_at_tcb_states_of_state_eq
|
||||
|
|
|
|||
|
|
@ -3358,13 +3358,12 @@ lemma step_restrict_s0:
|
|||
done
|
||||
|
||||
lemma Sys1_valid_initial_state_noenabled:
|
||||
assumes utf_det: "\<forall>pl pr pxn tc um es s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn um es s \<and> ct_running s
|
||||
\<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, um, es) = {x})"
|
||||
assumes utf_non_empty: "\<forall>t pl pr pxn tc um es. utf t pl pr pxn (tc, um, es) \<noteq> {}"
|
||||
assumes utf_non_interrupt: "\<forall>t pl pr pxn tc um es e f g. (e,f,g) \<in> utf t pl pr pxn (tc, um, es) \<longrightarrow> e \<noteq> Some Interrupt"
|
||||
assumes utf_det: "\<forall>pl pr pxn tc um ds es s. det_inv InUserMode tc s \<and> einvs s \<and> context_matches_state pl pr pxn um ds es s \<and> ct_running s
|
||||
\<longrightarrow> (\<exists>x. utf (cur_thread s) pl pr pxn (tc, um, ds, es) = {x})"
|
||||
assumes utf_non_empty: "\<forall>t pl pr pxn tc um ds es. utf t pl pr pxn (tc, um, ds, es) \<noteq> {}"
|
||||
assumes utf_non_interrupt: "\<forall>t pl pr pxn tc um ds es e f g. (e,f,g) \<in> utf t pl pr pxn (tc, um, ds, es) \<longrightarrow> e \<noteq> Some Interrupt"
|
||||
assumes det_inv_invariant: "invariant_over_ADT_if det_inv utf"
|
||||
assumes det_inv_s0: "det_inv KernelExit (cur_context s0_internal) s0_internal"
|
||||
shows "valid_initial_state_noenabled det_inv utf s0_internal Sys1PAS timer_irq s0_context"
|
||||
by (rule Sys1_valid_initial_state_noenabled[OF step_restrict_s0 utf_det utf_non_empty utf_non_interrupt det_inv_invariant det_inv_s0])
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1867,7 +1867,7 @@ lemma thread_set_tcb_registers_caps_merge_default_tcb_silc_inv[wp]:
|
|||
done
|
||||
|
||||
crunch silc_inv[wp]: recycle_cap "silc_inv aag st"
|
||||
(wp: crunch_wps simp: crunch_simps ignore: filterM set_object thread_set simp: filterM_mapM)
|
||||
(wp: crunch_wps hoare_unless_wp simp: crunch_simps ignore: filterM set_object thread_set simp: filterM_mapM)
|
||||
|
||||
lemma slots_holding_overlapping_caps_arch_reset_mem_mappings[simp]:
|
||||
"FinalCaps.slots_holding_overlapping_caps
|
||||
|
|
@ -1973,7 +1973,7 @@ lemma invoke_cnode_silc_inv:
|
|||
|
||||
lemma set_cap_default_cap_silc_inv:
|
||||
"\<lbrace>silc_inv aag st and K (is_subject aag (fst slot) \<and> is_subject aag oref)\<rbrace>
|
||||
set_cap (default_cap a oref b) slot
|
||||
set_cap (default_cap a oref b dev) slot
|
||||
\<lbrace>\<lambda>_. silc_inv aag st\<rbrace>"
|
||||
apply(rule hoare_pre)
|
||||
apply(rule set_cap_silc_inv)
|
||||
|
|
@ -1983,7 +1983,7 @@ lemma set_cap_default_cap_silc_inv:
|
|||
|
||||
lemma create_cap_silc_inv:
|
||||
"\<lbrace> silc_inv aag st and K (is_subject aag (fst (fst ref)) \<and> is_subject aag (snd ref) \<and> is_subject aag (fst c))\<rbrace>
|
||||
create_cap a b c ref
|
||||
create_cap a b c dev ref
|
||||
\<lbrace> \<lambda>_. silc_inv aag st \<rbrace>"
|
||||
unfolding create_cap_def
|
||||
apply(rule hoare_gen_asm)
|
||||
|
|
@ -1995,12 +1995,12 @@ lemma create_cap_silc_inv:
|
|||
done
|
||||
|
||||
crunch silc_inv[wp]: init_arch_objects "silc_inv aag st"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
(wp: crunch_wps hoare_unless_wp simp: crunch_simps)
|
||||
|
||||
lemma retype_region_silc_inv:
|
||||
"\<lbrace>silc_inv aag st and K (range_cover ptr sz (obj_bits_api type o_bits) num_objects \<and>
|
||||
(\<forall>x\<in>{ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)}. is_subject aag x)) \<rbrace>
|
||||
retype_region ptr num_objects o_bits type
|
||||
retype_region ptr num_objects o_bits type dev
|
||||
\<lbrace>\<lambda>_. silc_inv aag st \<rbrace>"
|
||||
apply(rule hoare_gen_asm)+
|
||||
apply(simp only: retype_region_def retype_addrs_def
|
||||
|
|
@ -2110,7 +2110,7 @@ lemma invoke_untyped_silc_inv:
|
|||
\<lbrace> \<lambda>_. silc_inv aag st \<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
apply(case_tac ui, simp add: mapM_x_def[symmetric] authorised_untyped_inv_def)
|
||||
apply(rename_tac word1 word2 apiobjt nat list)
|
||||
apply(rename_tac word1 word2 apiobjt nat list dev)
|
||||
apply wp
|
||||
apply(rule_tac Q="\<lambda> r s. silc_inv aag st s \<and> (\<forall> x\<in>set list. is_subject aag (fst x)) \<and> (\<forall> oref\<in>set orefs. is_subject aag oref)" in hoare_strengthen_post)
|
||||
apply (wp mapM_x_wp[OF _ subset_refl] create_cap_silc_inv retype_region_silc_inv
|
||||
|
|
@ -2224,19 +2224,17 @@ lemma is_arch_diminished_pt_is_pt_or_pg_cap:
|
|||
apply(erule cte_wp_at_weakenE)
|
||||
apply (clarsimp simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def split: cap.splits arch_cap.splits simp: acap_rights_update_def acap_rights_def)
|
||||
apply(case_tac c, simp_all)[1]
|
||||
apply fastforce
|
||||
apply(rename_tac arch_cap)
|
||||
apply(drule_tac x=arch_cap in spec)
|
||||
apply(case_tac arch_cap, simp_all add: is_pt_cap_def)[1]
|
||||
done
|
||||
|
||||
lemma is_arch_diminished_pg_is_pt_or_pg_cap:
|
||||
"cte_wp_at (is_arch_diminished (ArchObjectCap (PageCap x xa xb xc))) slot s
|
||||
"cte_wp_at (is_arch_diminished (ArchObjectCap (PageCap dev x xa xb xc))) slot s
|
||||
\<Longrightarrow> cte_wp_at (\<lambda>a. is_pt_cap a \<or> is_pg_cap a) slot s"
|
||||
apply(erule cte_wp_at_weakenE)
|
||||
apply (clarsimp simp: is_arch_diminished_def diminished_def mask_cap_def cap_rights_update_def split: cap.splits arch_cap.splits simp: acap_rights_update_def acap_rights_def)
|
||||
apply(case_tac c, simp_all)[1]
|
||||
apply fastforce
|
||||
apply(rename_tac arch_cap)
|
||||
apply(drule_tac x=arch_cap in spec)
|
||||
apply(case_tac arch_cap, simp_all add: is_pg_cap_def)[1]
|
||||
|
|
@ -2455,7 +2453,7 @@ lemma get_cap_perform_asid_control_invocation_helper:
|
|||
|
||||
lemma retype_region_cte_wp_at_other':
|
||||
"\<lbrace> cte_wp_at P slot and K ((fst slot) \<notin> set (retype_addrs ptr ty n us)) \<rbrace>
|
||||
retype_region ptr n us ty
|
||||
retype_region ptr n us ty dev
|
||||
\<lbrace> \<lambda>_. cte_wp_at P slot \<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
apply(clarsimp simp: valid_def)
|
||||
|
|
|
|||
|
|
@ -1798,7 +1798,8 @@ lemma arch_recycle_cap_reads_respects:
|
|||
mapM_x_swp_store_pde_invs_unmap
|
||||
find_pd_for_asid_reads_respects
|
||||
store_pde_invs_unmap
|
||||
mapM_x_wp'
|
||||
mapM_x_wp'
|
||||
hoare_unless_wp
|
||||
| wpc
|
||||
| simp add: when_def invs_valid_objs
|
||||
invs_psp_aligned pte_ref_def
|
||||
|
|
@ -1807,7 +1808,7 @@ lemma arch_recycle_cap_reads_respects:
|
|||
invs_valid_ko_at_arm
|
||||
pde_ref_def
|
||||
pde_ref2_def
|
||||
split del: split_if
|
||||
unless_def
|
||||
| intro impI conjI allI cte_wp_at_pt_exists_cap
|
||||
cte_wp_at_page_directory_not_in_kernel_mappings
|
||||
cte_wp_at_page_directory_not_in_globals
|
||||
|
|
@ -1853,6 +1854,8 @@ lemma set_irq_state_valid_global_objs:
|
|||
apply(fastforce simp: valid_global_objs_def)
|
||||
done
|
||||
|
||||
crunch device_state_invs[wp]: maskInterrupt "\<lambda> ms. P (device_state ms)"
|
||||
|
||||
lemma set_irq_state_globals_equiv:
|
||||
"invariant (set_irq_state state irq) (globals_equiv st)"
|
||||
apply(simp add: set_irq_state_def)
|
||||
|
|
@ -2093,7 +2096,7 @@ lemma arch_recycle_cap_globals_equiv:
|
|||
page_table_mapped_inv
|
||||
mapM_x_swp_store_pte_invs'
|
||||
mapM_x_swp_store_pte_globals_equiv
|
||||
|
||||
hoare_unless_wp
|
||||
hoare_drop_imps
|
||||
|
||||
| clarsimp simp add: valid_pspace_def pbfs_less_wb page_caps_do_not_overlap_arm_globals_frame
|
||||
|
|
@ -2104,7 +2107,7 @@ lemma arch_recycle_cap_globals_equiv:
|
|||
invs_distinct
|
||||
split: arch_cap.splits | intro impI conjI allI)+
|
||||
apply (rule_tac Q="\<lambda>r s. globals_equiv st s \<and> invs s" in hoare_strengthen_post)
|
||||
apply (wp mapM_x_swp_store_kernel_base_globals_equiv)
|
||||
apply (wp mapM_x_swp_store_kernel_base_globals_equiv )
|
||||
apply clarsimp
|
||||
apply assumption
|
||||
apply simp
|
||||
|
|
|
|||
|
|
@ -40,7 +40,8 @@ lemma delete_objects_irq_masks[wp]:
|
|||
|
||||
|
||||
crunch irq_masks[wp]: invoke_untyped "\<lambda>s. P (irq_masks_of_state s)"
|
||||
(ignore: delete_objects wp: crunch_wps dmo_wp simp: crunch_simps no_irq_clearMemory no_irq_cleanCacheRange_PoU mapM_x_def_bak)
|
||||
(ignore: delete_objects wp: hoare_unless_wp
|
||||
crunch_wps dmo_wp simp: crunch_simps no_irq_clearMemory no_irq_cleanCacheRange_PoU mapM_x_def_bak)
|
||||
|
||||
crunch irq_masks[wp]: cap_insert "\<lambda>s. P (irq_masks_of_state s)"
|
||||
(wp: crunch_wps)
|
||||
|
|
@ -301,7 +302,7 @@ lemma cap_revoke_irq_masks':
|
|||
lemmas cap_revoke_irq_masks = use_spec(2)[OF cap_revoke_irq_masks']
|
||||
|
||||
crunch irq_masks[wp]: recycle_cap "\<lambda>s. P (irq_masks_of_state s)"
|
||||
(wp: crunch_wps dmo_wp simp: filterM_mapM crunch_simps no_irq_clearMemory no_irq_invalidateTLB_ASID
|
||||
(wp: crunch_wps dmo_wp hoare_unless_wp simp: filterM_mapM crunch_simps no_irq_clearMemory no_irq_invalidateTLB_ASID
|
||||
ignore: filterM)
|
||||
|
||||
lemma finalise_slot_irq_masks:
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@ lemma equiv_forD:
|
|||
|
||||
|
||||
abbreviation equiv_machine_state :: "(word32 \<Rightarrow> bool) \<Rightarrow> (word32 set) \<Rightarrow> 'a machine_state_scheme \<Rightarrow> 'a machine_state_scheme \<Rightarrow> bool" where
|
||||
"equiv_machine_state P X s s' \<equiv> equiv_for (\<lambda> x. P x \<and> x \<notin> X) underlying_memory s s'"
|
||||
"equiv_machine_state P X s s' \<equiv> equiv_for (\<lambda> x. P x \<and> x \<notin> X) underlying_memory s s' \<and> equiv_for (\<lambda> x. P x \<and> x \<notin> X) device_state s s'"
|
||||
|
||||
definition equiv_asid :: "asid \<Rightarrow> det_ext state \<Rightarrow> det_ext state \<Rightarrow> bool"
|
||||
where
|
||||
|
|
@ -410,8 +410,14 @@ lemma states_equiv_forE_kheap:
|
|||
by(auto simp: states_equiv_for_def elim: equiv_forE)
|
||||
|
||||
lemma states_equiv_forE_mem:
|
||||
"\<lbrakk>states_equiv_for P Q R S X s s'; (\<And> x. \<lbrakk>P x; x \<notin> X (arm_globals_frame (arch_state s))\<rbrakk> \<Longrightarrow> (underlying_memory (machine_state s)) x = (underlying_memory (machine_state s')) x) \<Longrightarrow> Z\<rbrakk> \<Longrightarrow> Z"
|
||||
by(auto simp: states_equiv_for_def elim: equiv_forE)
|
||||
"\<lbrakk>states_equiv_for P Q R S X s s';
|
||||
(\<And> x. \<lbrakk>P x; x \<notin> X (arm_globals_frame (arch_state s))\<rbrakk>
|
||||
\<Longrightarrow> (underlying_memory (machine_state s)) x = (underlying_memory (machine_state s')) x
|
||||
\<and> (device_state (machine_state s)) x = (device_state (machine_state s')) x) \<Longrightarrow> Z\<rbrakk> \<Longrightarrow> Z"
|
||||
apply (clarsimp simp: states_equiv_for_def elim: equiv_forE)
|
||||
apply (elim equiv_forE)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma states_equiv_forE_cdt:
|
||||
"\<lbrakk>states_equiv_for P Q R S X s s'; (\<And> x. P (fst x) \<Longrightarrow> cdt s x = cdt s' x) \<Longrightarrow> Z\<rbrakk> \<Longrightarrow> Z"
|
||||
|
|
@ -527,7 +533,7 @@ definition globals_equiv :: "('z :: state_ext) state \<Rightarrow> ('z :: state_
|
|||
(\<forall>x\<in>range_of_arm_globals_frame s. underlying_memory (machine_state s) x = underlying_memory (machine_state s') x) \<and>
|
||||
arm_global_pd (arch_state s) = arm_global_pd (arch_state s') \<and>
|
||||
kheap s (arm_global_pd (arch_state s)) = kheap s' (arm_global_pd (arch_state s)) \<and>
|
||||
idle_equiv s s' \<and>
|
||||
idle_equiv s s' \<and> dom (device_state (machine_state s)) = dom (device_state (machine_state s')) \<and>
|
||||
cur_thread s = cur_thread s' \<and>
|
||||
(cur_thread s \<noteq> idle_thread s \<longrightarrow> exclusive_state_equiv s s')
|
||||
"
|
||||
|
|
@ -565,10 +571,10 @@ lemma reads_equivE:
|
|||
equiv_for ((aag_can_read aag) \<circ> fst) cdt s s';
|
||||
equiv_for ((aag_can_read aag) \<circ> fst) cdt_list s s';
|
||||
equiv_for (aag_can_read aag) ekheap s s';
|
||||
equiv_for ((aag_can_read aag) \<circ> fst) is_original_cap s s'; equiv_for (aag_can_read_irq aag) interrupt_states s s';
|
||||
equiv_for (aag_can_read_irq aag) interrupt_irq_node s s';
|
||||
equiv_asids (aag_can_read_asid aag) s s';
|
||||
equiv_for (aag_can_read_domain aag) ready_queues s s'; cur_thread s = cur_thread s'; cur_domain s = cur_domain s'; scheduler_action s = scheduler_action s'; work_units_completed s = work_units_completed s'; irq_state (machine_state s) = irq_state (machine_state s')\<rbrakk> \<Longrightarrow> R"
|
||||
equiv_for ((aag_can_read aag) \<circ> fst) is_original_cap s s'; equiv_for (aag_can_read_irq aag) interrupt_states s s';
|
||||
equiv_for (aag_can_read_irq aag) interrupt_irq_node s s';
|
||||
equiv_asids (aag_can_read_asid aag) s s';
|
||||
equiv_for (aag_can_read_domain aag) ready_queues s s'; cur_thread s = cur_thread s'; cur_domain s = cur_domain s'; scheduler_action s = scheduler_action s'; work_units_completed s = work_units_completed s'; irq_state (machine_state s) = irq_state (machine_state s')\<rbrakk> \<Longrightarrow> R"
|
||||
shows "R"
|
||||
apply(rule e)
|
||||
apply(insert sef)
|
||||
|
|
@ -1305,14 +1311,19 @@ lemma syscall_reads_respects_g:
|
|||
|
||||
|
||||
lemma do_machine_op_spec_reads_respects':
|
||||
assumes equiv_dmo:
|
||||
assumes equiv_dmo:
|
||||
"equiv_valid_inv (equiv_machine_state (aag_can_read aag) (range_of_arm_globals_frame st) And equiv_irq_state) (equiv_machine_state (aag_can_affect aag l) (range_of_arm_globals_frame st)) \<top> f"
|
||||
shows
|
||||
"spec_reads_respects st aag l \<top> (do_machine_op f)"
|
||||
unfolding do_machine_op_def spec_equiv_valid_def
|
||||
apply(rule equiv_valid_2_guard_imp)
|
||||
apply(rule_tac R'="\<lambda> rv rv'. equiv_machine_state (aag_can_read aag or aag_can_affect aag l) (range_of_arm_globals_frame st) rv rv' \<and> equiv_irq_state rv rv'" and Q="\<lambda> r s. st = s" and Q'="\<top>\<top>" and P="op = st" and P'="\<top>" in equiv_valid_2_bind)
|
||||
apply(rule_tac R'="\<lambda> (r, ms') (r', ms''). r = r' \<and> equiv_machine_state (aag_can_read aag) (range_of_arm_globals_frame st) ms' ms'' \<and> equiv_machine_state (aag_can_affect aag l) (range_of_arm_globals_frame st) ms' ms'' \<and> equiv_irq_state ms' ms''" and Q="\<lambda> r s. st = s" and Q'="\<top>\<top>" and P="\<top>" and P'="\<top>" in equiv_valid_2_bind_pre)
|
||||
apply(rule_tac R'="\<lambda> rv rv'.
|
||||
equiv_machine_state (aag_can_read aag or aag_can_affect aag l) (range_of_arm_globals_frame st) rv rv'
|
||||
\<and> equiv_irq_state rv rv'" and Q="\<lambda> r s. st = s" and Q'="\<top>\<top>" and P="op = st" and P'="\<top>" in equiv_valid_2_bind)
|
||||
apply(rule_tac R'="\<lambda> (r, ms') (r', ms''). r = r'
|
||||
\<and> equiv_machine_state (aag_can_read aag) (range_of_arm_globals_frame st) ms' ms''
|
||||
\<and> equiv_machine_state (aag_can_affect aag l) (range_of_arm_globals_frame st) ms' ms''
|
||||
\<and> equiv_irq_state ms' ms''" and Q="\<lambda> r s. st = s" and Q'="\<top>\<top>" and P="\<top>" and P'="\<top>" in equiv_valid_2_bind_pre)
|
||||
apply(clarsimp simp: modify_def get_def put_def bind_def return_def equiv_valid_2_def)
|
||||
apply(fastforce intro: reads_equiv_machine_state_update affects_equiv_machine_state_update)
|
||||
apply(insert equiv_dmo)[1]
|
||||
|
|
|
|||
|
|
@ -45,17 +45,13 @@ lemma dmo_storeWord_modifies_at_most:
|
|||
apply(subst dummy_machine_state_update)
|
||||
apply(rule states_equiv_for_machine_state_update)
|
||||
apply assumption
|
||||
apply(erule states_equiv_forE_mem)
|
||||
apply(rule equiv_forI)
|
||||
apply(fastforce simp: image_def dest: distinct_lemma[where f="pasObjectAbs aag"] intro: ptr_range_memI ptr_range_add_memI)
|
||||
apply (erule states_equiv_forE_mem)
|
||||
apply (intro conjI equiv_forI)
|
||||
apply(fastforce simp: image_def dest: distinct_lemma[where f="pasObjectAbs aag"] intro: ptr_range_memI ptr_range_add_memI)+
|
||||
done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
lemma get_object_reads_respects:
|
||||
"reads_respects aag l (K (aag_can_read aag oref \<or> aag_can_affect aag l oref)) (get_object oref)"
|
||||
unfolding get_object_def
|
||||
|
|
@ -101,11 +97,17 @@ lemma storeWord_equiv_but_for_labels:
|
|||
apply (rule states_equiv_forI)
|
||||
apply(fastforce intro!: equiv_forI elim!: states_equiv_forE dest: equiv_forD[where f=kheap])
|
||||
apply (simp add: states_equiv_for_def)
|
||||
apply(rule equiv_forI)
|
||||
apply (rule conjI)
|
||||
apply(rule equiv_forI)
|
||||
apply(erule states_equiv_forE)
|
||||
apply clarsimp
|
||||
apply(drule_tac f=underlying_memory in equiv_forD,fastforce)
|
||||
apply(fastforce intro: is_aligned_no_wrap' word_plus_mono_right simp: is_aligned_mask for_each_byte_of_word_def)
|
||||
apply(rule equiv_forI)
|
||||
apply(erule states_equiv_forE)
|
||||
apply simp
|
||||
apply(drule_tac f=underlying_memory in equiv_forD, assumption)
|
||||
apply(fastforce intro: is_aligned_no_wrap' word_plus_mono_right simp: is_aligned_mask for_each_byte_of_word_def)
|
||||
apply clarsimp
|
||||
apply(drule_tac f=device_state in equiv_forD,fastforce)
|
||||
apply clarsimp
|
||||
apply(fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=cdt])
|
||||
apply(fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=ekheap])
|
||||
apply(fastforce elim: states_equiv_forE intro: equiv_forI dest: equiv_forD[where f=cdt_list])
|
||||
|
|
@ -847,13 +849,14 @@ lemma lookup_ipc_buffer_has_read_auth:
|
|||
apply (simp add: dom_tcb_cap_cases)
|
||||
apply (frule (1) caps_of_state_valid_cap)
|
||||
apply (clarsimp simp: vm_read_only_def vm_read_write_def)
|
||||
apply (rule_tac Q="AllowRead \<in> xb" in conj_imp)
|
||||
apply (rule_tac Q="AllowRead \<in> xc" in conj_imp)
|
||||
apply (clarsimp simp: valid_cap_simps cap_aligned_def)
|
||||
apply (rule conjI)
|
||||
apply (erule aligned_add_aligned)
|
||||
apply (rule is_aligned_andI1)
|
||||
apply (drule (1) valid_tcb_objs)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
|
||||
split:if_splits)
|
||||
apply (rule order_trans [OF _ pbfs_atleast_pageBits])
|
||||
apply (simp add: msg_align_bits pageBits_def)
|
||||
apply (drule (1) cap_auth_caps_of_state)
|
||||
|
|
@ -1080,7 +1083,7 @@ lemma arch_derive_cap_reads_respects:
|
|||
done
|
||||
|
||||
lemma derive_cap_rev':
|
||||
"reads_equiv_valid_inv A aag (\<lambda> s. (\<exists>x xa xb. cap = cap.UntypedCap x xa xb) \<longrightarrow>
|
||||
"reads_equiv_valid_inv A aag (\<lambda> s. (\<exists>x xa xb d. cap = cap.UntypedCap d x xa xb) \<longrightarrow>
|
||||
pas_refined aag s \<and> is_subject aag (fst slot)) (derive_cap slot cap)"
|
||||
unfolding derive_cap_def arch_derive_cap_def
|
||||
apply(rule equiv_valid_guard_imp)
|
||||
|
|
@ -1245,7 +1248,6 @@ lemma load_cap_transfer_rev:
|
|||
done
|
||||
|
||||
|
||||
|
||||
lemma get_endpoint_rev:
|
||||
"reads_equiv_valid_inv A aag (K (is_subject aag ptr)) (get_endpoint ptr)"
|
||||
unfolding get_endpoint_def
|
||||
|
|
@ -1690,8 +1692,92 @@ lemma ipc_buffer_disjoint_from_None[simp]:
|
|||
apply(simp add: ipc_buffer_disjoint_from_def)
|
||||
done
|
||||
|
||||
(* GENERALIZE the following is possible *)
|
||||
lemma ptr_in_obj_range:
|
||||
"\<lbrakk>valid_objs s; pspace_aligned s; kheap s ptr = Some obj\<rbrakk>
|
||||
\<Longrightarrow> ptr + (a && mask (obj_bits obj)) \<in> obj_range ptr obj"
|
||||
apply (simp add:obj_range_def)
|
||||
apply (rule context_conjI)
|
||||
apply (frule(1) pspace_alignedD)
|
||||
apply (erule is_aligned_no_wrap')
|
||||
apply (rule and_mask_less')
|
||||
apply (drule valid_obj_sizes)
|
||||
apply fastforce
|
||||
apply (simp add:word_bits_def)
|
||||
apply (simp add:p_assoc_help)
|
||||
apply (rule word_plus_mono_right)
|
||||
apply (rule word_less_sub_1)
|
||||
apply (drule valid_obj_sizes)
|
||||
apply fastforce
|
||||
apply (simp add:word_bits_def and_mask_less')
|
||||
apply (rule is_aligned_no_overflow')
|
||||
apply (erule(1) pspace_alignedD)
|
||||
done
|
||||
|
||||
(* GENERALIZE the following is possible but the generalized version might not easy to use*)
|
||||
lemma ptr_not_in_globals_frame:
|
||||
"\<lbrakk> arm_globals_frame (arch_state s) \<noteq> ptr; valid_arch_state s;valid_objs s;
|
||||
pspace_distinct s;pspace_aligned s; kheap s ptr = Some obj\<rbrakk> \<Longrightarrow>
|
||||
ptr + (a && mask (obj_bits obj)) \<notin> range_of_arm_globals_frame s"
|
||||
apply (clarsimp simp:valid_arch_state_def pspace_distinct_def')
|
||||
apply (erule_tac x= ptr in allE)
|
||||
apply (erule_tac x="arm_globals_frame (arch_state s)" in allE)
|
||||
apply (clarsimp simp:obj_at_def obj_range_page_as_ptr_range_pageBitsForSize pageBits_def)
|
||||
apply (drule(2) ptr_in_obj_range[where ptr = ptr])
|
||||
apply (drule(1) IntI)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma pagecap_range:
|
||||
"cap_range (ArchObjectCap (PageCap dev ptr rights sz asid)) = ptr_range ptr (pageBitsForSize sz)"
|
||||
apply (simp add:cap_range_def)
|
||||
oops
|
||||
|
||||
lemma tcb_buffer_orth_globals_frame:
|
||||
"\<lbrakk>valid_objs s; valid_global_refs s; pspace_aligned s; pspace_distinct s; valid_arch_state s;
|
||||
get_tcb sender s = Some tcb;
|
||||
caps_of_state s (sender, tcb_cnode_index 4) = Some (ArchObjectCap (PageCap xa xb xc xd xe))\<rbrakk>
|
||||
\<Longrightarrow> range_of_arm_globals_frame s \<inter>
|
||||
ptr_range (xb + (tcb_ipc_buffer tcb && mask (pageBitsForSize xd))) msg_align_bits =
|
||||
{}"
|
||||
apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"])
|
||||
apply (simp add: dom_tcb_cap_cases)
|
||||
apply (frule (1) caps_of_state_valid_cap)
|
||||
apply (clarsimp simp: valid_cap_simps cap_aligned_def)
|
||||
apply (rule ptr_range_disjoint_strong)
|
||||
(* CLAGged from here onwards from auth_ipc_buffers_do_not_overlap_globals_frame *)
|
||||
apply (rule ccontr)
|
||||
apply clarsimp
|
||||
apply (frule caps_of_state_cteD)
|
||||
apply (frule cte_wp_at_valid_objs_valid_cap)
|
||||
apply(simp)
|
||||
apply (clarsimp simp: valid_cap_def)
|
||||
apply (simp add: valid_global_refs_def valid_refs_def)
|
||||
apply (erule_tac x=sender in allE)
|
||||
apply (erule_tac x="tcb_cnode_index 4" in allE)
|
||||
apply (erule notE)
|
||||
apply (erule cte_wp_at_weakenE)
|
||||
apply (clarsimp simp: global_refs_def cap_range_def)
|
||||
apply (drule_tac t = "tcb_ipcframe tcb" in sym,simp)
|
||||
apply (clarsimp simp:obj_at_def split:if_splits)
|
||||
apply (drule(5) ptr_not_in_globals_frame)
|
||||
apply (fastforce simp: obj_bits_def)
|
||||
apply (drule(5) ptr_not_in_globals_frame)
|
||||
apply (fastforce simp:obj_bits_def)
|
||||
apply (clarsimp simp:valid_arch_state_def obj_at_def dest!:pspace_alignedD)
|
||||
apply (erule aligned_add_aligned)
|
||||
apply (rule is_aligned_andI1)
|
||||
apply (drule (1) valid_tcb_objs)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
|
||||
split:if_splits)
|
||||
apply (rule order_trans [OF _ pbfs_atleast_pageBits])
|
||||
apply (simp add: msg_align_bits pageBits_def)
|
||||
apply simp
|
||||
apply (simp add:msg_align_bits)
|
||||
done
|
||||
|
||||
lemma lookup_ipc_buffer_disjoint_from_globals_frame:
|
||||
"\<lbrace>valid_objs and valid_global_refs and pspace_distinct and valid_arch_state\<rbrace> lookup_ipc_buffer b sender
|
||||
"\<lbrace>valid_objs and valid_global_refs and pspace_aligned and pspace_distinct and valid_arch_state\<rbrace> lookup_ipc_buffer b sender
|
||||
\<lbrace>\<lambda>rva s.
|
||||
ipc_buffer_disjoint_from (range_of_arm_globals_frame s) rva\<rbrace>"
|
||||
unfolding lookup_ipc_buffer_def
|
||||
|
|
@ -1699,60 +1785,26 @@ lemma lookup_ipc_buffer_disjoint_from_globals_frame:
|
|||
apply (wp get_cap_wp thread_get_wp' | wpc | simp)+
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state ipc_buffer_has_read_auth_def get_tcb_ko_at [symmetric])
|
||||
apply (rule drop_imp)
|
||||
(* CLAG from here onwards -- FIXME to remove duplication in this file *)
|
||||
(* upto the next CLAG, clagged from lookup_ipc_buffer_has_read auth *)
|
||||
apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"])
|
||||
apply (simp add: dom_tcb_cap_cases)
|
||||
apply (frule (1) caps_of_state_valid_cap)
|
||||
apply (clarsimp simp: valid_cap_simps cap_aligned_def)
|
||||
apply (simp add: ipc_buffer_disjoint_from_def)
|
||||
apply (rule conjI)
|
||||
apply (rule context_conjI)
|
||||
apply (erule aligned_add_aligned)
|
||||
apply (rule is_aligned_andI1)
|
||||
apply (drule (1) valid_tcb_objs)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def)
|
||||
apply (clarsimp simp: valid_obj_def valid_tcb_def valid_ipc_buffer_cap_def
|
||||
split:if_splits)
|
||||
apply (rule order_trans [OF _ pbfs_atleast_pageBits])
|
||||
apply (simp add: msg_align_bits pageBits_def)
|
||||
(* CLAGged from here onwards from auth_ipc_buffers_do_not_overlap_globals_frame *)
|
||||
apply(rule ccontr)
|
||||
apply(drule WordLemmaBucket.int_not_emptyD)
|
||||
apply(clarsimp)
|
||||
apply(frule caps_of_state_cteD)
|
||||
apply(frule cte_wp_at_valid_objs_valid_cap)
|
||||
apply(simp)
|
||||
apply(clarsimp simp: valid_cap_def)
|
||||
apply(clarsimp simp: obj_at_def) (* ko_at word from valid_objs*)
|
||||
apply(simp add: valid_global_refs_def valid_refs_def)
|
||||
apply(erule_tac x=sender in allE)
|
||||
apply(erule_tac x="tcb_cnode_index 4" in allE)
|
||||
apply(erule notE)
|
||||
apply(erule cte_wp_at_weakenE)
|
||||
apply(clarsimp)
|
||||
apply(simp add: global_refs_def)
|
||||
apply(clarsimp)
|
||||
apply(frule_tac p'=xa and R=xb and vms=xc and xx=xd in ipcframe_subset_page)
|
||||
apply(simp)
|
||||
apply(simp)
|
||||
apply(simp)
|
||||
apply(simp add: cap_range_def)
|
||||
apply(case_tac "tcb_ipcframe tcb")
|
||||
apply(simp)+
|
||||
apply(rename_tac arch_cap)
|
||||
apply(case_tac arch_cap)
|
||||
apply(simp)+ (* word \<noteq> arm_globals_frame from valid_global_refs*)
|
||||
apply(rename_tac word cap_rights vmpage_size option)
|
||||
apply(clarsimp simp: valid_arch_state_def obj_at_def) (* ko_at arm *)
|
||||
apply(unfold pspace_distinct_def')
|
||||
apply(erule_tac x=word in allE)
|
||||
apply(erule_tac x="arm_globals_frame (arch_state s)" in allE)
|
||||
apply(erule_tac x="ArchObj (DataPage vmpage_size)" in allE)
|
||||
apply(erule_tac x="ArchObj (DataPage ARMSmallPage)" in allE)
|
||||
apply(simp add: a_type_def)
|
||||
apply(fastforce simp: obj_range_def ptr_range_def)+
|
||||
apply (subst Int_commute)
|
||||
apply (rule tcb_buffer_orth_globals_frame)
|
||||
apply simp+
|
||||
done
|
||||
|
||||
lemma do_ipc_transfer_reads_respects:
|
||||
"reads_respects aag l (valid_objs and valid_global_refs and pspace_distinct
|
||||
"reads_respects aag l (valid_objs and valid_global_refs and pspace_distinct and pspace_aligned
|
||||
and valid_arch_state and pas_refined aag and
|
||||
K ((grant \<longrightarrow> (is_subject aag sender \<and>
|
||||
is_subject aag receiver)) \<and>
|
||||
|
|
@ -1791,7 +1843,7 @@ lemma receive_ipc_base_reads_respects:
|
|||
shows "reads_respects aag l
|
||||
(valid_objs
|
||||
and valid_global_refs
|
||||
and pspace_distinct
|
||||
and pspace_distinct and pspace_aligned
|
||||
and pas_refined aag
|
||||
and pas_cur_domain aag
|
||||
and valid_arch_state
|
||||
|
|
@ -1871,7 +1923,9 @@ lemma receive_ipc_base_reads_respects:
|
|||
done
|
||||
|
||||
lemma receive_ipc_reads_respects:
|
||||
"reads_respects aag l (valid_objs and pspace_distinct and valid_global_refs and valid_arch_state and sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_cap cap and (\<lambda>s. is_subject aag (cur_thread s)) and K (is_subject aag receiver \<and> (\<forall>epptr\<in>Access.obj_refs cap.
|
||||
"reads_respects aag l (valid_objs and pspace_distinct and pspace_aligned and
|
||||
valid_global_refs and valid_arch_state and sym_refs \<circ> state_refs_of and
|
||||
pas_refined aag and pas_cur_domain aag and valid_cap cap and (\<lambda>s. is_subject aag (cur_thread s)) and K (is_subject aag receiver \<and> (\<forall>epptr\<in>Access.obj_refs cap.
|
||||
(pasSubject aag, Receive, pasObjectAbs aag epptr) \<in> pasPolicy aag))) (receive_ipc receiver cap is_blocking)"
|
||||
apply (rule gen_asm_ev)
|
||||
apply (simp add: receive_ipc_def thread_get_def split: cap.split)
|
||||
|
|
@ -1945,7 +1999,8 @@ lemma receive_endpoint_reads_affects_queued:
|
|||
done
|
||||
|
||||
lemma send_ipc_reads_respects:
|
||||
"reads_respects aag l (pas_refined aag and pas_cur_domain aag and valid_objs and pspace_distinct and valid_arch_state and valid_global_refs and sym_refs \<circ> state_refs_of and
|
||||
"reads_respects aag l (pas_refined aag and pas_cur_domain aag and valid_objs and pspace_distinct and
|
||||
pspace_aligned and valid_arch_state and valid_global_refs and sym_refs \<circ> state_refs_of and
|
||||
(\<lambda>s. is_subject aag (cur_thread s)) and
|
||||
(\<lambda>s. \<exists>ep. ko_at (Endpoint ep) epptr s
|
||||
\<and> (can_grant \<longrightarrow> ((\<forall>(t, rt) \<in> ep_q_refs_of ep. rt = EPRecv \<longrightarrow> is_subject aag t)
|
||||
|
|
@ -2005,7 +2060,9 @@ lemma send_ipc_reads_respects:
|
|||
subsection "Faults"
|
||||
|
||||
lemma send_fault_ipc_reads_respects:
|
||||
"reads_respects aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_objs and pspace_distinct and valid_global_refs and valid_arch_state and (\<lambda>s. is_subject aag (cur_thread s)) and K (is_subject aag thread \<and> valid_fault fault)) (send_fault_ipc thread fault)"
|
||||
"reads_respects aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag
|
||||
and valid_objs and pspace_distinct and pspace_aligned
|
||||
and valid_global_refs and valid_arch_state and (\<lambda>s. is_subject aag (cur_thread s)) and K (is_subject aag thread \<and> valid_fault fault)) (send_fault_ipc thread fault)"
|
||||
apply (rule gen_asm_ev)
|
||||
apply (simp add: send_fault_ipc_def Let_def lookup_cap_def split_def)
|
||||
apply (wp send_ipc_reads_respects thread_set_reads_respects
|
||||
|
|
@ -2021,7 +2078,7 @@ lemma send_fault_ipc_reads_respects:
|
|||
(* clagged from Ipc_AC *)
|
||||
apply (rule_tac Q'="\<lambda>rv s. pas_refined aag s
|
||||
\<and> pas_cur_domain aag s
|
||||
\<and> valid_objs s \<and> pspace_distinct s
|
||||
\<and> valid_objs s \<and> pspace_distinct s \<and> pspace_aligned s
|
||||
\<and> valid_global_refs s \<and> valid_arch_state s
|
||||
\<and> sym_refs (state_refs_of s)
|
||||
\<and> valid_fault fault
|
||||
|
|
@ -2048,7 +2105,10 @@ lemma send_fault_ipc_reads_respects:
|
|||
|
||||
|
||||
lemma handle_fault_reads_respects:
|
||||
"reads_respects aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_objs and pspace_distinct and valid_global_refs and valid_arch_state and (\<lambda>s. is_subject aag (cur_thread s)) and K (is_subject aag thread \<and> valid_fault fault)) (handle_fault thread fault)"
|
||||
"reads_respects aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag
|
||||
and valid_objs and pspace_distinct and pspace_aligned
|
||||
and valid_global_refs and valid_arch_state and (\<lambda>s. is_subject aag (cur_thread s))
|
||||
and K (is_subject aag thread \<and> valid_fault fault)) (handle_fault thread fault)"
|
||||
unfolding handle_fault_def catch_def fun_app_def handle_double_fault_def
|
||||
apply(wp_once hoare_drop_imps |
|
||||
wp set_thread_state_reads_respects send_fault_ipc_reads_respects | wpc | simp)+
|
||||
|
|
@ -2099,7 +2159,7 @@ lemma do_reply_transfer_reads_respects_f:
|
|||
| wp cap_delete_one_invs hoare_vcg_all_lift
|
||||
cap_delete_one_silc_inv reads_respects_f[OF thread_get_reads_respects]
|
||||
reads_respects_f[OF get_thread_state_rev]
|
||||
| simp add: invs_valid_objs invs_valid_global_refs invs_distinct invs_arch_state invs_valid_ko_at_arm | rule conjI | elim conjE | assumption)+)[8]
|
||||
| simp add: invs_valid_objs invs_psp_aligned invs_valid_global_refs invs_distinct invs_arch_state invs_valid_ko_at_arm | rule conjI | elim conjE | assumption)+)[8]
|
||||
apply(clarsimp simp: conj_comms)
|
||||
apply(rule conjI, fastforce intro: reads_lrefl)+
|
||||
apply(rule allI)
|
||||
|
|
@ -2153,12 +2213,6 @@ lemma setup_caller_cap_globals_equiv:
|
|||
apply(simp_all)
|
||||
done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
lemma set_extra_badge_globals_equiv:
|
||||
"\<lbrace>globals_equiv s and (\<lambda>sa. ptr_range (buffer + (of_nat buffer_cptr_index
|
||||
+ of_nat n) * of_nat word_size) 2 \<inter> range_of_arm_globals_frame sa = {})\<rbrace>
|
||||
|
|
@ -2322,7 +2376,7 @@ lemma do_fault_transfer_globals_equiv:
|
|||
done
|
||||
|
||||
lemma lookup_ipc_buffer_ptr_range':
|
||||
"\<lbrace>\<top>\<rbrace>
|
||||
"\<lbrace>valid_objs\<rbrace>
|
||||
lookup_ipc_buffer True thread
|
||||
\<lbrace>\<lambda>rv s. rv = Some buf' \<longrightarrow> auth_ipc_buffers s thread = ptr_range buf' msg_align_bits\<rbrace>"
|
||||
unfolding lookup_ipc_buffer_def
|
||||
|
|
@ -2332,8 +2386,9 @@ lemma lookup_ipc_buffer_ptr_range':
|
|||
apply (frule caps_of_state_tcb_cap_cases [where idx = "tcb_cnode_index 4"])
|
||||
apply (simp add: dom_tcb_cap_cases)
|
||||
apply (clarsimp simp: auth_ipc_buffers_def get_tcb_ko_at [symmetric])
|
||||
apply (drule(1) valid_tcb_objs)
|
||||
apply (drule get_tcb_SomeD)+
|
||||
apply(simp add: vm_read_write_def)
|
||||
apply (simp add: vm_read_write_def valid_tcb_def valid_ipc_buffer_cap_def split:bool.splits)
|
||||
done
|
||||
|
||||
lemma lookup_ipc_buffer_aligned':
|
||||
|
|
@ -2343,49 +2398,23 @@ lemma lookup_ipc_buffer_aligned':
|
|||
apply(fastforce simp: valid_def)
|
||||
done
|
||||
|
||||
|
||||
lemma set_collection: "a = {x. x\<in>a}"
|
||||
by simp
|
||||
|
||||
lemma auth_ipc_buffers_do_not_overlap_arm_globals_frame:
|
||||
"\<lbrakk>valid_arch_state s; valid_global_refs s; valid_objs s; pspace_distinct s\<rbrakk> \<Longrightarrow> auth_ipc_buffers s thread \<inter> range_of_arm_globals_frame s = {}"
|
||||
apply(rule ccontr)
|
||||
apply(drule WordLemmaBucket.int_not_emptyD)
|
||||
apply(clarsimp simp: auth_ipc_buffers_member_def)
|
||||
apply(frule caps_of_state_cteD)
|
||||
apply(frule cte_wp_at_valid_objs_valid_cap)
|
||||
apply(simp)
|
||||
apply(clarsimp simp: valid_cap_def)
|
||||
apply(clarsimp simp: obj_at_def) (* ko_at word from valid_objs*)
|
||||
apply(simp add: valid_global_refs_def valid_refs_def)
|
||||
apply(erule_tac x=thread in allE)
|
||||
apply(erule_tac x="tcb_cnode_index 4" in allE)
|
||||
apply(erule notE)
|
||||
apply(erule cte_wp_at_weakenE)
|
||||
apply(clarsimp)
|
||||
apply(simp add: global_refs_def)
|
||||
apply(clarsimp)
|
||||
apply(frule_tac p'=p' and R=R and vms=vms and xx=xx in ipcframe_subset_page)
|
||||
apply(simp)
|
||||
apply(simp)
|
||||
apply(simp)
|
||||
apply(simp add: cap_range_def)
|
||||
apply(case_tac "tcb_ipcframe tcb")
|
||||
apply(simp)+
|
||||
apply(rename_tac arch_cap)
|
||||
apply(case_tac arch_cap)
|
||||
apply(simp)+ (* word \<noteq> arm_globals_frame from valid_global_refs*)
|
||||
apply(rename_tac word rights vmpage_size option)
|
||||
apply(clarsimp simp: valid_arch_state_def obj_at_def) (* ko_at arm *)
|
||||
apply(unfold pspace_distinct_def')
|
||||
apply(erule_tac x=word in allE)
|
||||
apply(erule_tac x="arm_globals_frame (arch_state s)" in allE)
|
||||
apply(erule_tac x="ArchObj (DataPage vmpage_size)" in allE)
|
||||
apply(erule_tac x="ArchObj (DataPage ARMSmallPage)" in allE)
|
||||
apply(fastforce simp: obj_range_def ptr_range_def)+
|
||||
"\<lbrakk>valid_arch_state s; valid_global_refs s; valid_objs s; pspace_distinct s; pspace_aligned s\<rbrakk>
|
||||
\<Longrightarrow> auth_ipc_buffers s thread \<inter> range_of_arm_globals_frame s = {}"
|
||||
apply (rule ccontr)
|
||||
apply (drule WordLemmaBucket.int_not_emptyD)
|
||||
apply (clarsimp simp: auth_ipc_buffers_member_def)
|
||||
apply (erule(1) in_empty_interE[rotated])
|
||||
apply (rule tcb_buffer_orth_globals_frame)
|
||||
apply auto
|
||||
done
|
||||
|
||||
|
||||
lemma do_ipc_transfer_globals_equiv:
|
||||
"\<lbrace>globals_equiv st and valid_ko_at_arm and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and (\<lambda>s. receiver \<noteq> idle_thread s)\<rbrace>
|
||||
"\<lbrace>globals_equiv st and valid_ko_at_arm and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and valid_global_objs and (\<lambda>s. receiver \<noteq> idle_thread s)\<rbrace>
|
||||
do_ipc_transfer sender ep badge grant receiver
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding do_ipc_transfer_def
|
||||
|
|
@ -2454,7 +2483,8 @@ lemma do_ipc_transfer_globals_equiv:
|
|||
crunch valid_ko_at_arm[wp]: do_ipc_transfer "valid_ko_at_arm"
|
||||
|
||||
lemma send_ipc_globals_equiv:
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and valid_idle and (\<lambda>s. sym_refs (state_refs_of s))\<rbrace>
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and valid_global_objs and valid_idle and (\<lambda>s. sym_refs (state_refs_of s))\<rbrace>
|
||||
send_ipc block call badge can_grant thread epptr
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding send_ipc_def
|
||||
|
|
@ -2470,7 +2500,9 @@ lemma send_ipc_globals_equiv:
|
|||
apply(clarsimp)
|
||||
apply(rule hoare_drop_imps)
|
||||
apply(wp set_endpoint_globals_equiv)
|
||||
apply(rule_tac Q="\<lambda>ep. ko_at (Endpoint ep) epptr and globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and (\<lambda>s. sym_refs (state_refs_of s)) and valid_idle"
|
||||
apply(rule_tac Q="\<lambda>ep. ko_at (Endpoint ep) epptr and globals_equiv st and valid_objs
|
||||
and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned
|
||||
and valid_global_objs and (\<lambda>s. sym_refs (state_refs_of s)) and valid_idle"
|
||||
in hoare_strengthen_post)
|
||||
apply(wp get_endpoint_sp)
|
||||
apply(clarsimp simp: valid_arch_state_ko_at_arm)+
|
||||
|
|
@ -2502,7 +2534,8 @@ crunch globals_equiv[wp]: complete_signal "globals_equiv st"
|
|||
|
||||
lemma receive_ipc_globals_equiv:
|
||||
notes do_nbrecv_failed_transfer_def[simp]
|
||||
shows "\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace>
|
||||
shows "\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct
|
||||
and pspace_aligned and valid_global_objs and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace>
|
||||
receive_ipc thread cap is_blocking
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding receive_ipc_def thread_get_def
|
||||
|
|
@ -2637,13 +2670,18 @@ lemma set_object_valid_global_refs:
|
|||
|
||||
|
||||
lemma send_fault_ipc_globals_equiv:
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and valid_idle and (\<lambda>s. sym_refs (state_refs_of s)) and K (valid_fault fault)\<rbrace> send_fault_ipc tptr fault
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned
|
||||
and valid_global_objs and valid_idle and (\<lambda>s. sym_refs (state_refs_of s)) and K (valid_fault fault)\<rbrace>
|
||||
send_fault_ipc tptr fault
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding send_fault_ipc_def
|
||||
apply(wp)
|
||||
apply(simp add: Let_def)
|
||||
apply(wp send_ipc_globals_equiv thread_set_globals_equiv thread_set_valid_objs'' thread_set_fault_valid_global_refs thread_set_valid_idle_trivial thread_set_refs_trivial | wpc | simp)+
|
||||
apply(rule_tac Q'="\<lambda>_. globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and K (valid_fault fault) and valid_idle and (\<lambda>s. sym_refs (state_refs_of s))"
|
||||
apply(rule_tac Q'="\<lambda>_. globals_equiv st and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and
|
||||
valid_global_objs and K (valid_fault fault) and valid_idle and (\<lambda>s. sym_refs (state_refs_of s))"
|
||||
in hoare_post_imp_R)
|
||||
apply(wp | simp)+
|
||||
apply(clarsimp simp: valid_arch_state_ko_at_arm)
|
||||
|
|
@ -2699,7 +2737,10 @@ lemma send_fault_ipc_valid_ko_at_arm[wp]:
|
|||
done
|
||||
|
||||
lemma handle_fault_globals_equiv:
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and valid_idle and (\<lambda>s. sym_refs (state_refs_of s)) and K (valid_fault ex)\<rbrace> handle_fault thread ex
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned
|
||||
and valid_global_objs and valid_idle and (\<lambda>s. sym_refs (state_refs_of s))
|
||||
and K (valid_fault ex)\<rbrace> handle_fault thread ex
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding handle_fault_def
|
||||
apply(wp handle_double_fault_globals_equiv)
|
||||
|
|
@ -2720,28 +2761,33 @@ lemma handle_fault_reply_globals_equiv:
|
|||
crunch valid_global_objs: handle_fault_reply "valid_global_objs"
|
||||
|
||||
lemma do_reply_transfer_globals_equiv:
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and valid_idle\<rbrace>
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct
|
||||
and pspace_aligned and valid_global_objs and valid_idle\<rbrace>
|
||||
do_reply_transfer sender receiver slot
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding do_reply_transfer_def
|
||||
apply(wp set_thread_state_globals_equiv cap_delete_one_globals_equiv do_ipc_transfer_globals_equiv thread_set_globals_equiv handle_fault_reply_globals_equiv dxo_wp_weak | wpc | simp split del: split_if)+
|
||||
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_ko_at_arm and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and (\<lambda>s. receiver \<noteq> idle_thread s) and valid_idle" in hoare_strengthen_post)
|
||||
apply(wp set_thread_state_globals_equiv cap_delete_one_globals_equiv do_ipc_transfer_globals_equiv
|
||||
thread_set_globals_equiv handle_fault_reply_globals_equiv dxo_wp_weak | wpc | simp split del: split_if)+
|
||||
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_ko_at_arm and valid_objs and valid_arch_state
|
||||
and valid_global_refs and pspace_distinct and pspace_aligned and valid_global_objs and (\<lambda>s. receiver \<noteq> idle_thread s) and valid_idle" in hoare_strengthen_post)
|
||||
apply (wp gts_wp | fastforce simp: valid_arch_state_ko_at_arm pred_tcb_at_def obj_at_def valid_idle_def)+
|
||||
done
|
||||
|
||||
lemma handle_reply_globals_equiv:
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and valid_idle\<rbrace> handle_reply
|
||||
"\<lbrace>globals_equiv st and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and valid_global_objs and valid_idle\<rbrace> handle_reply
|
||||
\<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
|
||||
unfolding handle_reply_def
|
||||
apply(wp do_reply_transfer_globals_equiv | wpc)+
|
||||
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_global_objs and valid_idle"
|
||||
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and valid_global_objs and valid_idle"
|
||||
in hoare_strengthen_post)
|
||||
apply(wp | simp)+
|
||||
done
|
||||
|
||||
lemma reply_from_kernel_globals_equiv:
|
||||
"\<lbrace>globals_equiv s and valid_objs and valid_arch_state and valid_global_refs and pspace_distinct
|
||||
and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace> reply_from_kernel thread x
|
||||
and pspace_aligned and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace> reply_from_kernel thread x
|
||||
\<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
|
||||
unfolding reply_from_kernel_def
|
||||
apply(wp set_message_info_globals_equiv set_mrs_globals_equiv
|
||||
|
|
@ -2807,7 +2853,9 @@ lemma receive_signal_reads_respects_g:
|
|||
subsection "Sycn IPC"
|
||||
|
||||
lemma send_ipc_reads_respects_g:
|
||||
"reads_respects_g aag l (pas_refined aag and pas_cur_domain aag and valid_objs and valid_global_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_idle and sym_refs \<circ> state_refs_of and is_subject aag \<circ> cur_thread and (\<lambda> s. \<exists>ep. ko_at (Endpoint ep) epptr s \<and>
|
||||
"reads_respects_g aag l (pas_refined aag and pas_cur_domain aag and valid_objs and valid_global_objs
|
||||
and valid_arch_state and valid_global_refs and pspace_distinct and pspace_aligned
|
||||
and valid_idle and sym_refs \<circ> state_refs_of and is_subject aag \<circ> cur_thread and (\<lambda> s. \<exists>ep. ko_at (Endpoint ep) epptr s \<and>
|
||||
(can_grant \<longrightarrow>
|
||||
(\<forall>x\<in>ep_q_refs_of ep.
|
||||
(\<lambda>(t, rt). rt = EPRecv \<longrightarrow> is_subject aag t) x) \<and>
|
||||
|
|
@ -2820,7 +2868,8 @@ lemma send_ipc_reads_respects_g:
|
|||
done
|
||||
|
||||
lemma receive_ipc_reads_respects_g:
|
||||
"reads_respects_g aag l (valid_objs and valid_global_objs and valid_arch_state and valid_global_refs and pspace_distinct and (\<lambda>s. receiver \<noteq> idle_thread s) and sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_cap cap and is_subject aag \<circ> cur_thread and K (is_subject aag receiver \<and> (\<forall>epptr\<in>Access.obj_refs cap.
|
||||
"reads_respects_g aag l (valid_objs and valid_global_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and (\<lambda>s. receiver \<noteq> idle_thread s) and sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_cap cap and is_subject aag \<circ> cur_thread and K (is_subject aag receiver \<and> (\<forall>epptr\<in>Access.obj_refs cap.
|
||||
(pasSubject aag, Receive, pasObjectAbs aag epptr) \<in> pasPolicy aag))) (receive_ipc receiver cap is_blocking)"
|
||||
apply(rule equiv_valid_guard_imp[OF reads_respects_g])
|
||||
apply(rule receive_ipc_reads_respects)
|
||||
|
|
@ -2832,7 +2881,8 @@ lemma receive_ipc_reads_respects_g:
|
|||
subsection "Faults"
|
||||
|
||||
lemma send_fault_ipc_reads_respects_g:
|
||||
"reads_respects_g aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_objs and valid_global_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_idle and is_subject aag \<circ> cur_thread and K (is_subject aag thread \<and> valid_fault fault)) (send_fault_ipc thread fault)"
|
||||
"reads_respects_g aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_objs and valid_global_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and valid_idle and is_subject aag \<circ> cur_thread and K (is_subject aag thread \<and> valid_fault fault)) (send_fault_ipc thread fault)"
|
||||
apply(rule equiv_valid_guard_imp[OF reads_respects_g])
|
||||
apply(rule send_fault_ipc_reads_respects)
|
||||
apply(rule doesnt_touch_globalsI)
|
||||
|
|
@ -2841,7 +2891,9 @@ lemma send_fault_ipc_reads_respects_g:
|
|||
|
||||
|
||||
lemma handle_fault_reads_respects_g:
|
||||
"reads_respects_g aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag and valid_objs and valid_global_objs and valid_arch_state and valid_global_refs and pspace_distinct and valid_idle and is_subject aag \<circ> cur_thread and K (is_subject aag thread \<and> valid_fault fault)) (handle_fault thread fault)"
|
||||
"reads_respects_g aag l (sym_refs \<circ> state_refs_of and pas_refined aag and pas_cur_domain aag
|
||||
and valid_objs and valid_global_objs and valid_arch_state and valid_global_refs
|
||||
and pspace_distinct and pspace_aligned and valid_idle and is_subject aag \<circ> cur_thread and K (is_subject aag thread \<and> valid_fault fault)) (handle_fault thread fault)"
|
||||
apply(rule equiv_valid_guard_imp[OF reads_respects_g])
|
||||
apply(rule handle_fault_reads_respects)
|
||||
apply(rule doesnt_touch_globalsI)
|
||||
|
|
@ -2880,8 +2932,8 @@ lemma handle_reply_reads_respects_g:
|
|||
|
||||
lemma reply_from_kernel_reads_respects_g:
|
||||
"reads_respects_g aag l (valid_global_objs and
|
||||
valid_objs and
|
||||
valid_arch_state and valid_global_refs and pspace_distinct and (\<lambda>s. thread \<noteq> idle_thread s) and K (is_subject aag thread)) (reply_from_kernel thread x)"
|
||||
valid_objs and valid_arch_state and valid_global_refs and pspace_distinct
|
||||
and pspace_aligned and (\<lambda>s. thread \<noteq> idle_thread s) and K (is_subject aag thread)) (reply_from_kernel thread x)"
|
||||
apply(rule equiv_valid_guard_imp[OF reads_respects_g])
|
||||
apply(rule reply_from_kernel_reads_respects)
|
||||
apply(rule doesnt_touch_globalsI)
|
||||
|
|
|
|||
|
|
@ -203,17 +203,18 @@ lemma schedule_reads_affects_equiv_sameFor:
|
|||
|
||||
|
||||
lemma globals_equiv_to_scheduler_globals_frame_equiv:
|
||||
"globals_equiv s t \<Longrightarrow> invs s \<Longrightarrow> scheduler_globals_frame_equiv s t"
|
||||
"globals_equiv s t \<Longrightarrow> invs s \<Longrightarrow> invs t\<Longrightarrow> scheduler_globals_frame_equiv s t"
|
||||
apply(simp add: globals_equiv_def scheduler_globals_frame_equiv_def)
|
||||
apply(rule ballI)
|
||||
apply(clarify, erule bspec)
|
||||
apply(rule subsetD[OF Access.ptr_range_subset[where x="0", simplified]])
|
||||
prefer 4
|
||||
apply fastforce
|
||||
apply clarify
|
||||
apply (drule sym)
|
||||
apply clarsimp
|
||||
apply(frule subsetD[OF Access.ptr_range_subset[where x="0" and sz = 12, simplified],rotated -1])
|
||||
apply(rule arm_globals_frame_aligned)
|
||||
apply(erule invs_arch_state)
|
||||
apply(erule invs_psp_aligned)
|
||||
apply simp+
|
||||
apply (simp add:globals_frame_not_device)
|
||||
done
|
||||
|
||||
lemma globals_equiv_to_cur_thread_eq:
|
||||
|
|
@ -225,7 +226,9 @@ lemma globals_equiv_to_exclusive_state_equiv:
|
|||
by(simp add: globals_equiv_def idle_equiv_def)
|
||||
|
||||
lemma sameFor_scheduler_affects_equiv:
|
||||
"\<lbrakk>(s,s') \<in> sameFor (pasPolicy aag) (pasObjectAbs aag) (pasIRQAbs aag) (pasASIDAbs aag) (pasDomainAbs aag) PSched; (s,s') \<in> sameFor (pasPolicy aag) (pasObjectAbs aag) (pasIRQAbs aag) (pasASIDAbs aag) (pasDomainAbs aag) (Partition l); invs (internal_state_if s)\<rbrakk> \<Longrightarrow>
|
||||
"\<lbrakk>(s,s') \<in> sameFor (pasPolicy aag) (pasObjectAbs aag) (pasIRQAbs aag) (pasASIDAbs aag) (pasDomainAbs aag) PSched;
|
||||
(s,s') \<in> sameFor (pasPolicy aag) (pasObjectAbs aag) (pasIRQAbs aag) (pasASIDAbs aag) (pasDomainAbs aag) (Partition l);
|
||||
invs (internal_state_if s);invs (internal_state_if s')\<rbrakk> \<Longrightarrow>
|
||||
scheduler_equiv aag (internal_state_if s) (internal_state_if s') \<and> scheduler_affects_equiv aag (OrdinaryLabel l) (internal_state_if s) (internal_state_if s')"
|
||||
apply (rule conjI)
|
||||
apply (blast intro: sameFor_scheduler_equiv)
|
||||
|
|
@ -314,10 +317,22 @@ lemma pas_refined_irq_state_independent:
|
|||
apply(auto simp: irq_state_independent_def)
|
||||
done
|
||||
|
||||
lemma irq_update_pspace_respects_device_region[simp]:
|
||||
"pspace_respects_device_region (s\<lparr>machine_state := irq_state_update f sa\<rparr>)
|
||||
= pspace_respects_device_region (s\<lparr>machine_state := sa\<rparr>)"
|
||||
by (clarsimp simp: pspace_respects_device_region_def user_mem_def device_mem_def)
|
||||
|
||||
lemma irq_update_cap_refs_respects_device_region[simp]:
|
||||
"cap_refs_respects_device_region (s\<lparr>machine_state := irq_state_update f sa\<rparr>)
|
||||
= cap_refs_respects_device_region (s\<lparr>machine_state := sa\<rparr>)"
|
||||
by (clarsimp simp: cap_refs_respects_device_region_def user_mem_def
|
||||
device_mem_def cap_range_respects_device_region_def)
|
||||
|
||||
lemma invs_irq_state_independent:
|
||||
"irq_state_independent
|
||||
(\<lambda>sa. invs (s\<lparr>machine_state := sa\<rparr>))"
|
||||
apply(auto simp: irq_state_independent_def invs_def valid_state_def valid_machine_state_def cur_tcb_def valid_irq_states_def)
|
||||
apply(auto simp: irq_state_independent_def invs_def valid_state_def
|
||||
valid_machine_state_def cur_tcb_def valid_irq_states_def)
|
||||
done
|
||||
|
||||
lemma thread_set_tcb_context_update_ct_active[wp]:
|
||||
|
|
@ -397,16 +412,41 @@ lemma kernel_entry_if_integrity:
|
|||
apply(rule ext, simp_all)
|
||||
done
|
||||
|
||||
lemma dmo_device_update_respects_Write:
|
||||
"\<lbrace>integrity aag X st
|
||||
and K (\<forall>p \<in> dom um'. aag_has_auth_to aag Write p)\<rbrace>
|
||||
do_machine_op (device_memory_update um')
|
||||
\<lbrace>\<lambda>a. integrity aag X st\<rbrace>"
|
||||
apply (simp add: device_memory_update_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp dmo_wp)
|
||||
apply clarsimp
|
||||
apply (simp cong: abstract_state.fold_congs)
|
||||
apply (rule integrity_device_state_update)
|
||||
apply simp
|
||||
apply clarify
|
||||
apply (drule(1) bspec)
|
||||
apply simp
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
(* clagged straight from ADT_AC.do_user_op_respects *)
|
||||
lemma do_user_op_if_integrity:
|
||||
"\<lbrace> invs and integrity aag X st and is_subject aag \<circ> cur_thread and pas_refined aag \<rbrace>
|
||||
do_user_op_if uop tc
|
||||
\<lbrace>\<lambda>rv. integrity aag X st\<rbrace>"
|
||||
apply (simp add: do_user_op_if_def)
|
||||
apply (wp dmo_user_memory_update_respects_Write hoare_vcg_all_lift hoare_vcg_imp_lift
|
||||
apply (wp dmo_user_memory_update_respects_Write dmo_device_update_respects_Write
|
||||
hoare_vcg_all_lift hoare_vcg_imp_lift
|
||||
| wpc | clarsimp)+
|
||||
apply (rule hoare_pre_cont)
|
||||
apply (wp select_wp | wpc | clarsimp)+
|
||||
apply (rule conjI)
|
||||
apply clarsimp
|
||||
apply (simp add: restrict_map_def ptable_lift_s_def ptable_rights_s_def split:if_splits)
|
||||
apply (drule_tac auth=Write in user_op_access')
|
||||
apply (simp add: vspace_cap_rights_to_auth_def)+
|
||||
apply clarsimp
|
||||
apply (simp add: restrict_map_def ptable_lift_s_def ptable_rights_s_def split:if_splits)
|
||||
apply (drule_tac auth=Write in user_op_access')
|
||||
apply (simp add: vspace_cap_rights_to_auth_def)+
|
||||
|
|
@ -524,10 +564,10 @@ lemma dmo_user_memory_update_globals_equiv_scheduler:
|
|||
pr = ptable_rights t s))\<rbrace>
|
||||
do_machine_op
|
||||
(user_memory_update
|
||||
(ba |`
|
||||
((ba |`
|
||||
{y. \<exists>x. pl x = Some y \<and>
|
||||
AllowWrite \<in> pr x} \<circ>
|
||||
addrFromPPtr))
|
||||
addrFromPPtr) |` S))
|
||||
\<lbrace>\<lambda>y. globals_equiv_scheduler st\<rbrace>"
|
||||
apply(rule do_machine_op_globals_equiv_scheduler)
|
||||
apply clarsimp
|
||||
|
|
@ -539,6 +579,23 @@ lemma dmo_user_memory_update_globals_equiv_scheduler:
|
|||
apply(blast dest: empty_rights_in_arm_globals_frame)
|
||||
done
|
||||
|
||||
lemma dmo_device_memory_update_globals_equiv_scheduler:
|
||||
"\<lbrace>globals_equiv_scheduler st and (\<lambda>s. device_region s = S)\<rbrace>
|
||||
do_machine_op
|
||||
(device_memory_update
|
||||
((ba |`
|
||||
{y. \<exists>x. pl x = Some y \<and>
|
||||
AllowWrite \<in> pr x} \<circ>
|
||||
addrFromPPtr) |` S))
|
||||
\<lbrace>\<lambda>y. globals_equiv_scheduler st\<rbrace>"
|
||||
apply(rule do_machine_op_globals_equiv_scheduler)
|
||||
apply clarsimp
|
||||
apply(simp add: device_memory_update_def simpler_modify_def)
|
||||
apply(clarsimp simp: globals_equiv_scheduler_def split: option.splits)
|
||||
apply blast
|
||||
done
|
||||
|
||||
|
||||
lemma globals_equiv_scheduler_exclusive_state_update[simp]:
|
||||
"globals_equiv_scheduler st (s\<lparr>machine_state := machine_state s\<lparr>exclusive_state := es\<rparr>\<rparr>) = globals_equiv_scheduler st s"
|
||||
by (simp add: globals_equiv_scheduler_def)
|
||||
|
|
@ -548,7 +605,8 @@ lemma do_user_op_if_globals_equiv_scheduler:
|
|||
do_user_op_if tc uop
|
||||
\<lbrace>\<lambda>_. globals_equiv_scheduler st\<rbrace>"
|
||||
apply(simp add: do_user_op_if_def)
|
||||
apply (wp dmo_user_memory_update_globals_equiv_scheduler select_wp | wpc | simp)+
|
||||
apply (wp dmo_user_memory_update_globals_equiv_scheduler
|
||||
dmo_device_memory_update_globals_equiv_scheduler select_wp | wpc | simp)+
|
||||
apply (auto simp: ptable_lift_s_def ptable_rights_s_def)
|
||||
done
|
||||
|
||||
|
|
@ -678,20 +736,23 @@ lemmas integrity_subjects_eobj =
|
|||
lemmas integrity_subjects_mem =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct1]
|
||||
|
||||
lemmas integrity_subjects_cdt =
|
||||
lemmas integrity_subjects_device =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct1]
|
||||
|
||||
lemmas integrity_subjects_cdt_list =
|
||||
lemmas integrity_subjects_cdt =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct1]
|
||||
|
||||
lemmas integrity_subjects_interrupts =
|
||||
lemmas integrity_subjects_cdt_list =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct1]
|
||||
|
||||
lemmas integrity_subjects_asids =
|
||||
lemmas integrity_subjects_interrupts =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct1]
|
||||
|
||||
lemmas integrity_subjects_asids =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct1]
|
||||
|
||||
lemmas integrity_subjects_ready_queues =
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2]
|
||||
integrity_subjects_def[THEN meta_eq_to_obj_eq, THEN iffD1, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2, THEN conjunct2]
|
||||
|
||||
|
||||
lemma partitionIntegrity_arm_globals_frame:
|
||||
|
|
@ -1194,6 +1255,26 @@ lemma subject_can_affect_its_own_partition:
|
|||
apply(blast intro: affects_lrefl reads_lrefl)
|
||||
done
|
||||
|
||||
(* FIXME: cleanup this wonderful proof *)
|
||||
lemma partitionIntegrity_subjectAffects_device:
|
||||
"\<lbrakk>partitionIntegrity aag s s'; pas_refined aag s; invs s;
|
||||
invs s';
|
||||
device_state (machine_state s) x \<noteq>
|
||||
device_state (machine_state s') x; x \<notin> range_of_arm_globals_frame s \<or> x \<notin> range_of_arm_globals_frame s'\<rbrakk> \<Longrightarrow>
|
||||
pasObjectAbs aag x
|
||||
\<in> subjectAffects (pasPolicy aag) (pasSubject aag)"
|
||||
apply(frule partitionIntegrity_arm_globals_frame)
|
||||
apply(drule partitionIntegrity_integrity)
|
||||
apply(frule integrity_subjects_device)
|
||||
apply(drule_tac x=x in spec)
|
||||
apply(erule integrity_device.cases)
|
||||
apply(fastforce intro: affects_lrefl)
|
||||
apply blast
|
||||
apply(fastforce intro: affects_write)
|
||||
done
|
||||
|
||||
|
||||
|
||||
(* a hack to prevent safe etc. below from taking apart the implication *)
|
||||
definition guarded_is_subject_cur_thread where
|
||||
"guarded_is_subject_cur_thread aag s \<equiv> cur_thread s \<noteq> idle_thread s \<longrightarrow> is_subject aag (cur_thread s)"
|
||||
|
|
@ -1217,6 +1298,7 @@ lemma partsSubjectAffects_bounds_subjects_affects:
|
|||
apply ((auto dest: partitionIntegrity_subjectAffects_obj
|
||||
partitionIntegrity_subjectAffects_eobj
|
||||
partitionIntegrity_subjectAffects_mem
|
||||
partitionIntegrity_subjectAffects_device
|
||||
partitionIntegrity_subjectAffects_cdt
|
||||
partitionIntegrity_subjectAffects_cdt_list
|
||||
partitionIntegrity_subjectAffects_is_original_cap
|
||||
|
|
@ -1224,7 +1306,7 @@ lemma partsSubjectAffects_bounds_subjects_affects:
|
|||
partitionIntegrity_subjectAffects_interrupt_irq_node
|
||||
partitionIntegrity_subjectAffects_asid
|
||||
partitionIntegrity_subjectAffects_ready_queues[folded guarded_is_subject_cur_thread_def]
|
||||
| fastforce simp: partitionIntegrity_def silc_dom_equiv_def equiv_for_def)+)[10]
|
||||
| fastforce simp: partitionIntegrity_def silc_dom_equiv_def equiv_for_def)+)[11]
|
||||
apply((fastforce intro: affects_lrefl simp: partitionIntegrity_def domain_fields_equiv_def)+)[16]
|
||||
done
|
||||
|
||||
|
|
@ -2199,7 +2281,7 @@ lemma schedule_if_reads_respects_g:
|
|||
done
|
||||
|
||||
lemma do_user_op_if_reads_respects_g:
|
||||
"reads_respects_g aag l (pas_refined aag and einvs and is_subject aag \<circ> cur_thread and det_inv InUserMode tc and ct_running) (do_user_op_if utf tc)"
|
||||
"reads_respects_g aag l (pas_refined aag and valid_pdpt_objs and einvs and is_subject aag \<circ> cur_thread and det_inv InUserMode tc and ct_running) (do_user_op_if utf tc)"
|
||||
apply (rule equiv_valid_guard_imp)
|
||||
apply (rule UserOp_IF.do_user_op_reads_respects_g[where P="\<lambda>tc. einvs and det_inv InUserMode tc and ct_running"])
|
||||
using utf_det
|
||||
|
|
@ -3375,7 +3457,7 @@ fun label_for_partition where
|
|||
| "label_for_partition PSched = SilcLabel"
|
||||
|
||||
lemma uwr_scheduler_affects_equiv:
|
||||
"\<lbrakk>(s,s') \<in> uwr PSched; (s,s') \<in> uwr u; invs_if s\<rbrakk> \<Longrightarrow>
|
||||
"\<lbrakk>(s,s') \<in> uwr PSched; (s,s') \<in> uwr u; invs_if s; invs_if s'\<rbrakk> \<Longrightarrow>
|
||||
scheduler_equiv initial_aag (internal_state_if s) (internal_state_if s') \<and> scheduler_affects_equiv initial_aag (label_for_partition u) (internal_state_if s) (internal_state_if s')"
|
||||
apply (simp add: uwr_def)
|
||||
apply (case_tac u)
|
||||
|
|
|
|||
|
|
@ -57,7 +57,6 @@ definition policy :: "(domain \<times> domain) set" where "policy \<equiv> {(Onl
|
|||
|
||||
definition out :: "domain \<Rightarrow> state \<Rightarrow> state" where "out \<equiv> \<lambda> d x. x"
|
||||
|
||||
|
||||
lemma execution_Step_0:
|
||||
"length as = 0 \<Longrightarrow> execution Step S0 as = {S0}"
|
||||
apply(clarsimp simp: execution_def)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ imports CNode_IF
|
|||
begin
|
||||
|
||||
lemma create_cap_reads_respects:
|
||||
"reads_respects aag l (K (is_subject aag (fst (fst slot)))) (create_cap type bits untyped slot)"
|
||||
"reads_respects aag l (K (is_subject aag (fst (fst slot)))) (create_cap type bits untyped dev slot)"
|
||||
apply(rule gen_asm_ev)
|
||||
apply(simp add: create_cap_def split_def bind_assoc[symmetric])
|
||||
apply (fold update_cdt_def)
|
||||
|
|
@ -61,9 +61,11 @@ lemma equiv_machine_state_machine_state_rest_update:
|
|||
|
||||
lemma machine_op_lift_ev:
|
||||
"equiv_valid_inv (equiv_machine_state P X) (equiv_machine_state Q Y) \<top> (machine_op_lift mop)"
|
||||
apply(rule equiv_valid_guard_imp)
|
||||
apply(rule machine_op_lift_ev')
|
||||
apply(fastforce intro: equiv_machine_state_machine_state_rest_update)
|
||||
apply (rule equiv_valid_guard_imp)
|
||||
apply (rule machine_op_lift_ev')
|
||||
apply clarsimp
|
||||
apply (intro conjI impI)
|
||||
apply (drule equiv_machine_state_machine_state_rest_update,fastforce)+
|
||||
done
|
||||
|
||||
lemma cacheRangeOp_ev[wp]:
|
||||
|
|
@ -237,7 +239,7 @@ lemma globals_equiv_is_original_cap_update:
|
|||
|
||||
|
||||
lemma create_cap_globals_equiv:
|
||||
"\<lbrace> globals_equiv s and valid_global_objs \<rbrace> create_cap type bits untyped slot
|
||||
"\<lbrace> globals_equiv s and valid_global_objs \<rbrace> create_cap type bits untyped dev slot
|
||||
\<lbrace> \<lambda>_. globals_equiv s \<rbrace>"
|
||||
apply(simp add: create_cap_def split_def)
|
||||
apply (wp set_cap_globals_equiv set_original_globals_equiv set_cdt_globals_equiv set_cdt_valid_global_objs dxo_wp_weak| simp)+
|
||||
|
|
@ -364,14 +366,16 @@ lemma do_machine_op_globals_equiv:
|
|||
|
||||
lemma dmo_no_mem_globals_equiv:
|
||||
"\<lbrakk>\<And>P. invariant f (\<lambda>ms. P (underlying_memory ms));
|
||||
\<And>P. invariant f (\<lambda>ms. P (device_state ms));
|
||||
\<And>P. invariant f (\<lambda>ms. P (exclusive_state ms))\<rbrakk> \<Longrightarrow>
|
||||
invariant (do_machine_op f) (globals_equiv s)"
|
||||
unfolding do_machine_op_def
|
||||
apply(wp | simp add: split_def)+
|
||||
apply (wp | simp add: split_def)+
|
||||
apply atomize
|
||||
apply(erule_tac x="op = (underlying_memory (machine_state sa))" in allE)
|
||||
apply(erule_tac x="op = (exclusive_state (machine_state sa))" in allE)
|
||||
apply(fastforce simp: valid_def globals_equiv_def idle_equiv_def)
|
||||
apply (erule_tac x="op = (underlying_memory (machine_state sa))" in allE)
|
||||
apply (erule_tac x="op = (device_state (machine_state sa))" in allE)
|
||||
apply (erule_tac x="op = (exclusive_state (machine_state sa))" in allE)
|
||||
apply (fastforce simp: valid_def globals_equiv_def idle_equiv_def)
|
||||
done
|
||||
|
||||
lemma mol_globals_equiv:
|
||||
|
|
@ -536,10 +540,12 @@ lemma do_machine_op_mapM_x:
|
|||
done
|
||||
|
||||
lemma create_word_objects_reads_respects:
|
||||
"reads_respects aag l \<top> (create_word_objects ptr bits sz)"
|
||||
"reads_respects aag l \<top> (create_word_objects ptr bits sz dev)"
|
||||
unfolding create_word_objects_def fun_app_def reserve_region_def
|
||||
apply(subst do_machine_op_mapM_x[OF empty_fail_clearMemory])
|
||||
apply(wp dmo_clearMemory_reads_respects mapM_x_ev | simp)+
|
||||
apply(wp dmo_clearMemory_reads_respects mapM_x_ev hoare_unless_wp
|
||||
| simp add:unless_def when_def
|
||||
| intro conjI impI)+
|
||||
done
|
||||
|
||||
lemma create_word_objects_globals_equiv:
|
||||
|
|
@ -547,12 +553,12 @@ lemma create_word_objects_globals_equiv:
|
|||
shows
|
||||
"\<lbrace> globals_equiv s and (\<lambda> s. range_cover ptr sz bits numObjects \<and>
|
||||
(0::word32) < of_nat numObjects \<and> 2 \<le> bits \<and> {ptr..ptr + of_nat numObjects * 2 ^ bits - 1} \<inter> range_of_arm_globals_frame s = {})\<rbrace>
|
||||
create_word_objects ptr numObjects bits
|
||||
create_word_objects ptr numObjects bits dev
|
||||
\<lbrace> \<lambda>_. globals_equiv s \<rbrace>"
|
||||
unfolding create_word_objects_def reserve_region_def fun_app_def do_machine_op_def
|
||||
apply(rule hoare_pre)
|
||||
apply(simp add: do_machine_op_def clearMemory_def split_def cleanCacheRange_PoU_def)
|
||||
apply(wp)
|
||||
apply(wp hoare_unless_wp)
|
||||
apply clarsimp
|
||||
apply(erule use_valid)
|
||||
apply(wp mapM_x_wp' storeWord_globals_equiv mol_globals_equiv | simp add: cleanByVA_PoU_def)+
|
||||
|
|
@ -574,7 +580,8 @@ lemma create_word_objects_globals_equiv:
|
|||
|
||||
lemma create_word_objects_reads_respects_g:
|
||||
"reads_respects_g aag l (\<lambda> s. range_cover ptr sz bits numObjects \<and>
|
||||
(0::word32) < of_nat numObjects \<and> 2 \<le> bits \<and> {ptr..ptr + of_nat numObjects * 2 ^ bits - 1} \<inter> range_of_arm_globals_frame s = {}) (create_word_objects ptr numObjects bits)"
|
||||
(0::word32) < of_nat numObjects \<and> 2 \<le> bits \<and> {ptr..ptr + of_nat numObjects * 2 ^ bits - 1} \<inter> range_of_arm_globals_frame s = {})
|
||||
(create_word_objects ptr numObjects bits dev)"
|
||||
apply(rule equiv_valid_guard_imp)
|
||||
apply(rule reads_respects_g)
|
||||
apply(rule create_word_objects_reads_respects)
|
||||
|
|
@ -603,7 +610,7 @@ lemma init_arch_objects_reads_respects_g:
|
|||
K (\<forall>x\<in>set refs. new_type = ArchObject PageDirectoryObj
|
||||
\<longrightarrow> is_aligned x pd_bits) and
|
||||
K ((0::word32) < of_nat num_objects))
|
||||
(init_arch_objects new_type ptr num_objects obj_sz refs)"
|
||||
(init_arch_objects new_type ptr num_objects obj_sz refs dev)"
|
||||
apply(unfold init_arch_objects_def fun_app_def)
|
||||
apply(rule gen_asm_ev)+
|
||||
apply(subst do_machine_op_mapM_x[OF empty_fail_cleanCacheRange_PoU])+
|
||||
|
|
@ -630,11 +637,11 @@ lemma init_arch_objects_globals_equiv:
|
|||
"\<lbrace> globals_equiv s and
|
||||
(\<lambda> s. arm_global_pd (arch_state s) \<notin> set refs \<and>
|
||||
pspace_aligned s \<and> valid_arch_state s) and
|
||||
word_object_range_cover_globals new_type ptr sz num_objects and
|
||||
word_object_range_cover_globals new_type ptr sz num_objects and
|
||||
K (\<forall>x\<in>set refs. new_type = ArchObject PageDirectoryObj
|
||||
\<longrightarrow> is_aligned x pd_bits) and
|
||||
K ((0::word32) < of_nat num_objects)\<rbrace>
|
||||
(init_arch_objects new_type ptr num_objects obj_sz refs)
|
||||
(init_arch_objects new_type ptr num_objects obj_sz refs dev)
|
||||
\<lbrace> \<lambda>_. globals_equiv s \<rbrace>"
|
||||
unfolding init_arch_objects_def fun_app_def
|
||||
apply(rule hoare_gen_asm)+
|
||||
|
|
@ -647,7 +654,8 @@ lemma init_arch_objects_globals_equiv:
|
|||
done
|
||||
|
||||
lemma create_cap_reads_respects_g:
|
||||
"reads_respects_g aag l (K (is_subject aag (fst (fst slot))) and valid_global_objs) (create_cap type bits untyped slot)"
|
||||
"reads_respects_g aag l (K (is_subject aag (fst (fst slot))) and valid_global_objs)
|
||||
(create_cap type bits untyped dev slot)"
|
||||
apply(rule equiv_valid_guard_imp[OF reads_respects_g])
|
||||
apply(rule create_cap_reads_respects)
|
||||
apply(rule doesnt_touch_globalsI[OF create_cap_globals_equiv])
|
||||
|
|
@ -655,8 +663,9 @@ lemma create_cap_reads_respects_g:
|
|||
|
||||
lemma default_object_not_asid_pool:
|
||||
"\<lbrakk>type \<noteq> ArchObject ASIDPoolObj; type \<noteq> Untyped\<rbrakk> \<Longrightarrow>
|
||||
\<not> default_object type o_bits = ArchObj (ASIDPool asid_pool)"
|
||||
apply(clarsimp simp: default_object_def split: apiobject_type.splits simp: default_arch_object_def split: aobject_type.splits)
|
||||
\<not> default_object type o_bits dev = ArchObj (ASIDPool asid_pool)"
|
||||
apply(clarsimp simp: default_object_def split: apiobject_type.splits
|
||||
simp: default_arch_object_def split: aobject_type.splits)
|
||||
done
|
||||
|
||||
lemma retype_region_ext_def2:
|
||||
|
|
@ -667,7 +676,7 @@ lemma retype_region_ext_def2:
|
|||
done
|
||||
|
||||
lemma retype_region_reads_respects:
|
||||
"reads_respects aag l \<top> (retype_region ptr num_objects o_bits type)"
|
||||
"reads_respects aag l \<top> (retype_region ptr num_objects o_bits type dev)"
|
||||
apply(simp only: retype_region_def retype_addrs_def
|
||||
foldr_upd_app_if fun_app_def K_bind_def when_def
|
||||
retype_region_ext_extended.dxo_eq
|
||||
|
|
@ -708,14 +717,14 @@ lemma retype_region_globals_equiv:
|
|||
Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
|
||||
shows
|
||||
"\<lbrace>globals_equiv s and
|
||||
(\<lambda>s. \<exists>idx. cte_wp_at (\<lambda>c. c = UntypedCap (ptr && ~~ mask sz) sz idx)
|
||||
(\<lambda>s. \<exists>idx. cte_wp_at (\<lambda>c. c = UntypedCap dev (ptr && ~~ mask sz) sz idx)
|
||||
slot s \<and>
|
||||
(idx \<le> unat (ptr && mask sz) \<or>
|
||||
pspace_no_overlap ptr sz s)) and
|
||||
invs and
|
||||
K (range_cover ptr sz (obj_bits_api type o_bits) num_objects) and
|
||||
K (0 < num_objects)\<rbrace>
|
||||
retype_region ptr num_objects o_bits type
|
||||
retype_region ptr num_objects o_bits type dev
|
||||
\<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
|
||||
apply(simp only: retype_region_def foldr_upd_app_if fun_app_def K_bind_def)
|
||||
apply (wp dxo_wp_weak |simp)+
|
||||
|
|
@ -784,14 +793,14 @@ lemma retype_region_globals_equiv:
|
|||
|
||||
lemma retype_region_reads_respects_g:
|
||||
"reads_respects_g aag l
|
||||
((\<lambda>s. \<exists>idx. cte_wp_at (\<lambda>c. c = UntypedCap (ptr && ~~ mask sz) sz idx)
|
||||
((\<lambda>s. \<exists>idx. cte_wp_at (\<lambda>c. c = UntypedCap dev (ptr && ~~ mask sz) sz idx)
|
||||
slot s \<and>
|
||||
(idx \<le> unat (ptr && mask sz) \<or>
|
||||
pspace_no_overlap ptr sz s)) and
|
||||
invs and
|
||||
K (range_cover ptr sz (obj_bits_api type o_bits) num_objects) and
|
||||
K (0 < num_objects))
|
||||
(retype_region ptr num_objects o_bits type)"
|
||||
(retype_region ptr num_objects o_bits type dev)"
|
||||
apply(rule equiv_valid_guard_imp[OF reads_respects_g[OF retype_region_reads_respects]])
|
||||
apply(rule doesnt_touch_globalsI)
|
||||
apply(rule hoare_weaken_pre[OF retype_region_globals_equiv])
|
||||
|
|
@ -868,15 +877,15 @@ lemma detype_reads_respects_g:
|
|||
done
|
||||
|
||||
lemma a_type_small_pageD:
|
||||
"a_type ko = AArch (AIntData ARMSmallPage) \<Longrightarrow>
|
||||
ko = ArchObj (DataPage ARMSmallPage)"
|
||||
"a_type ko = AArch (AUserData ARMSmallPage) \<Longrightarrow>
|
||||
ko = ArchObj (DataPage False ARMSmallPage)"
|
||||
apply (clarsimp simp: a_type_def
|
||||
split: Structures_A.kernel_object.splits
|
||||
arch_kernel_obj.splits split_if_asm)
|
||||
done
|
||||
|
||||
lemma obj_range_small_page_as_ptr_range:
|
||||
"obj_range ptr (ArchObj (DataPage ARMSmallPage)) =
|
||||
"obj_range ptr (ArchObj (DataPage dev ARMSmallPage)) =
|
||||
ptr_range ptr 12"
|
||||
apply(simp add: obj_range_def)
|
||||
apply(simp add: ptr_range_def)
|
||||
|
|
@ -884,7 +893,7 @@ lemma obj_range_small_page_as_ptr_range:
|
|||
|
||||
|
||||
lemma untyped_caps_do_not_overlap_global_refs:
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap word sz idx)) slot s;
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap dev word sz idx)) slot s;
|
||||
valid_global_refs s\<rbrakk> \<Longrightarrow>
|
||||
ptr_range word sz \<inter> global_refs s = {}"
|
||||
apply(simp add: cte_wp_at_caps_of_state)
|
||||
|
|
@ -892,8 +901,47 @@ lemma untyped_caps_do_not_overlap_global_refs:
|
|||
apply(fastforce simp: cap_range_def ptr_range_def)
|
||||
done
|
||||
|
||||
lemma singleton_set_size:
|
||||
"{ptr..(ptr::'a::len word) + 2 ^ 0 - 1} = {ptr}"
|
||||
by (simp add:field_simps)
|
||||
|
||||
lemma cap_range_of_valid_capD:
|
||||
"valid_cap cap s \<Longrightarrow> (cap_range cap = {}) \<or> (\<exists>ptr sz. (cap_range cap = ptr_range ptr sz))"
|
||||
apply (rule disj_subst)
|
||||
apply (case_tac cap,auto simp: valid_cap_def valid_untyped_def cap_aligned_def cap_range_def ptr_range_def)[1]
|
||||
apply (intro exI | rule singleton_set_size[symmetric])+
|
||||
done
|
||||
|
||||
(* FIX ME: Many ptr_range proofs are not nice, should use the following lemma instead *)
|
||||
lemma ptr_range_disjoint_strong:
|
||||
"\<lbrakk>ptr' \<notin> ptr_range (ptr :: ('a :: len word)) sz; is_aligned ptr sz; is_aligned ptr' sz';
|
||||
sz < len_of TYPE('a); sz'\<le> sz \<rbrakk>
|
||||
\<Longrightarrow> ptr_range ptr sz \<inter> ptr_range ptr' sz' = {}"
|
||||
apply (unfold ptr_range_def)
|
||||
apply (frule(1) aligned_ranges_subset_or_disjoint[where p'=ptr'])
|
||||
apply (elim disjE)
|
||||
apply simp
|
||||
apply clarsimp
|
||||
apply (drule order_trans[where x = ptr and y = "ptr + a - b" for a b])
|
||||
apply simp
|
||||
apply (drule neg_mask_mono_le[where n = sz'])
|
||||
apply (subst (asm) is_aligned_neg_mask_eq)
|
||||
apply (erule is_aligned_weaken)
|
||||
apply simp
|
||||
apply (subst(asm) x_t2n_sub_1_neg_mask)
|
||||
apply simp
|
||||
apply simp
|
||||
apply (subst (asm) is_aligned_neg_mask_eq)
|
||||
apply (erule is_aligned_weaken)
|
||||
apply simp
|
||||
apply simp
|
||||
apply (drule base_member_set[where sz = sz'],simp)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
|
||||
lemma untyped_caps_do_not_overlap_arm_globals_frame:
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap word sz idx)) slot s; valid_objs s;
|
||||
"\<lbrakk>cte_wp_at (op = (UntypedCap dev word sz idx)) slot s; valid_objs s;
|
||||
valid_arch_state s; valid_global_refs s\<rbrakk> \<Longrightarrow>
|
||||
ptr_range word sz \<inter> range_of_arm_globals_frame s = {}"
|
||||
apply(frule (1) cte_wp_at_valid_objs_valid_cap)
|
||||
|
|
@ -901,12 +949,12 @@ lemma untyped_caps_do_not_overlap_arm_globals_frame:
|
|||
apply(clarsimp simp: valid_arch_state_def)
|
||||
apply(clarsimp simp: obj_at_def)
|
||||
apply(drule_tac x="arm_globals_frame (arch_state s)" in spec)
|
||||
apply(drule_tac x="ArchObj (DataPage ARMSmallPage)" in spec)
|
||||
apply(drule_tac x="ArchObj (DataPage False ARMSmallPage)" in spec)
|
||||
apply(fold ptr_range_def)+
|
||||
apply(subst(asm) obj_range_small_page_as_ptr_range)+
|
||||
apply(simp add: cte_wp_at_caps_of_state)
|
||||
apply(drule (1) valid_global_refsD2)
|
||||
apply(fold ptr_range_def)
|
||||
apply(clarsimp simp: cap_range_def, fold ptr_range_def)
|
||||
apply(simp add: obj_range_small_page_as_ptr_range)
|
||||
apply(rule ccontr)
|
||||
apply(simp add: Int_ac)
|
||||
apply(clarsimp simp: global_refs_def)
|
||||
|
|
@ -914,7 +962,7 @@ lemma untyped_caps_do_not_overlap_arm_globals_frame:
|
|||
done
|
||||
|
||||
lemma obj_range_page_as_ptr_range_pageBitsForSize:
|
||||
"obj_range ptr (ArchObj (DataPage vmpage_size)) =
|
||||
"obj_range ptr (ArchObj (DataPage dev vmpage_size)) =
|
||||
ptr_range ptr (pageBitsForSize vmpage_size)"
|
||||
apply(simp add: obj_range_def)
|
||||
apply(simp add: ptr_range_def)
|
||||
|
|
@ -928,7 +976,7 @@ lemma pspace_distinct_def':
|
|||
by(auto simp: pspace_distinct_def obj_range_def field_simps)
|
||||
|
||||
lemma page_caps_do_not_overlap_arm_globals_frame:
|
||||
"\<lbrakk>cte_wp_at (op = (ArchObjectCap (PageCap word fun vmpage_size option))) slot s; valid_objs s;
|
||||
"\<lbrakk>cte_wp_at (op = (ArchObjectCap (PageCap dev word fun vmpage_size option))) slot s; valid_objs s;
|
||||
valid_arch_state s; valid_global_refs s; pspace_distinct s\<rbrakk> \<Longrightarrow>
|
||||
ptr_range word (pageBitsForSize vmpage_size) \<inter> range_of_arm_globals_frame s = {}"
|
||||
apply(frule (1) cte_wp_at_valid_objs_valid_cap)
|
||||
|
|
@ -939,9 +987,9 @@ lemma page_caps_do_not_overlap_arm_globals_frame:
|
|||
apply(rule ccontr)
|
||||
apply(drule_tac x=word in spec)
|
||||
apply(drule_tac x="arm_globals_frame (arch_state s)" in spec)
|
||||
apply(clarsimp simp: valid_arch_state_def obj_at_def global_refs_def)
|
||||
apply(simp add: obj_range_small_page_as_ptr_range)
|
||||
apply(simp add: obj_range_page_as_ptr_range_pageBitsForSize)
|
||||
apply(clarsimp simp: valid_arch_state_def obj_at_def global_refs_def split:if_splits)
|
||||
apply(simp add: obj_range_small_page_as_ptr_range
|
||||
obj_range_page_as_ptr_range_pageBitsForSize)+
|
||||
done
|
||||
|
||||
lemma delete_objects_reads_respects_g:
|
||||
|
|
@ -991,9 +1039,10 @@ lemma set_free_index_invs':
|
|||
(descendants_range_in {word1..word1 + 2 ^ sz - 1} slot s \<and>
|
||||
pspace_no_overlap word1 sz s)) \<and>
|
||||
idx' \<le> 2 ^ sz \<and>
|
||||
is_untyped_cap cap) and K(word1 = obj_ref_of cap \<and> sz = bits_of cap)\<rbrace>
|
||||
is_untyped_cap cap) and
|
||||
K(word1 = obj_ref_of cap \<and> sz = bits_of cap \<and> dev = cap_is_device cap)\<rbrace>
|
||||
set_cap
|
||||
(UntypedCap word1 sz idx')
|
||||
(UntypedCap dev word1 sz idx')
|
||||
slot
|
||||
\<lbrace>\<lambda>_. invs \<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
|
|
@ -1016,7 +1065,10 @@ lemma when_ev:
|
|||
|
||||
|
||||
lemma delete_objects_caps_no_overlap:
|
||||
"\<lbrace> invs and ct_active and (\<lambda> s. \<exists> slot idx. cte_wp_at (op = (UntypedCap ptr sz idx)) slot s \<and> descendants_range_in {ptr..ptr + 2 ^ sz - 1} slot s) \<rbrace> delete_objects ptr sz \<lbrace>\<lambda>_. caps_no_overlap ptr sz\<rbrace>"
|
||||
"\<lbrace> invs and ct_active and (\<lambda> s. \<exists> slot idx.
|
||||
cte_wp_at (op = (UntypedCap dev ptr sz idx)) slot s \<and> descendants_range_in {ptr..ptr + 2 ^ sz - 1} slot s) \<rbrace>
|
||||
delete_objects ptr sz
|
||||
\<lbrace>\<lambda>_. caps_no_overlap ptr sz\<rbrace>"
|
||||
apply(clarsimp simp: valid_def)
|
||||
apply(rule descendants_range_caps_no_overlapI)
|
||||
apply(erule use_valid | wp | simp add: descendants_range_def2 | blast)+
|
||||
|
|
@ -1043,7 +1095,7 @@ lemma word_object_range_cover_globalsI:
|
|||
notes blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
|
||||
shows
|
||||
"\<lbrakk>range_cover ptr sz (obj_bits_api new_type us) num_objects;
|
||||
cte_wp_at (op = (UntypedCap (ptr && ~~ mask sz) sz idx)) slot s; invs s;
|
||||
cte_wp_at (op = (UntypedCap dev (ptr && ~~ mask sz) sz idx)) slot s; invs s;
|
||||
num_objects \<noteq> 0\<rbrakk> \<Longrightarrow>
|
||||
word_object_range_cover_globals new_type ptr sz num_objects s"
|
||||
apply(clarsimp simp: word_object_range_cover_globals_def obj_bits_api_def word_object_size_def default_arch_object_def)
|
||||
|
|
@ -1071,7 +1123,7 @@ lemma invoke_untyped_reads_respects_g:
|
|||
shows
|
||||
"reads_respects_g aag l (invs and valid_untyped_inv ui and ct_active and authorised_untyped_inv_state aag ui and K (authorised_untyped_inv aag ui)) (invoke_untyped ui)"
|
||||
apply(case_tac ui)
|
||||
apply(rename_tac cslot_ptr word1 word2 apiobject_type nat list)
|
||||
apply(rename_tac cslot_ptr word1 word2 apiobject_type nat list dev)
|
||||
apply(simp add: mapM_x_def[symmetric])
|
||||
apply(wp mapM_x_ev'' create_cap_reads_respects_g hoare_vcg_ball_lift
|
||||
create_cap_valid_global_objs init_arch_objects_reads_respects_g
|
||||
|
|
@ -1094,7 +1146,7 @@ lemma invoke_untyped_reads_respects_g:
|
|||
retype_region_global_refs_disjoint
|
||||
retype_region_ret_pd_aligned
|
||||
retype_region_aligned_for_init
|
||||
retype_region_post_retype_invs)
|
||||
retype_region_post_retype_invs_spec)
|
||||
apply(fastforce simp: global_refs_def
|
||||
intro: post_retype_invs_pspace_alignedI
|
||||
post_retype_invs_valid_arch_stateI
|
||||
|
|
@ -1107,7 +1159,7 @@ lemma invoke_untyped_reads_respects_g:
|
|||
apply(rule_tac Q="\<lambda>rvb s.
|
||||
(\<exists>idx. cte_wp_at
|
||||
(\<lambda>c. c =
|
||||
UntypedCap
|
||||
UntypedCap dev
|
||||
(word2 &&
|
||||
~~ mask
|
||||
(bits_of rv))
|
||||
|
|
@ -1168,10 +1220,7 @@ region_in_kernel_window
|
|||
set_cap_caps_no_overlap
|
||||
region_in_kernel_window_preserved)
|
||||
apply clarsimp
|
||||
apply(rule conjI)
|
||||
apply(rule_tac x=idx in exI)
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply(intro conjI,(fastforce simp:cte_wp_at_caps_of_state)+)[1]
|
||||
apply(wp when_ev delete_objects_reads_respects_g hoare_vcg_disj_lift
|
||||
delete_objects_pspace_no_overlap
|
||||
delete_objects_descendants_range_in
|
||||
|
|
@ -1222,7 +1271,7 @@ region_in_kernel_window
|
|||
apply fastforce
|
||||
apply(fastforce dest: range_cover_subset')
|
||||
apply(subgoal_tac "usable_untyped_range
|
||||
(UntypedCap (word2 && ~~ mask sz) sz
|
||||
(UntypedCap dev (word2 && ~~ mask sz) sz
|
||||
(unat
|
||||
((word2 && mask sz) + of_nat (length list) * 2 ^ obj_bits_api apiobject_type nat))) \<inter>
|
||||
{word2..word2 +
|
||||
|
|
@ -1252,7 +1301,7 @@ region_in_kernel_window
|
|||
apply(simp add: range_cover.range_cover_compare_bound[simplified add.commute])
|
||||
apply(simp add: bits_of_UntypedCap)+
|
||||
apply(fastforce intro!: word_object_range_cover_globalsI)
|
||||
apply(drule_tac x="UntypedCap (word2 && ~~ mask sz) sz idx" in spec)
|
||||
apply(drule_tac x="UntypedCap dev (word2 && ~~ mask sz) sz idx" in spec)
|
||||
apply(clarsimp simp: ptr_range_def p_assoc_help bits_of_UntypedCap)
|
||||
apply(erule_tac A="{word2 && ~~ mask sz..b}" for b in bspec)
|
||||
apply(erule subsetD[rotated])
|
||||
|
|
@ -1299,7 +1348,7 @@ lemma delete_objects_globals_equiv[wp]:
|
|||
apply (clarsimp simp: ptr_range_def)+
|
||||
done
|
||||
|
||||
fun slots_of_untyped_inv where "slots_of_untyped_inv (Retype _ _ _ _ _ slots ) = slots"
|
||||
fun slots_of_untyped_inv where "slots_of_untyped_inv (Retype _ _ _ _ _ slots _) = slots"
|
||||
|
||||
lemma invoke_untyped_globals_equiv:
|
||||
notes blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
|
||||
|
|
@ -1311,7 +1360,7 @@ lemma invoke_untyped_globals_equiv:
|
|||
\<lbrace> \<lambda>_. globals_equiv st \<rbrace>"
|
||||
apply(rule hoare_gen_asm)
|
||||
apply(case_tac ui)
|
||||
apply(rename_tac cslot_ptr word1 word2 apiobject_type nat list)
|
||||
apply(rename_tac cslot_ptr word1 word2 apiobject_type nat list dev)
|
||||
apply(simp add: mapM_x_def[symmetric])
|
||||
apply(wp)
|
||||
apply(rule_tac Q="\<lambda>_. globals_equiv st and valid_global_objs" in hoare_strengthen_post)
|
||||
|
|
@ -1319,22 +1368,22 @@ lemma invoke_untyped_globals_equiv:
|
|||
apply(rule_tac Q="\<lambda>_. globals_equiv st and invs" in hoare_strengthen_post)
|
||||
apply(wp init_arch_objects_globals_equiv init_arch_objects_invs_from_restricted)
|
||||
apply(fastforce simp: invs_def)
|
||||
apply(rule_tac Q="\<lambda> rva s. globals_equiv st s \<and>
|
||||
word_object_range_cover_globals apiobject_type word2
|
||||
sz
|
||||
apply(rule_tac Q="\<lambda> rva s. globals_equiv st s \<and> word_object_range_cover_globals apiobject_type word2 sz
|
||||
(length list) s \<and>
|
||||
((0::word32) < of_nat (length list)) \<and>
|
||||
(\<forall>x\<in>set rva. is_aligned x (obj_bits_api apiobject_type nat)) \<and>
|
||||
(post_retype_invs apiobject_type rva s) \<and>
|
||||
(global_refs s \<inter> set rva = {})" for sz in hoare_strengthen_post)
|
||||
apply(wp retype_region_ret_is_subject[simplified] retype_region_global_refs_disjoint retype_region_ret_pd_aligned retype_region_aligned_for_init retype_region_post_retype_invs retype_region_globals_equiv[where slot="slot_of_untyped_inv ui"] word_object_range_cover_globals_inv)[1]
|
||||
apply(wp retype_region_ret_is_subject[simplified] retype_region_global_refs_disjoint
|
||||
retype_region_ret_pd_aligned retype_region_aligned_for_init retype_region_post_retype_invs_spec
|
||||
retype_region_globals_equiv[where slot="slot_of_untyped_inv ui"] word_object_range_cover_globals_inv)[1]
|
||||
apply(auto simp: global_refs_def simp: obj_bits_api_def default_arch_object_def pd_bits_def pageBits_def post_retype_invs_def)[1]
|
||||
apply (fold ptr_range_def, simp)
|
||||
apply(rule_tac
|
||||
Q="\<lambda>ya s. globals_equiv st s \<and>
|
||||
(\<exists>idx. cte_wp_at
|
||||
(\<lambda>c. c =
|
||||
UntypedCap
|
||||
UntypedCap dev
|
||||
(word2 &&
|
||||
~~ mask
|
||||
(bits_of cap))
|
||||
|
|
@ -1388,7 +1437,8 @@ word_object_range_cover_globals apiobject_type word2
|
|||
word_object_range_cover_globals_inv set_cap_caps_no_overlap
|
||||
set_untyped_cap_caps_overlap_reserved
|
||||
region_in_kernel_window_preserved)
|
||||
apply fastforce
|
||||
apply clarsimp
|
||||
apply(intro conjI,(fastforce simp:cte_wp_at_caps_of_state)+)[1]
|
||||
apply(wp hoare_vcg_ex_lift hoare_vcg_disj_lift
|
||||
delete_objects_pspace_no_overlap delete_objects_descendants_range_in
|
||||
word_object_range_cover_globals_inv delete_objects_caps_no_overlap
|
||||
|
|
@ -1401,29 +1451,30 @@ word_object_range_cover_globals apiobject_type word2
|
|||
apply(split split_if)
|
||||
apply(intro impI conjI)
|
||||
apply(simp_all add: invs_psp_aligned invs_valid_objs cte_wp_cte_at bits_of_UntypedCap)
|
||||
apply(clarsimp simp: valid_cap_def cap_aligned_def)
|
||||
apply(rule conjI)
|
||||
apply (erule untyped_caps_do_not_overlap_arm_globals_frame, (simp add: invs_valid_objs invs_arch_state invs_valid_global_refs)+)
|
||||
apply(fastforce dest!: untyped_caps_do_not_overlap_global_refs simp: invs_valid_global_refs ptr_range_def global_refs_def)
|
||||
apply(clarsimp simp: descendants_range_def2 blah)
|
||||
apply(rule ssubst[OF free_index_of_UntypedCap])
|
||||
apply(fastforce simp: ptr_range_def)
|
||||
apply(fastforce dest!: untyped_slots_not_in_untyped_range[OF _ _ _ _ _ subset_refl] simp: blah ptr_range_def)
|
||||
apply(fastforce intro!: disjI2)
|
||||
apply(clarsimp simp: descendants_range_def2 blah)
|
||||
apply(rule ssubst[OF free_index_of_UntypedCap])
|
||||
apply(fastforce simp: ptr_range_def)
|
||||
apply(fastforce dest!: untyped_slots_not_in_untyped_range[OF _ _ _ _ _ subset_refl] simp: blah ptr_range_def)
|
||||
apply(fastforce intro!: disjI2 simp:ptr_range_def)
|
||||
apply(frule range_cover.range_cover_compare_bound)
|
||||
apply(frule range_cover.unat_of_nat_n)
|
||||
apply(simp add: shiftl_t2n)
|
||||
apply(subst unat_mult_power_lem)
|
||||
apply(erule range_cover.string)
|
||||
apply(simp add: mult.commute)
|
||||
apply(fastforce intro!: word_object_range_cover_globalsI)
|
||||
apply(fastforce simp: ptr_range_def bits_of_UntypedCap p_assoc_help)
|
||||
apply(fastforce simp: bits_of_UntypedCap)
|
||||
apply(clarsimp simp: valid_cap_def cap_aligned_def)
|
||||
apply(rule conjI)
|
||||
apply (erule untyped_caps_do_not_overlap_arm_globals_frame, (simp add: invs_valid_objs invs_arch_state invs_valid_global_refs)+)
|
||||
apply(fastforce dest!: untyped_caps_do_not_overlap_global_refs simp: invs_valid_global_refs ptr_range_def global_refs_def)
|
||||
apply(clarsimp simp: descendants_range_def2 blah)
|
||||
apply(rule ssubst[OF free_index_of_UntypedCap])
|
||||
apply(fastforce simp: ptr_range_def)
|
||||
apply(fastforce dest!: untyped_slots_not_in_untyped_range[OF _ _ _ _ _ subset_refl] simp: blah ptr_range_def)
|
||||
apply(fastforce intro!: disjI2)
|
||||
apply(clarsimp simp: descendants_range_def2 blah)
|
||||
apply(rule ssubst[OF free_index_of_UntypedCap])
|
||||
apply(fastforce simp: ptr_range_def)
|
||||
apply(fastforce dest!: untyped_slots_not_in_untyped_range[OF _ _ _ _ _ subset_refl] simp: blah ptr_range_def)
|
||||
apply(fastforce intro!: disjI2 simp:ptr_range_def)
|
||||
apply(frule range_cover.range_cover_compare_bound)
|
||||
apply(frule range_cover.unat_of_nat_n)
|
||||
apply(simp add: shiftl_t2n)
|
||||
apply(subst unat_mult_power_lem)
|
||||
apply(erule range_cover.string)
|
||||
apply(simp add: mult.commute)
|
||||
apply(fastforce intro!: word_object_range_cover_globalsI)
|
||||
apply(fastforce simp: ptr_range_def bits_of_UntypedCap p_assoc_help)
|
||||
apply(fastforce simp: bits_of_UntypedCap)
|
||||
apply simp
|
||||
apply(fastforce intro!: word_object_range_cover_globalsI)
|
||||
apply(fastforce simp: cte_wp_at_def blah)
|
||||
apply(fastforce dest!: untyped_slots_not_in_untyped_range[OF _ _ _ _ _ subset_refl] simp: blah ptr_range_def)
|
||||
|
|
@ -1434,7 +1485,7 @@ word_object_range_cover_globals apiobject_type word2
|
|||
apply(fastforce simp: ptr_range_def)
|
||||
apply(fastforce dest: range_cover_subset')
|
||||
apply(subgoal_tac "usable_untyped_range
|
||||
(UntypedCap (word2 && ~~ mask sz) sz
|
||||
(UntypedCap dev (word2 && ~~ mask sz) sz
|
||||
(unat
|
||||
((word2 && mask sz) + of_nat (length list) * 2 ^ obj_bits_api apiobject_type nat))) \<inter>
|
||||
{word2..word2 +
|
||||
|
|
|
|||
|
|
@ -24,12 +24,15 @@ abbreviation scheduler_affects_globals_frame where
|
|||
definition globals_equiv_scheduler :: "'z::state_ext state \<Rightarrow> 'z::state_ext state \<Rightarrow> bool" where
|
||||
"globals_equiv_scheduler s s' \<equiv> arm_globals_frame (arch_state s) = arm_globals_frame (arch_state s') \<and>
|
||||
arm_global_pd (arch_state s) = arm_global_pd (arch_state s') \<and>
|
||||
(\<forall>x\<in>range_of_arm_globals_frame s - scheduler_affects_globals_frame s. underlying_memory (machine_state s) x = underlying_memory (machine_state s') x) \<and>
|
||||
(\<forall>x\<in>range_of_arm_globals_frame s - scheduler_affects_globals_frame s.
|
||||
underlying_memory (machine_state s) x = underlying_memory (machine_state s') x) \<and>
|
||||
kheap s (arm_global_pd (arch_state s)) = kheap s' (arm_global_pd (arch_state s))
|
||||
\<and> idle_equiv s s'"
|
||||
\<and> idle_equiv s s' \<and> device_region s = device_region s'"
|
||||
|
||||
definition scheduler_globals_frame_equiv :: "'z::state_ext state \<Rightarrow> 'z::state_ext state \<Rightarrow> bool" where
|
||||
"scheduler_globals_frame_equiv s s' \<equiv> arm_globals_frame (arch_state s) = arm_globals_frame (arch_state s') \<and> (\<forall>x\<in>scheduler_affects_globals_frame s. underlying_memory (machine_state s) x = underlying_memory (machine_state s') x)"
|
||||
"scheduler_globals_frame_equiv s s' \<equiv> arm_globals_frame (arch_state s) = arm_globals_frame (arch_state s')
|
||||
\<and> (\<forall>x\<in>scheduler_affects_globals_frame s. underlying_memory (machine_state s) x = underlying_memory (machine_state s') x
|
||||
\<and> device_state (machine_state s) x = device_state (machine_state s') x)"
|
||||
|
||||
definition domain_fields_equiv :: "det_ext state \<Rightarrow> det_ext state \<Rightarrow> bool"
|
||||
where
|
||||
|
|
@ -275,7 +278,7 @@ lemma idle_equiv_cur_thread_update'[simp]: "idle_equiv (st\<lparr>cur_thread :=
|
|||
done
|
||||
|
||||
lemma globals_equiv_scheduler_inv':
|
||||
"(\<And>st. \<lbrace> P and globals_equiv st\<rbrace> f \<lbrace>\<lambda>_. globals_equiv st\<rbrace>) \<Longrightarrow>
|
||||
"\<lbrakk>(\<And>st. \<lbrace> P and globals_equiv st\<rbrace> f \<lbrace>\<lambda>_. globals_equiv st\<rbrace>)\<rbrakk> \<Longrightarrow>
|
||||
\<lbrace> P and globals_equiv_scheduler s\<rbrace> f \<lbrace>\<lambda>_. globals_equiv_scheduler s\<rbrace>"
|
||||
apply atomize
|
||||
apply (rule use_spec)
|
||||
|
|
@ -513,17 +516,25 @@ lemma globals_equiv_scheduler_update:
|
|||
done
|
||||
|
||||
lemma dmo_no_mem_globals_equiv_scheduler:
|
||||
"(\<And>P. invariant f (\<lambda>ms. P (underlying_memory ms))) \<Longrightarrow>
|
||||
invariant (do_machine_op f) (globals_equiv_scheduler s)"
|
||||
assumes a: "(\<And>P. invariant f (\<lambda>ms. P (underlying_memory ms)))"
|
||||
and b: "(\<And>P. invariant f (\<lambda>ms. P (device_state ms)))"
|
||||
shows "invariant (do_machine_op f) (globals_equiv_scheduler s)"
|
||||
unfolding do_machine_op_def
|
||||
apply(wp | simp add: split_def)+
|
||||
apply(fastforce simp: valid_def globals_equiv_scheduler_def idle_equiv_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp | simp add: split_def)+
|
||||
apply clarsimp
|
||||
apply (frule_tac P1 = "\<lambda>um. um = underlying_memory (machine_state sa)" in use_valid[OF _ a])
|
||||
apply simp
|
||||
apply (frule_tac P1 = "\<lambda>um. um = device_state (machine_state sa)" in use_valid[OF _ b])
|
||||
apply simp
|
||||
apply (fastforce simp: valid_def globals_equiv_scheduler_def idle_equiv_def)
|
||||
done
|
||||
|
||||
lemma clearExMonitor_globals_equiv_scheduler[wp]: "\<lbrace> globals_equiv_scheduler sta \<rbrace> do_machine_op clearExMonitor \<lbrace> \<lambda>_. globals_equiv_scheduler sta \<rbrace>"
|
||||
unfolding clearExMonitor_def
|
||||
apply (wp dmo_no_mem_globals_equiv_scheduler)
|
||||
apply simp
|
||||
apply simp
|
||||
apply (simp add:simpler_modify_def valid_def)
|
||||
done
|
||||
|
||||
lemma arch_switch_to_thread_globals_equiv_scheduler:
|
||||
|
|
@ -597,6 +608,36 @@ lemma range_is_globals_frame': "\<lbrakk>valid_arch_state s; pspace_aligned s\<r
|
|||
apply uint_arith
|
||||
done
|
||||
|
||||
lemma scheduler_equiv_invs_device_state_equiv:
|
||||
"\<lbrakk>scheduler_equiv aag s t; invs s; invs t\<rbrakk> \<Longrightarrow>\<forall>x\<in> range_of_arm_globals_frame s.
|
||||
device_state (machine_state s) x = device_state (machine_state t) x"
|
||||
apply (clarsimp simp:scheduler_equiv_def globals_equiv_scheduler_def)
|
||||
apply (drule(1) globals_frame_not_device[rotated])
|
||||
apply (drule globals_frame_not_device[rotated])
|
||||
apply fastforce
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma scheduler_affects_in_globals_frame:
|
||||
"\<lbrakk>valid_arch_state s;pspace_aligned s\<rbrakk> \<Longrightarrow> scheduler_affects_globals_frame s \<subseteq> range_of_arm_globals_frame s"
|
||||
apply (clarsimp simp:ptr_range_def)
|
||||
apply (drule(1) arm_globals_frame_aligned)
|
||||
apply (clarsimp simp:field_simps)
|
||||
apply (rule word_plus_mono_right)
|
||||
apply simp
|
||||
apply (simp add:is_aligned_no_wrap')
|
||||
done
|
||||
|
||||
lemma scheduler_equiv_scheduler_affects_globals_frame_equiv:
|
||||
"\<lbrakk>scheduler_equiv aag s t; invs s; invs t\<rbrakk> \<Longrightarrow>\<forall>x\<in> scheduler_affects_globals_frame s.
|
||||
device_state (machine_state s) x = device_state (machine_state t) x"
|
||||
apply clarsimp
|
||||
apply (drule subsetD[rotated,OF _ scheduler_affects_in_globals_frame])
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply (clarsimp simp:scheduler_equiv_invs_device_state_equiv)
|
||||
done
|
||||
|
||||
lemma store_cur_thread_midstrength_reads_respects: "equiv_valid (scheduler_equiv aag) (midstrength_scheduler_affects_equiv aag l)
|
||||
(scheduler_affects_equiv aag l) (invs and (\<lambda>s. rva = arm_globals_frame (arch_state s)) and (\<lambda>s. t = idle_thread s))
|
||||
(do y \<leftarrow> do_machine_op (storeWord rva rvb);
|
||||
|
|
@ -610,6 +651,7 @@ lemma store_cur_thread_midstrength_reads_respects: "equiv_valid (scheduler_equiv
|
|||
apply (fold simpler_modify_def)
|
||||
apply (intro impI conjI)
|
||||
apply (rule ev_modify)
|
||||
apply (frule scheduler_equiv_scheduler_affects_globals_frame_equiv,simp+)
|
||||
apply (clarsimp simp: scheduler_equiv_def domain_fields_equiv_def
|
||||
globals_equiv_scheduler_def)
|
||||
apply (clarsimp simp add: scheduler_affects_equiv_def states_equiv_for_def
|
||||
|
|
@ -617,7 +659,8 @@ lemma store_cur_thread_midstrength_reads_respects: "equiv_valid (scheduler_equiv
|
|||
scheduler_globals_frame_equiv_def silc_dom_equiv_def
|
||||
weak_scheduler_affects_equiv_def midstrength_scheduler_affects_equiv_def
|
||||
idle_equiv_def)
|
||||
apply (drule range_is_globals_frame'[rotated -1], clarsimp+)
|
||||
apply (frule range_is_globals_frame'[rotated -1])
|
||||
apply fastforce+
|
||||
apply (simp add: equiv_valid_def2 equiv_valid_2_def)
|
||||
done
|
||||
|
||||
|
|
@ -918,6 +961,7 @@ lemma ev_midstrength_to_asahi_dmo_storeWord: "equiv_valid (scheduler_equiv aag)
|
|||
apply (fold simpler_modify_def)
|
||||
apply (intro impI conjI)
|
||||
apply (rule ev_modify)
|
||||
apply (frule scheduler_equiv_scheduler_affects_globals_frame_equiv,simp+)
|
||||
apply (clarsimp simp: scheduler_equiv_def domain_fields_equiv_def
|
||||
globals_equiv_scheduler_def)
|
||||
apply (clarsimp simp add: scheduler_affects_equiv_def states_equiv_for_def
|
||||
|
|
@ -927,7 +971,8 @@ lemma ev_midstrength_to_asahi_dmo_storeWord: "equiv_valid (scheduler_equiv aag)
|
|||
asahi_scheduler_affects_equiv_def idle_equiv_def)
|
||||
apply (subgoal_tac "pspace_aligned t" "valid_arch_state t")
|
||||
apply (frule(2) range_is_globals_frame')
|
||||
apply simp
|
||||
apply fastforce
|
||||
apply clarsimp
|
||||
apply ((simp add: invs_def valid_state_def valid_pspace_def)+)[2]
|
||||
apply (simp add: equiv_valid_def2 equiv_valid_2_def)
|
||||
done
|
||||
|
|
@ -2103,6 +2148,10 @@ lemma dmo_resetTimer_arch_state[wp]: "\<lbrace>\<lambda>s. P(arch_state s)\<rbra
|
|||
apply (wp dmo_wp | simp)+
|
||||
done
|
||||
|
||||
lemma dmo_resetTimer_device_state[wp]: "\<lbrace>\<lambda>s. P( device_state (machine_state s))\<rbrace> do_machine_op resetTimer \<lbrace>\<lambda>r s. P (device_state (machine_state s))\<rbrace>"
|
||||
apply (wp dmo_wp | simp)+
|
||||
done
|
||||
|
||||
lemma dmo_resetTimer_exclusive_state[wp]: "\<lbrace>\<lambda>s. P (exclusive_state (machine_state s))\<rbrace> do_machine_op resetTimer \<lbrace>\<lambda>r s. P (exclusive_state (machine_state s))\<rbrace>"
|
||||
apply (wp dmo_mol_exclusive_state | simp add: resetTimer_def)+
|
||||
done
|
||||
|
|
@ -2121,8 +2170,7 @@ lemma dmo_resetTimer_reads_respects_scheduler:
|
|||
apply (simp add: states_equiv_for_def[abs_def] equiv_for_def equiv_asids_def
|
||||
equiv_asid_def)
|
||||
apply (rule hoare_pre)
|
||||
apply wps
|
||||
apply (wp | simp)+
|
||||
apply (wp | simp | wp dmo_wp)+
|
||||
done
|
||||
|
||||
lemma irq_inactive_or_timer: "\<lbrace>domain_sep_inv False st and Q IRQTimer and Q IRQInactive\<rbrace> get_irq_state irq \<lbrace>Q\<rbrace>"
|
||||
|
|
|
|||
|
|
@ -19,6 +19,15 @@ begin
|
|||
|
||||
crunch_ignore (add: OR_choice set_scheduler_action)
|
||||
|
||||
(* FIXME: move *)
|
||||
lemma globals_frame_not_device:
|
||||
"\<lbrakk>x\<in>range_of_arm_globals_frame s;invs s\<rbrakk> \<Longrightarrow> device_state (machine_state s) x = None"
|
||||
apply (clarsimp simp:invs_def valid_state_def valid_arch_state_def obj_at_def)
|
||||
apply (drule pspace_respects_device_regionD[rotated -1])
|
||||
apply fastforce+
|
||||
apply (clarsimp simp:obj_range_page_as_ptr_range_pageBitsForSize)
|
||||
apply fastforce
|
||||
done
|
||||
(* The contents of the delete_globals_equiv locale *)
|
||||
|
||||
lemma globals_equiv_irq_state_update[simp]:
|
||||
|
|
@ -790,7 +799,7 @@ lemma handle_recv_reads_respects_f:
|
|||
\<and> (pasSubject aag, Receive, pasObjectAbs aag x31) \<in> pasPolicy aag"
|
||||
in hoare_strengthen_post)
|
||||
apply(wp mywp | wpc | assumption | simp |
|
||||
clarsimp simp: invs_valid_objs invs_sym_refs invs_distinct
|
||||
clarsimp simp: invs_valid_objs invs_sym_refs invs_distinct invs_psp_aligned
|
||||
invs_valid_global_refs invs_arch_state)+
|
||||
apply (rule_tac Q'="\<lambda>r s.
|
||||
silc_inv aag st s \<and> einvs s \<and> pas_refined aag s \<and>
|
||||
|
|
|
|||
|
|
@ -47,7 +47,11 @@ definition getExMonitor :: "exclusive_monitors machine_monad" where
|
|||
definition setExMonitor :: "exclusive_monitors \<Rightarrow> unit machine_monad" where
|
||||
"setExMonitor es \<equiv> modify (\<lambda>ms. ms\<lparr>exclusive_state := es\<rparr>)"
|
||||
|
||||
definition do_user_op_if where
|
||||
definition
|
||||
"compl (A::'a set) \<equiv> - A"
|
||||
|
||||
definition do_user_op_if
|
||||
where
|
||||
"do_user_op_if uop tc =
|
||||
do
|
||||
(* Get the page rights of each address (ReadOnly, ReadWrite, None, etc). *)
|
||||
|
|
@ -59,6 +63,9 @@ definition do_user_op_if where
|
|||
(* Get the mapping from virtual to physical addresses. *)
|
||||
pl \<leftarrow> gets (\<lambda>s. restrict_map (ptable_lift_s s) {x. pr x \<noteq> {}});
|
||||
|
||||
allow_read \<leftarrow> return {y. EX x. pl x = Some y \<and> AllowRead \<in> pr x};
|
||||
allow_write \<leftarrow> return {y. EX x. pl x = Some y \<and> AllowWrite \<in> pr x};
|
||||
|
||||
(* Get the current thread. *)
|
||||
t \<leftarrow> gets cur_thread;
|
||||
|
||||
|
|
@ -66,24 +73,26 @@ definition do_user_op_if where
|
|||
* memory that the user doesn't have access to. (The user must
|
||||
* have both (1) a mapping to the page; (2) that mapping has the
|
||||
* AllowRead right. *)
|
||||
um \<leftarrow> gets (\<lambda>s. restrict_map (user_mem s \<circ> ptrFromPAddr)
|
||||
{y. EX x. pl x = Some y \<and> AllowRead \<in> pr x});
|
||||
um \<leftarrow> gets (\<lambda>s. (user_mem s) \<circ> ptrFromPAddr);
|
||||
dm \<leftarrow> gets (\<lambda>s. (device_mem s) \<circ> ptrFromPAddr);
|
||||
ds \<leftarrow> gets (device_state \<circ> machine_state);
|
||||
|
||||
(* Fetch exclusive monitor state, used for ARM atomic instructions. *)
|
||||
es \<leftarrow> do_machine_op getExMonitor;
|
||||
|
||||
(* Non-deterministically execute one of the user's operations. *)
|
||||
u \<leftarrow> return (uop t pl pr pxn (tc, um, es));
|
||||
u \<leftarrow> return (uop t pl pr pxn (tc, um|`allow_read, (ds \<circ> ptrFromPAddr)|` allow_read, es));
|
||||
assert (u \<noteq> {});
|
||||
(e,(tc',um',es')) \<leftarrow> select u;
|
||||
(e,(tc',um',ds',es')) \<leftarrow> select u;
|
||||
|
||||
(* Update the changes the user made to memory into our model.
|
||||
* We ignore changes that took place where they didn't have
|
||||
* write permissions. (uop shouldn't be doing that --- if it is,
|
||||
* uop isn't correctly modelling real hardware.) *)
|
||||
do_machine_op (user_memory_update
|
||||
(restrict_map um' {y. EX x. pl x = Some y \<and> AllowWrite : pr x} \<circ>
|
||||
addrFromPPtr));
|
||||
do_machine_op (user_memory_update
|
||||
(((um' |` allow_write) \<circ> addrFromPPtr) |` (-(dom ds))));
|
||||
|
||||
do_machine_op (device_memory_update
|
||||
(((ds' |` allow_write) \<circ> addrFromPPtr) |` (dom ds)));
|
||||
|
||||
(* Update exclusive monitor state used by the thread. *)
|
||||
do_machine_op (setExMonitor es');
|
||||
|
|
@ -363,19 +372,518 @@ lemma requiv_ptable_xn_eq:
|
|||
\<Longrightarrow> ptable_xn_s s x = ptable_xn_s s' x"
|
||||
by (simp add: ptable_xn_s_def requiv_ptable_attrs_eq)
|
||||
|
||||
|
||||
lemma valid_arch_objsD2:
|
||||
"\<lbrakk>(\<exists>\<rhd> p) s; ko_at (ArchObj ao) p s;
|
||||
valid_arch_objs s\<rbrakk>
|
||||
\<Longrightarrow> valid_arch_obj ao s"
|
||||
by (clarsimp simp:valid_arch_objsD)
|
||||
|
||||
lemma mask_shift_le:
|
||||
"z \<le> y \<Longrightarrow> (x::'a:: len word) && ~~ mask z >> y = x >> y"
|
||||
proof -
|
||||
assume le: "z \<le> y"
|
||||
have shifttwice: "\<And>(x::'a:: len word). x >> y = x >> z >> y - z"
|
||||
by (simp add:shiftr_shiftr le)
|
||||
show ?thesis
|
||||
apply (subst shifttwice)
|
||||
apply (simp add:mask_shift)
|
||||
apply (simp add:shiftr_shiftr le)
|
||||
done
|
||||
qed
|
||||
|
||||
|
||||
lemma data_at_obj_range:
|
||||
"\<lbrakk>data_at sz ptr s;pspace_aligned s;valid_objs s \<rbrakk>
|
||||
\<Longrightarrow> ptr + (offset && mask (pageBitsForSize sz)) \<in> obj_range ptr (ArchObj (DataPage dev sz))"
|
||||
apply (clarsimp simp:data_at_def)
|
||||
apply (elim disjE)
|
||||
apply (clarsimp simp:obj_at_def)
|
||||
apply (drule(2) ptr_in_obj_range)
|
||||
apply (clarsimp simp:obj_bits_def obj_range_def)
|
||||
apply fastforce
|
||||
apply (clarsimp simp:obj_at_def)
|
||||
apply (drule(2) ptr_in_obj_range)
|
||||
apply (clarsimp simp:obj_bits_def obj_range_def)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma obj_range_data_for_cong:
|
||||
"obj_range ptr (ArchObj (DataPage dev sz'))
|
||||
= obj_range ptr (ArchObj (DataPage False sz'))"
|
||||
by (simp add:obj_range_def)
|
||||
|
||||
lemma data_at_disjoint_equiv:
|
||||
"\<lbrakk>ptr' \<noteq> ptr;data_at sz' ptr' s; data_at sz ptr s; valid_objs s; pspace_aligned s;
|
||||
pspace_distinct s; ptr' \<in> obj_range ptr (ArchObj (DataPage dev sz)) \<rbrakk>
|
||||
\<Longrightarrow> False"
|
||||
apply (frule(2) data_at_obj_range[where offset = 0,simplified])
|
||||
apply (clarsimp simp:data_at_def obj_at_def)
|
||||
apply (elim disjE)
|
||||
apply (clarsimp dest!:spec simp:obj_at_def pspace_distinct_def'
|
||||
,erule impE,erule conjI2[OF conjI2],(fastforce+)[2]
|
||||
,fastforce cong:obj_range_data_for_cong)+
|
||||
done
|
||||
|
||||
lemma data_at_aligned:
|
||||
"\<lbrakk>data_at sz base s;pspace_aligned s\<rbrakk> \<Longrightarrow> is_aligned base (pageBitsForSize sz)"
|
||||
apply (clarsimp simp:data_at_def)
|
||||
apply (elim disjE)
|
||||
apply (clarsimp simp:obj_at_def split:kernel_object.split_asm split_if_asm
|
||||
arch_kernel_obj.split_asm dest!:pspace_alignedD)+
|
||||
done
|
||||
|
||||
lemma ptrFromPAddr_mask_simp:
|
||||
"(ptrFromPAddr z && ~~ mask (pageBitsForSize l)) = (ptrFromPAddr (z && ~~ mask (pageBitsForSize l)))"
|
||||
apply (simp add:ptrFromPAddr_def field_simps)
|
||||
apply (subst mask_out_add_aligned[OF is_aligned_physMappingOffset])
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma pageBitsForSize_le_t24:
|
||||
"pageBitsForSize sz \<le> 24"
|
||||
by (cases sz, simp_all)
|
||||
|
||||
lemma data_at_same_size:
|
||||
assumes dat_sz': "data_at sz' (ptrFromPAddr base) s"
|
||||
and dat_sz: "data_at sz (ptrFromPAddr (base + (x && mask (pageBitsForSize sz'))) && ~~ mask (pageBitsForSize sz)) s"
|
||||
and vs: "pspace_distinct s" "pspace_aligned s" "valid_objs s"
|
||||
shows "sz' = sz"
|
||||
proof -
|
||||
from dat_sz' and dat_sz
|
||||
have trivial: "sz' \<noteq> sz \<Longrightarrow> (ptrFromPAddr (base + (x && mask (pageBitsForSize sz'))) && ~~ mask (pageBitsForSize sz))
|
||||
\<noteq> (ptrFromPAddr base)"
|
||||
apply (simp add:data_at_def obj_at_def)
|
||||
apply (rule ccontr)
|
||||
apply (auto)
|
||||
done
|
||||
have sz_equiv: "(pageBitsForSize sz = pageBitsForSize sz') = (sz' = sz)"
|
||||
by (clarsimp simp:pageBitsForSize_def split:vmpage_size.splits)
|
||||
show ?thesis
|
||||
apply (rule sz_equiv[THEN iffD1])
|
||||
apply (rule ccontr)
|
||||
apply (drule neq_iff[THEN iffD1])
|
||||
using dat_sz' dat_sz vs
|
||||
apply (cut_tac trivial) prefer 2
|
||||
apply (fastforce simp:sz_equiv)
|
||||
apply (frule(1) data_at_aligned)
|
||||
apply (elim disjE)
|
||||
apply (erule(5) data_at_disjoint_equiv)
|
||||
apply (unfold obj_range_def)
|
||||
apply (rule mask_in_range[THEN iffD1])
|
||||
apply (simp add:obj_bits_def)+
|
||||
apply (simp add:mask_lower_twice ptrFromPAddr_mask_simp)
|
||||
apply (rule arg_cong[where f = ptrFromPAddr])
|
||||
apply (drule is_aligned_ptrFromPAddrD[OF _ pageBitsForSize_le_t24])
|
||||
apply (subst neg_mask_add_aligned[OF _ and_mask_less'])
|
||||
apply simp
|
||||
apply (fastforce simp: pbfs_less_wb[unfolded word_bits_def,simplified])
|
||||
apply (simp add:is_aligned_neg_mask_eq)
|
||||
apply (drule not_sym)
|
||||
apply (erule(5) data_at_disjoint_equiv)
|
||||
apply (unfold obj_range_def)
|
||||
apply (rule mask_in_range[THEN iffD1])
|
||||
apply (simp add:obj_bits_def is_aligned_neg_mask)+
|
||||
apply (simp add:mask_lower_twice ptrFromPAddr_mask_simp)
|
||||
apply (rule arg_cong[where f = ptrFromPAddr])
|
||||
apply (drule is_aligned_ptrFromPAddrD[OF _ pageBitsForSize_le_t24])
|
||||
apply (subst mask_lower_twice[symmetric])
|
||||
apply (erule less_imp_le_nat)
|
||||
apply (rule sym)
|
||||
apply (subst mask_lower_twice[symmetric])
|
||||
apply (erule less_imp_le_nat)
|
||||
apply (rule arg_cong[where f = "\<lambda>x. x && ~~ mask z" for z])
|
||||
apply (subst neg_mask_add_aligned[OF _ and_mask_less'])
|
||||
apply simp
|
||||
apply (fastforce simp: pbfs_less_wb[unfolded word_bits_def,simplified])
|
||||
apply simp
|
||||
done
|
||||
qed
|
||||
|
||||
lemma valid_pdpt_align_ptD:
|
||||
"\<lbrakk>kheap s ptr = Some (ArchObj (PageTable pt));valid_pdpt_objs s; pt a = entry\<rbrakk> \<Longrightarrow> is_aligned a (pte_range_sz entry)"
|
||||
apply (drule(1) valid_pdpt_objs_ptD)
|
||||
apply (clarsimp simp:entries_align_def)
|
||||
done
|
||||
|
||||
lemma valid_pdpt_align_pdD:
|
||||
"\<lbrakk>kheap s ptr = Some (ArchObj (PageDirectory pd));valid_pdpt_objs s; pd a = entry\<rbrakk> \<Longrightarrow> is_aligned a (pde_range_sz entry)"
|
||||
apply (drule(1) valid_pdpt_objs_pdD)
|
||||
apply (clarsimp simp:entries_align_def)
|
||||
done
|
||||
|
||||
lemma ptable_lift_data_consistant:
|
||||
assumes vs: "valid_state s"
|
||||
and vpdpt: "valid_pdpt_objs s"
|
||||
and pt_lift: "ptable_lift t s x = Some ptr"
|
||||
and dat: "data_at sz ((ptrFromPAddr ptr) && ~~ mask (pageBitsForSize sz)) s"
|
||||
and misc: "get_pd_of_thread (kheap s) (arch_state s) t
|
||||
\<noteq> arm_global_pd (arch_state s)" "x \<notin> kernel_mappings"
|
||||
shows "ptable_lift t s (x && ~~ mask (pageBitsForSize sz)) = Some (ptr && ~~ mask (pageBitsForSize sz))"
|
||||
proof -
|
||||
have aligned_stuff:
|
||||
"\<lbrakk>is_aligned (ucast ((x >> 12) && mask 8) :: word8) 4\<rbrakk> \<Longrightarrow>
|
||||
(x && ~~ mask 16 >> 12) = x >> 12"
|
||||
apply (simp add:is_aligned_mask)
|
||||
apply word_bitwise
|
||||
apply (simp add:mask_def)
|
||||
done
|
||||
have aligned_stuff':
|
||||
"\<lbrakk>is_aligned ((ucast (x >> 20)):: 12 word) 4\<rbrakk> \<Longrightarrow>
|
||||
(x && ~~ mask 24 >> 20) = x >> 20"
|
||||
apply (simp add:is_aligned_mask)
|
||||
apply word_bitwise
|
||||
apply (simp add:mask_def)
|
||||
done
|
||||
have vs': "valid_objs s \<and> valid_arch_objs s \<and> pspace_distinct s \<and> pspace_aligned s"
|
||||
using vs
|
||||
by (simp add:valid_state_def valid_pspace_def)
|
||||
have x_less_kb: "x < kernel_base"
|
||||
using misc
|
||||
by (simp add:kernel_mappings_def) (* FIXME: any rules exists already ? *)
|
||||
|
||||
thus ?thesis
|
||||
using pt_lift dat vs'
|
||||
apply (clarsimp simp: ptable_rights_def ptable_lift_def split: option.splits)
|
||||
apply (clarsimp simp:get_page_info_def split:option.splits)
|
||||
apply (rename_tac base sz' attrs rights pde)
|
||||
apply (case_tac pde,simp_all)
|
||||
apply (clarsimp simp:get_pd_entry_def split:arch_kernel_obj.split_asm option.splits)
|
||||
apply (clarsimp simp:get_pt_info_def get_arch_obj_def
|
||||
get_pt_entry_def split:option.splits arch_kernel_obj.split_asm kernel_object.splits)
|
||||
apply (rename_tac pd_base vmattr mw pd pt)
|
||||
apply (cut_tac get_pd_of_thread_reachable[OF misc(1)])
|
||||
apply (frule(1) valid_arch_objsD2[rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule bspec)
|
||||
apply (rule Compl_iff[THEN iffD2])
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (clarsimp simp: valid_pde_def obj_at_def a_type_def)
|
||||
apply (case_tac "pt (ucast ((x >> 12) && mask 8))",simp_all)
|
||||
apply (frule valid_arch_objsD2[where p = "ptrFromPAddr p" for p,rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (rule exI)
|
||||
apply (erule vs_lookup_step)
|
||||
apply (simp add:vs_lookup1_def lookup_pd_slot_def Let_def pd_shifting
|
||||
pd_shifting_dual obj_at_def)
|
||||
apply (rule_tac x = "VSRef (x>>20) (Some APageDirectory)" in exI)
|
||||
apply (rule context_conjI,simp)
|
||||
apply (erule vs_refs_pdI)
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (intro allI impI)
|
||||
apply (simp add: nth_shiftr)
|
||||
apply (rule bang_big[simplified])
|
||||
apply (simp add:word_size)
|
||||
apply (frule(1) valid_pdpt_align_ptD[OF _ vpdpt])
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule_tac x = "(ucast ((x >> 12) && mask 8))" in spec)
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMLargePage,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def
|
||||
get_arch_obj_def entries_align_def aligned_stuff mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 16,simplified])
|
||||
apply (simp add: neg_mask_add_aligned[OF _ and_mask_less'] is_aligned_neg_mask_eq)
|
||||
apply (frule valid_arch_objsD2[where p = "ptrFromPAddr p" for p,rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (rule exI)
|
||||
apply (erule vs_lookup_step)
|
||||
apply (simp add:vs_lookup1_def lookup_pd_slot_def Let_def pd_shifting
|
||||
pd_shifting_dual obj_at_def)
|
||||
apply (rule_tac x = "VSRef (x>>20) (Some APageDirectory)" in exI)
|
||||
apply (rule context_conjI,simp)
|
||||
apply (erule vs_refs_pdI)
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (intro allI impI)
|
||||
apply (simp add: nth_shiftr)
|
||||
apply (rule bang_big[simplified])
|
||||
apply (simp add:word_size)
|
||||
apply (frule(1) valid_pdpt_align_ptD[OF _ vpdpt])
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule_tac x = "(ucast ((x >> 12) && mask 8))" in spec)
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMSmallPage,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def neg_mask_add_aligned[OF _ and_mask_less']
|
||||
is_aligned_neg_mask_eq get_arch_obj_def entries_align_def mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 12,simplified])
|
||||
apply (clarsimp simp:get_pd_entry_def get_arch_obj_def
|
||||
split:arch_kernel_obj.split_asm option.splits)
|
||||
apply (clarsimp simp: get_pt_entry_def
|
||||
split:option.splits arch_kernel_obj.split_asm kernel_object.splits)
|
||||
apply (rename_tac pd_base vmattr mw pd caprights)
|
||||
apply (cut_tac get_pd_of_thread_reachable[OF misc(1)])
|
||||
apply (frule(1) valid_arch_objsD2[rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule bspec)
|
||||
apply (rule Compl_iff[THEN iffD2])
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (clarsimp simp: valid_pde_def obj_at_def a_type_def)
|
||||
apply (frule(1) valid_pdpt_align_pdD[OF _ vpdpt])
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMSection,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def neg_mask_add_aligned[OF _ and_mask_less']
|
||||
is_aligned_neg_mask_eq get_arch_obj_def entries_align_def mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 20,simplified])
|
||||
apply (clarsimp simp:get_pd_entry_def get_arch_obj_def
|
||||
split:arch_kernel_obj.split_asm option.splits)
|
||||
apply (clarsimp simp: get_pt_entry_def
|
||||
split:option.splits arch_kernel_obj.split_asm kernel_object.splits)
|
||||
apply (rename_tac pd_base vmattr rights pd)
|
||||
apply (cut_tac get_pd_of_thread_reachable[OF misc(1)])
|
||||
apply (frule(1) valid_arch_objsD2[rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule bspec)
|
||||
apply (rule Compl_iff[THEN iffD2])
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (clarsimp simp: valid_pde_def obj_at_def a_type_def)
|
||||
apply (frule(1) valid_pdpt_align_pdD[OF _ vpdpt])
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMSuperSection,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def neg_mask_add_aligned[OF _ and_mask_less']
|
||||
is_aligned_neg_mask_eq get_arch_obj_def entries_align_def aligned_stuff' mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 24,simplified])
|
||||
done
|
||||
qed
|
||||
|
||||
lemma ptable_rights_data_consistant:
|
||||
assumes vs: "valid_state s"
|
||||
and vpdpt: "valid_pdpt_objs s"
|
||||
and pt_lift: "ptable_lift t s x = Some ptr"
|
||||
and dat: "data_at sz ((ptrFromPAddr ptr) && ~~ mask (pageBitsForSize sz)) s"
|
||||
and misc: "get_pd_of_thread (kheap s) (arch_state s) t
|
||||
\<noteq> arm_global_pd (arch_state s)" "x \<notin> kernel_mappings"
|
||||
shows "ptable_rights t s (x && ~~ mask (pageBitsForSize sz)) = ptable_rights t s x"
|
||||
proof -
|
||||
have aligned_stuff:
|
||||
"\<lbrakk>is_aligned (ucast ((x >> 12) && mask 8) :: word8) 4\<rbrakk> \<Longrightarrow>
|
||||
(x && ~~ mask 16 >> 12) = x >> 12"
|
||||
apply (simp add:is_aligned_mask)
|
||||
apply word_bitwise
|
||||
apply (simp add:mask_def)
|
||||
done
|
||||
have aligned_stuff':
|
||||
"\<lbrakk>is_aligned ((ucast (x >> 20)):: 12 word) 4\<rbrakk> \<Longrightarrow>
|
||||
(x && ~~ mask 24 >> 20) = x >> 20"
|
||||
apply (simp add:is_aligned_mask)
|
||||
apply word_bitwise
|
||||
apply (simp add:mask_def)
|
||||
done
|
||||
have vs': "valid_objs s \<and> valid_arch_objs s \<and> pspace_distinct s \<and> pspace_aligned s"
|
||||
using vs
|
||||
by (simp add:valid_state_def valid_pspace_def)
|
||||
have x_less_kb: "x < kernel_base"
|
||||
using misc
|
||||
by (simp add:kernel_mappings_def) (* FIXME: any rules exists already ? *)
|
||||
|
||||
thus ?thesis
|
||||
using pt_lift dat vs'
|
||||
apply (clarsimp simp: ptable_rights_def ptable_lift_def split: option.splits)
|
||||
apply (clarsimp simp:get_page_info_def split:option.splits)
|
||||
apply (rename_tac base sz' attrs rights pde)
|
||||
apply (case_tac pde,simp_all)
|
||||
apply (clarsimp simp:get_pd_entry_def split:arch_kernel_obj.split_asm option.splits)
|
||||
apply (clarsimp simp:get_pt_info_def get_arch_obj_def
|
||||
get_pt_entry_def split:option.splits arch_kernel_obj.split_asm kernel_object.splits)
|
||||
apply (rename_tac pd_base vmattr mw pd pt)
|
||||
apply (cut_tac get_pd_of_thread_reachable[OF misc(1)])
|
||||
apply (frule(1) valid_arch_objsD2[rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule bspec)
|
||||
apply (rule Compl_iff[THEN iffD2])
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (clarsimp simp: valid_pde_def obj_at_def a_type_def)
|
||||
apply (case_tac "pt (ucast ((x >> 12) && mask 8))",simp_all)
|
||||
apply (frule valid_arch_objsD2[where p = "ptrFromPAddr p" for p,rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (rule exI)
|
||||
apply (erule vs_lookup_step)
|
||||
apply (simp add:vs_lookup1_def lookup_pd_slot_def Let_def pd_shifting
|
||||
pd_shifting_dual obj_at_def)
|
||||
apply (rule_tac x = "VSRef (x>>20) (Some APageDirectory)" in exI)
|
||||
apply (rule context_conjI,simp)
|
||||
apply (erule vs_refs_pdI)
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (intro allI impI)
|
||||
apply (simp add: nth_shiftr)
|
||||
apply (rule bang_big[simplified])
|
||||
apply (simp add:word_size)
|
||||
apply (frule(1) valid_pdpt_align_ptD[OF _ vpdpt])
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule_tac x = "(ucast ((x >> 12) && mask 8))" in spec)
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMLargePage,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def
|
||||
get_arch_obj_def entries_align_def aligned_stuff mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 16,simplified])
|
||||
apply (frule valid_arch_objsD2[where p = "ptrFromPAddr p" for p,rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (rule exI)
|
||||
apply (erule vs_lookup_step)
|
||||
apply (simp add:vs_lookup1_def lookup_pd_slot_def Let_def pd_shifting
|
||||
pd_shifting_dual obj_at_def)
|
||||
apply (rule_tac x = "VSRef (x>>20) (Some APageDirectory)" in exI)
|
||||
apply (rule context_conjI,simp)
|
||||
apply (erule vs_refs_pdI)
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (intro allI impI)
|
||||
apply (simp add: nth_shiftr)
|
||||
apply (rule bang_big[simplified])
|
||||
apply (simp add:word_size)
|
||||
apply (frule(1) valid_pdpt_align_ptD[OF _ vpdpt])
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule_tac x = "(ucast ((x >> 12) && mask 8))" in spec)
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMSmallPage,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def neg_mask_add_aligned[OF _ and_mask_less']
|
||||
is_aligned_neg_mask_eq get_arch_obj_def entries_align_def mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 12,simplified])
|
||||
apply (clarsimp simp:get_pd_entry_def get_arch_obj_def
|
||||
split:arch_kernel_obj.split_asm option.splits)
|
||||
apply (clarsimp simp: get_pt_entry_def
|
||||
split:option.splits arch_kernel_obj.split_asm kernel_object.splits)
|
||||
apply (rename_tac pd_base vmattr mw pd caprights)
|
||||
apply (cut_tac get_pd_of_thread_reachable[OF misc(1)])
|
||||
apply (frule(1) valid_arch_objsD2[rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule bspec)
|
||||
apply (rule Compl_iff[THEN iffD2])
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (clarsimp simp: valid_pde_def obj_at_def a_type_def)
|
||||
apply (frule(1) valid_pdpt_align_pdD[OF _ vpdpt])
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMSection,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:get_pd_entry_def get_arch_obj_def
|
||||
split:arch_kernel_obj.split_asm option.splits)
|
||||
apply (clarsimp simp: get_pt_entry_def
|
||||
split:option.splits arch_kernel_obj.split_asm kernel_object.splits)
|
||||
apply (rename_tac pd_base vmattr rights pd)
|
||||
apply (cut_tac get_pd_of_thread_reachable[OF misc(1)])
|
||||
apply (frule(1) valid_arch_objsD2[rotated,unfolded obj_at_def,simplified],simp)
|
||||
apply (simp add:valid_arch_obj_def)
|
||||
apply (drule bspec)
|
||||
apply (rule Compl_iff[THEN iffD2])
|
||||
apply (rule kernel_mappings_kernel_mapping_slots[OF misc(2)])
|
||||
apply (clarsimp simp: valid_pde_def obj_at_def a_type_def)
|
||||
apply (frule(1) valid_pdpt_align_pdD[OF _ vpdpt])
|
||||
apply (frule data_at_same_size[where sz = sz and sz' = ARMSuperSection,rotated,simplified],
|
||||
clarsimp+)
|
||||
apply (clarsimp simp:mask_shift_le get_pt_info_def get_pt_entry_def neg_mask_add_aligned[OF _ and_mask_less']
|
||||
is_aligned_neg_mask_eq get_arch_obj_def entries_align_def aligned_stuff' mask_AND_NOT_mask
|
||||
dest!:data_at_aligned is_aligned_ptrFromPAddrD[where a = 24,simplified])
|
||||
done
|
||||
qed
|
||||
|
||||
lemma user_op_access_data_at:
|
||||
"\<lbrakk> invs s; valid_pdpt_objs s;pas_refined aag s; is_subject aag tcb;
|
||||
ptable_lift tcb s x = Some ptr;
|
||||
data_at sz ((ptrFromPAddr ptr) && ~~ mask (pageBitsForSize sz)) s;
|
||||
auth \<in> vspace_cap_rights_to_auth (ptable_rights tcb s x) \<rbrakk>
|
||||
\<Longrightarrow> (pasObjectAbs aag tcb, auth, pasObjectAbs aag (ptrFromPAddr (ptr && ~~ mask (pageBitsForSize sz)))) \<in> pasPolicy aag"
|
||||
apply (case_tac "x \<in> kernel_mappings")
|
||||
apply (clarsimp simp: ptable_lift_def ptable_rights_def split: option.splits)
|
||||
apply (frule some_get_page_info_kmapsD)
|
||||
apply (fastforce simp: invs_valid_global_pd_mappings invs_equal_kernel_mappings
|
||||
vspace_cap_rights_to_auth_def)+
|
||||
|
||||
apply (case_tac "get_pd_of_thread (kheap s) (arch_state s) tcb
|
||||
= arm_global_pd (arch_state s)")
|
||||
apply (clarsimp simp: ptable_lift_def ptable_rights_def split: option.splits)
|
||||
apply (frule get_page_info_gpd_kmaps[rotated, rotated])
|
||||
apply (fastforce simp: invs_valid_global_objs invs_arch_state)+
|
||||
apply (frule(3) ptable_lift_data_consistant[rotated 2])
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply (frule (3) ptable_rights_data_consistant[rotated 2])
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply (erule(3) user_op_access)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma user_frame_at_equiv:
|
||||
"\<lbrakk>typ_at (AArch (AUserData sz)) p s ; equiv_for P kheap s s'; P p \<rbrakk>
|
||||
\<Longrightarrow> typ_at (AArch (AUserData sz)) p s'"
|
||||
by (clarsimp simp:equiv_for_def obj_at_def)
|
||||
|
||||
lemma device_frame_at_equiv:
|
||||
"\<lbrakk>typ_at (AArch (ADeviceData sz)) p s ; equiv_for P kheap s s'; P p \<rbrakk>
|
||||
\<Longrightarrow> typ_at (AArch (ADeviceData sz)) p s'"
|
||||
by (clarsimp simp:equiv_for_def obj_at_def)
|
||||
|
||||
lemma typ_at_user_data_at:
|
||||
"typ_at (AArch (AUserData sz)) p s \<Longrightarrow> data_at sz p s"
|
||||
by (simp add:data_at_def)
|
||||
|
||||
lemma typ_at_device_data_at:
|
||||
"typ_at (AArch (ADeviceData sz)) p s \<Longrightarrow> data_at sz p s"
|
||||
by (simp add:data_at_def)
|
||||
|
||||
lemma equiv_symmetric:
|
||||
"equiv_for a b c d = equiv_for a b d c"
|
||||
by (auto simp:equiv_for_def)
|
||||
|
||||
lemma requiv_device_mem_eq:
|
||||
"\<lbrakk> reads_equiv aag s s'; globals_equiv s s'; invs s;
|
||||
invs s'; valid_pdpt_objs s; valid_pdpt_objs s';
|
||||
is_subject aag (cur_thread s); AllowRead \<in> ptable_rights_s s x;
|
||||
ptable_lift_s s x = Some y; pas_refined aag s; pas_refined aag s'
|
||||
\<rbrakk>
|
||||
\<Longrightarrow> device_mem s (ptrFromPAddr y) = device_mem s' (ptrFromPAddr y)"
|
||||
apply (simp add: device_mem_def)
|
||||
apply (rule conjI)
|
||||
apply (erule reads_equivE)
|
||||
apply (clarsimp simp:in_device_frame_def)
|
||||
apply (rule exI)
|
||||
apply (rule device_frame_at_equiv)
|
||||
apply assumption+
|
||||
apply (erule_tac f="underlying_memory" in equiv_forE)
|
||||
apply (frule_tac auth=Read in user_op_access_data_at[where s = s])
|
||||
apply (fastforce simp: ptable_lift_s_def ptable_rights_s_def
|
||||
vspace_cap_rights_to_auth_def | intro typ_at_device_data_at)+
|
||||
apply (rule reads_read)
|
||||
apply (fastforce simp:ptrFromPAddr_mask_simp)
|
||||
apply clarsimp
|
||||
apply (frule requiv_ptable_rights_eq, fastforce+)
|
||||
apply (frule requiv_ptable_lift_eq, fastforce+)
|
||||
apply (clarsimp simp:globals_equiv_def)
|
||||
apply (erule notE)
|
||||
apply (erule reads_equivE)
|
||||
apply (clarsimp simp:in_device_frame_def)
|
||||
apply (rule exI)
|
||||
apply (rule device_frame_at_equiv)
|
||||
apply assumption+
|
||||
apply (erule_tac f="underlying_memory" in equiv_forE)
|
||||
apply (erule equiv_symmetric[THEN iffD1])
|
||||
apply (frule_tac auth=Read in user_op_access_data_at[where s = s'])
|
||||
apply (fastforce simp: ptable_lift_s_def ptable_rights_s_def
|
||||
vspace_cap_rights_to_auth_def | intro typ_at_device_data_at)+
|
||||
apply (rule reads_read)
|
||||
apply (fastforce simp:ptrFromPAddr_mask_simp)
|
||||
done
|
||||
|
||||
lemma requiv_user_mem_eq:
|
||||
"\<lbrakk> reads_equiv aag s s'; globals_equiv s s'; invs s;
|
||||
invs s'; is_subject aag (cur_thread s); AllowRead \<in> ptable_rights_s s x;
|
||||
ptable_lift_s s x = Some y; pas_refined aag s; pas_refined aag s' \<rbrakk>
|
||||
invs s'; valid_pdpt_objs s; valid_pdpt_objs s';
|
||||
is_subject aag (cur_thread s); AllowRead \<in> ptable_rights_s s x;
|
||||
ptable_lift_s s x = Some y; pas_refined aag s; pas_refined aag s'
|
||||
\<rbrakk>
|
||||
\<Longrightarrow> user_mem s (ptrFromPAddr y) = user_mem s' (ptrFromPAddr y)"
|
||||
apply (simp add: user_mem_def)
|
||||
apply (subgoal_tac "in_user_frame (ptrFromPAddr y) s")
|
||||
apply (subgoal_tac "in_user_frame (ptrFromPAddr y) s'")
|
||||
apply (rule conjI)
|
||||
apply clarsimp
|
||||
apply (rule context_conjI')
|
||||
apply (erule reads_equivE)
|
||||
apply (clarsimp simp:in_user_frame_def)
|
||||
apply (rule exI)
|
||||
apply (rule user_frame_at_equiv)
|
||||
apply assumption+
|
||||
apply (erule_tac f="underlying_memory" in equiv_forE)
|
||||
apply (frule_tac auth=Read in user_op_access_data_at[where s = s])
|
||||
apply (fastforce simp: ptable_lift_s_def ptable_rights_s_def
|
||||
vspace_cap_rights_to_auth_def | intro typ_at_user_data_at)+
|
||||
apply (rule reads_read)
|
||||
apply (fastforce simp:ptrFromPAddr_mask_simp)
|
||||
apply clarsimp
|
||||
apply (rule_tac P="(ptrFromPAddr y) \<in> range_of_arm_globals_frame s" in case_split)
|
||||
apply (clarsimp simp: globals_equiv_def)
|
||||
apply (subgoal_tac "aag_can_read aag (ptrFromPAddr y)")
|
||||
apply (erule reads_equivE)
|
||||
apply clarsimp
|
||||
apply (erule_tac f="underlying_memory" in equiv_forE)
|
||||
apply simp
|
||||
apply (frule_tac auth=Read in user_op_access)
|
||||
|
|
@ -383,14 +891,73 @@ lemma requiv_user_mem_eq:
|
|||
vspace_cap_rights_to_auth_def)+
|
||||
apply (rule reads_read)
|
||||
apply simp
|
||||
apply (frule requiv_ptable_rights_eq, fastforce+)
|
||||
apply (frule requiv_ptable_lift_eq, fastforce+)
|
||||
apply (rule ptable_rights_imp_user_frame)
|
||||
apply (fastforce simp: invs_valid_stateI ptable_rights_s_def ptable_lift_s_def)+
|
||||
apply (rule ptable_rights_imp_user_frame)
|
||||
apply (fastforce simp: invs_valid_stateI ptable_rights_s_def ptable_lift_s_def)+
|
||||
apply (frule requiv_ptable_rights_eq, fastforce+)
|
||||
apply (frule requiv_ptable_lift_eq, fastforce+)
|
||||
apply (clarsimp simp:globals_equiv_def)
|
||||
apply (erule notE)
|
||||
apply (erule reads_equivE)
|
||||
apply (clarsimp simp:in_user_frame_def)
|
||||
apply (rule exI)
|
||||
apply (rule user_frame_at_equiv)
|
||||
apply assumption+
|
||||
apply (erule_tac f="underlying_memory" in equiv_forE)
|
||||
apply (erule equiv_symmetric[THEN iffD1])
|
||||
apply (frule_tac auth=Read in user_op_access_data_at[where s = s'])
|
||||
apply (fastforce simp: ptable_lift_s_def ptable_rights_s_def
|
||||
vspace_cap_rights_to_auth_def | intro typ_at_user_data_at)+
|
||||
apply (rule reads_read)
|
||||
apply (fastforce simp:ptrFromPAddr_mask_simp)
|
||||
done
|
||||
|
||||
lemma ptable_rights_imp_frameD:
|
||||
"\<lbrakk>ptable_lift t s x = Some y;valid_state s;ptable_rights t s x \<noteq> {}\<rbrakk> \<Longrightarrow>
|
||||
\<exists>sz. data_at sz (ptrFromPAddr y && ~~ mask (pageBitsForSize sz)) s"
|
||||
apply (subst(asm) addrFromPPtr_ptrFromPAddr_id[symmetric])
|
||||
apply (drule ptable_rights_imp_frame)
|
||||
apply simp+
|
||||
apply (rule addrFromPPtr_ptrFromPAddr_id[symmetric])
|
||||
apply (auto simp:in_user_frame_def in_device_frame_def
|
||||
dest!:spec typ_at_user_data_at typ_at_device_data_at)
|
||||
done
|
||||
|
||||
lemma globals_equiv_invs_device_state_equiv:
|
||||
"\<lbrakk>globals_equiv s t; invs s; invs t\<rbrakk> \<Longrightarrow>\<forall>x\<in> range_of_arm_globals_frame s.
|
||||
device_state (machine_state s) x = device_state (machine_state t) x"
|
||||
apply (clarsimp simp:globals_equiv_def)
|
||||
apply (drule(1) globals_frame_not_device[rotated])
|
||||
apply (drule globals_frame_not_device[rotated])
|
||||
apply fastforce
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma requiv_user_device_eq:
|
||||
"\<lbrakk> reads_equiv aag s s'; globals_equiv s s'; invs s;
|
||||
invs s'; valid_pdpt_objs s; valid_pdpt_objs s';
|
||||
is_subject aag (cur_thread s); AllowRead \<in> ptable_rights_s s x;
|
||||
ptable_lift_s s x = Some y; pas_refined aag s; pas_refined aag s'
|
||||
\<rbrakk>
|
||||
\<Longrightarrow> device_state (machine_state s) (ptrFromPAddr y) = device_state (machine_state s') (ptrFromPAddr y)"
|
||||
apply (simp add:ptable_lift_s_def)
|
||||
apply (frule ptable_rights_imp_frameD)
|
||||
apply fastforce
|
||||
apply (fastforce simp:ptable_rights_s_def)
|
||||
apply (erule reads_equivE)
|
||||
apply clarsimp
|
||||
apply (rule_tac P="(ptrFromPAddr y) \<in> range_of_arm_globals_frame s" in case_split)
|
||||
apply (drule globals_equiv_invs_device_state_equiv)
|
||||
apply simp+
|
||||
apply (erule_tac f="device_state" in equiv_forD)
|
||||
apply simp
|
||||
apply (frule_tac auth=Read in user_op_access_data_at[where s = s])
|
||||
apply ((fastforce simp: ptable_lift_s_def ptable_rights_s_def
|
||||
vspace_cap_rights_to_auth_def | intro typ_at_user_data_at)+)[6]
|
||||
apply (rule reads_read)
|
||||
apply (frule_tac auth=Read in user_op_access)
|
||||
apply (fastforce simp: ptable_lift_s_def ptable_rights_s_def
|
||||
vspace_cap_rights_to_auth_def)+
|
||||
done
|
||||
|
||||
|
||||
lemma gets_ev''':
|
||||
"equiv_valid_inv I A (\<lambda>s. P s \<and> (\<forall> t. I s t \<and> A s t \<and> P t \<longrightarrow> f s = f t)) (gets f)"
|
||||
apply (simp add: equiv_valid_def2)
|
||||
|
|
@ -420,11 +987,12 @@ lemma reads_equiv_g_refl:
|
|||
done
|
||||
|
||||
definition context_matches_state where
|
||||
"context_matches_state pl pr pxn um es s \<equiv>
|
||||
"context_matches_state pl pr pxn um ds es s \<equiv>
|
||||
pl = ptable_lift_s s |` {x. pr x \<noteq> {}} \<and>
|
||||
pr = ptable_rights_s s \<and>
|
||||
pxn = (\<lambda>x. pr x \<noteq> {} \<and> ptable_xn_s s x) \<and>
|
||||
um = (user_mem s \<circ> ptrFromPAddr) |` {y. \<exists>x. pl x = Some y \<and> AllowRead \<in> pr x} \<and>
|
||||
ds = (device_state (machine_state s) \<circ> ptrFromPAddr) |` {y. \<exists>x. pl x = Some y \<and> AllowRead \<in> pr x} \<and>
|
||||
es = exclusive_state (machine_state s)"
|
||||
|
||||
(* FIXME - move - duplicated in Schedule_IF *)
|
||||
|
|
@ -468,45 +1036,138 @@ lemma getExMonitor_wp[wp]:
|
|||
"\<lbrace>\<lambda>ms. P (exclusive_state ms) ms\<rbrace> getExMonitor \<lbrace>P\<rbrace>"
|
||||
by (simp add: getExMonitor_def | wp)+
|
||||
|
||||
lemma map_add_eq:
|
||||
"\<lbrakk>ms x = ms' x\<rbrakk> \<Longrightarrow> (ms ++ um) x = (ms' ++ um) x"
|
||||
by (clarsimp simp:map_add_def split:option.splits)
|
||||
|
||||
lemma dmo_device_state_update_reads_respects_g:
|
||||
"reads_respects_g aag l (\<lambda>s. dom um \<subseteq> device_region s) (do_machine_op (device_memory_update um))"
|
||||
apply(clarsimp simp: equiv_valid_def2 equiv_valid_2_def)
|
||||
apply(clarsimp simp: do_machine_op_def device_memory_update_def gets_def select_f_def
|
||||
get_def bind_def in_monad)
|
||||
apply(clarsimp simp: reads_equiv_g_def globals_equiv_def split: option.splits)
|
||||
apply(subgoal_tac "reads_respects aag l \<top> (do_machine_op (device_memory_update um))")
|
||||
apply(fastforce simp: equiv_valid_def2 equiv_valid_2_def in_monad
|
||||
do_machine_op_def device_memory_update_def select_f_def
|
||||
idle_equiv_def)
|
||||
apply(rule use_spec_ev)
|
||||
apply (simp add: device_memory_update_def)
|
||||
apply(rule do_machine_op_spec_reads_respects)
|
||||
apply(simp add: equiv_valid_def2)
|
||||
apply(rule modify_ev2)
|
||||
apply(fastforce intro: map_add_eq equiv_forI elim: equiv_forE split: option.splits)
|
||||
apply (wp | simp)+
|
||||
done
|
||||
|
||||
lemma spec_equiv_valid_inv_gets:
|
||||
assumes proj_retain: "\<And>t. \<lbrakk>P st; P t; I st t; A st t\<rbrakk> \<Longrightarrow> proj (f st) = proj (f t)"
|
||||
and spec_eqv_valid: "spec_equiv_valid_inv st I A P (g (proj (f st)))"
|
||||
shows "spec_equiv_valid_inv st I A
|
||||
P (do r \<leftarrow> gets f; g (proj r) od)"
|
||||
apply (clarsimp simp:spec_equiv_valid_def equiv_valid_2_def
|
||||
gets_def get_def bind_def return_def)
|
||||
apply (frule(3) proj_retain)
|
||||
apply (cut_tac spec_eqv_valid)
|
||||
apply (clarsimp simp:spec_equiv_valid_def equiv_valid_2_def
|
||||
gets_def get_def bind_def return_def)
|
||||
apply (drule spec)+
|
||||
apply (erule impE)
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemmas spec_equiv_valid_inv_gets_more =
|
||||
spec_equiv_valid_inv_gets[where proj = "\<lambda>x. (proj x,projsnd x)"
|
||||
and g = "\<lambda>z. g (fst z) (snd z)" for proj and projsnd and g,simplified]
|
||||
|
||||
lemmas spec_equiv_valid_inv_gets_triple =
|
||||
spec_equiv_valid_inv_gets_more[where projsnd = "\<lambda>x. (p (projsnd x) , p' (projsnd x))"
|
||||
and g = "\<lambda>a z. g a (fst z) (snd z)" for projsnd and p and p' and g,simplified]
|
||||
|
||||
lemma restrict_eq_imp_dom_eq:
|
||||
"a |` r = b|` r \<Longrightarrow> dom a \<inter> r = dom b \<inter> r"
|
||||
apply (clarsimp simp: set_eq_iff restrict_map_def)
|
||||
apply (drule_tac x = x in fun_cong)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma restrict_map_eq_same_domain:
|
||||
"\<lbrakk>\<And>x. x\<in> dom a \<Longrightarrow> b x = c x\<rbrakk> \<Longrightarrow> a |` dom b = a |` dom c"
|
||||
apply (rule ext)
|
||||
apply (clarsimp simp:restrict_map_def)
|
||||
apply (intro conjI impI)
|
||||
apply fastforce
|
||||
apply (rule ccontr)
|
||||
apply (drule not_sym)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma restrict_map_eq_same_domain_compl:
|
||||
"\<lbrakk>\<And>x. x\<in> dom a \<Longrightarrow> b x = c x\<rbrakk> \<Longrightarrow> a |` (- dom b) = a |` (- dom c)"
|
||||
apply (rule ext)
|
||||
apply (clarsimp simp:restrict_map_def)
|
||||
apply (intro conjI impI)
|
||||
apply fastforce
|
||||
apply (rule ccontr)
|
||||
apply (drule not_sym)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma do_user_op_reads_respects_g:
|
||||
notes split_paired_All[simp del]
|
||||
shows "( \<forall>pl pr pxn tc um es s. P tc s \<and> context_matches_state pl pr pxn um es s \<longrightarrow> (\<exists>x. uop (cur_thread s) pl pr pxn (tc, um, es) = {x}))
|
||||
\<Longrightarrow> reads_respects_g aag l (pas_refined aag and invs and is_subject aag \<circ> cur_thread and (\<lambda>s. cur_thread s \<noteq> idle_thread s) and P tc) (do_user_op_if uop tc)"
|
||||
apply (simp add: do_user_op_if_def)
|
||||
shows "( \<forall>pl pr pxn tc um es ds s. P tc s \<and> context_matches_state pl pr pxn um ds es s \<longrightarrow> (\<exists>x. uop (cur_thread s) pl pr pxn (tc, um, ds , es) = {x}))
|
||||
\<Longrightarrow> reads_respects_g aag l (pas_refined aag and invs and valid_pdpt_objs and is_subject aag \<circ> cur_thread and (\<lambda>s. cur_thread s \<noteq> idle_thread s) and P tc) (do_user_op_if uop tc)"
|
||||
apply (simp add: do_user_op_if_def restrict_restrict)
|
||||
apply (rule use_spec_ev)
|
||||
apply (rule spec_equiv_valid_add_asm)
|
||||
apply (rule spec_equiv_valid_add_rel[OF _ reads_equiv_g_refl])
|
||||
apply (rule spec_equiv_valid_add_rel'[OF _ affects_equiv_refl])
|
||||
apply (rule spec_equiv_valid_guard_imp)
|
||||
apply (wp dmo_user_memory_update_reads_respects_g dmo_setExMonitor_reads_respects_g | wpc)+
|
||||
apply (erule_tac x = rvb in allE)
|
||||
apply (erule_tac x = "rv" in allE)
|
||||
apply (erule_tac x = "rva" in allE)
|
||||
apply (erule_tac x = "tc" in allE)
|
||||
apply (erule_tac x = "rvd" in allE)
|
||||
apply (erule_tac x = "rve" in allE)
|
||||
apply (erule_tac x = st in allE)
|
||||
apply (rule_tac Q="P tc st \<and> context_matches_state rvb rv rva rvd rve st" in gen_asm_ev(2))
|
||||
apply clarsimp
|
||||
apply (wp add: select_wp select_ev dmo_getExMonitor_reads_respects_g del: gets_ev
|
||||
| rule_tac P="pas_refined aag and invs" in gets_ev''' | simp)+
|
||||
apply (simp add: reads_equiv_g_def)
|
||||
apply (intro context_conjI allI impI, safe)
|
||||
apply (clarsimp simp: requiv_ptable_rights_eq)
|
||||
apply (rule ext)
|
||||
apply (case_tac "ptable_rights_s s x = {}", simp)
|
||||
apply (simp add: requiv_ptable_xn_eq)
|
||||
apply (subst expand_restrict_map_eq)
|
||||
apply (clarsimp simp: requiv_ptable_lift_eq)
|
||||
apply (clarsimp simp: requiv_cur_thread_eq)
|
||||
apply (rule spec_equiv_valid_inv_gets[where proj=id,simplified])
|
||||
apply (clarsimp simp: reads_equiv_g_def)
|
||||
apply (rule requiv_ptable_rights_eq,simp+)[1]
|
||||
apply (rule spec_equiv_valid_inv_gets[where proj=id,simplified])
|
||||
apply (rule ext)
|
||||
apply (clarsimp simp:reads_equiv_g_def)
|
||||
apply (case_tac "ptable_rights_s st x = {}", simp)
|
||||
apply simp
|
||||
apply (rule requiv_ptable_xn_eq,simp+)[1]
|
||||
apply (rule spec_equiv_valid_inv_gets[where proj=id,simplified])
|
||||
apply (subst expand_restrict_map_eq,clarsimp)
|
||||
apply (clarsimp simp:reads_equiv_g_def)
|
||||
apply (rule requiv_ptable_lift_eq,simp+)[1]
|
||||
apply (rule spec_equiv_valid_inv_gets[where proj=id,simplified])
|
||||
apply (clarsimp simp:reads_equiv_g_def)
|
||||
apply (rule requiv_cur_thread_eq,fastforce)
|
||||
apply (rule spec_equiv_valid_inv_gets_more
|
||||
[where proj = "\<lambda>m. dom m \<inter> cw" and projsnd = "\<lambda>m. m|` cr" for cr and cw])
|
||||
apply (rule context_conjI')
|
||||
apply (subst expand_restrict_map_eq)
|
||||
apply (clarsimp simp: restrict_map_def requiv_user_mem_eq
|
||||
requiv_user_mem_eq[symmetric, OF reads_equiv_sym globals_equiv_sym])
|
||||
apply (simp add: context_matches_state_def comp_def)
|
||||
apply (clarsimp)
|
||||
apply (erule_tac x=st in allE)+
|
||||
apply (simp add: context_matches_state_def reads_equiv_sym globals_equiv_sym affects_equiv_sym comp_def)
|
||||
apply (simp add: globals_equiv_def)
|
||||
done
|
||||
apply (clarsimp simp:reads_equiv_g_def restrict_map_def)
|
||||
apply (rule requiv_user_mem_eq)
|
||||
apply simp+
|
||||
apply fastforce
|
||||
apply (rule spec_equiv_valid_inv_gets[where proj = "\<lambda>x. ()",simplified])
|
||||
apply (rule spec_equiv_valid_inv_gets_more[where proj = "\<lambda>m. (m \<circ> ptrFromPAddr)|` cr" for cr])
|
||||
apply (rule conjI)
|
||||
apply (subst expand_restrict_map_eq)
|
||||
apply (clarsimp simp: restrict_map_def reads_equiv_g_def)
|
||||
apply (rule requiv_user_device_eq)
|
||||
apply simp+
|
||||
apply (clarsimp simp:globals_equiv_def reads_equiv_g_def)
|
||||
|
||||
apply (rule spec_equiv_valid_guard_imp)
|
||||
apply (wp dmo_user_memory_update_reads_respects_g dmo_device_state_update_reads_respects_g
|
||||
dmo_setExMonitor_reads_respects_g dmo_device_state_update_reads_respects_g
|
||||
select_ev select_wp dmo_getExMonitor_reads_respects_g | wpc)+
|
||||
apply (wp dmo_wp)
|
||||
apply clarsimp
|
||||
apply (rule conjI)
|
||||
apply clarsimp
|
||||
apply (drule spec)+
|
||||
apply (erule impE)
|
||||
prefer 2
|
||||
apply assumption
|
||||
apply (clarsimp simp:context_matches_state_def comp_def reads_equiv_g_def globals_equiv_def)
|
||||
apply (clarsimp simp: reads_equiv_g_def globals_equiv_def)
|
||||
done
|
||||
end
|
||||
|
|
|
|||
|
|
@ -151,25 +151,7 @@ definition
|
|||
where
|
||||
"Init_A \<equiv> {((empty_context, init_A_st), UserMode, None)}"
|
||||
|
||||
text {*
|
||||
The content of user memory is stored in the machine state.
|
||||
The definition below constructs a map
|
||||
from all kernel addresses pointing inside a user frame
|
||||
to the respective memory content.
|
||||
|
||||
NOTE: There is an offset from kernel addresses to physical memory addresses.
|
||||
*}
|
||||
definition
|
||||
"user_mem s \<equiv> \<lambda>p.
|
||||
if (in_user_frame p s)
|
||||
then Some (underlying_memory (machine_state s) p)
|
||||
else None"
|
||||
|
||||
definition
|
||||
"device_mem s \<equiv> \<lambda>p.
|
||||
if (in_device_frame p s)
|
||||
then Some p
|
||||
else None"
|
||||
|
||||
|
||||
definition
|
||||
|
|
@ -177,6 +159,10 @@ definition
|
|||
ms\<lparr>underlying_memory := (\<lambda>a. case um a of Some x \<Rightarrow> x
|
||||
| None \<Rightarrow> underlying_memory ms a)\<rparr>)"
|
||||
|
||||
definition
|
||||
"device_memory_update um \<equiv> modify (\<lambda>ms.
|
||||
ms\<lparr>device_state := (device_state ms ++ um ) \<rparr>)"
|
||||
|
||||
definition
|
||||
"option_to_0 x \<equiv> case x of None \<Rightarrow> 0 | Some y \<Rightarrow> y"
|
||||
|
||||
|
|
@ -713,17 +699,26 @@ definition
|
|||
"do_user_op uop tc \<equiv>
|
||||
do t \<leftarrow> gets cur_thread;
|
||||
conv \<leftarrow> gets (ptable_lift t);
|
||||
|
||||
rights \<leftarrow> gets (ptable_rights t);
|
||||
|
||||
um \<leftarrow> gets (\<lambda>s. (user_mem s) \<circ> ptrFromPAddr);
|
||||
dm \<leftarrow> gets device_mem;
|
||||
|
||||
dm \<leftarrow> gets (\<lambda>s. (device_mem s) \<circ> ptrFromPAddr);
|
||||
|
||||
ds \<leftarrow> gets (device_state \<circ> machine_state);
|
||||
|
||||
(e,tc',um',ds') \<leftarrow> select (fst
|
||||
(uop t (restrict_map conv {pa. rights pa \<noteq> {}}) rights
|
||||
(tc, restrict_map um {pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va},ds)));
|
||||
(tc, restrict_map um {pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va}
|
||||
,(ds \<circ> ptrFromPAddr) |` {pa. \<exists>va. conv va = Some pa \<and> AllowRead \<in> rights va} )
|
||||
));
|
||||
do_machine_op (user_memory_update
|
||||
(restrict_map (um'|` dom um) {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va}
|
||||
\<circ> Platform.addrFromPPtr));
|
||||
do_machine_op (device_update (ds ++ (ds'|` dom dm)));
|
||||
((um' |` {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va}
|
||||
\<circ> Platform.addrFromPPtr) |` (- dom ds)));
|
||||
do_machine_op (device_memory_update
|
||||
((ds' |` {pa. \<exists>va. conv va = Some pa \<and> AllowWrite \<in> rights va}
|
||||
\<circ> Platform.addrFromPPtr) |` (dom ds)));
|
||||
return (e, tc')
|
||||
od"
|
||||
|
||||
|
|
|
|||
|
|
@ -278,31 +278,73 @@ lemma ptable_rights_imp_frame:
|
|||
apply (clarsimp simp:field_simps simp: data_at_def)
|
||||
done
|
||||
|
||||
lemma user_mem_dom_cong:
|
||||
"kheap s = kheap s' \<Longrightarrow> dom (user_mem s) = dom (user_mem s')"
|
||||
by (simp add:user_mem_def in_user_frame_def dom_def obj_at_def)
|
||||
|
||||
lemma device_mem_dom_cong:
|
||||
"kheap s = kheap s' \<Longrightarrow> dom (device_mem s) = dom (device_mem s')"
|
||||
by (simp add:device_mem_def in_device_frame_def dom_def obj_at_def)
|
||||
|
||||
lemma device_update_invs:
|
||||
"\<lbrace>invs\<rbrace>do_machine_op (device_update ds)
|
||||
"\<lbrace>invs and (\<lambda>s. (dom ds) \<subseteq> (device_region s))\<rbrace> do_machine_op (device_memory_update ds)
|
||||
\<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (simp add:do_machine_op_def device_update_def simpler_modify_def select_f_def
|
||||
gets_def get_def bind_def valid_def return_def)
|
||||
by (clarsimp simp:invs_def valid_state_def valid_irq_states_def valid_machine_state_def
|
||||
cur_tcb_def)
|
||||
apply (simp add:do_machine_op_def device_memory_update_def simpler_modify_def select_f_def
|
||||
gets_def get_def bind_def valid_def return_def)
|
||||
apply (clarsimp simp:invs_def valid_state_def valid_irq_states_def valid_machine_state_def
|
||||
cur_tcb_def pspace_respects_device_region_def cap_refs_respects_device_region_def
|
||||
cong: user_mem_dom_cong simp del:split_paired_All)
|
||||
apply (clarsimp cong:device_mem_dom_cong simp:cap_range_respects_device_region_def
|
||||
simp del:split_paired_All split_paired_Ex)
|
||||
apply (intro conjI)
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply (clarsimp simp del:split_paired_All split_paired_Ex)
|
||||
apply (drule_tac x = "(a,b)" in spec)
|
||||
apply (erule notE)
|
||||
apply (erule cte_wp_at_weakenE)
|
||||
apply clarsimp
|
||||
apply (fastforce split:if_splits) (* takes 20 secs *)
|
||||
done
|
||||
|
||||
lemma device_update_ct_in_state:
|
||||
"\<lbrace>ct_in_state P\<rbrace>do_machine_op (device_update ds)
|
||||
"\<lbrace>ct_in_state P\<rbrace> do_machine_op (device_update ds)
|
||||
\<lbrace>\<lambda>_. ct_in_state P\<rbrace>"
|
||||
apply (simp add:do_machine_op_def device_update_def simpler_modify_def select_f_def
|
||||
gets_def get_def bind_def valid_def return_def)
|
||||
by (clarsimp simp:ct_in_state_def )
|
||||
|
||||
crunch device_state_inv[wp]: user_memory_update "\<lambda>ms. P (device_state ms)"
|
||||
|
||||
lemma dom_restrict_plus_eq:
|
||||
"a \<inter> b \<union> b = b"
|
||||
by auto
|
||||
|
||||
lemma user_memory_update[wp]:
|
||||
"\<lbrace>\<lambda>s. P (device_region s) \<rbrace> do_machine_op (user_memory_update a)
|
||||
\<lbrace>\<lambda>rv s. P (device_region s)\<rbrace>"
|
||||
by (simp add:do_machine_op_def user_memory_update_def simpler_modify_def
|
||||
valid_def bind_def gets_def return_def get_def select_f_def)
|
||||
|
||||
lemma device_frame_in_device_region:
|
||||
"\<lbrakk>in_device_frame p s; pspace_respects_device_region s\<rbrakk>
|
||||
\<Longrightarrow> device_state (machine_state s) p \<noteq> None"
|
||||
by (auto simp add:pspace_respects_device_region_def dom_def device_mem_def)
|
||||
|
||||
lemma do_user_op_invs:
|
||||
"\<lbrace>invs and ct_running\<rbrace>
|
||||
do_user_op f tc
|
||||
\<lbrace>\<lambda>_. invs and ct_running\<rbrace>"
|
||||
apply (simp add: do_user_op_def split_def)
|
||||
apply (wp device_update_invs device_update_ct_in_state)
|
||||
apply (wp ct_running_machine_op select_wp dmo_invs)
|
||||
apply (wp ct_running_machine_op select_wp dmo_invs | simp add:dom_restrict_plus_eq)+
|
||||
apply (clarsimp simp: user_mem_def user_memory_update_def simpler_modify_def
|
||||
restrict_map_def invs_def cur_tcb_def
|
||||
split: option.splits split_if_asm)
|
||||
apply (frule ptable_rights_imp_frame)
|
||||
apply fastforce
|
||||
apply simp
|
||||
apply (clarsimp simp:valid_state_def device_frame_in_device_region)
|
||||
done
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1639,8 +1639,16 @@ lemma set_pt_kernel_window[wp]:
|
|||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
lemma set_pt_respects_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_pt p pt \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_pt_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm
|
||||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
lemma set_pt_caps_kernel_window[wp]:
|
||||
lemma set_pt_caps_in_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window\<rbrace> set_pt p pt \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
|
||||
apply (simp add: set_pt_def)
|
||||
apply (wp set_object_cap_refs_in_kernel_window get_object_wp)
|
||||
|
|
@ -1649,6 +1657,15 @@ lemma set_pt_caps_kernel_window[wp]:
|
|||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
lemma set_pt_caps_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> set_pt p pt \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_pt_def)
|
||||
apply (wp set_object_cap_refs_respects_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm
|
||||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
|
||||
lemma set_pt_valid_ioc[wp]:
|
||||
"\<lbrace>valid_ioc\<rbrace> set_pt p pt \<lbrace>\<lambda>_. valid_ioc\<rbrace>"
|
||||
|
|
@ -1661,7 +1678,7 @@ lemma set_pt_valid_ioc[wp]:
|
|||
|
||||
lemma valid_machine_stateE:
|
||||
assumes vm: "valid_machine_state s"
|
||||
assumes e: "\<lbrakk>in_user_frame p s \<or> in_device_frame p s
|
||||
assumes e: "\<lbrakk>in_user_frame p s
|
||||
\<or> underlying_memory (machine_state s) p = 0 \<rbrakk> \<Longrightarrow> E "
|
||||
shows E
|
||||
using vm
|
||||
|
|
@ -1698,8 +1715,6 @@ shows
|
|||
apply (elim disjE,simp_all)
|
||||
apply (drule(1) in_user_frame_same_type_upd[OF tyat])
|
||||
apply simp+
|
||||
apply (drule(1) in_device_frame_same_type_upd[OF tyat])
|
||||
apply simp
|
||||
done
|
||||
done
|
||||
|
||||
|
|
@ -2194,6 +2209,13 @@ lemma set_asid_pool_kernel_window[wp]:
|
|||
including unfold_objects_asm
|
||||
by (clarsimp simp: a_type_def)
|
||||
|
||||
lemma set_asid_pool_pspace_respects_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_asid_pool p ap \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_asid_pool_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
including unfold_objects_asm
|
||||
by (clarsimp simp: a_type_def)
|
||||
|
||||
|
||||
lemma set_asid_pool_caps_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window\<rbrace> set_asid_pool p ap \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
|
||||
|
|
@ -2202,6 +2224,13 @@ lemma set_asid_pool_caps_kernel_window[wp]:
|
|||
including unfold_objects_asm
|
||||
by clarsimp
|
||||
|
||||
lemma set_asid_pool_caps_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> set_asid_pool p ap \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_asid_pool_def)
|
||||
apply (wp set_object_cap_refs_respects_device_region get_object_wp)
|
||||
including unfold_objects_asm
|
||||
by clarsimp
|
||||
|
||||
|
||||
lemma set_asid_pool_valid_ioc[wp]:
|
||||
"\<lbrace>valid_ioc\<rbrace> set_asid_pool p ap \<lbrace>\<lambda>_. valid_ioc\<rbrace>"
|
||||
|
|
@ -3323,6 +3352,15 @@ lemma set_pd_kernel_window[wp]:
|
|||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
lemma set_pd_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_pd p pd \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_pd_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm
|
||||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
|
||||
lemma set_pd_caps_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window\<rbrace> set_pd p pd \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
|
||||
|
|
@ -3333,6 +3371,14 @@ lemma set_pd_caps_kernel_window[wp]:
|
|||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
lemma set_pd_caps_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> set_pd p pd \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_pd_def)
|
||||
apply (wp set_object_cap_refs_respects_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm
|
||||
arch_kernel_obj.split_asm)
|
||||
done
|
||||
|
||||
lemma set_pd_valid_ioc[wp]:
|
||||
"\<lbrace>valid_ioc\<rbrace> set_pd p pt \<lbrace>\<lambda>_. valid_ioc\<rbrace>"
|
||||
|
|
|
|||
|
|
@ -574,6 +574,7 @@ lemma retype_region_no_cap_to_obj:
|
|||
and caps_no_overlap ptr sz
|
||||
and pspace_no_overlap ptr sz
|
||||
and no_cap_to_obj_with_diff_ref cap S
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = Structures_A.CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) 1) \<rbrace>
|
||||
retype_region ptr 1 us ty dev
|
||||
|
|
@ -737,6 +738,9 @@ lemma valid_kernel_mappings_asid_upd [iff]:
|
|||
= valid_kernel_mappings s"
|
||||
by (simp add: valid_kernel_mappings_def)
|
||||
|
||||
lemma safe_parent_cap_is_device:
|
||||
"safe_parent_for m p cap pcap \<Longrightarrow> cap_is_device cap = cap_is_device pcap"
|
||||
by (simp add: safe_parent_for_def)
|
||||
|
||||
lemma cap_insert_ap_invs:
|
||||
"\<lbrace>invs and valid_cap cap and tcb_cap_valid cap dest and
|
||||
|
|
@ -762,8 +766,9 @@ lemma cap_insert_ap_invs:
|
|||
cap_insert_valid_global_refs cap_insert_idle
|
||||
valid_irq_node_typ cap_insert_simple_arch_caps_ap)
|
||||
apply (clarsimp simp: is_simple_cap_def cte_wp_at_caps_of_state is_cap_simps)
|
||||
apply (frule safe_parent_cap_is_device)
|
||||
apply (drule safe_parent_cap_range)
|
||||
apply simp
|
||||
apply (simp add:cap_range_def)
|
||||
apply (rule conjI)
|
||||
prefer 2
|
||||
apply (clarsimp simp: obj_at_def a_type_def)
|
||||
|
|
@ -878,6 +883,21 @@ lemma perform_asid_control_invocation_st_tcb_at:
|
|||
done
|
||||
|
||||
|
||||
lemma set_cap_idx_up_aligned_area:
|
||||
"\<lbrace>K (pcap = UntypedCap dev ptr pageBits idx) and cte_wp_at (op = pcap) slot and valid_objs\<rbrace> set_cap (max_free_index_update pcap) slot
|
||||
\<lbrace>\<lambda>rv s. (\<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr pageBits \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (wp hoare_vcg_ex_lift set_cap_cte_wp_at)
|
||||
apply (rule_tac x = slot in exI)
|
||||
apply clarsimp
|
||||
apply (frule(1) cte_wp_valid_cap)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state is_aligned_neg_mask_eq
|
||||
p_assoc_help valid_cap_def valid_untyped_def cap_aligned_def)
|
||||
done
|
||||
|
||||
primrec get_untyped_cap_idx :: "cap \<Rightarrow> nat"
|
||||
where "get_untyped_cap_idx (UntypedCap dev ref sz idx) = idx"
|
||||
|
||||
lemma aci_invs':
|
||||
assumes Q_ignores_arch[simp]: "\<And>f s. Q (arch_state_update f s) = Q s"
|
||||
assumes Q_ignore_machine_state[simp]: "\<And>f s. Q (machine_state_update f s) = Q s"
|
||||
|
|
@ -946,7 +966,9 @@ lemma aci_invs':
|
|||
cong: conj_cong)
|
||||
apply (wp set_cap_caps_no_overlap set_cap_no_overlap get_cap_wp
|
||||
max_index_upd_caps_overlap_reserved max_index_upd_invs_simple
|
||||
set_cap_cte_cap_wp_to set_cap_cte_wp_at max_index_upd_no_cap_to)
|
||||
set_cap_cte_cap_wp_to set_cap_cte_wp_at max_index_upd_no_cap_to
|
||||
set_cap_idx_up_aligned_area[where dev = False,simplified]
|
||||
)
|
||||
apply (rule_tac P = "is_aligned word1 page_bits" in hoare_gen_asm)
|
||||
apply (subst delete_objects_rewrite)
|
||||
apply (simp add:page_bits_def pageBits_def)
|
||||
|
|
@ -998,6 +1020,8 @@ lemma aci_invs':
|
|||
apply (clarsimp simp:region_in_kernel_window_def valid_cap_def
|
||||
cap_aligned_def is_aligned_neg_mask_eq)
|
||||
apply clarsimp
|
||||
apply (rule get_untyped_cap_idx.simps[symmetric])
|
||||
apply (clarsimp dest!: invs_valid_objs)
|
||||
apply (clarsimp simp:obj_bits_api_def page_bits_def
|
||||
default_arch_object_def arch_kobj_size_def)+
|
||||
apply (erule(1) cap_to_protected)
|
||||
|
|
|
|||
|
|
@ -2226,6 +2226,56 @@ lemma cap_swap_vms[wp]:
|
|||
hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_disj_lift)
|
||||
done
|
||||
|
||||
crunch pspace_respects_device_region[wp]: cap_swap pspace_respects_device_region
|
||||
|
||||
lemma cap_refs_respects_device_region_original_cap[wp]:
|
||||
"cap_refs_respects_device_region
|
||||
(s\<lparr>is_original_cap := ocp\<rparr>) = cap_refs_respects_device_region s"
|
||||
by (simp add:cap_refs_respects_device_region_def)
|
||||
|
||||
lemma weak_derived_cap_is_device:
|
||||
"\<lbrakk>weak_derived c' c\<rbrakk> \<Longrightarrow> cap_is_device c = cap_is_device c'"
|
||||
apply (auto simp: weak_derived_def copy_of_def is_cap_simps
|
||||
same_object_as_def2
|
||||
split: split_if_asm
|
||||
dest!: master_cap_eq_is_device_cap_eq)
|
||||
done
|
||||
|
||||
lemma cap_swap_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\<rbrace>
|
||||
cap_swap c a c' b \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (simp add:cap_swap_def)
|
||||
apply wp
|
||||
apply (simp add:cap_refs_respects_device_region_def)
|
||||
apply (rule hoare_strengthen_post[OF CSpace_AI.set_cdt_cap_refs_respects_device_region])
|
||||
apply simp
|
||||
apply wp
|
||||
apply (clarsimp simp add: cap_refs_respects_device_region_def cte_wp_at_caps_of_state
|
||||
cap_range_respects_device_region_def
|
||||
simp del: split_paired_All split_paired_Ex split_paired_all
|
||||
| wp hoare_vcg_all_lift hoare_vcg_imp_lift)+
|
||||
apply (frule_tac x = a in spec)
|
||||
apply (frule_tac x = b in spec)
|
||||
apply (clarsimp simp: weak_derived_cap_range)
|
||||
apply (intro conjI impI allI)
|
||||
apply (simp add:weak_derived_cap_range weak_derived_cap_is_device)+
|
||||
apply (rule ccontr)
|
||||
apply simp
|
||||
apply (rule disjI2)
|
||||
apply (intro conjI impI)
|
||||
apply (simp add:weak_derived_cap_range weak_derived_cap_is_device)+
|
||||
apply (rule ccontr)
|
||||
apply simp
|
||||
apply (simp add:weak_derived_cap_range weak_derived_cap_is_device)+
|
||||
apply (rule ccontr)
|
||||
apply simp
|
||||
apply (rule disjI2)
|
||||
apply (rule ccontr)
|
||||
apply (clarsimp simp add:weak_derived_cap_range weak_derived_cap_is_device)+
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
crunch valid_irq_states[wp]: cap_swap "valid_irq_states"
|
||||
|
||||
lemma cap_swap_invs[wp]:
|
||||
|
|
@ -4101,6 +4151,8 @@ lemma cap_move_invs[wp]:
|
|||
apply (wp set_cap_valid_objs set_cap_idle set_cap_typ_at
|
||||
cap_table_at_lift_irq tcb_at_typ_at
|
||||
hoare_vcg_disj_lift hoare_vcg_all_lift
|
||||
set_cap_cap_refs_respects_device_region_NullCap
|
||||
| wp set_cap_cap_refs_respects_device_region_spec[where ptr = ptr]
|
||||
| simp del: split_paired_Ex split_paired_All
|
||||
| simp add: valid_irq_node_def valid_machine_state_def
|
||||
del: split_paired_All split_paired_Ex)+
|
||||
|
|
@ -4109,10 +4161,11 @@ lemma cap_move_invs[wp]:
|
|||
apply (frule(1) cap_refs_in_kernel_windowD[where ptr=ptr])
|
||||
apply (frule weak_derived_cap_range)
|
||||
apply (frule weak_derived_is_reply_master)
|
||||
apply (frule weak_derived_cap_is_device)
|
||||
apply (simp add: cap_range_NullCap valid_ipc_buffer_cap_def[where c=cap.NullCap])
|
||||
apply (simp add: is_cap_simps)
|
||||
apply (subgoal_tac "tcb_cap_valid cap.NullCap ptr s")
|
||||
apply (simp add: tcb_cap_valid_def)
|
||||
apply (simp add: tcb_cap_valid_def)
|
||||
apply (rule tcb_cap_valid_NullCapD)
|
||||
apply (erule(1) tcb_cap_valid_caps_of_stateD)
|
||||
apply (simp add: is_cap_simps)
|
||||
|
|
|
|||
|
|
@ -1261,7 +1261,7 @@ where
|
|||
\<and> \<not> is_untyped_cap newcap \<and> \<not> is_master_reply_cap newcap
|
||||
\<and> \<not> is_reply_cap newcap
|
||||
\<and> newcap \<noteq> cap.IRQControlCap
|
||||
\<and> (newcap \<noteq> cap.NullCap \<longrightarrow> cap_class newcap = cap_class cap)
|
||||
\<and> (newcap \<noteq> cap.NullCap \<longrightarrow> (cap_class newcap = cap_class cap \<and> cap_is_device newcap = cap_is_device cap))
|
||||
\<and> (\<forall>vref. vs_cap_ref cap = Some vref
|
||||
\<longrightarrow> (vs_cap_ref newcap = Some vref
|
||||
\<and> obj_refs newcap = obj_refs cap)
|
||||
|
|
@ -1999,6 +1999,16 @@ lemma set_cap_kernel_window[wp]:
|
|||
a_type_def wf_cs_upd)
|
||||
done
|
||||
|
||||
lemma set_cap_pspace_respects_device[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_cap cap p \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_cap_def split_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp | wpc)+
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (clarsimp simp: fun_upd_def[symmetric]
|
||||
a_type_def wf_cs_upd)
|
||||
done
|
||||
|
||||
|
||||
lemma set_cap_cap_refs_in_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window
|
||||
and (\<lambda>s. \<forall>ref \<in> cap_range cap. arm_kernel_vspace (arch_state s) ref
|
||||
|
|
@ -2013,6 +2023,76 @@ lemma set_cap_cap_refs_in_kernel_window[wp]:
|
|||
apply wp
|
||||
done
|
||||
|
||||
lemma set_cap_cap_refs_respects_device_region:
|
||||
"\<lbrace>cap_refs_respects_device_region
|
||||
and (\<lambda>s. \<exists>ptr. cte_wp_at (\<lambda>c. cap_range cap \<subseteq> cap_range c \<and>((cap_range cap \<noteq> {}) \<longrightarrow> cap_is_device cap = cap_is_device c)) ptr s)\<rbrace>
|
||||
set_cap cap p
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: cap_refs_respects_device_region_def cap_range_respects_device_region_def)
|
||||
apply (rule hoare_pre)
|
||||
apply wps
|
||||
apply (simp add: cte_wp_at_caps_of_state)
|
||||
apply (wp hoare_vcg_all_lift)
|
||||
apply clarsimp
|
||||
apply (rule conjI)
|
||||
apply (rule impI)
|
||||
apply (drule_tac x = a in spec)
|
||||
apply (drule_tac x = b in spec)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state)
|
||||
apply fastforce
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state)
|
||||
done
|
||||
|
||||
lemma set_cap_cap_refs_respects_device_region_spec:
|
||||
"\<lbrace>cap_refs_respects_device_region
|
||||
and (\<lambda>s. cte_wp_at (\<lambda>c. cap_range cap \<subseteq> cap_range c \<and> ((cap_range cap \<noteq> {}) \<longrightarrow> cap_is_device cap = cap_is_device c)) ptr s)\<rbrace>
|
||||
set_cap cap p
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (wp set_cap_cap_refs_respects_device_region)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma set_cap_cap_refs_respects_device_region_NullCap:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace>
|
||||
set_cap NullCap p
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: cap_refs_respects_device_region_def cap_range_respects_device_region_def)
|
||||
apply (rule hoare_pre)
|
||||
apply wps
|
||||
apply (simp add: cte_wp_at_caps_of_state )
|
||||
apply (wp hoare_vcg_all_lift)
|
||||
apply (clarsimp simp:cap_range_def)
|
||||
apply (drule_tac x = x in spec)
|
||||
apply (drule_tac x = xa in spec)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state)
|
||||
done
|
||||
|
||||
lemma replaceable_cap_range:
|
||||
"replaceable s p cap c \<Longrightarrow> cap_range cap \<subseteq> cap_range c"
|
||||
apply (simp add:replaceable_def)
|
||||
apply (elim disjE,simp_all)
|
||||
apply (clarsimp simp:cap_range_def)
|
||||
apply (case_tac cap,simp_all add:is_cap_simps cap_range_def)
|
||||
done
|
||||
|
||||
lemma replaceable_cap_is_device_cap:
|
||||
"\<lbrakk>replaceable s p cap c; cap \<noteq> NullCap\<rbrakk>\<Longrightarrow> cap_is_device cap = cap_is_device c"
|
||||
apply (simp add:replaceable_def is_cap_simps is_final_cap'_def)
|
||||
apply (elim disjE,simp_all add:is_cap_simps)
|
||||
done
|
||||
|
||||
lemma set_cap_cap_refs_respects_device_region_replaceable:
|
||||
"\<lbrace>cap_refs_respects_device_region and (\<lambda>s. cte_wp_at (replaceable s p cap) p s)\<rbrace>
|
||||
set_cap cap p
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (case_tac "cap = NullCap")
|
||||
apply (wp set_cap_cap_refs_respects_device_region_NullCap | simp)+
|
||||
apply (wp set_cap_cap_refs_respects_device_region_spec[where ptr = p])
|
||||
apply clarsimp
|
||||
apply (erule cte_wp_at_weakenE)
|
||||
apply (simp add: replaceable_cap_is_device_cap replaceable_cap_range)
|
||||
done
|
||||
|
||||
(* FIXME: SELFOUR-421 - how does this change? *)
|
||||
lemma cap_refs_in_kernel_windowD:
|
||||
"\<lbrakk> caps_of_state s ptr = Some cap; cap_refs_in_kernel_window s \<rbrakk>
|
||||
|
|
@ -2110,6 +2190,9 @@ lemma descendants_inc_minor:
|
|||
apply simp
|
||||
done
|
||||
|
||||
|
||||
|
||||
|
||||
lemma replace_cap_invs:
|
||||
"\<lbrace>\<lambda>s. invs s \<and> cte_wp_at (replaceable s p cap) p s
|
||||
\<and> cap \<noteq> cap.NullCap
|
||||
|
|
@ -2123,9 +2206,9 @@ lemma replace_cap_invs:
|
|||
set_cap_caps_of_state2 set_cap_idle
|
||||
replace_cap_ifunsafe valid_irq_node_typ
|
||||
set_cap_typ_at set_cap_irq_handlers
|
||||
set_cap_valid_arch_caps set_cap_valid_arch_objs)
|
||||
apply (clarsimp simp: valid_pspace_def cte_wp_at_caps_of_state
|
||||
replaceable_def)
|
||||
set_cap_valid_arch_caps set_cap_valid_arch_objs
|
||||
set_cap_cap_refs_respects_device_region_replaceable)
|
||||
apply (clarsimp simp: valid_pspace_def cte_wp_at_caps_of_state replaceable_def)
|
||||
apply (rule conjI)
|
||||
apply (fastforce simp: tcb_cap_valid_def
|
||||
dest!: cte_wp_tcb_cap_valid [OF caps_of_state_cteD])
|
||||
|
|
|
|||
|
|
@ -3653,7 +3653,8 @@ lemma set_free_index_invs:
|
|||
apply wps
|
||||
|
||||
apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap_arch_objs set_cap_valid_arch_caps
|
||||
set_cap_valid_global_objs set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at )
|
||||
set_cap_valid_global_objs set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at
|
||||
set_cap_cap_refs_respects_device_region_spec[where ptr = cref])
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state)
|
||||
apply (rule conjI,simp add:valid_pspace_def)
|
||||
apply (rule conjI,clarsimp simp:is_cap_simps)
|
||||
|
|
@ -4410,9 +4411,14 @@ crunch global_pd_mappings[wp]: cap_insert "valid_global_pd_mappings"
|
|||
crunch pspace_in_kernel_window[wp]: cap_insert "pspace_in_kernel_window"
|
||||
(wp: crunch_wps)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: cap_insert "pspace_respects_device_region"
|
||||
(wp: crunch_wps)
|
||||
|
||||
|
||||
crunch cap_refs_in_kernel_window[wp]: update_cdt "cap_refs_in_kernel_window"
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: update_cdt "cap_refs_respects_device_region"
|
||||
|
||||
lemma cap_insert_cap_refs_in_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window
|
||||
and cte_wp_at (\<lambda>c. cap_range cap \<subseteq> cap_range c) src\<rbrace>
|
||||
|
|
@ -4425,12 +4431,34 @@ lemma cap_insert_cap_refs_in_kernel_window[wp]:
|
|||
apply auto
|
||||
done
|
||||
|
||||
lemma cap_is_device_free_index_update_simp[simp]:
|
||||
"is_untyped_cap c \<Longrightarrow> cap_is_device (max_free_index_update c) = cap_is_device c"
|
||||
by (case_tac c,simp_all add:is_cap_simps)
|
||||
|
||||
lemma cap_insert_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region
|
||||
and cte_wp_at (\<lambda>c. cap_range cap \<subseteq> cap_range c \<and> ((cap_range cap \<noteq> {}) \<longrightarrow> cap_is_device cap = cap_is_device c)) src\<rbrace>
|
||||
cap_insert cap src dest
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: cap_insert_def set_untyped_cap_as_full_def)
|
||||
apply (wp get_cap_wp set_cap_cte_wp_at' set_cap_cap_refs_respects_device_region_spec[where ptr = src]
|
||||
| simp split del: split_if)+
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state is_derived_def)
|
||||
done
|
||||
|
||||
lemma is_derived_cap_range:
|
||||
"is_derived m srcptr cap cap'
|
||||
\<Longrightarrow> cap_range cap' = cap_range cap"
|
||||
by (clarsimp simp: is_derived_def cap_range_def is_cap_simps dest!: master_cap_cap_range
|
||||
split: split_if_asm)
|
||||
|
||||
lemma is_derived_cap_is_device:
|
||||
"\<lbrakk>is_derived m srcptr cap cap'\<rbrakk>
|
||||
\<Longrightarrow> cap_is_device cap' = cap_is_device cap"
|
||||
apply (case_tac cap)
|
||||
apply (clarsimp simp: is_derived_def cap_range_def is_cap_simps cap_master_cap_def
|
||||
split: split_if_asm cap.splits arch_cap.splits)+
|
||||
done
|
||||
|
||||
lemma set_cdt_valid_ioc[wp]:
|
||||
"\<lbrace>valid_ioc\<rbrace> set_cdt t \<lbrace>\<lambda>_. valid_ioc\<rbrace>"
|
||||
|
|
@ -4508,7 +4536,7 @@ lemma cap_insert_invs[wp]:
|
|||
apply (rule hoare_pre)
|
||||
apply (wp cap_insert_valid_pspace cap_insert_ifunsafe cap_insert_idle
|
||||
valid_irq_node_typ cap_insert_valid_arch_caps)
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state
|
||||
apply (auto simp: cte_wp_at_caps_of_state is_derived_cap_is_device
|
||||
is_derived_cap_range valid_pspace_def)
|
||||
done
|
||||
|
||||
|
|
@ -5169,6 +5197,7 @@ crunch global_pd_mappings[wp]: setup_reply_master "valid_global_pd_mappings"
|
|||
|
||||
|
||||
crunch pspace_in_kernel_window[wp]: setup_reply_master "pspace_in_kernel_window"
|
||||
crunch pspace_respects_device_region[wp]: setup_reply_master "pspace_respects_device_region"
|
||||
|
||||
lemma setup_reply_master_cap_refs_in_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window and tcb_at t and pspace_in_kernel_window\<rbrace>
|
||||
|
|
@ -5180,8 +5209,20 @@ lemma setup_reply_master_cap_refs_in_kernel_window[wp]:
|
|||
cap_range_def)
|
||||
done
|
||||
|
||||
lemma setup_reply_master_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region and tcb_at t and pspace_in_kernel_window\<rbrace>
|
||||
setup_reply_master t
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: setup_reply_master_def)
|
||||
apply (wp get_cap_wp set_cap_cap_refs_respects_device_region)
|
||||
apply (clarsimp simp: pspace_in_kernel_window_def obj_at_def
|
||||
cap_range_def)
|
||||
apply (auto simp:cte_wp_at_caps_of_state)
|
||||
done
|
||||
|
||||
crunch cap_refs_in_kernel_window[wp]: setup_reply_master "cap_refs_in_kernel_window"
|
||||
|
||||
|
||||
lemma set_original_set_cap_comm:
|
||||
"(set_original slot val >>= (\<lambda>_. set_cap cap slot)) =
|
||||
(set_cap cap slot >>= (\<lambda>_. set_original slot val))"
|
||||
|
|
@ -5224,13 +5265,13 @@ definition
|
|||
\<not>is_pt_cap cap \<and> \<not> is_pd_cap cap"
|
||||
|
||||
|
||||
(* FIXME: SELFOUR-421: add conditions for device caps? *)
|
||||
definition
|
||||
"safe_parent_for m p cap parent \<equiv>
|
||||
cap_is_device cap = cap_is_device parent \<and>
|
||||
same_region_as parent cap \<and>
|
||||
((\<exists>irq. cap = cap.IRQHandlerCap irq) \<and> parent = cap.IRQControlCap \<or>
|
||||
is_untyped_cap parent \<and> descendants_of p m = {} (*\<and>
|
||||
(\<exists>frame base. cap = cap.ArchObjectCap (ASIDPoolCap frame base) \<longrightarrow> cap_is_device parent)*))"
|
||||
is_untyped_cap parent \<and> descendants_of p m = {} (*\<and>
|
||||
(\<exists>frame base. cap = cap.ArchObjectCap (ASIDPoolCap frame base) \<longrightarrow> cap_is_device parent)*))"
|
||||
|
||||
|
||||
(* FIXME: prove same_region_as_def2 instead or change def *)
|
||||
|
|
@ -5511,11 +5552,11 @@ lemma cap_insert_simple_invs:
|
|||
cap_insert_valid_global_refs cap_insert_idle
|
||||
valid_irq_node_typ cap_insert_simple_arch_caps_no_ap)
|
||||
apply (clarsimp simp: is_simple_cap_def cte_wp_at_caps_of_state)
|
||||
apply (drule safe_parent_cap_range)
|
||||
apply (frule safe_parent_cap_range)
|
||||
apply simp
|
||||
apply (rule conjI)
|
||||
prefer 2
|
||||
apply (clarsimp simp: is_cap_simps)
|
||||
apply (clarsimp simp: is_cap_simps safe_parent_for_def)
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state)
|
||||
apply (drule_tac p="(a,b)" in caps_of_state_valid_cap, fastforce)
|
||||
apply (clarsimp dest!: is_cap_simps' [THEN iffD1])
|
||||
|
|
|
|||
|
|
@ -168,15 +168,7 @@ lemma caps_of_state_ko:
|
|||
done
|
||||
|
||||
|
||||
lemma p_in_obj_range:
|
||||
"\<lbrakk> kheap s p = Some ko; pspace_aligned s; valid_objs s \<rbrakk> \<Longrightarrow> p \<in> obj_range p ko"
|
||||
apply (simp add: pspace_aligned_def)
|
||||
apply (drule bspec, erule domI)
|
||||
apply (drule valid_obj_sizes, erule ranI)
|
||||
apply (simp add: obj_range_def add_diff_eq[symmetric])
|
||||
apply (erule is_aligned_no_wrap')
|
||||
apply (erule word_power_less_1[where 'a=32, folded word_bits_def])
|
||||
done
|
||||
|
||||
|
||||
|
||||
lemma untyped_cap_descendants_range:
|
||||
|
|
@ -507,7 +499,7 @@ proof (simp add: invs_def valid_state_def valid_pspace_def
|
|||
apply (auto simp: valid_ntfn_def ntfn_bound_refs_def split: option.splits)
|
||||
done
|
||||
|
||||
show "valid_objs (detype (untyped_range cap) s)"
|
||||
show vobjs: "valid_objs (detype (untyped_range cap) s)"
|
||||
using invs_valid_objs[OF invs]
|
||||
apply (clarsimp simp add: valid_objs_def dom_def)
|
||||
apply (erule allE, erule impE, erule exI)
|
||||
|
|
@ -515,7 +507,7 @@ proof (simp add: invs_def valid_state_def valid_pspace_def
|
|||
apply (simp add: obj_at_def)
|
||||
done
|
||||
|
||||
show "pspace_aligned (detype (untyped_range cap) s)"
|
||||
show psp_aligned: "pspace_aligned (detype (untyped_range cap) s)"
|
||||
using invs_psp_aligned[OF invs]
|
||||
apply (clarsimp simp: pspace_aligned_def)
|
||||
apply (drule bspec, erule domI)
|
||||
|
|
@ -944,6 +936,25 @@ proof (simp add: invs_def valid_state_def valid_pspace_def
|
|||
by (simp add: valid_kernel_mappings_def detype_def
|
||||
ball_ran_eq)
|
||||
|
||||
have "pspace_respects_device_region s"
|
||||
using invs by (simp add: invs_def valid_state_def)
|
||||
thus "pspace_respects_device_region (clear_um (untyped_range cap) (detype (untyped_range cap) s))"
|
||||
apply (intro pspace_respects_device_regionI)
|
||||
using psp_aligned vobjs invs
|
||||
apply (simp_all add:clear_um.pspace detype_def dom_def clear_um_def
|
||||
split:split_if_asm )
|
||||
apply (drule pspace_respects_device_regionD[rotated -1],auto)+
|
||||
done
|
||||
|
||||
have "cap_refs_respects_device_region s"
|
||||
using invs by (simp add:invs_def valid_state_def)
|
||||
thus "cap_refs_respects_device_region (clear_um (untyped_range cap) (detype (untyped_range cap) s))"
|
||||
apply (clarsimp simp:clear_um_def cap_refs_respects_device_region_def cte_wp_at_detype
|
||||
simp del:split_paired_All split_paired_Ex)
|
||||
apply (drule_tac x = "(a,b)" in spec)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state cap_range_respects_device_region_def detype_def)
|
||||
done
|
||||
|
||||
have "valid_asid_map s"
|
||||
using invs by (simp add: invs_def valid_state_def)
|
||||
thus "valid_asid_map (detype (untyped_range cap) s)"
|
||||
|
|
|
|||
|
|
@ -326,7 +326,9 @@ lemma empty_slot_invs:
|
|||
apply (wp replace_cap_valid_pspace set_cap_caps_of_state2
|
||||
replace_cap_ifunsafe get_cap_wp
|
||||
set_cap_idle valid_irq_node_typ set_cap_typ_at
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps | simp add: trans_state_update[symmetric] del: trans_state_update fun_upd_apply split del: split_if )+
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps
|
||||
set_cap_cap_refs_respects_device_region_NullCap
|
||||
| simp add: trans_state_update[symmetric] del: trans_state_update fun_upd_apply split del: split_if )+
|
||||
apply (clarsimp simp: is_final_cap'_def2 simp del: fun_upd_apply)
|
||||
apply (clarsimp simp: conj_comms invs_def valid_state_def valid_mdb_def2)
|
||||
apply (subgoal_tac "mdb_empty_abs s")
|
||||
|
|
@ -2998,6 +3000,9 @@ lemma clearMemory_invs[wp]:
|
|||
apply (simp add: do_machine_op_def split_def)
|
||||
apply wp
|
||||
apply (clarsimp simp: invs_def valid_state_def clearMemory_vms cur_tcb_def)
|
||||
apply (frule use_valid)
|
||||
apply (rule_tac P = "\<lambda>ms. ms = device_state (machine_state s)" in clearMemory_device_state_inv)
|
||||
apply clarsimp+
|
||||
apply(erule use_valid[OF _ clearMemory_valid_irq_states], simp)
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -56,7 +56,9 @@ definition all_invs_but_valid_irq_states_for where
|
|||
valid_asid_map and
|
||||
valid_global_pd_mappings and
|
||||
pspace_in_kernel_window and
|
||||
cap_refs_in_kernel_window and cur_tcb"
|
||||
cap_refs_in_kernel_window and
|
||||
pspace_respects_device_region and
|
||||
cap_refs_respects_device_region and cur_tcb"
|
||||
|
||||
lemma dmo_maskInterrupt_invs:
|
||||
"\<lbrace>all_invs_but_valid_irq_states_for irq and (\<lambda>s. state = interrupt_states s irq)\<rbrace>
|
||||
|
|
|
|||
|
|
@ -331,6 +331,8 @@ lemma invoke_irq_control_invs[wp]:
|
|||
ex_cte_cap_to_cnode_always_appropriate_strg)
|
||||
done
|
||||
|
||||
crunch device_state_inv[wp]: resetTimer "\<lambda>ms. P (device_state ms)"
|
||||
|
||||
lemma resetTimer_invs[wp]:
|
||||
"\<lbrace>invs\<rbrace> do_machine_op resetTimer \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (wp dmo_invs)
|
||||
|
|
|
|||
|
|
@ -1041,6 +1041,32 @@ where
|
|||
(\<forall>y \<in> {x .. x + (2 ^ obj_bits ko) - 1}.
|
||||
arm_kernel_vspace (arch_state s) y = ArmVSpaceKernelWindow)"
|
||||
|
||||
text "objects live in device_region or non_device_region"
|
||||
|
||||
definition
|
||||
"in_device_frame p \<equiv> \<lambda>s.
|
||||
\<exists>sz. typ_at (AArch (ADeviceData sz)) (p && ~~ mask (pageBitsForSize sz)) s"
|
||||
|
||||
definition
|
||||
"user_mem s \<equiv> \<lambda>p.
|
||||
if (in_user_frame p s)
|
||||
then Some (underlying_memory (machine_state s) p)
|
||||
else None"
|
||||
|
||||
definition
|
||||
"device_mem s \<equiv> \<lambda>p.
|
||||
if (in_device_frame p s)
|
||||
then Some p
|
||||
else None"
|
||||
|
||||
abbreviation "device_region s \<equiv> dom (device_state (machine_state s))"
|
||||
|
||||
definition
|
||||
pspace_respects_device_region:: "'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"pspace_respects_device_region \<equiv> \<lambda>s. (dom (user_mem s)) \<subseteq> - (device_region s)
|
||||
\<and> (dom (device_mem s)) \<subseteq> (device_region s)"
|
||||
|
||||
primrec
|
||||
live :: "Structures_A.kernel_object \<Rightarrow> bool"
|
||||
where
|
||||
|
|
@ -1302,6 +1328,16 @@ where
|
|||
"cap_refs_in_kernel_window \<equiv> \<lambda>s. valid_refs
|
||||
{x. arm_kernel_vspace (arch_state s) x \<noteq> ArmVSpaceKernelWindow} s"
|
||||
|
||||
definition "cap_range_respects_device_region c s \<equiv>
|
||||
if (cap_is_device c) then cap_range c \<subseteq> device_region s
|
||||
else cap_range c \<subseteq> - device_region s"
|
||||
|
||||
definition
|
||||
cap_refs_respects_device_region :: "'z::state_ext state \<Rightarrow> bool"
|
||||
where
|
||||
"cap_refs_respects_device_region \<equiv> \<lambda>s. \<forall>cref.
|
||||
\<not> cte_wp_at (\<lambda>c. \<not> cap_range_respects_device_region c s) cref s"
|
||||
|
||||
definition
|
||||
vs_cap_ref :: "cap \<Rightarrow> vs_ref list option"
|
||||
where
|
||||
|
|
@ -1417,13 +1453,11 @@ definition
|
|||
(\<lambda>s. unique_table_caps (caps_of_state s)
|
||||
\<and> unique_table_refs (caps_of_state s))"
|
||||
|
||||
definition
|
||||
"in_device_frame p \<equiv> \<lambda>s.
|
||||
\<exists>sz. typ_at (AArch (ADeviceData sz)) (p && ~~ mask (pageBitsForSize sz)) s"
|
||||
|
||||
(* FIXME: this is a bit cheating as we assume that if in_device_frame p (s::'z::state_ext state)
|
||||
then um p = 0 *)
|
||||
definition
|
||||
"valid_machine_state \<equiv>
|
||||
\<lambda>s. \<forall>p. in_user_frame p (s::'z::state_ext state) \<or> in_device_frame p (s::'z::state_ext state) \<or> underlying_memory (machine_state s) p = 0"
|
||||
\<lambda>s. \<forall>p. in_user_frame p (s::'z::state_ext state) \<or> underlying_memory (machine_state s) p = 0"
|
||||
|
||||
definition
|
||||
valid_state :: "'z::state_ext state \<Rightarrow> bool"
|
||||
|
|
@ -1450,7 +1484,9 @@ where
|
|||
and valid_asid_map
|
||||
and valid_global_pd_mappings
|
||||
and pspace_in_kernel_window
|
||||
and cap_refs_in_kernel_window"
|
||||
and cap_refs_in_kernel_window
|
||||
and pspace_respects_device_region
|
||||
and cap_refs_respects_device_region"
|
||||
|
||||
definition
|
||||
"ct_in_state test \<equiv> \<lambda>s. st_tcb_at test (cur_thread s) s"
|
||||
|
|
@ -1540,6 +1576,7 @@ abbreviation(input)
|
|||
and equal_kernel_mappings and valid_asid_map
|
||||
and valid_global_pd_mappings
|
||||
and pspace_in_kernel_window and cap_refs_in_kernel_window
|
||||
and pspace_respects_device_region and cap_refs_respects_device_region
|
||||
and cur_tcb"
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -345,6 +345,9 @@ lemma set_ep_cap_refs_in_kernel_window [wp]:
|
|||
split: Structures_A.kernel_object.splits)
|
||||
done
|
||||
|
||||
crunch pspace_respects_device_region[wp]: set_endpoint pspace_respects_device_region
|
||||
crunch cap_refs_respects_device_region[wp]: set_endpoint cap_refs_respects_device_region
|
||||
(wp: crunch_wps)
|
||||
|
||||
lemma set_endpoint_valid_ioc[wp]:
|
||||
"\<lbrace>valid_ioc\<rbrace> set_endpoint ptr ep \<lbrace>\<lambda>rv. valid_ioc\<rbrace>"
|
||||
|
|
@ -929,6 +932,8 @@ lemma cancel_all_ipc_invs_helper:
|
|||
apply (rule hoare_pre)
|
||||
apply (wp cancel_all_invs_helper hoare_vcg_const_Ball_lift valid_irq_node_typ)
|
||||
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def valid_ep_def)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp elim!:obj_at_weakenE)
|
||||
apply (rule conjI)
|
||||
apply (clarsimp elim!:obj_at_weakenE)
|
||||
apply (rule conjI)
|
||||
|
|
@ -1252,7 +1257,7 @@ lemma cancel_badged_sends_invs[wp]:
|
|||
cong: list.case_cong)
|
||||
apply (rule hoare_strengthen_post,
|
||||
rule cancel_badged_sends_filterM_helper[where epptr=epptr])
|
||||
apply blast
|
||||
apply (auto intro:obj_at_weakenE)[1]
|
||||
apply (wp valid_irq_node_typ)
|
||||
apply (clarsimp simp: valid_ep_def conj_comms)
|
||||
apply (subst obj_at_weakenE[where P'=is_ep], assumption)
|
||||
|
|
@ -1261,7 +1266,7 @@ lemma cancel_badged_sends_invs[wp]:
|
|||
apply (frule(1) if_live_then_nonz_capD, clarsimp+)
|
||||
apply (erule(1) obj_at_valid_objsE)
|
||||
apply (clarsimp simp: valid_obj_def valid_ep_def st_tcb_at_refs_of_rev)
|
||||
apply (simp add: fun_upd_idem | subst fun_upd_def[symmetric])+
|
||||
apply (simp add: fun_upd_idem obj_at_def is_ep_def | subst fun_upd_def[symmetric])+
|
||||
apply (clarsimp, drule(1) bspec)
|
||||
apply (drule st_tcb_at_state_refs_ofD)
|
||||
apply (clarsimp simp only: cancel_badged_sends_invs_helper Un_iff, clarsimp)
|
||||
|
|
|
|||
|
|
@ -1236,7 +1236,7 @@ proof -
|
|||
p && ~~ mask (pageBitsForSize sz)")
|
||||
apply (simp only: is_aligned_mask[of _ 2])
|
||||
apply (elim disjE, simp_all add:is_aligned_mask)
|
||||
apply (rule aligned_offset_ignore[symmetric], simp+)+
|
||||
apply (auto intro: aligned_offset_ignore[symmetric])
|
||||
done
|
||||
qed
|
||||
|
||||
|
|
@ -1254,6 +1254,11 @@ lemma transfer_caps_loop_vms[wp]:
|
|||
crunch valid_irq_states[wp]: set_extra_badge "valid_irq_states"
|
||||
(ignore: do_machine_op)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: set_extra_badge "pspace_respects_device_region"
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: set_extra_badge "cap_refs_respects_device_region"
|
||||
(wp: crunch_wps cap_refs_respects_device_region_dmo)
|
||||
|
||||
lemma transfer_caps_loop_valid_irq_states[wp]:
|
||||
"\<lbrace>\<lambda>s. valid_irq_states s\<rbrace>
|
||||
transfer_caps_loop ep buffer n caps slots mi
|
||||
|
|
@ -1261,6 +1266,31 @@ lemma transfer_caps_loop_valid_irq_states[wp]:
|
|||
apply(wp transfer_caps_loop_pres)
|
||||
done
|
||||
|
||||
lemma transfer_caps_respects_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region \<rbrace>
|
||||
transfer_caps_loop ep buffer n caps slots mi
|
||||
\<lbrace>\<lambda>_. pspace_respects_device_region\<rbrace>"
|
||||
apply(wp transfer_caps_loop_pres)
|
||||
done
|
||||
|
||||
lemma transfer_caps_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region and valid_objs and valid_mdb and (\<lambda>s. \<forall>slot \<in> set slots. real_cte_at slot s \<and> cte_wp_at (\<lambda>cap. cap = cap.NullCap) slot s)
|
||||
and transfer_caps_srcs caps and K (distinct slots)\<rbrace>
|
||||
transfer_caps_loop ep buffer n caps slots mi
|
||||
\<lbrace>\<lambda>_. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (rule transfer_caps_loop_presM[where vo=True and em=True and ex=False])
|
||||
apply wp
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state is_derived_cap_range is_derived_cap_is_device)
|
||||
apply (wp set_extra_badge_valid_mdb)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state)
|
||||
apply (drule(1) bspec)+
|
||||
apply clarsimp
|
||||
apply (drule(1) caps_of_state_valid)
|
||||
apply (case_tac "a = cap.NullCap")
|
||||
apply clarsimp+
|
||||
done
|
||||
|
||||
lemma transfer_caps_loop_invs[wp]:
|
||||
"\<lbrace>\<lambda>s. invs s
|
||||
\<and> (\<forall>x \<in> set slots. ex_cte_cap_wp_to is_cnode_cap x s) \<and> distinct slots
|
||||
|
|
@ -1996,10 +2026,23 @@ lemma as_user_cap_refs_in_kernel_window[wp]:
|
|||
thread_set_cap_refs_in_kernel_window
|
||||
| simp)+
|
||||
|
||||
lemma as_user_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> as_user t m \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
by (wp as_user_wp_thread_set_helper ball_tcb_cap_casesI
|
||||
thread_set_cap_refs_respects_device_region
|
||||
| simp)+
|
||||
|
||||
lemmas set_mrs_cap_refs_in_kernel_window[wp]
|
||||
= set_mrs_thread_set_dmo[OF thread_set_cap_refs_in_kernel_window
|
||||
do_machine_op_cap_refs_in_kernel_window]
|
||||
|
||||
crunch storeWord_device_state_inv[wp]: storeWord "\<lambda>ms. P (device_state ms)"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
|
||||
lemmas set_mrs_cap_refs_respects_device_region[wp]
|
||||
= set_mrs_thread_set_dmo[OF thread_set_cap_refs_respects_device_region
|
||||
VSpace_AI.cap_refs_respects_device_region_dmo[OF storeWord_storeWord_device_state_inv]]
|
||||
|
||||
crunch cap_refs_in_kernel_window[wp]: do_ipc_transfer "cap_refs_in_kernel_window"
|
||||
(wp: crunch_wps hoare_vcg_const_Ball_lift ball_tcb_cap_casesI
|
||||
simp: zipWithM_x_mapM crunch_simps ball_conj_distrib )
|
||||
|
|
@ -2854,8 +2897,102 @@ crunch vms[wp]: setup_caller_cap "valid_machine_state"
|
|||
|
||||
crunch valid_irq_states[wp]: setup_caller_cap "valid_irq_states"
|
||||
|
||||
crunch pspace_respects_device_region[wp]: setup_caller_cap "pspace_respects_device_region"
|
||||
|
||||
crunch cap_refs_respects_device_region: setup_caller_cap "cap_refs_respects_device_region"
|
||||
|
||||
lemma same_caps_tcb_upd_state[simp]:
|
||||
"same_caps (TCB (tcb \<lparr>tcb_state := BlockedOnReply\<rparr>)) = same_caps (TCB tcb)"
|
||||
apply (rule ext)
|
||||
apply (simp add:tcb_cap_cases_def)
|
||||
done
|
||||
|
||||
lemma same_caps_simps[simp]:
|
||||
"same_caps (CNode sz cs) = (\<lambda>val. val = CNode sz cs)"
|
||||
"same_caps (TCB tcb) = (\<lambda>val. (\<exists>tcb'. val = TCB tcb'
|
||||
\<and> (\<forall>(getF, t) \<in> ran tcb_cap_cases. getF tcb' = getF tcb)))"
|
||||
"same_caps (Endpoint ep) = (\<lambda>val. is_ep val)"
|
||||
"same_caps (Notification ntfn) = (\<lambda>val. is_ntfn val)"
|
||||
"same_caps (ArchObj ao) = (\<lambda>val. (\<exists>ao'. val = ArchObj ao'))"
|
||||
apply (rule ext)
|
||||
apply (case_tac val, (fastforce simp: is_obj_defs)+)+
|
||||
done
|
||||
|
||||
lemma tcb_at_cte_at_2:
|
||||
"tcb_at tcb s \<Longrightarrow> cte_at (tcb, tcb_cnode_index 2) s"
|
||||
by (auto simp: obj_at_def cte_at_cases is_tcb)
|
||||
|
||||
lemma tcb_at_cte_at_3:
|
||||
"tcb_at tcb s \<Longrightarrow> cte_at (tcb, tcb_cnode_index 3) s"
|
||||
by (auto simp: obj_at_def cte_at_cases is_tcb)
|
||||
|
||||
lemma setup_caller_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region and
|
||||
valid_objs\<rbrace>
|
||||
setup_caller_cap tcb cap
|
||||
\<lbrace>\<lambda>_. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add:setup_caller_cap_def set_thread_state_def | wp)+
|
||||
apply (wp set_object_cap_refs_respects_device_region set_object_cte_wp_at | clarsimp )+
|
||||
apply (clarsimp dest!:get_tcb_SomeD simp:tcb_cap_cases_def obj_at_def cap_range_def)
|
||||
apply (rule tcb_at_cte_at_2)
|
||||
apply (simp add:tcb_at_def get_tcb_def)
|
||||
done
|
||||
|
||||
crunch valid_irq_states[wp]: do_ipc_transfer "valid_irq_states"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: do_ipc_transfer "pspace_respects_device_region"
|
||||
(wp: crunch_wps simp: crunch_simps)
|
||||
|
||||
crunch cap_refs_in_kernel_window[wp]: do_ipc_transfer "cap_refs_in_kernel_window"
|
||||
(wp: crunch_wps hoare_vcg_const_Ball_lift ball_tcb_cap_casesI
|
||||
simp: zipWithM_x_mapM crunch_simps ball_conj_distrib )
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: do_fault_transfer "cap_refs_respects_device_region"
|
||||
(wp: crunch_wps hoare_vcg_const_Ball_lift
|
||||
VSpace_AI.cap_refs_respects_device_region_dmo ball_tcb_cap_casesI
|
||||
const_on_failure_wp simp: crunch_simps zipWithM_x_mapM ball_conj_distrib)
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: do_fault_transfer "cap_refs_respects_device_region"
|
||||
(wp: crunch_wps hoare_vcg_const_Ball_lift
|
||||
VSpace_AI.cap_refs_respects_device_region_dmo ball_tcb_cap_casesI
|
||||
const_on_failure_wp simp: crunch_simps zipWithM_x_mapM ball_conj_distrib)
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: copy_mrs "cap_refs_respects_device_region"
|
||||
(wp: crunch_wps hoare_vcg_const_Ball_lift
|
||||
VSpace_AI.cap_refs_respects_device_region_dmo ball_tcb_cap_casesI
|
||||
const_on_failure_wp simp: crunch_simps zipWithM_x_mapM ball_conj_distrib)
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: get_receive_slots "cap_refs_respects_device_region"
|
||||
(wp: crunch_wps hoare_vcg_const_Ball_lift
|
||||
VSpace_AI.cap_refs_respects_device_region_dmo ball_tcb_cap_casesI
|
||||
const_on_failure_wp simp: crunch_simps zipWithM_x_mapM )
|
||||
|
||||
lemma invs_respects_device_region:
|
||||
"invs s \<Longrightarrow> cap_refs_respects_device_region s \<and> pspace_respects_device_region s"
|
||||
by (clarsimp simp: invs_def valid_state_def)
|
||||
|
||||
lemma do_ipc_transfer_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region and tcb_at t and valid_objs and valid_mdb\<rbrace>
|
||||
do_ipc_transfer t ep bg grt r
|
||||
\<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: do_ipc_transfer_def)
|
||||
apply (wp|wpc)+
|
||||
apply (simp add: do_normal_transfer_def transfer_caps_def bind_assoc)
|
||||
apply (wp|wpc)+
|
||||
apply (rule hoare_vcg_all_lift)
|
||||
apply (rule hoare_drop_imps)
|
||||
apply wp
|
||||
apply (subst ball_conj_distrib)
|
||||
apply (wp get_rs_cte_at2 thread_get_wp static_imp_wp grs_distinct
|
||||
hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_conj_lift | simp)+
|
||||
apply (rule hoare_strengthen_post[where Q = "\<lambda>r s. cap_refs_respects_device_region s
|
||||
\<and> valid_objs s \<and> valid_mdb s \<and> obj_at (\<lambda>ko. \<exists>tcb. ko = TCB tcb) t s"])
|
||||
apply wp
|
||||
apply (clarsimp simp:obj_at_def is_tcb_def)
|
||||
apply (simp split: kernel_object.split_asm)
|
||||
apply auto
|
||||
done
|
||||
(*
|
||||
lemma as_user_obj_at_ntfn:
|
||||
"\<lbrace>obj_at P ntfnptr\<rbrace> as_user t m \<lbrace>obj_at P ntfnptr\<rbrace>"
|
||||
|
|
@ -2880,6 +3017,10 @@ lemma complete_signal_invs:
|
|||
obj_at_valid_objsE[OF _ invs_valid_objs])
|
||||
done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
lemma ri_invs':
|
||||
notes split_if[split del]
|
||||
assumes set_endpoint_Q[wp]: "\<And>a b.\<lbrace>Q\<rbrace> set_endpoint a b \<lbrace>\<lambda>_.Q\<rbrace>"
|
||||
|
|
@ -2931,7 +3072,7 @@ lemma ri_invs':
|
|||
apply (simp add: invs_def valid_state_def valid_pspace_def)
|
||||
apply (wp hoare_drop_imps valid_irq_node_typ hoare_post_imp[OF disjI1]
|
||||
sts_only_idle
|
||||
| simp add: valid_tcb_state_def
|
||||
| simp add: valid_tcb_state_def cap_range_def
|
||||
| strengthen reply_cap_doesnt_exist_strg | wpc
|
||||
| (wp hoare_vcg_conj_lift | wp dxo_wp_weak | simp)+)+
|
||||
apply (clarsimp simp: st_tcb_at_tcb_at neq_Nil_conv)
|
||||
|
|
@ -2949,7 +3090,8 @@ lemma ri_invs':
|
|||
[where P="\<lambda>ts. \<exists>pl. ts = st pl" for st])
|
||||
apply (subgoal_tac "y \<noteq> t \<and> y \<noteq> idle_thread s \<and> t \<noteq> idle_thread s \<and>
|
||||
idle_thread s \<notin> set ys")
|
||||
apply (clarsimp simp: st_tcb_def2 obj_at_def is_ep_def)
|
||||
apply (clarsimp simp: st_tcb_def2 obj_at_def is_ep_def
|
||||
conj_comms tcb_at_cte_at_2)
|
||||
apply (erule delta_sym_refs)
|
||||
apply (clarsimp split: split_if_asm)
|
||||
apply (clarsimp split: split_if_asm split_if)
|
||||
|
|
@ -2966,7 +3108,7 @@ lemma ri_invs':
|
|||
apply (rule hoare_pre)
|
||||
apply (wp hoare_vcg_const_Ball_lift valid_irq_node_typ sts_only_idle
|
||||
failed_transfer_Q[unfolded do_nbrecv_failed_transfer_def, simplified]
|
||||
| simp add: valid_ep_def do_nbrecv_failed_transfer_def | wpc)+
|
||||
| simp add: valid_ep_def do_nbrecv_failed_transfer_def | wpc)+
|
||||
apply (clarsimp simp: valid_tcb_state_def st_tcb_at_tcb_at)
|
||||
apply (frule ko_at_state_refs_ofD)
|
||||
apply (frule active_st_tcb_at_state_refs_ofD)
|
||||
|
|
@ -3275,7 +3417,8 @@ lemma si_invs':
|
|||
apply (case_tac list, simp_all add: invs_def valid_state_def valid_pspace_def split del:split_if)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp valid_irq_node_typ)
|
||||
apply (simp add: if_apply_def2)
|
||||
apply (simp add: if_apply_def2 )
|
||||
apply (wp sts_only_idle sts_st_tcb_at_cases valid_irq_node_typ)
|
||||
apply (wp hoare_drop_imps sts_st_tcb_at_cases valid_irq_node_typ do_ipc_transfer_tcb_caps
|
||||
sts_only_idle hoare_vcg_if_lift hoare_vcg_disj_lift thread_get_wp' hoare_vcg_all_lift
|
||||
| clarsimp simp:is_cap_simps | wpc
|
||||
|
|
|
|||
|
|
@ -547,6 +547,53 @@ lemma set_object_pspace_in_kernel_window:
|
|||
apply (simp add: obj_bits_T)
|
||||
done
|
||||
|
||||
lemma in_user_frame_obj_upd:
|
||||
"\<lbrakk>kheap s p = Some ko; a_type k = a_type ko\<rbrakk> \<Longrightarrow>
|
||||
in_user_frame x (s\<lparr>kheap := \<lambda>a. if a = p then Some k else kheap s a\<rparr>)
|
||||
= in_user_frame x s"
|
||||
apply (rule iffI)
|
||||
apply (clarsimp simp:in_user_frame_def obj_at_def split:split_if_asm)
|
||||
apply (elim disjE)
|
||||
apply clarsimp
|
||||
apply (intro exI)
|
||||
apply (rule conjI,assumption)
|
||||
apply (simp add:a_type_def)
|
||||
apply (fastforce simp:a_type_def)
|
||||
apply (clarsimp simp:in_user_frame_def obj_at_def split:split_if_asm)
|
||||
apply (rule_tac x = sz in exI)
|
||||
apply (intro conjI impI)
|
||||
apply (fastforce simp:a_type_def)+
|
||||
done
|
||||
|
||||
lemma in_device_frame_obj_upd:
|
||||
"\<lbrakk>kheap s p = Some ko; a_type k = a_type ko\<rbrakk> \<Longrightarrow>
|
||||
in_device_frame x (s\<lparr>kheap := \<lambda>a. if a = p then Some k else kheap s a\<rparr>)
|
||||
= in_device_frame x s"
|
||||
apply (rule iffI)
|
||||
apply (clarsimp simp:in_device_frame_def obj_at_def split:split_if_asm)
|
||||
apply (elim disjE)
|
||||
apply clarsimp
|
||||
apply (intro exI)
|
||||
apply (rule conjI,assumption)
|
||||
apply (simp add:a_type_def)
|
||||
apply (fastforce simp:a_type_def)
|
||||
apply (clarsimp simp:in_device_frame_def obj_at_def split:split_if_asm)
|
||||
apply (rule_tac x = sz in exI)
|
||||
apply (intro conjI impI)
|
||||
apply (fastforce simp:a_type_def)+
|
||||
done
|
||||
|
||||
lemma set_object_pspace_respect_device_region:
|
||||
"\<lbrace>pspace_respects_device_region and obj_at (\<lambda>ko. a_type k = a_type ko) p\<rbrace>
|
||||
set_object p k
|
||||
\<lbrace>\<lambda>r. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_object_def, wp)
|
||||
apply (clarsimp simp: pspace_respects_device_region_def
|
||||
obj_at_def user_mem_def in_user_frame_obj_upd in_device_frame_obj_upd dom_def
|
||||
device_mem_def
|
||||
split:split_if_asm)
|
||||
done
|
||||
|
||||
lemma set_ntfn_kernel_window[wp]:
|
||||
"\<lbrace>pspace_in_kernel_window\<rbrace> set_notification ptr val \<lbrace>\<lambda>rv. pspace_in_kernel_window\<rbrace>"
|
||||
apply (simp add: set_notification_def)
|
||||
|
|
@ -555,6 +602,14 @@ lemma set_ntfn_kernel_window[wp]:
|
|||
split: Structures_A.kernel_object.split_asm)
|
||||
done
|
||||
|
||||
lemma set_ntfn_respect_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_notification ptr val \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_notification_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm)
|
||||
done
|
||||
|
||||
lemma set_ep_kernel_window[wp]:
|
||||
"\<lbrace>pspace_in_kernel_window\<rbrace> set_endpoint ptr val \<lbrace>\<lambda>rv. pspace_in_kernel_window\<rbrace>"
|
||||
apply (simp add: set_endpoint_def)
|
||||
|
|
@ -563,6 +618,14 @@ lemma set_ep_kernel_window[wp]:
|
|||
split: Structures_A.kernel_object.split_asm)
|
||||
done
|
||||
|
||||
lemma set_ep_respects_device_region[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> set_endpoint ptr val \<lbrace>\<lambda>rv. pspace_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_endpoint_def)
|
||||
apply (wp set_object_pspace_respect_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.split_asm)
|
||||
done
|
||||
|
||||
lemma swp_apply [simp]:
|
||||
"swp f x y = f y x" by (simp add: swp_def)
|
||||
|
||||
|
|
@ -776,6 +839,7 @@ lemma cap_refs_in_kernel_window_arch_update[simp]:
|
|||
\<Longrightarrow> cap_refs_in_kernel_window (arch_state_update f s) = cap_refs_in_kernel_window s"
|
||||
by (simp add: cap_refs_in_kernel_window_def)
|
||||
|
||||
|
||||
lemma set_object_cap_refs_in_kernel_window:
|
||||
"\<lbrace>cap_refs_in_kernel_window and obj_at (same_caps ko) p\<rbrace>
|
||||
set_object p ko
|
||||
|
|
@ -785,6 +849,21 @@ lemma set_object_cap_refs_in_kernel_window:
|
|||
apply (clarsimp simp: valid_refs_def cte_wp_at_after_update)
|
||||
done
|
||||
|
||||
lemma set_object_cap_refs_respects_device_region:
|
||||
"\<lbrace>cap_refs_respects_device_region and obj_at (same_caps ko) p\<rbrace>
|
||||
set_object p ko
|
||||
\<lbrace>\<lambda>r. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_object_def, wp)
|
||||
apply (clarsimp simp: cap_refs_respects_device_region_def)
|
||||
apply (drule_tac x = a in spec)
|
||||
apply (drule_tac x = b in spec)
|
||||
apply (clarsimp simp: valid_refs_def cte_wp_at_after_update
|
||||
cap_range_respects_device_region_def)
|
||||
apply (erule notE)
|
||||
apply (erule cte_wp_at_weakenE)
|
||||
apply auto
|
||||
done
|
||||
|
||||
|
||||
crunch no_cdt[wp]: set_notification "\<lambda>s. P (cdt s)"
|
||||
(wp: crunch_wps)
|
||||
|
|
@ -947,9 +1026,21 @@ lemma valid_irq_statesE:
|
|||
"\<lbrakk>valid_irq_states s; (\<And> irq. interrupt_states s irq = IRQInactive \<Longrightarrow> irq_masks (machine_state s) irq) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
|
||||
by(auto simp: valid_irq_states_def valid_irq_masks_def)
|
||||
|
||||
lemma pspace_respects_region_cong[cong]:
|
||||
"\<lbrakk>kheap a = kheap b; device_state (machine_state a) = device_state (machine_state b)\<rbrakk>
|
||||
\<Longrightarrow> pspace_respects_device_region a = pspace_respects_device_region b"
|
||||
by (simp add:pspace_respects_device_region_def device_mem_def user_mem_def in_device_frame_def
|
||||
in_user_frame_def obj_at_def dom_def)
|
||||
|
||||
lemma cap_refs_respects_region_cong[cong]:
|
||||
"\<lbrakk>caps_of_state a = caps_of_state b; device_state (machine_state a) = device_state (machine_state b)\<rbrakk>
|
||||
\<Longrightarrow> cap_refs_respects_device_region a = cap_refs_respects_device_region b"
|
||||
by (simp add:cap_refs_respects_device_region_def cte_wp_at_caps_of_state dom_def cap_range_respects_device_region_def)
|
||||
|
||||
lemma dmo_invs:
|
||||
"\<lbrace>(\<lambda>s. \<forall>m. \<forall>(r,m')\<in>fst (f m). (\<forall>p.
|
||||
in_user_frame p s \<or> in_device_frame p s \<or> underlying_memory m' p = underlying_memory m p) \<and>
|
||||
assumes valid_mf: "\<And>P. \<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> f \<lbrace>\<lambda>r ms. P (device_state ms)\<rbrace>"
|
||||
shows "\<lbrace>(\<lambda>s. \<forall>m. \<forall>(r,m')\<in>fst (f m). (\<forall>p.
|
||||
in_user_frame p s \<or> underlying_memory m' p = underlying_memory m p) \<and>
|
||||
(m = machine_state s \<longrightarrow> (\<forall>irq. (interrupt_states s irq = IRQInactive \<longrightarrow> irq_masks m' irq) \<or> (irq_masks m' irq = irq_masks m irq))))
|
||||
and invs\<rbrace>
|
||||
do_machine_op f
|
||||
|
|
@ -960,14 +1051,15 @@ lemma dmo_invs:
|
|||
valid_machine_state_def
|
||||
intro: valid_irq_states_machine_state_updateI
|
||||
elim: valid_irq_statesE)
|
||||
apply (frule_tac P1 = "op = (device_state (machine_state s))" in use_valid[OF _ valid_mf])
|
||||
apply simp
|
||||
apply clarsimp
|
||||
apply (intro conjI)
|
||||
apply (fastforce simp: invs_def cur_tcb_def valid_state_def
|
||||
apply (fastforce simp: invs_def cur_tcb_def valid_state_def
|
||||
valid_machine_state_def
|
||||
intro: valid_irq_states_machine_state_updateI
|
||||
elim: valid_irq_statesE)
|
||||
apply (drule_tac x = "machine_state s" in spec)
|
||||
apply (drule(1) bspec)
|
||||
apply fastforce
|
||||
intro: valid_irq_states_machine_state_updateI
|
||||
elim: valid_irq_statesE)
|
||||
apply (drule_tac x = "machine_state s" in spec,fastforce)
|
||||
done
|
||||
|
||||
|
||||
|
|
@ -1771,6 +1863,15 @@ lemma set_ntfn_cap_refs_kernel_window[wp]:
|
|||
split: Structures_A.kernel_object.split_asm)
|
||||
done
|
||||
|
||||
lemma set_ntfn_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> set_notification p ep \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: set_notification_def)
|
||||
apply (wp set_object_cap_refs_respects_device_region get_object_wp)
|
||||
apply (clarsimp simp: obj_at_def is_ntfn
|
||||
split: Structures_A.kernel_object.split_asm)
|
||||
done
|
||||
|
||||
|
||||
(* There are two wp rules for preserving valid_ioc over set_object.
|
||||
First, the more involved rule for CNodes and TCBs *)
|
||||
lemma set_object_valid_ioc_caps:
|
||||
|
|
@ -1840,13 +1941,8 @@ lemma set_notification_valid_machine_state[wp]:
|
|||
apply (elim disjE)
|
||||
apply (clarsimp simp: a_type_simps obj_at_def split: Structures_A.kernel_object.splits)
|
||||
apply (rule_tac x=sz in exI)
|
||||
apply (drule_tac x = sz in spec)
|
||||
apply (clarsimp simp:a_type_simps)
|
||||
apply (clarsimp simp: a_type_simps obj_at_def split: Structures_A.kernel_object.splits)
|
||||
apply (rule_tac x=sz in exI)
|
||||
apply (drule_tac x = sz in spec)
|
||||
apply (clarsimp simp:a_type_simps)
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
lemma valid_irq_states_triv:
|
||||
|
|
|
|||
|
|
@ -227,6 +227,23 @@ lemma caps_of_state_init_A_st_Null:
|
|||
lemmas cte_wp_at_caps_of_state_eq
|
||||
= cte_wp_at_caps_of_state[where P="op = cap" for cap]
|
||||
|
||||
lemma pspace_respects_device_region_init[simp]:
|
||||
"pspace_respects_device_region init_A_st"
|
||||
apply (clarsimp simp:pspace_respects_device_region_def init_A_st_def init_machine_state_def device_mem_def
|
||||
in_device_frame_def obj_at_def init_kheap_def a_type_def)
|
||||
apply (rule ext)
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
lemma cap_refs_respects_device_region_init[simp]:
|
||||
"cap_refs_respects_device_region init_A_st"
|
||||
apply (clarsimp simp:cap_refs_respects_device_region_def)
|
||||
apply (frule cte_wp_at_caps_of_state[THEN iffD1])
|
||||
apply clarsimp
|
||||
apply (subst(asm) caps_of_state_init_A_st_Null)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state cap_range_respects_device_region_def)
|
||||
done
|
||||
|
||||
lemma invs_A:
|
||||
"invs init_A_st"
|
||||
|
||||
|
|
@ -369,8 +386,9 @@ lemma invs_A:
|
|||
apply (rule less_imp_le)
|
||||
apply (rule less_le_trans[OF shiftl_less_t2n'[OF ucast_less]],simp+)[1]
|
||||
apply (rule in_kernel_base|simp)+
|
||||
apply (simp add: cap_refs_in_kernel_window_def caps_of_state_init_A_st_Null
|
||||
apply (simp add: cap_refs_in_kernel_window_def caps_of_state_init_A_st_Null
|
||||
valid_refs_def[unfolded cte_wp_at_caps_of_state])
|
||||
|
||||
apply word_bitwise
|
||||
done
|
||||
|
||||
|
|
|
|||
|
|
@ -1071,6 +1071,12 @@ lemma invoke_untyped_valid_pdpt[wp]:
|
|||
apply (rule is_aligned_neg_mask)
|
||||
apply simp
|
||||
done
|
||||
have set_cap_device_and_range_aligned:
|
||||
"\<And>aref idx. \<lbrace>\<lambda>s. (ptr && ~~ mask sz = ptr)\<rbrace> set_cap (UntypedCap dev ptr sz idx) aref
|
||||
\<lbrace>\<lambda>rv s. (\<exists>slot. cte_wp_at (\<lambda>c. cap_is_device c = dev \<and> {ptr..ptr + (2 ^ sz - 1)} \<subseteq> cap_range c) slot s)\<rbrace>"
|
||||
apply (rule hoare_gen_asm[where P'="\<top>",simplified])
|
||||
using set_cap_device_and_range[where ptr = ptr and sz = sz]
|
||||
by auto
|
||||
|
||||
note set_cap_free_index_invs_spec = set_free_index_invs[where cap = "cap.UntypedCap dev (ptr && ~~ mask sz) sz idx"
|
||||
,unfolded free_index_update_def free_index_of_def,simplified]
|
||||
|
|
@ -1092,7 +1098,8 @@ lemma invoke_untyped_valid_pdpt[wp]:
|
|||
apply (clarsimp simp:conj_comms bits_of_def region_in_kernel_window_def)
|
||||
apply (wp set_cap_no_overlap hoare_vcg_ball_lift set_cap_free_index_invs_spec
|
||||
set_cap_cte_wp_at set_cap_descendants_range_in set_cap_caps_no_overlap
|
||||
set_untyped_cap_caps_overlap_reserved set_cap_cte_cap_wp_to get_cap_wp)
|
||||
set_untyped_cap_caps_overlap_reserved set_cap_cte_cap_wp_to get_cap_wp
|
||||
set_cap_device_and_range)
|
||||
apply (insert cte_wp_at)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state untyped_range.simps)
|
||||
apply (insert misc cover)
|
||||
|
|
@ -1112,7 +1119,7 @@ lemma invoke_untyped_valid_pdpt[wp]:
|
|||
apply (rule_tac P = "cap = cap.UntypedCap dev (ptr && ~~ mask sz) sz idx" in hoare_gen_asm)
|
||||
apply (clarsimp simp:conj_comms bits_of_def region_in_kernel_window_def)
|
||||
apply (wp set_cap_no_overlap set_untyped_cap_invs_simple
|
||||
set_cap_cte_wp_at set_cap_caps_no_overlap
|
||||
set_cap_cte_wp_at set_cap_caps_no_overlap set_cap_device_and_range_aligned
|
||||
set_untyped_cap_caps_overlap_reserved get_cap_wp)
|
||||
apply (rule_tac P = "cap = cap.UntypedCap dev ptr sz idx" in hoare_gen_asm)
|
||||
apply (clarsimp simp:bits_of_def delete_objects_rewrite)
|
||||
|
|
|
|||
|
|
@ -16,6 +16,9 @@ theory Retype_AI
|
|||
imports VSpace_AI
|
||||
begin
|
||||
|
||||
abbreviation "up_aligned_area ptr sz \<equiv> {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)}"
|
||||
abbreviation "down_aligned_area ptr sz \<equiv> {(ptr && ~~ mask sz) + (2 ^ sz - 1) .. ptr}"
|
||||
|
||||
lemma upto_enum_inc_1:
|
||||
"a < 2^word_bits - 1 \<Longrightarrow> [(0::word32).e.1 + a] = [0.e.a] @ [(1+a)]"
|
||||
apply (simp add:upto_enum_word)
|
||||
|
|
@ -369,6 +372,12 @@ lemma obj_bits_api_def3:
|
|||
by (auto simp add: obj_bits_api_def2 cong:obj_bits_cong
|
||||
split: Structures_A.apiobject_type.split)
|
||||
|
||||
lemma obj_bits_api_def4:
|
||||
"obj_bits_api type obj_size_bits =
|
||||
(if type = Structures_A.Untyped then obj_size_bits
|
||||
else obj_bits (default_object type True obj_size_bits))"
|
||||
by (auto simp add: obj_bits_api_def2 cong:obj_bits_cong
|
||||
split: Structures_A.apiobject_type.split)
|
||||
|
||||
definition
|
||||
"retype_addrs \<equiv> \<lambda>(ptr' :: obj_ref) ty n us. map (\<lambda>p. ptr_add ptr' (p * 2 ^ obj_bits_api ty us))
|
||||
|
|
@ -1368,6 +1377,38 @@ lemma create_word_objects_valid_irq_states[wp]:
|
|||
apply (simp add: valid_irq_states_def | wp no_irq_clearMemory)+
|
||||
done
|
||||
|
||||
crunch device_state_inv[wp]: clearMemory "\<lambda>ms. P (device_state ms)"
|
||||
(wp: mapM_x_wp)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: reserve_region pspace_respects_device_region
|
||||
crunch cap_refs_respects_device_region[wp]: reserve_region cap_refs_respects_device_region
|
||||
|
||||
lemma create_word_objects_pspace_respects_device[wp]:
|
||||
"\<lbrace>pspace_respects_device_region\<rbrace> create_word_objects ptr bits sz dev \<lbrace>\<lambda>_. pspace_respects_device_region\<rbrace>"
|
||||
apply (clarsimp simp add:create_word_objects_def unless_def when_def)
|
||||
apply (intro conjI impI)
|
||||
apply (rule hoare_pre,wp pspace_respects_device_region_dmo)
|
||||
apply (rule hoare_pre,wp mapM_x_wp)
|
||||
apply fastforce
|
||||
apply simp
|
||||
apply wp
|
||||
apply simp
|
||||
apply wp
|
||||
done
|
||||
|
||||
lemma create_word_objects_cap_refs_respects_device[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> create_word_objects ptr bits sz dev \<lbrace>\<lambda>_. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (clarsimp simp add:create_word_objects_def unless_def when_def)
|
||||
apply (intro conjI impI)
|
||||
apply (rule hoare_pre,wp cap_refs_respects_device_region_dmo)
|
||||
apply (rule hoare_pre,wp mapM_x_wp)
|
||||
apply fastforce
|
||||
apply simp
|
||||
apply wp
|
||||
apply simp
|
||||
apply wp
|
||||
done
|
||||
|
||||
lemma create_word_objects_invs[wp]:
|
||||
"\<lbrace>invs\<rbrace> create_word_objects ptr bits sz dev \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (simp add:invs_def valid_state_def)
|
||||
|
|
@ -1375,20 +1416,17 @@ lemma create_word_objects_invs[wp]:
|
|||
apply (rule hoare_strengthen_post)
|
||||
apply (rule hoare_vcg_conj_lift[OF create_word_objects_vms])
|
||||
apply (rule hoare_vcg_conj_lift[OF create_word_objects_valid_irq_states])
|
||||
apply (rule hoare_vcg_conj_lift[OF create_word_objects_pspace_respects_device])
|
||||
apply (rule hoare_vcg_conj_lift[OF create_word_objects_cap_refs_respects_device])
|
||||
prefer 2
|
||||
apply clarsimp
|
||||
apply assumption
|
||||
apply (clarsimp simp: create_word_objects_def reserve_region_def
|
||||
split_def do_machine_op_def unless_def)
|
||||
apply wp
|
||||
apply (simp add: invs_def cur_tcb_def valid_state_def)
|
||||
apply (clarsimp simp add: invs_def cur_tcb_def valid_state_def)
|
||||
done
|
||||
|
||||
crunch invs [wp]: reserve_region "invs"
|
||||
|
||||
crunch invs [wp]: reserve_region "invs"
|
||||
|
||||
|
||||
abbreviation(input)
|
||||
"all_invs_but_equal_kernel_mappings_restricted S
|
||||
\<equiv> (\<lambda>s. equal_kernel_mappings (s \<lparr> kheap := restrict_map (kheap s) (- S) \<rparr>))
|
||||
|
|
@ -1400,6 +1438,7 @@ abbreviation(input)
|
|||
and valid_arch_caps and valid_global_objs and valid_kernel_mappings
|
||||
and valid_asid_map and valid_global_pd_mappings
|
||||
and pspace_in_kernel_window and cap_refs_in_kernel_window
|
||||
and pspace_respects_device_region and cap_refs_respects_device_region
|
||||
and cur_tcb and valid_ioc and valid_machine_state"
|
||||
|
||||
|
||||
|
|
@ -1451,6 +1490,11 @@ crunch pspace_in_kernel_window[wp]: copy_global_mappings "pspace_in_kernel_windo
|
|||
crunch cap_refs_in_kernel_window[wp]: copy_global_mappings "cap_refs_in_kernel_window"
|
||||
(wp: crunch_wps)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: copy_global_mappings "pspace_respects_device_region"
|
||||
(wp: crunch_wps)
|
||||
|
||||
crunch cap_refs_respects_device_region[wp]: copy_global_mappings "cap_refs_respects_device_region"
|
||||
(wp: crunch_wps)
|
||||
|
||||
(* FIXME: move to VSpace_R *)
|
||||
lemma vs_refs_add_one'':
|
||||
|
|
@ -2196,9 +2240,9 @@ lemma retype_addrs_obj_range_subset:
|
|||
"\<lbrakk> p \<in> set (retype_addrs ptr ty n us);
|
||||
range_cover ptr sz (obj_bits (default_object ty dev us)) n;
|
||||
ty \<noteq> Untyped \<rbrakk>
|
||||
\<Longrightarrow> obj_range p (default_object ty dev us) \<subseteq> {ptr..(ptr && ~~ mask sz) + 2^sz - 1}"
|
||||
\<Longrightarrow> obj_range p (default_object ty dev us) \<subseteq> {ptr..(ptr && ~~ mask sz) + (2^sz - 1)}"
|
||||
by(simp add: obj_range_def obj_bits_api_default_object[symmetric]
|
||||
retype_addrs_range_subset
|
||||
retype_addrs_range_subset p_assoc_help[symmetric]
|
||||
del: atLeastatMost_subset_iff)
|
||||
|
||||
lemma obj_bits_dev_irr:
|
||||
|
|
@ -2485,7 +2529,7 @@ lemma valid_untyped_helper:
|
|||
apply (erule disjE)
|
||||
apply (simp add:cte_wp_at_caps_of_state)
|
||||
apply (drule cn[unfolded caps_no_overlap_def,THEN bspec,OF ranI])
|
||||
apply simp
|
||||
apply (simp add:p_assoc_help[symmetric])
|
||||
apply (erule impE)
|
||||
apply blast (* set arith *)
|
||||
apply blast (* set arith *)
|
||||
|
|
@ -2493,6 +2537,18 @@ lemma valid_untyped_helper:
|
|||
done
|
||||
qed
|
||||
|
||||
|
||||
lemma cap_refs_respects_device_region_cap_range:
|
||||
"\<lbrakk>cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s;
|
||||
cap_refs_respects_device_region s\<rbrakk>
|
||||
\<Longrightarrow> up_aligned_area ptr sz \<subseteq> (if dev then device_region s else - device_region s)"
|
||||
unfolding cap_refs_respects_device_region_def
|
||||
apply (drule spec[where x = slot])
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state cap_range_respects_device_region_def)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
|
||||
locale retype_region_proofs =
|
||||
fixes s ty us ptr sz n ps s' dev
|
||||
assumes vp: "valid_pspace s"
|
||||
|
|
@ -2502,7 +2558,8 @@ locale retype_region_proofs =
|
|||
and tyct: "ty = CapTableObject \<Longrightarrow> us < word_bits - cte_level_bits \<and> 0 < us"
|
||||
and orth: "pspace_no_overlap ptr sz s"
|
||||
and mem : "caps_no_overlap ptr sz s"
|
||||
and cover: "range_cover ptr sz (obj_bits_api ty us) n"
|
||||
and cover: "range_cover ptr sz (obj_bits_api ty us) n"
|
||||
and dev: "\<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s"
|
||||
defines "ps \<equiv> (\<lambda>x. if x \<in> set (retype_addrs ptr ty n us) then Some (default_object ty dev us)
|
||||
else kheap s x)"
|
||||
and "s' \<equiv> kheap_update (\<lambda>y. ps) s"
|
||||
|
|
@ -2511,7 +2568,6 @@ lemma obj_at_pres: "\<And>P x. obj_at P x s \<Longrightarrow> obj_at P x s'"
|
|||
by (clarsimp simp: obj_at_def s'_def ps_def dest: domI)
|
||||
(rule pspace_no_overlapC [OF orth _ _ cover vp])
|
||||
|
||||
|
||||
lemma orthr:
|
||||
"\<And>x obj. kheap s x = Some obj \<Longrightarrow> x \<notin> set (retype_addrs ptr ty n us)"
|
||||
apply (rule ccontr)
|
||||
|
|
@ -2804,11 +2860,11 @@ lemma valid_cap:
|
|||
apply (intro conjI)
|
||||
apply clarsimp
|
||||
apply (drule disjoint_subset [OF retype_addrs_obj_range_subset [OF _ cover' tyunt]])
|
||||
apply (simp add:Int_ac)
|
||||
apply (simp add:Int_ac p_assoc_help[symmetric])
|
||||
apply simp
|
||||
apply clarsimp
|
||||
apply (drule disjoint_subset [OF retype_addrs_obj_range_subset [OF _ cover' tyunt]])
|
||||
apply (simp add:Int_ac)
|
||||
apply (simp add:Int_ac p_assoc_help[symmetric])
|
||||
apply simp
|
||||
using cover tyunt
|
||||
apply (simp add: obj_bits_api_def2 split:Structures_A.apiobject_type.splits)
|
||||
|
|
@ -3035,6 +3091,95 @@ where
|
|||
"region_in_kernel_window S \<equiv>
|
||||
\<lambda>s. \<forall>x \<in> S. arm_kernel_vspace (arch_state s) x = ArmVSpaceKernelWindow"
|
||||
|
||||
lemma p_in_obj_range:
|
||||
"\<lbrakk> kheap s p = Some ko; pspace_aligned s; valid_objs s \<rbrakk> \<Longrightarrow> p \<in> obj_range p ko"
|
||||
apply (simp add: pspace_aligned_def)
|
||||
apply (drule bspec, erule domI)
|
||||
apply (drule valid_obj_sizes, erule ranI)
|
||||
apply (simp add: obj_range_def add_diff_eq[symmetric])
|
||||
apply (erule is_aligned_no_wrap')
|
||||
apply (erule word_power_less_1[where 'a=32, folded word_bits_def])
|
||||
done
|
||||
|
||||
lemma p_in_obj_range_internal:
|
||||
"\<lbrakk> kheap s (p && ~~ mask (obj_bits ko))= Some ko; pspace_aligned s; valid_objs s \<rbrakk>
|
||||
\<Longrightarrow> p \<in> obj_range (p && ~~ mask (obj_bits ko)) ko"
|
||||
apply (drule p_in_obj_range,simp+)
|
||||
apply (simp add:obj_range_def word_and_le2 word_neg_and_le p_assoc_help)
|
||||
done
|
||||
|
||||
lemma pspace_respects_device_regionI:
|
||||
assumes uat: "\<And>ptr sz. kheap s ptr = Some (ArchObj (DataPage False sz))
|
||||
\<Longrightarrow> obj_range ptr (ArchObj $ DataPage False sz) \<subseteq> - device_region s"
|
||||
and dat: "\<And>ptr sz. kheap s ptr = Some (ArchObj (DataPage True sz))
|
||||
\<Longrightarrow> obj_range ptr (ArchObj $ DataPage True sz) \<subseteq> device_region s"
|
||||
and inv: "pspace_aligned s" "valid_objs s"
|
||||
shows "pspace_respects_device_region s"
|
||||
|
||||
apply (simp add:pspace_respects_device_region_def,intro conjI)
|
||||
apply (rule subsetI)
|
||||
apply (clarsimp simp:dom_def user_mem_def obj_at_def in_user_frame_def split: split_if_asm)
|
||||
apply (frule uat)
|
||||
apply (cut_tac ko = "(ArchObj (DataPage False sz))" in p_in_obj_range_internal[OF _ inv])
|
||||
prefer 2
|
||||
apply (fastforce simp:obj_bits_def)
|
||||
apply simp
|
||||
apply (rule subsetI)
|
||||
apply (clarsimp simp:dom_def device_mem_def obj_at_def in_device_frame_def split: split_if_asm)
|
||||
apply (frule dat)
|
||||
apply (cut_tac ko = "(ArchObj (DataPage True sz))" in p_in_obj_range_internal[OF _ inv])
|
||||
prefer 2
|
||||
apply (fastforce simp:obj_bits_def)
|
||||
apply simp
|
||||
done
|
||||
|
||||
lemma obj_range_respect_device_range:
|
||||
"\<lbrakk>kheap s ptr = Some (ArchObj (DataPage dev sz));pspace_aligned s\<rbrakk> \<Longrightarrow>
|
||||
obj_range ptr (ArchObj $ DataPage dev sz) \<subseteq> (if dev then dom (device_mem s) else dom (user_mem s))"
|
||||
apply (drule(1) pspace_alignedD[rotated])
|
||||
apply (clarsimp simp:user_mem_def in_user_frame_def obj_at_def obj_range_def device_mem_def in_device_frame_def)
|
||||
apply (intro impI conjI)
|
||||
apply clarsimp
|
||||
apply (rule exI[where x = sz])
|
||||
apply (simp add: mask_in_range[symmetric,THEN iffD1] a_type_def)
|
||||
apply clarsimp
|
||||
apply (rule exI[where x = sz])
|
||||
apply (simp add: mask_in_range[symmetric,THEN iffD1] a_type_def)
|
||||
done
|
||||
|
||||
lemma pspace_respects_device_regionD:
|
||||
assumes inv: "pspace_aligned s" "valid_objs s" "pspace_respects_device_region s"
|
||||
shows uat: "\<And>ptr sz. kheap s ptr = Some (ArchObj (DataPage False sz))
|
||||
\<Longrightarrow> obj_range ptr (ArchObj $ DataPage False sz) \<subseteq> - device_region s"
|
||||
and dat: "\<And>ptr sz. kheap s ptr = Some (ArchObj (DataPage True sz))
|
||||
\<Longrightarrow> obj_range ptr (ArchObj $ DataPage True sz) \<subseteq> device_region s"
|
||||
using inv
|
||||
apply (simp_all add:pspace_respects_device_region_def)
|
||||
apply (rule subsetI)
|
||||
apply (drule obj_range_respect_device_range[OF _ inv(1)])
|
||||
apply (clarsimp split:if_splits)
|
||||
apply (drule(1) subsetD[rotated])
|
||||
apply (drule(1) subsetD[rotated])
|
||||
apply (simp add: dom_def)
|
||||
apply (rule subsetI)
|
||||
apply (drule obj_range_respect_device_range[OF _ inv(1)])
|
||||
apply (clarsimp split:if_splits)
|
||||
apply (drule(1) subsetD[rotated])
|
||||
apply (drule(1) subsetD[rotated])
|
||||
apply (simp add: dom_def)
|
||||
done
|
||||
|
||||
|
||||
lemma default_obj_dev:
|
||||
"\<lbrakk>ty \<noteq> Invariants_AI.Untyped;default_object ty dev us = ArchObj (DataPage dev' sz)\<rbrakk> \<Longrightarrow> dev = dev'"
|
||||
by (clarsimp simp:default_object_def default_arch_object_def
|
||||
split:apiobject_type.split_asm aobject_type.split_asm)
|
||||
|
||||
lemma cap_range_respects_device_region_cong[cong]:
|
||||
"device_state (machine_state s) = device_state (machine_state s')
|
||||
\<Longrightarrow> cap_range_respects_device_region cap s = cap_range_respects_device_region cap s'"
|
||||
by (clarsimp simp:cap_range_respects_device_region_def)
|
||||
|
||||
context retype_region_proofs
|
||||
begin
|
||||
|
||||
|
|
@ -3175,6 +3320,66 @@ lemma pspace_in_kernel_window:
|
|||
apply (fastforce simp: field_simps obj_bits_dev_irr tyunt)
|
||||
done
|
||||
|
||||
lemma pspace_respects_device_region:
|
||||
assumes psp_resp_dev: "pspace_respects_device_region s"
|
||||
and cap_refs_resp_dev: "cap_refs_respects_device_region s"
|
||||
shows "pspace_respects_device_region s'"
|
||||
proof -
|
||||
note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff
|
||||
atLeastatMost_subset_iff atLeastLessThan_iff
|
||||
Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
|
||||
show ?thesis
|
||||
apply (cut_tac vp)
|
||||
apply (rule pspace_respects_device_regionI)
|
||||
apply (clarsimp simp add: pspace_respects_device_region_def s'_def ps_def
|
||||
split:split_if_asm )
|
||||
apply (drule retype_addrs_obj_range_subset[OF _ _ tyunt])
|
||||
using cover tyunt
|
||||
apply (simp add:obj_bits_api_def3 split:if_splits)
|
||||
apply (frule default_obj_dev[OF tyunt],simp)
|
||||
apply (drule(1) subsetD)
|
||||
apply (rule exE[OF dev])
|
||||
apply (drule cap_refs_respects_device_region_cap_range[OF _ cap_refs_resp_dev])
|
||||
apply (fastforce split:if_splits)
|
||||
apply (drule pspace_respects_device_regionD[OF _ _ psp_resp_dev, rotated -1])
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply (clarsimp simp add: pspace_respects_device_region_def s'_def ps_def
|
||||
split:split_if_asm )
|
||||
apply (drule retype_addrs_obj_range_subset[OF _ _ tyunt])
|
||||
using cover tyunt
|
||||
apply (simp add:obj_bits_api_def4 split:if_splits)
|
||||
apply (frule default_obj_dev[OF tyunt],simp)
|
||||
apply (drule(1) subsetD)
|
||||
apply (rule exE[OF dev])
|
||||
apply (drule cap_refs_respects_device_region_cap_range[OF _ cap_refs_resp_dev])
|
||||
apply (fastforce split:if_splits)
|
||||
apply (drule pspace_respects_device_regionD[OF _ _ psp_resp_dev, rotated -1])
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
apply fastforce
|
||||
using valid_pspace
|
||||
apply fastforce+
|
||||
done
|
||||
qed
|
||||
|
||||
|
||||
|
||||
lemma cap_refs_respects_device_region:
|
||||
assumes psp_resp_dev: "pspace_respects_device_region s"
|
||||
and cap_refs_resp_dev: "cap_refs_respects_device_region s"
|
||||
shows "cap_refs_respects_device_region s'"
|
||||
using cap_refs_resp_dev
|
||||
apply (clarsimp simp:cap_refs_respects_device_region_def
|
||||
simp del:split_paired_All split_paired_Ex)
|
||||
apply (drule_tac x = "(a,b)" in spec)
|
||||
apply (erule notE)
|
||||
apply (subst(asm) cte_retype)
|
||||
apply (simp add:cap_range_respects_device_region_def cap_range_def)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state s'_def dom_def)
|
||||
done
|
||||
|
||||
lemma valid_irq_states:
|
||||
"valid_irq_states s \<Longrightarrow> valid_irq_states s'"
|
||||
apply(simp add: s'_def valid_irq_states_def)
|
||||
|
|
@ -3198,8 +3403,6 @@ lemma vms:
|
|||
apply (elim exE disjE,simp_all)
|
||||
apply (rule disjI1)
|
||||
apply (rule_tac x=sz in exI, clarsimp simp: obj_at_def orthr)
|
||||
apply (rule disjI2,rule disjI1)
|
||||
apply (rule_tac x=sz in exI, clarsimp simp: obj_at_def orthr)
|
||||
done
|
||||
|
||||
lemma post_retype_invs:
|
||||
|
|
@ -3217,13 +3420,15 @@ lemma post_retype_invs:
|
|||
valid_pspace cur_tcb only_idle
|
||||
valid_kernel_mappings valid_asid_map
|
||||
valid_global_pd_mappings valid_ioc vms
|
||||
pspace_in_kernel_window
|
||||
cap_refs_in_kernel_window valid_irq_states)
|
||||
pspace_in_kernel_window pspace_respects_device_region
|
||||
cap_refs_respects_device_region
|
||||
cap_refs_in_kernel_window valid_irq_states
|
||||
split: split_if_asm)
|
||||
|
||||
end
|
||||
|
||||
lemma use_retype_region_proofs':
|
||||
assumes x: "\<And>s. \<lbrakk> retype_region_proofs s ty us ptr sz n; P s \<rbrakk>
|
||||
assumes x: "\<And>s. \<lbrakk> retype_region_proofs s ty us ptr sz n dev; P s \<rbrakk>
|
||||
\<Longrightarrow> Q (retype_addrs ptr ty n us) (s\<lparr>kheap :=
|
||||
\<lambda>x. if x \<in> set (retype_addrs ptr ty n us)
|
||||
then Some (default_object ty dev us)
|
||||
|
|
@ -3234,8 +3439,9 @@ lemma use_retype_region_proofs':
|
|||
\<And>s. P s \<longrightarrow> Q (retype_addrs ptr ty n us) s \<rbrakk> \<Longrightarrow>
|
||||
\<lbrace>\<lambda>s. valid_pspace s \<and> valid_mdb s \<and> range_cover ptr sz (obj_bits_api ty us) n
|
||||
\<and> caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1} s
|
||||
\<and> caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s \<and>
|
||||
P s\<rbrace> retype_region ptr n us ty dev \<lbrace>Q\<rbrace>"
|
||||
\<and> caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s
|
||||
\<and> (\<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
\<and> P s\<rbrace> retype_region ptr n us ty dev \<lbrace>Q\<rbrace>"
|
||||
apply (simp add: retype_region_def split del: split_if)
|
||||
apply (rule hoare_pre, (wp|simp add:y trans_state_update[symmetric] del: trans_state_update)+)
|
||||
apply (clarsimp simp: retype_addrs_fold
|
||||
|
|
@ -3243,7 +3449,7 @@ lemma use_retype_region_proofs':
|
|||
apply safe
|
||||
apply (rule x)
|
||||
apply (rule retype_region_proofs.intro, simp_all)[1]
|
||||
apply (simp add: range_cover_def obj_bits_api_def
|
||||
apply (fastforce simp add: range_cover_def obj_bits_api_def
|
||||
slot_bits_def word_bits_def cte_level_bits_def)+
|
||||
done
|
||||
|
||||
|
|
@ -3270,6 +3476,7 @@ lemma retype_region_valid_cap:
|
|||
\<Longrightarrow> \<lbrace>(\<lambda>s. valid_pspace s \<and> caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1} s \<and>
|
||||
valid_mdb s \<and> range_cover ptr sz (obj_bits_api ty us) n \<and>
|
||||
caps_no_overlap ptr sz s \<and> pspace_no_overlap ptr sz s \<and>
|
||||
(\<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) \<and>
|
||||
s \<turnstile> cap) and K (untyped_range cap \<inter> {ptr..(ptr &&~~ mask sz) + 2 ^ sz - 1} = {})\<rbrace>
|
||||
retype_region ptr n us ty dev
|
||||
\<lbrace>\<lambda>r s. s \<turnstile> cap\<rbrace>"
|
||||
|
|
@ -3358,6 +3565,7 @@ lemma retype_region_post_retype_invs:
|
|||
"\<lbrace>invs and caps_no_overlap ptr sz and pspace_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = Structures_A.CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n) \<rbrace>
|
||||
retype_region ptr n us ty dev\<lbrace>\<lambda>rv. post_retype_invs ty rv\<rbrace>"
|
||||
|
|
@ -3374,6 +3582,7 @@ lemma retype_region_plain_invs:
|
|||
"\<lbrace>invs and caps_no_overlap ptr sz and pspace_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr .. (ptr &&~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = Structures_A.CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)
|
||||
and K (ty \<noteq> ArchObject PageDirectoryObj)\<rbrace>
|
||||
|
|
|
|||
|
|
@ -123,6 +123,7 @@ lemma set_vm_root_kheap_arch_state[wp]:
|
|||
apply (wp | simp add: throwError_def validE_R_def validE_def)+
|
||||
done
|
||||
|
||||
crunch device_state_inv[wp]: clearExMonitor "\<lambda>ms. P (device_state ms)"
|
||||
lemma clearExMonitor_invs [wp]:
|
||||
"\<lbrace>invs\<rbrace> do_machine_op clearExMonitor \<lbrace>\<lambda>_. invs\<rbrace>"
|
||||
apply (wp dmo_invs)
|
||||
|
|
|
|||
|
|
@ -425,6 +425,9 @@ lemma thread_set_pspace_in_kernel_window[wp]:
|
|||
apply (clarsimp simp: obj_at_def dest!: get_tcb_SomeD)
|
||||
done
|
||||
|
||||
crunch pspace_respects_device_region[wp]: thread_set "pspace_respects_device_region"
|
||||
(wp: set_object_pspace_respect_device_region)
|
||||
|
||||
lemma thread_set_cap_refs_in_kernel_window:
|
||||
assumes y: "\<And>tcb. \<forall>(getF, v) \<in> ran tcb_cap_cases.
|
||||
getF (f tcb) = getF tcb"
|
||||
|
|
@ -439,6 +442,20 @@ lemma thread_set_cap_refs_in_kernel_window:
|
|||
apply (erule sym)
|
||||
done
|
||||
|
||||
lemma thread_set_cap_refs_respects_device_region:
|
||||
assumes y: "\<And>tcb. \<forall>(getF, v) \<in> ran tcb_cap_cases.
|
||||
getF (f tcb) = getF tcb"
|
||||
shows
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace> thread_set f t \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (simp add: thread_set_def)
|
||||
apply (wp set_object_cap_refs_respects_device_region)
|
||||
apply (clarsimp simp: obj_at_def)
|
||||
apply (clarsimp dest!: get_tcb_SomeD)
|
||||
apply (drule bspec[OF y])
|
||||
apply simp
|
||||
apply (erule sym)
|
||||
done
|
||||
|
||||
(* NOTE: The function "thread_set f p" updates a TCB at p using function f.
|
||||
It should not be used to change capabilities, though. *)
|
||||
lemma thread_set_valid_ioc_trivial:
|
||||
|
|
@ -500,6 +517,7 @@ lemma thread_set_invs_trivial:
|
|||
thread_set_caps_of_state_trivial
|
||||
thread_set_arch_caps_trivial thread_set_only_idle
|
||||
thread_set_cap_refs_in_kernel_window
|
||||
thread_set_cap_refs_respects_device_region
|
||||
thread_set_aligned
|
||||
| rule x z z' w y a | erule bspec_split [OF x] | simp add: z')+
|
||||
apply (simp add: z)
|
||||
|
|
@ -1577,6 +1595,9 @@ lemma set_thread_state_pspace_in_kernel_window[wp]:
|
|||
set_thread_state p st \<lbrace>\<lambda>rv. pspace_in_kernel_window\<rbrace>"
|
||||
by (simp add: set_thread_state_thread_set, wp, simp, wp)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: set_thread_state pspace_respects_device_region
|
||||
(wp: set_object_pspace_respect_device_region)
|
||||
|
||||
lemma set_thread_state_cap_refs_in_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window\<rbrace>
|
||||
set_thread_state p st \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
|
||||
|
|
@ -1584,6 +1605,13 @@ lemma set_thread_state_cap_refs_in_kernel_window[wp]:
|
|||
| wp thread_set_cap_refs_in_kernel_window
|
||||
ball_tcb_cap_casesI)+
|
||||
|
||||
lemma set_thread_state_cap_refs_respects_device_regionw[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace>
|
||||
set_thread_state p st \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
by (simp add: set_thread_state_thread_set
|
||||
| wp thread_set_cap_refs_respects_device_region
|
||||
ball_tcb_cap_casesI)+
|
||||
|
||||
lemma set_bound_notification_global_pd_mappings[wp]:
|
||||
"\<lbrace>valid_global_pd_mappings\<rbrace>
|
||||
set_bound_notification p ntfn \<lbrace>\<lambda>rv. valid_global_pd_mappings\<rbrace>"
|
||||
|
|
@ -1594,6 +1622,9 @@ lemma set_bound_notification_pspace_in_kernel_window[wp]:
|
|||
set_bound_notification p ntfn \<lbrace>\<lambda>rv. pspace_in_kernel_window\<rbrace>"
|
||||
by (simp add: set_bound_notification_thread_set, wp)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: set_bound_notification pspace_respects_device_region
|
||||
(wp: set_object_pspace_respect_device_region)
|
||||
|
||||
lemma set_bound_notification_cap_refs_in_kernel_window[wp]:
|
||||
"\<lbrace>cap_refs_in_kernel_window\<rbrace>
|
||||
set_bound_notification p ntfn \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
|
||||
|
|
@ -1601,6 +1632,13 @@ lemma set_bound_notification_cap_refs_in_kernel_window[wp]:
|
|||
| wp thread_set_cap_refs_in_kernel_window
|
||||
ball_tcb_cap_casesI)+
|
||||
|
||||
lemma set_bound_notification_cap_refs_respects_device_region[wp]:
|
||||
"\<lbrace>cap_refs_respects_device_region\<rbrace>
|
||||
set_bound_notification p ntfn \<lbrace>\<lambda>rv. cap_refs_respects_device_region\<rbrace>"
|
||||
by (simp add: set_bound_notification_thread_set
|
||||
| wp thread_set_cap_refs_respects_device_region
|
||||
ball_tcb_cap_casesI)+
|
||||
|
||||
lemma set_thread_state_valid_ioc[wp]:
|
||||
"\<lbrace>valid_ioc\<rbrace> set_thread_state t st \<lbrace>\<lambda>_. valid_ioc\<rbrace>"
|
||||
apply (simp add: set_thread_state_def)
|
||||
|
|
|
|||
|
|
@ -801,6 +801,7 @@ lemma thread_set_tcb_ipc_buffer_cap_cleared_invs:
|
|||
thread_set_only_idle
|
||||
thread_set_cap_refs_in_kernel_window
|
||||
thread_set_valid_ioc_trivial
|
||||
thread_set_cap_refs_respects_device_region
|
||||
| simp add: ran_tcb_cap_cases
|
||||
| rule conjI | erule disjE)+
|
||||
apply (clarsimp simp: valid_tcb_def dest!: get_tcb_SomeD)
|
||||
|
|
|
|||
|
|
@ -1462,36 +1462,42 @@ lemma retype_region_invs_extras:
|
|||
"\<lbrace>invs and pspace_no_overlap ptr sz and caps_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)\<rbrace>
|
||||
retype_region ptr n us ty dev\<lbrace>\<lambda>rv. pspace_aligned\<rbrace>"
|
||||
"\<lbrace>invs and pspace_no_overlap ptr sz and caps_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)\<rbrace>
|
||||
retype_region ptr n us ty dev\<lbrace>\<lambda>rv. valid_objs\<rbrace>"
|
||||
"\<lbrace>invs and pspace_no_overlap ptr sz and caps_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)\<rbrace>
|
||||
retype_region ptr n us ty dev \<lbrace>\<lambda>rv. pspace_distinct\<rbrace>"
|
||||
"\<lbrace>invs and pspace_no_overlap ptr sz and caps_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)\<rbrace>
|
||||
retype_region ptr n us ty dev \<lbrace>\<lambda>rv. valid_mdb\<rbrace>"
|
||||
"\<lbrace>invs and pspace_no_overlap ptr sz and caps_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)\<rbrace>
|
||||
retype_region ptr n us ty dev\<lbrace>\<lambda>rv. valid_global_objs\<rbrace>"
|
||||
"\<lbrace>invs and pspace_no_overlap ptr sz and caps_no_overlap ptr sz
|
||||
and caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api ty us - 1}
|
||||
and region_in_kernel_window {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}
|
||||
and (\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. {ptr..(ptr && ~~ mask sz) + (2 ^ sz - 1)} \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
and K (ty = CapTableObject \<longrightarrow> 0 < us)
|
||||
and K (range_cover ptr sz (obj_bits_api ty us) n)\<rbrace>
|
||||
retype_region ptr n us ty dev \<lbrace>\<lambda>rv. valid_arch_state\<rbrace>"
|
||||
|
|
@ -2157,6 +2163,16 @@ lemma set_free_index_valid_pspace_simple:
|
|||
apply (clarsimp simp:is_master_reply_cap_def)
|
||||
done
|
||||
|
||||
lemma set_untyped_cap_refs_respects_device_simple:
|
||||
"\<lbrace>K (is_untyped_cap cap) and cte_wp_at (op = cap) cref and cap_refs_respects_device_region \<rbrace> set_cap (UntypedCap (cap_is_device cap) (obj_ref_of cap) (cap_bits cap) idx) cref
|
||||
\<lbrace>\<lambda>rv s. cap_refs_respects_device_region s\<rbrace>"
|
||||
apply (wp set_cap_cap_refs_respects_device_region)
|
||||
apply (clarsimp simp del:split_paired_Ex)
|
||||
apply (rule_tac x = cref in exI)
|
||||
apply (erule cte_wp_at_weakenE)
|
||||
apply (case_tac cap,auto)
|
||||
done
|
||||
|
||||
lemma set_untyped_cap_invs_simple:
|
||||
"\<lbrace>\<lambda>s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \<and> pspace_no_overlap ptr sz s \<and> invs s
|
||||
\<and> cte_wp_at (\<lambda>c. is_untyped_cap c \<and> cap_bits c = sz \<and> obj_ref_of c = ptr \<and> cap_is_device c = dev) cref s \<and> idx \<le> 2^ sz\<rbrace>
|
||||
|
|
@ -2170,7 +2186,8 @@ lemma set_untyped_cap_invs_simple:
|
|||
apply (simp add:valid_irq_node_def)
|
||||
apply wps
|
||||
apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap_arch_objs set_cap_valid_arch_caps
|
||||
set_cap_valid_global_objs set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at )
|
||||
set_cap_valid_global_objs set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at
|
||||
set_untyped_cap_refs_respects_device_simple)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state is_cap_simps)
|
||||
apply (intro conjI,clarsimp)
|
||||
apply (rule ext,clarsimp simp:is_cap_simps)
|
||||
|
|
@ -3248,11 +3265,30 @@ lemma create_cap_vms[wp]:
|
|||
done
|
||||
|
||||
crunch valid_irq_states[wp]: create_cap "valid_irq_states"
|
||||
crunch pspace_respects_device_region[wp]: create_cap pspace_respects_device_region
|
||||
|
||||
lemma cap_range_subseteq_weaken:
|
||||
"\<lbrakk>obj_refs c \<subseteq> untyped_range cap; untyped_range c \<subseteq> untyped_range cap\<rbrakk>
|
||||
\<Longrightarrow> cap_range c \<subseteq> cap_range cap"
|
||||
by (fastforce simp add:cap_range_def)
|
||||
|
||||
lemma create_cap_refs_respects_device:
|
||||
"\<lbrace>cap_refs_respects_device_region and cte_wp_at (\<lambda>c. cap_is_device (default_cap tp oref sz dev) = cap_is_device c \<and>is_untyped_cap c \<and> cap_range (default_cap tp oref sz dev) \<subseteq> cap_range c) p\<rbrace>
|
||||
create_cap tp sz p dev (cref, oref) \<lbrace>\<lambda>rv s. cap_refs_respects_device_region s\<rbrace>"
|
||||
apply (simp add:create_cap_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp set_cap_cap_refs_respects_device_region hoare_vcg_ex_lift
|
||||
set_cdt_cte_wp_at | simp del:split_paired_Ex)+
|
||||
apply (rule_tac x = p in exI)
|
||||
apply clarsimp
|
||||
apply (erule cte_wp_at_weakenE)
|
||||
apply (fastforce simp:is_cap_simps)
|
||||
done
|
||||
|
||||
lemma create_cap_invs[wp]:
|
||||
"\<lbrace>invs
|
||||
and cte_wp_at (\<lambda>c. is_untyped_cap c \<and>
|
||||
obj_refs (default_cap tp oref sz dev) \<subseteq> untyped_range c \<and>
|
||||
and cte_wp_at (\<lambda>c. is_untyped_cap c \<and> cap_is_device (default_cap tp oref sz dev) = cap_is_device c
|
||||
\<and> obj_refs (default_cap tp oref sz dev) \<subseteq> untyped_range c \<and>
|
||||
untyped_range (default_cap tp oref sz dev) \<subseteq> untyped_range c
|
||||
\<and> untyped_range (default_cap tp oref sz dev) \<inter> usable_untyped_range c = {}) p
|
||||
and descendants_range (default_cap tp oref sz dev) p
|
||||
|
|
@ -3267,7 +3303,7 @@ lemma create_cap_invs[wp]:
|
|||
create_cap tp sz p dev (cref, oref) \<lbrace>\<lambda>rv. invs\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (simp add: invs_def valid_state_def valid_pspace_def)
|
||||
apply (wp | simp add: valid_cap_def)+
|
||||
apply (wp create_cap_refs_respects_device | simp add: valid_cap_def)+
|
||||
apply clarsimp
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state valid_pspace_def)
|
||||
apply (frule_tac p1 = p in valid_cap_aligned[OF caps_of_state_valid])
|
||||
|
|
@ -3324,13 +3360,24 @@ lemma cap_range_inter_emptyI:
|
|||
apply (simp_all add:cap_range_not_untyped)
|
||||
done
|
||||
|
||||
definition "obj_is_device tp dev \<equiv>
|
||||
case tp of Invariants_AI.Untyped \<Rightarrow> dev
|
||||
| _ \<Rightarrow>(case (default_object tp dev 0) of (ArchObj (DataPage dev _)) \<Rightarrow> dev
|
||||
| _ \<Rightarrow> False)"
|
||||
|
||||
lemma cap_is_device_obj_is_device[simp]:
|
||||
"cap_is_device (default_cap tp a sz dev) = obj_is_device tp dev"
|
||||
by (simp add:default_cap_def arch_default_cap_def obj_is_device_def
|
||||
default_object_def default_arch_object_def
|
||||
split:apiobject_type.splits aobject_type.splits)
|
||||
|
||||
lemma create_caps_invs_inv:
|
||||
assumes create_cap_Q[wp]: "\<lbrace>invs and Q and cte_wp_at (\<lambda>c. is_untyped_cap c) p and cte_wp_at (op = NullCap) cref\<rbrace>
|
||||
create_cap tp sz p dev (cref,oref) \<lbrace>\<lambda>_. Q \<rbrace>"
|
||||
shows
|
||||
"\<lbrace>(\<lambda>s. invs s \<and> Q s
|
||||
\<and> cte_wp_at is_untyped_cap p s
|
||||
\<and> (\<forall>tup \<in> set ((cref,oref)#list).
|
||||
\<and> cte_wp_at (\<lambda>c. is_untyped_cap c \<and> obj_is_device tp dev = cap_is_device c) p s
|
||||
\<and> (\<forall>tup \<in> set ((cref,oref)#list).
|
||||
cte_wp_at (\<lambda>c. cap_range (default_cap tp (snd tup) sz dev) \<subseteq> untyped_range c
|
||||
\<and> (untyped_range (default_cap tp (snd tup) sz dev) \<inter> usable_untyped_range c = {})) p s)
|
||||
\<and> (\<forall>tup \<in> set ((cref,oref)#list).
|
||||
|
|
@ -3351,11 +3398,11 @@ lemma create_caps_invs_inv:
|
|||
\<and> tp \<noteq> ArchObject ASIDPoolObj) \<rbrace>
|
||||
create_cap tp sz p dev (cref,oref)
|
||||
\<lbrace>(\<lambda>r s.
|
||||
|
||||
invs s \<and> Q s
|
||||
\<and> cte_wp_at is_untyped_cap p s
|
||||
\<and> cte_wp_at (\<lambda>c. is_untyped_cap c \<and> obj_is_device tp dev = cap_is_device c) p s
|
||||
\<and> (\<forall>tup \<in> set list.
|
||||
cte_wp_at (\<lambda>c. cap_range (default_cap tp (snd tup) sz dev) \<subseteq> untyped_range c
|
||||
cte_wp_at (\<lambda>c.
|
||||
cap_range (default_cap tp (snd tup) sz dev) \<subseteq> untyped_range c
|
||||
\<and> (untyped_range (default_cap tp (snd tup) sz dev) \<inter> usable_untyped_range c = {})) p s)
|
||||
\<and> (\<forall>tup \<in> set list.
|
||||
descendants_range (default_cap tp (snd tup) sz dev) p s)
|
||||
|
|
@ -3377,15 +3424,15 @@ lemma create_caps_invs_inv:
|
|||
apply (wp hoare_vcg_const_Ball_lift | clarsimp)+
|
||||
apply (clarsimp simp: conj_comms invs_mdb distinct_sets_prop distinct_prop_map
|
||||
ex_cte_cap_to_cnode_always_appropriate_strg)
|
||||
apply (simp add: cte_wp_at_caps_of_state[where p=p])
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state[where p=p])
|
||||
apply (intro conjI)
|
||||
apply (clarsimp simp:image_def)
|
||||
apply (drule(1) bspec)+
|
||||
apply simp
|
||||
apply (fastforce simp:cap_range_def)
|
||||
apply (clarsimp simp:is_cap_simps)
|
||||
apply fastforce
|
||||
apply (clarsimp simp: cap_range_def)
|
||||
apply (clarsimp simp:image_def)
|
||||
apply (drule(1) bspec)+
|
||||
apply simp
|
||||
apply (fastforce simp:cap_range_def)
|
||||
apply (clarsimp simp:is_cap_simps)
|
||||
apply fastforce
|
||||
apply (clarsimp simp: cap_range_def)+
|
||||
done
|
||||
|
||||
|
||||
|
|
@ -3403,7 +3450,7 @@ lemma create_caps_invs:
|
|||
"*)
|
||||
shows
|
||||
"\<lbrace>\<lambda>s. invs s \<and> Q s
|
||||
\<and> cte_wp_at is_untyped_cap p s
|
||||
\<and> cte_wp_at (\<lambda>c. is_untyped_cap c \<and> obj_is_device tp dev = cap_is_device c) p s
|
||||
\<and> (\<forall>tup \<in> set (zip crefs orefs).
|
||||
cte_wp_at (\<lambda>c. cap_range (default_cap tp (snd tup) sz dev) \<subseteq> untyped_range c
|
||||
\<and> (untyped_range (default_cap tp (snd tup) sz dev) \<inter> usable_untyped_range c = {})) p s)
|
||||
|
|
@ -3434,17 +3481,18 @@ lemma create_caps_invs:
|
|||
apply assumption
|
||||
apply (thin_tac "valid a b c" for a b c)
|
||||
apply (rule hoare_pre)
|
||||
apply (rule hoare_strengthen_post)
|
||||
apply (rule_tac list=list in create_caps_invs_inv[OF create_cap_Q],clarsimp+)
|
||||
apply (rule hoare_strengthen_post)
|
||||
apply (rule_tac list=list in create_caps_invs_inv[OF create_cap_Q],clarsimp+)
|
||||
done
|
||||
|
||||
lemma create_caps_invs_empty_descendants:
|
||||
assumes create_cap_Q[wp]: "\<And>tp sz p cref oref.\<lbrace>invs and Q and cte_wp_at (\<lambda>c. is_untyped_cap c) p and cte_wp_at (op = NullCap) cref\<rbrace>
|
||||
assumes create_cap_Q[wp]: "\<And>tp sz p cref oref.
|
||||
\<lbrace>invs and Q and cte_wp_at (\<lambda>c. is_untyped_cap c) p and cte_wp_at (op = NullCap) cref\<rbrace>
|
||||
create_cap tp sz p dev (cref,oref) \<lbrace>\<lambda>_. Q \<rbrace>"
|
||||
shows
|
||||
"\<lbrace>\<lambda>s. invs s \<and> Q s
|
||||
\<and> descendants_of p (cdt s) = {}
|
||||
\<and> cte_wp_at is_untyped_cap p s
|
||||
\<and> cte_wp_at (\<lambda>c. is_untyped_cap c \<and> obj_is_device tp dev = cap_is_device c) p s
|
||||
\<and> (\<forall>tup \<in> set (zip crefs orefs).
|
||||
cte_wp_at (\<lambda>c. cap_range (default_cap tp (snd tup) sz dev) \<subseteq> untyped_range c
|
||||
\<and> (untyped_range (default_cap tp (snd tup) sz dev) \<inter> usable_untyped_range c = {})) p s)
|
||||
|
|
@ -3513,6 +3561,7 @@ lemma retype_region_not_cte_wp_at:
|
|||
"\<lbrace>(\<lambda>s. \<not> cte_wp_at P p s) and valid_pspace and
|
||||
caps_overlap_reserved {ptr..ptr + of_nat n * 2 ^ obj_bits_api tp us - 1} and
|
||||
valid_mdb and pspace_no_overlap ptr sz and caps_no_overlap ptr sz and
|
||||
(\<lambda>s. \<exists>cref. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) cref s) and
|
||||
K (\<not> P cap.NullCap \<and> (tp = CapTableObject \<longrightarrow> 0 < us) \<and> range_cover ptr sz (obj_bits_api tp us) n)\<rbrace>
|
||||
retype_region ptr n us tp dev
|
||||
\<lbrace>\<lambda>rv s. \<not> cte_wp_at P p s\<rbrace>"
|
||||
|
|
@ -3908,6 +3957,16 @@ lemma init_arch_objects_ex_cte_cap_wp_to[wp]:
|
|||
\<lbrace>\<lambda>rv. ex_cte_cap_wp_to P p\<rbrace>"
|
||||
by (simp add: ex_cte_cap_wp_to_def) (wp hoare_vcg_ex_lift)
|
||||
|
||||
lemma set_cap_device_and_range:
|
||||
"\<lbrace>\<top>\<rbrace> set_cap (UntypedCap dev (ptr && ~~ mask sz) sz idx) aref
|
||||
\<lbrace>\<lambda>rv s. (\<exists>slot. cte_wp_at (\<lambda>c. cap_is_device c = dev \<and> up_aligned_area ptr sz \<subseteq> cap_range c) slot s)\<rbrace>"
|
||||
apply (rule hoare_pre)
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state simp del:split_paired_All split_paired_Ex)
|
||||
apply (wp set_cap_cte_wp_at' hoare_vcg_ex_lift)
|
||||
apply (rule_tac x = "aref" in exI)
|
||||
apply (auto intro:word_and_le2 simp:p_assoc_help)
|
||||
done
|
||||
|
||||
lemma invoke_untyp_invs':
|
||||
assumes create_cap_Q[wp]: "\<And>tp sz p cref oref dev.\<lbrace>invs and Q and cte_wp_at (\<lambda>c. is_untyped_cap c) p and cte_wp_at (op = NullCap) cref\<rbrace>
|
||||
create_cap tp sz p dev (cref,oref) \<lbrace>\<lambda>_. Q \<rbrace>"
|
||||
|
|
@ -3921,7 +3980,7 @@ lemma invoke_untyp_invs':
|
|||
apply (cases ui, simp split del: split_if del:invoke_untyped.simps)
|
||||
apply (rule hoare_name_pre_state)
|
||||
apply (clarsimp simp del:split_paired_All split_paired_Ex split_paired_Ball invoke_untyped.simps)
|
||||
apply (rename_tac cref oref ptr tp us slots s sz idx)
|
||||
apply (rename_tac cref oref ptr tp us slots dev s sz idx)
|
||||
proof -
|
||||
fix cref oref ptr tp us slots s sz idx dev
|
||||
assume cte_wp_at : "cte_wp_at (\<lambda>c. c = cap.UntypedCap dev (ptr && ~~ mask sz) sz idx) (cref,oref) (s::'a::state_ext state)"
|
||||
|
|
@ -3936,6 +3995,7 @@ lemma invoke_untyp_invs':
|
|||
" ct_active s"
|
||||
assume cover : "range_cover ptr sz (obj_bits_api tp us) (length slots)"
|
||||
assume vslot : "slots\<noteq> []"
|
||||
assume dev_check: "dev \<longrightarrow> tp = Invariants_AI.Untyped \<or> is_frame_type tp"
|
||||
|
||||
have pf : "invoke_untyped_proofs s (cref,oref) ptr tp us slots sz idx dev"
|
||||
using cte_wp_at desc_range misc cover vslot
|
||||
|
|
@ -3943,7 +4003,12 @@ lemma invoke_untyp_invs':
|
|||
apply (drule(1) bspec)
|
||||
apply (clarsimp elim!:ex_cte_cap_wp_to_weakenE)
|
||||
done
|
||||
|
||||
have obj_is_dev[simp]: "obj_is_device tp dev = dev"
|
||||
using dev_check
|
||||
apply (case_tac dev)
|
||||
apply (clarsimp simp: obj_is_device_def default_object_def default_arch_object_def is_frame_type_def arch_is_frame_type_def
|
||||
split: aobject_type.split_asm apiobject_type.split_asm)+
|
||||
done
|
||||
have of_nat_length: "(of_nat (length slots)::word32) - (1::word32) < (of_nat (length slots)::word32)"
|
||||
using vslot
|
||||
using range_cover.range_cover_le_n_less(1)[OF cover,where p = "length slots"]
|
||||
|
|
@ -4121,6 +4186,12 @@ lemma invoke_untyp_invs':
|
|||
apply (frule_tac cap="(UntypedCap dev ptr sz idx)" in detype_Q)
|
||||
apply (simp add: blah)+
|
||||
done
|
||||
have set_cap_device_and_range_aligned:
|
||||
"\<And>aref idx. \<lbrace>\<lambda>s. (ptr && ~~ mask sz = ptr)\<rbrace> set_cap (UntypedCap dev ptr sz idx) aref
|
||||
\<lbrace>\<lambda>rv s. (\<exists>slot. cte_wp_at (\<lambda>c. cap_is_device c = dev \<and> {ptr..ptr + (2 ^ sz - 1)} \<subseteq> cap_range c) slot s)\<rbrace>"
|
||||
apply (rule hoare_gen_asm[where P'="\<top>",simplified])
|
||||
using set_cap_device_and_range[where ptr = ptr and sz = sz]
|
||||
by auto
|
||||
|
||||
note set_cap_free_index_invs_spec = set_free_index_invs[where cap = "cap.UntypedCap dev (ptr && ~~ mask sz) sz idx"
|
||||
,unfolded free_index_update_def free_index_of_def,simplified]
|
||||
|
|
@ -4182,6 +4253,7 @@ lemma invoke_untyp_invs':
|
|||
set_cap_free_index_invs_spec
|
||||
set_cap_cte_wp_at set_cap_descendants_range_in
|
||||
set_cap_caps_no_overlap
|
||||
set_cap_device_and_range
|
||||
set_untyped_cap_caps_overlap_reserved set_cap_cte_cap_wp_to)
|
||||
apply (wp set_cap_cte_wp_at_neg hoare_vcg_all_lift get_cap_wp)
|
||||
apply (insert cte_wp_at)
|
||||
|
|
@ -4255,7 +4327,8 @@ lemma invoke_untyp_invs':
|
|||
set_untyped_cap_invs_simple
|
||||
set_cap_cte_wp_at set_cap_descendants_range_in
|
||||
set_cap_caps_no_overlap set_untyped_cap_caps_overlap_reserved
|
||||
set_cap_cte_cap_wp_to)
|
||||
set_cap_cte_cap_wp_to
|
||||
set_cap_device_and_range_aligned)
|
||||
apply (wp set_cap_cte_wp_at_neg hoare_vcg_all_lift)
|
||||
apply (rule_tac P = "cap = cap.UntypedCap dev ptr sz idx \<and> sz \<le> word_bits
|
||||
\<and> 2 \<le> sz" in hoare_gen_asm)
|
||||
|
|
|
|||
|
|
@ -35,11 +35,100 @@ lemma throw_on_false_wp[wp]:
|
|||
apply simp
|
||||
done
|
||||
|
||||
crunch_ignore (add: throw_on_false)
|
||||
lemma pspace_respects_device_region_dmo:
|
||||
assumes valid_f: "\<And>P. \<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> f \<lbrace>\<lambda>r ms. P (device_state ms)\<rbrace>"
|
||||
shows "\<lbrace>pspace_respects_device_region\<rbrace>do_machine_op f\<lbrace>\<lambda>r. pspace_respects_device_region\<rbrace>"
|
||||
apply (clarsimp simp:do_machine_op_def gets_def select_f_def simpler_modify_def bind_def valid_def
|
||||
get_def return_def)
|
||||
apply (drule_tac P1 = "op = (device_state (machine_state s))" in use_valid[OF _ valid_f])
|
||||
apply auto
|
||||
done
|
||||
|
||||
lemma cap_refs_respects_device_region_dmo:
|
||||
assumes valid_f: "\<And>P. \<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> f \<lbrace>\<lambda>r ms. P (device_state ms)\<rbrace>"
|
||||
shows "\<lbrace>cap_refs_respects_device_region\<rbrace>do_machine_op f\<lbrace>\<lambda>r. cap_refs_respects_device_region\<rbrace>"
|
||||
apply (clarsimp simp:do_machine_op_def gets_def select_f_def simpler_modify_def bind_def valid_def
|
||||
get_def return_def)
|
||||
apply (drule_tac P1 = "op = (device_state (machine_state s))" in use_valid[OF _ valid_f])
|
||||
apply auto
|
||||
done
|
||||
|
||||
lemma machine_op_lift_device_state[wp]:
|
||||
"\<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> machine_op_lift f \<lbrace>\<lambda>_ ms. P (device_state ms)\<rbrace>"
|
||||
by (clarsimp simp:machine_op_lift_def NonDetMonad.valid_def bind_def
|
||||
machine_rest_lift_def gets_def simpler_modify_def get_def return_def
|
||||
select_def ignore_failure_def select_f_def split:if_splits)
|
||||
|
||||
crunch device_state_inv[wp]: invalidateTLB_ASID "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: invalidateTLB_VAASID "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: setHardwareASID "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: isb "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: dsb "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: setCurrentPD "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: storeWord "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: cleanByVA_PoU "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: cleanL2Range "\<lambda>ms. P (device_state ms)"
|
||||
|
||||
|
||||
lemma cleanCacheRange_PoU_respects_device_region[wp]:
|
||||
"\<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> cleanCacheRange_PoU a b c \<lbrace>\<lambda>_ ms. P (device_state ms)\<rbrace>"
|
||||
apply (clarsimp simp:cleanCacheRange_PoU_def cacheRangeOp_def)
|
||||
apply (wp mapM_x_wp | wpc | clarsimp)+
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma cacheRangeOp_respects_device_region[wp]:
|
||||
assumes valid_f: "\<And>a b P. \<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> f a b \<lbrace>\<lambda>_ ms. P (device_state ms)\<rbrace>"
|
||||
shows "\<lbrace>\<lambda>ms. P (device_state ms)\<rbrace> cacheRangeOp f a b c\<lbrace>\<lambda>_ ms. P (device_state ms)\<rbrace>"
|
||||
apply (clarsimp simp:do_flush_def cacheRangeOp_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp mapM_x_wp valid_f | wpc | clarsimp | assumption)+
|
||||
done
|
||||
|
||||
crunch device_state_inv[wp]: cleanByVA "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: cleanCacheRange_PoC "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: cleanCacheRange_RAM "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: cleanInvalByVA "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: invalidateByVA "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: invalidateL2Range "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: invalidateCacheRange_RAM "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region simp:crunch_simps)
|
||||
|
||||
crunch device_state_inv[wp]: branchFlush "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: branchFlushRange "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: invalidateByVA_I "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: cleanInvalidateL2Range "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: do_flush "\<lambda>ms. P (device_state ms)"
|
||||
(wp: cacheRangeOp_respects_device_region)
|
||||
|
||||
crunch device_state_inv[wp]: storeWord "\<lambda>ms. P (device_state ms)"
|
||||
|
||||
crunch pspace_in_kernel_window[wp]: perform_page_invocation "pspace_in_kernel_window"
|
||||
(simp: crunch_simps wp: crunch_wps)
|
||||
|
||||
crunch pspace_respects_device_region[wp]: perform_page_invocation "pspace_respects_device_region"
|
||||
(simp: crunch_simps wp: crunch_wps set_object_pspace_respect_device_region pspace_respects_device_region_dmo)
|
||||
|
||||
|
||||
definition
|
||||
"is_arch_update cap cap' \<equiv> is_arch_cap cap \<and> cap_master_cap cap = cap_master_cap cap'"
|
||||
|
|
@ -603,6 +692,10 @@ lemma clean_D_PoU_underlying_memory[wp]:
|
|||
by (clarsimp simp: clean_D_PoU_def machine_op_lift_def
|
||||
machine_rest_lift_def split_def | wp)+
|
||||
|
||||
crunch device_state_inv[wp]: invalidate_I_PoU "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: clean_D_PoU "\<lambda>ms. P (device_state ms)"
|
||||
crunch device_state_inv[wp]: cleanCaches_PoU "\<lambda>ms. P (device_state ms)"
|
||||
|
||||
lemma dmo_cleanCaches_PoU_invs[wp]: "\<lbrace>invs\<rbrace> do_machine_op cleanCaches_PoU \<lbrace>\<lambda>y. invs\<rbrace>"
|
||||
apply (wp dmo_invs)
|
||||
apply safe
|
||||
|
|
@ -1671,6 +1764,10 @@ lemma find_free_hw_asid_invs [wp]:
|
|||
pd_at_asid_arch_up')
|
||||
apply (rule conjI, blast)
|
||||
apply (clarsimp simp: pd_at_asid_def)
|
||||
apply (drule_tac P1 = "op = (device_state (machine_state s))" in
|
||||
use_valid[OF _ VSpace_AI.invalidateTLB_ASID_device_state_inv])
|
||||
apply simp
|
||||
apply clarsimp
|
||||
done
|
||||
|
||||
lemma get_hw_asid_invs [wp]:
|
||||
|
|
@ -1719,6 +1816,7 @@ lemma dmo_setCurrentPD_invs[wp]: "\<lbrace>invs\<rbrace> do_machine_op (setCurre
|
|||
apply(erule (1) use_valid[OF _ setCurrentPD_irq_masks])
|
||||
done
|
||||
|
||||
crunch device_state_inv[wp]: ackInterrupt "\<lambda>ms. P (device_state ms)"
|
||||
lemma dmo_ackInterrupt[wp]: "\<lbrace>invs\<rbrace> do_machine_op (ackInterrupt irq) \<lbrace>\<lambda>y. invs\<rbrace>"
|
||||
apply (wp dmo_invs)
|
||||
apply safe
|
||||
|
|
@ -3084,6 +3182,12 @@ lemma master_cap_eq_is_pg_cap_eq:
|
|||
by (simp add: cap_master_cap_def is_pg_cap_def
|
||||
split: cap.splits arch_cap.splits)
|
||||
|
||||
(* FIXME: move *)
|
||||
lemma master_cap_eq_is_device_cap_eq:
|
||||
"cap_master_cap c = cap_master_cap d \<Longrightarrow> cap_is_device c = cap_is_device d"
|
||||
by (simp add: cap_master_cap_def
|
||||
split: cap.splits arch_cap.splits)
|
||||
|
||||
(* FIXME: move *)
|
||||
lemmas vs_cap_ref_eq_imp_table_cap_ref_eq' =
|
||||
vs_cap_ref_eq_imp_table_cap_ref_eq[OF master_cap_eq_is_pg_cap_eq]
|
||||
|
|
@ -3098,7 +3202,8 @@ lemma arch_update_cap_invs_map:
|
|||
apply (rule hoare_pre)
|
||||
apply (wp arch_update_cap_pspace arch_update_cap_valid_mdb set_cap_idle
|
||||
update_cap_ifunsafe valid_irq_node_typ set_cap_typ_at
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps)
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps
|
||||
set_cap_cap_refs_respects_device_region_spec[where ptr = p])
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state
|
||||
simp del: imp_disjL)
|
||||
apply (frule(1) valid_global_refsD2)
|
||||
|
|
@ -3164,10 +3269,11 @@ lemma arch_update_cap_invs_map:
|
|||
apply (simp add: cap_asid_def)
|
||||
apply simp
|
||||
apply (clarsimp simp: is_cap_simps is_pt_cap_def cap_master_cap_simps
|
||||
cap_asid_def vs_cap_ref_def ranI
|
||||
cap_asid_def vs_cap_ref_def ranI
|
||||
dest!: cap_master_cap_eqDs split: option.split_asm split_if_asm
|
||||
elim!: ranE
|
||||
elim!: ranE cong:master_cap_eq_is_device_cap_eq
|
||||
| rule conjI)+
|
||||
apply (clarsimp dest!: master_cap_eq_is_device_cap_eq)
|
||||
done
|
||||
|
||||
(* Want something like
|
||||
|
|
@ -3186,7 +3292,8 @@ lemma arch_update_cap_invs_unmap_page:
|
|||
apply (rule hoare_pre)
|
||||
apply (wp arch_update_cap_pspace arch_update_cap_valid_mdb set_cap_idle
|
||||
update_cap_ifunsafe valid_irq_node_typ set_cap_typ_at
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps)
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps
|
||||
set_cap_cap_refs_respects_device_region_spec[where ptr = p])
|
||||
apply clarsimp
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_update_def
|
||||
is_cap_simps cap_master_cap_simps
|
||||
|
|
@ -3224,7 +3331,8 @@ lemma arch_update_cap_invs_unmap_page_table:
|
|||
apply (rule hoare_pre)
|
||||
apply (wp arch_update_cap_pspace arch_update_cap_valid_mdb set_cap_idle
|
||||
update_cap_ifunsafe valid_irq_node_typ set_cap_typ_at
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps)
|
||||
set_cap_irq_handlers set_cap_valid_arch_caps
|
||||
set_cap_cap_refs_respects_device_region_spec[where ptr = p])
|
||||
apply (simp add: final_cap_at_eq)
|
||||
apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_update_def
|
||||
is_cap_simps cap_master_cap_simps
|
||||
|
|
|
|||
|
|
@ -1917,17 +1917,25 @@ definition
|
|||
do t \<leftarrow> getCurThread;
|
||||
trans \<leftarrow> gets (ptable_lift t \<circ> absKState);
|
||||
perms \<leftarrow> gets (ptable_rights t \<circ> absKState);
|
||||
|
||||
um \<leftarrow> gets (\<lambda>s. user_mem' s \<circ> ptrFromPAddr);
|
||||
dm \<leftarrow> gets device_mem';
|
||||
dm \<leftarrow> gets (\<lambda>s. device_mem' s \<circ> ptrFromPAddr);
|
||||
|
||||
ds \<leftarrow> gets (device_state \<circ> ksMachineState);
|
||||
assert (dom (um \<circ> addrFromPPtr) \<subseteq> - dom ds);
|
||||
assert (dom (dm \<circ> addrFromPPtr) \<subseteq> dom ds);
|
||||
|
||||
(e, tc',um',ds') \<leftarrow> select (fst (uop t (restrict_map trans {pa. perms pa \<noteq> {}}) perms
|
||||
(tc, restrict_map um
|
||||
{pa. \<exists>va. trans va = Some pa \<and> AllowRead \<in> perms va},ds)));
|
||||
{pa. \<exists>va. trans va = Some pa \<and> AllowRead \<in> perms va}
|
||||
,(ds \<circ> ptrFromPAddr) |` {pa. \<exists>va. trans va = Some pa \<and> AllowRead \<in> perms va} )
|
||||
));
|
||||
doMachineOp (user_memory_update
|
||||
(restrict_map (um'|` dom um)
|
||||
{pa. \<exists>va. trans va = Some pa \<and> AllowWrite \<in> perms va} \<circ>
|
||||
addrFromPPtr));
|
||||
doMachineOp (device_update (ds ++ ds'|` (dom dm)));
|
||||
((um' |` {pa. \<exists>va. trans va = Some pa \<and> AllowWrite \<in> perms va}
|
||||
\<circ> Platform.addrFromPPtr) |` (- dom ds)));
|
||||
doMachineOp (device_memory_update
|
||||
((ds' |` {pa. \<exists>va. trans va = Some pa \<and> AllowWrite \<in> perms va}
|
||||
\<circ> Platform.addrFromPPtr )|` (dom ds)));
|
||||
return (e, tc')
|
||||
od"
|
||||
|
||||
|
|
|
|||
|
|
@ -109,6 +109,22 @@ lemma retype_region2_ext_retype_region_ArchObject:
|
|||
apply simp
|
||||
done
|
||||
|
||||
lemma set_cap_device_and_range_aligned:
|
||||
"is_aligned ptr sz \<Longrightarrow> \<lbrace>\<lambda>_. True\<rbrace>
|
||||
set_cap
|
||||
(cap.UntypedCap dev ptr sz idx)
|
||||
aref
|
||||
\<lbrace>\<lambda>rv s.
|
||||
\<exists>slot.
|
||||
cte_wp_at
|
||||
(\<lambda>c. cap_is_device c = dev \<and>
|
||||
up_aligned_area ptr sz \<subseteq> cap_range c)
|
||||
slot s\<rbrace>"
|
||||
apply (subst is_aligned_neg_mask_eq[symmetric])
|
||||
apply simp
|
||||
apply (wp set_cap_device_and_range)
|
||||
done
|
||||
|
||||
lemma pac_corres:
|
||||
"asid_ci_map i = i' \<Longrightarrow>
|
||||
corres dc
|
||||
|
|
@ -205,7 +221,8 @@ lemma pac_corres:
|
|||
set_cap_cte_wp_at
|
||||
set_cap_caps_no_overlap[where sz = pageBits]
|
||||
set_cap_no_overlap[where sz = pageBits]
|
||||
set_untyped_cap_caps_overlap_reserved[where sz = pageBits])
|
||||
set_cap_device_and_range_aligned[where dev = False,simplified]
|
||||
set_untyped_cap_caps_overlap_reserved[where sz = pageBits] | assumption)+
|
||||
apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def
|
||||
objBits_simps archObjSize_def default_arch_object_def
|
||||
makeObjectKO_def range_cover_full
|
||||
|
|
|
|||
|
|
@ -4197,14 +4197,17 @@ lemma set_thread_all_corres:
|
|||
apply (clarsimp simp add: state_relation_def z)
|
||||
apply (simp add: trans_state_update'[symmetric] trans_state_update[symmetric]
|
||||
del: trans_state_update)
|
||||
apply (clarsimp simp add: caps_of_state_after_update cte_wp_at_after_update
|
||||
swp_def fun_upd_def obj_at_def is_etcb_at_def)
|
||||
apply (clarsimp simp add: swp_def fun_upd_def obj_at_def is_etcb_at_def)
|
||||
apply (subst cte_wp_at_after_update,fastforce simp add:obj_at_def)
|
||||
apply (subst caps_of_state_after_update,fastforce simp add:obj_at_def)
|
||||
apply clarsimp
|
||||
apply (subst conj_assoc[symmetric])
|
||||
apply (rule conjI[rotated])
|
||||
apply (clarsimp simp add: ghost_relation_def)
|
||||
apply (erule_tac x=ptr in allE)+
|
||||
apply (clarsimp simp: obj_at_def a_type_def
|
||||
split: Structures_A.kernel_object.splits split_if_asm)
|
||||
|
||||
apply (fold fun_upd_def)
|
||||
apply (simp only: pspace_relation_def dom_fun_upd2 simp_thms)
|
||||
apply (subst pspace_dom_update)
|
||||
|
|
|
|||
|
|
@ -498,9 +498,9 @@ definition
|
|||
"ex_abs G \<equiv> \<lambda>s'. \<exists>s. ((s :: (det_ext) state),s') \<in> state_relation \<and> G s"
|
||||
|
||||
lemma device_update_invs':
|
||||
"\<lbrace>invs'\<rbrace>doMachineOp (device_update ds)
|
||||
"\<lbrace>invs'\<rbrace>doMachineOp (device_memory_update ds)
|
||||
\<lbrace>\<lambda>_. invs'\<rbrace>"
|
||||
apply (simp add:doMachineOp_def device_update_def simpler_modify_def select_f_def
|
||||
apply (simp add:doMachineOp_def device_memory_update_def simpler_modify_def select_f_def
|
||||
gets_def get_def bind_def valid_def return_def)
|
||||
by (clarsimp simp:invs'_def valid_state'_def valid_irq_states'_def valid_machine_state'_def)
|
||||
|
||||
|
|
@ -519,8 +519,9 @@ lemma doUserOp_invs':
|
|||
(\<lambda>s. ksSchedulerAction s = ResumeCurrentThread) and ct_running'\<rbrace>"
|
||||
apply (simp add: doUserOp_def split_def ex_abs_def)
|
||||
apply (wp device_update_invs' device_update_ct_in_state')
|
||||
apply (wp dmo_invs')
|
||||
apply (clarsimp simp add: no_irq_modify user_memory_update_def)
|
||||
apply (wp dmo_invs' doMachineOp_ct_running')
|
||||
apply (clarsimp simp add: no_irq_modify device_memory_update_def
|
||||
user_memory_update_def)
|
||||
apply (wp doMachineOp_ct_running' doMachineOp_sch_act select_wp)
|
||||
apply (clarsimp simp: user_memory_update_def simpler_modify_def
|
||||
restrict_map_def
|
||||
|
|
@ -664,6 +665,9 @@ lemma do_user_op_corres:
|
|||
apply (rule_tac r'="op=" in corres_split)
|
||||
prefer 2
|
||||
apply (rule corres_gets_machine_state)
|
||||
apply (rule_tac F = "dom (rvb \<circ> addrFromPPtr) \<subseteq> - dom rvd" in corres_gen_asm)
|
||||
apply (rule_tac F = "dom (rvc \<circ> addrFromPPtr) \<subseteq> dom rvd" in corres_gen_asm)
|
||||
apply simp
|
||||
apply (rule_tac r'="op=" in corres_split[OF _ corres_select])
|
||||
apply (rule corres_split'[OF corres_machine_op])
|
||||
apply simp
|
||||
|
|
@ -672,7 +676,9 @@ lemma do_user_op_corres:
|
|||
apply (wp | simp)+
|
||||
apply (rule corres_split'[OF corres_machine_op,where Q = dc and Q'=dc])
|
||||
apply (rule corres_underlying_trivial)
|
||||
apply (wp | simp add:dc_def)+
|
||||
apply (wp | simp add:dc_def device_memory_update_def)+
|
||||
apply (clarsimp simp:invs_def valid_state_def pspace_respects_device_region_def)
|
||||
apply fastforce
|
||||
done
|
||||
|
||||
lemma ct_running_related:
|
||||
|
|
|
|||
|
|
@ -5995,6 +5995,7 @@ lemma corres_retype_region_createNewCaps:
|
|||
(\<lambda>s. valid_pspace s \<and> valid_mdb s \<and> valid_etcbs s \<and> valid_list s \<and> valid_arch_state s
|
||||
\<and> caps_no_overlap y sz s \<and> pspace_no_overlap y sz s
|
||||
\<and> caps_overlap_reserved {y..y + of_nat n * 2 ^ (obj_bits_api (APIType_map2 (Inr ty)) us) - 1} s
|
||||
\<and> (\<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area y sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s)
|
||||
\<and> (APIType_map2 (Inr ty) = Structures_A.CapTableObject \<longrightarrow> 0 < us))
|
||||
(\<lambda>s. pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' y sz s
|
||||
\<and> valid_pspace' s \<and> valid_arch_state' s
|
||||
|
|
|
|||
|
|
@ -3642,9 +3642,11 @@ lemma createNewCaps_ranges':
|
|||
apply (rule map_snd_zip_prefix [unfolded less_eq_list_def])
|
||||
done
|
||||
|
||||
declare split_paired_Ex[simp del]
|
||||
lemmas corres_split_retype_createNewCaps
|
||||
= corres_split [OF _ corres_retype_region_createNewCaps,
|
||||
simplified bind_assoc, simplified]
|
||||
simplified bind_assoc, simplified ]
|
||||
declare split_paired_Ex[simp add]
|
||||
|
||||
crunch cte_wp_at[wp]: do_machine_op "\<lambda>s. P (cte_wp_at P' p s)"
|
||||
|
||||
|
|
@ -3653,6 +3655,7 @@ lemma retype_region_caps_overlap_reserved:
|
|||
pspace_no_overlap ptr sz and caps_no_overlap ptr sz and
|
||||
caps_overlap_reserved
|
||||
{ptr..ptr + of_nat n * 2^obj_bits_api (APIType_map2 (Inr ao')) us - 1} and
|
||||
(\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) and
|
||||
K (APIType_map2 (Inr ao') = Invariants_AI.CapTableObject \<longrightarrow> 0 < us) and
|
||||
K (range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) n) and
|
||||
K (S \<subseteq> {ptr..ptr + of_nat n *
|
||||
|
|
@ -3677,6 +3680,7 @@ lemma retype_region_caps_overlap_reserved_ret:
|
|||
pspace_no_overlap ptr sz and
|
||||
caps_overlap_reserved
|
||||
{ptr..ptr + of_nat n * 2^obj_bits_api (APIType_map2 (Inr ao')) us - 1} and
|
||||
(\<lambda>s. \<exists>slot. cte_wp_at (\<lambda>c. up_aligned_area ptr sz \<subseteq> cap_range c \<and> cap_is_device c = dev) slot s) and
|
||||
K (APIType_map2 (Inr ao') = Invariants_AI.CapTableObject \<longrightarrow> 0 < us) and
|
||||
K (range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) n)\<rbrace>
|
||||
retype_region ptr n us (APIType_map2 (Inr ao')) dev
|
||||
|
|
@ -3689,13 +3693,14 @@ lemma retype_region_caps_overlap_reserved_ret:
|
|||
apply (erule use_valid[OF _ retype_region_caps_overlap_reserved])
|
||||
apply clarsimp
|
||||
apply (intro conjI,simp_all)
|
||||
apply fastforce
|
||||
apply (case_tac ao')
|
||||
apply (simp_all add:APIType_map2_def)
|
||||
apply (rename_tac apiobject_type)
|
||||
apply (case_tac apiobject_type)
|
||||
apply (simp_all add:obj_bits_api_def ptr_add_def)
|
||||
apply (drule(1) range_cover_subset)
|
||||
apply clarsimp+
|
||||
apply (clarsimp)+
|
||||
done
|
||||
|
||||
lemma getObjectSize_def_eq:
|
||||
|
|
@ -5010,6 +5015,13 @@ lemma inv_untyped_corres':
|
|||
apply (simp add: add.commute word_plus_and_or_coroll2)
|
||||
done
|
||||
|
||||
have set_cap_device_and_range_aligned:
|
||||
"\<And>aref idx. \<lbrace>\<lambda>s. (ptr && ~~ mask sz = ptr)\<rbrace> set_cap (cap.UntypedCap d ptr sz idx) aref
|
||||
\<lbrace>\<lambda>rv s. (\<exists>slot. cte_wp_at (\<lambda>c. cap_is_device c = d \<and> {ptr..ptr + (2 ^ sz - 1)} \<subseteq> cap_range c) slot s)\<rbrace>"
|
||||
apply (rule hoare_gen_asm[where P'="\<top>",simplified])
|
||||
using set_cap_device_and_range[where ptr = ptr and sz = sz]
|
||||
by auto
|
||||
|
||||
note set_cap_free_index_invs_spec = set_free_index_invs[where cap = "cap.UntypedCap d (ptr && ~~ mask sz) sz idx"
|
||||
,unfolded free_index_update_def free_index_of_def,simplified]
|
||||
|
||||
|
|
@ -5084,7 +5096,7 @@ lemma inv_untyped_corres':
|
|||
apply (rule hoare_strengthen_post[OF set_cap_sets])
|
||||
apply (clarsimp simp:cte_wp_at_caps_of_state invs)
|
||||
apply (wp set_cap_no_overlap hoare_vcg_ball_lift
|
||||
set_cap_free_index_invs_spec
|
||||
set_cap_free_index_invs_spec set_cap_device_and_range
|
||||
set_cap_cte_wp_at set_cap_descendants_range_in
|
||||
set_untyped_cap_caps_overlap_reserved)
|
||||
apply (clarsimp simp:conj_comms ball_conj_distrib simp del:capFreeIndex_update.simps)
|
||||
|
|
@ -5223,6 +5235,7 @@ lemma inv_untyped_corres':
|
|||
set_untyped_cap_invs_simple
|
||||
set_cap_cte_wp_at
|
||||
set_cap_descendants_range_in
|
||||
set_cap_device_and_range_aligned
|
||||
set_untyped_cap_caps_overlap_reserved)
|
||||
apply (clarsimp simp:conj_comms ball_conj_distrib simp del:capFreeIndex_update.simps)
|
||||
apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
|
||||
|
|
|
|||
Loading…
Reference in New Issue