adbrucker
/
lh-l4v
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

arm refine: update for changed corres split rules 

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
This commit is contained in:
Corey Lewis 2022-08-29 14:00:04 +10:00 committed by Gerwin Klein
parent f9295d6a97
commit 7289575cc7
20 changed files with 2784 additions and 2743 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
proof/refine/ARM/Arch_R.thy
View File

@ -154,8 +154,11 @@ lemma performASIDControlInvocation_corres:
apply (erule deleteObjects_corres)
apply (simp add:pageBits_def)
apply (rule corres_split[OF getSlotCap_corres])
apply simp
apply (rule_tac F = " pcap = (cap.UntypedCap False word1 pageBits idxa)" in corres_gen_asm)
apply (rule corres_split[OF updateFreeIndex_corres])
apply (clarsimp simp:is_cap_simps)
apply (simp add: free_index_of_def)
apply (rule corres_split)
apply (simp add: retype_region2_ext_retype_region_ArchObject )
apply (rule corres_retype [where ty="Inl (KOArch (KOASIDPool F))",
@ -208,9 +211,6 @@ lemma performASIDControlInvocation_corres:
apply (rule descendants_of'_helper)
apply (wp createObjects_null_filter'
[where sz = pageBits and ty="Inl (KOArch (KOASIDPool undefined))"])
apply (clarsimp simp:is_cap_simps)
apply (simp add: free_index_of_def)
apply (clarsimp simp: conj_comms obj_bits_api_def arch_kobj_size_def
objBits_simps archObjSize_def default_arch_object_def
pred_conj_def)
@ -507,6 +507,7 @@ lemma resolveVAddr_corres:
and R'="\<lambda>_ s. pspace_distinct' s \<and> pspace_aligned' s
\<and> vs_valid_duplicates' (ksPSpace s)"
in corres_split[OF get_master_pde_corres])
apply simp
apply (case_tac rv, simp_all add: pde_relation'_def)[1]
apply (rule corres_stateAssert_assume_stronger)
apply (rule stronger_corres_guard_imp)
@ -767,14 +768,6 @@ lemma resolve_vaddr_valid_mapping_size:
split: if_split_asm)
done
lemma corres_splitEE':
assumes "corres_underlying sr nf nf' (f \<oplus> r') P P' a c"
assumes "\<And>rv rv'. r' rv rv'
\<Longrightarrow> corres_underlying sr nf nf' (f \<oplus> r) (R rv) (R' rv') (b rv) (d rv')"
assumes "\<lbrace>Q\<rbrace> a \<lbrace>R\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>" "\<lbrace>Q'\<rbrace> c \<lbrace>R'\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>"
shows "corres_underlying sr nf nf' (f \<oplus> r) (P and Q) (P' and Q') (a >>=E (\<lambda>rv. b rv)) (c >>=E (\<lambda>rv'. d rv'))"
by (rule corres_splitEE; rule assms)
lemmas whenE_throwError_corres_terminal =
whenE_throwError_corres[where m="returnOk ()" and m'="returnOk ()", OF _ _ corres_returnOkTT, simplified]
@ -947,7 +940,7 @@ shows
apply (rule_tac P="\<nexists>pd asid. pd_cap = cap.ArchObjectCap (arch_cap.PageDirectoryCap pd (Some asid))"
in corres_symmetric_bool_cases[where Q=\<top> and Q'=\<top>, OF refl])
apply (case_tac pd_cap; clarsimp; rename_tac pd_acap pd_acap'; case_tac pd_acap; clarsimp)
apply (rule corres_splitEE'[where r'="(=)" and P=\<top> and P'=\<top>])
apply (rule corres_splitEE[where r'="(=)" and P=\<top> and P'=\<top>])
apply (clarsimp simp: corres_returnOkTT)
apply (rule_tac F="pd_cap = cap.ArchObjectCap (arch_cap.PageDirectoryCap (fst rv) (Some (snd rv)))"
in corres_gen_asm)
@ -960,18 +953,18 @@ shows
apply (erule disjE; clarsimp simp: whenE_def kernel_base_def pptrBase_def
split: option.splits)
apply clarsimp
apply (rule corres_splitEE'[where r'=dc and P=\<top> and P'=\<top>])
apply (rule corres_splitEE[where r'=dc and P=\<top> and P'=\<top>])
apply (case_tac map_data
; clarsimp simp: whenE_def kernel_base_def pptrBase_def
corres_returnOkTT)
\<comment> \<open>pd=undefined as vspace_at_asid not used in find_pd_for_asid_corres and avoid unresolved schematics\<close>
apply (rule corres_splitEE'[
apply (rule corres_splitEE[
OF corres_lookup_error[OF find_pd_for_asid_corres[where pd=undefined, OF refl]]])
apply (rule whenE_throwError_corres; simp)
apply (rule corres_splitEE'[where r'=dc, OF checkVPAlignment_corres])
apply (rule corres_splitEE'[OF createMappingEntries_corres]
apply (rule corres_splitEE[where r'=dc, OF checkVPAlignment_corres])
apply (rule corres_splitEE[OF createMappingEntries_corres]
; simp add: mask_vmrights_corres vm_attributes_corres)
apply (rule corres_splitEE'[OF ensureSafeMapping_corres], assumption)
apply (rule corres_splitEE[OF ensureSafeMapping_corres], assumption)
apply (rule corres_returnOkTT)
\<comment> \<open>program split done, now prove resulting preconditions and Hoare triples\<close>
apply (simp add: archinv_relation_def page_invocation_map_def)

18
proof/refine/ARM/Bits_R.thy
View File

@ -232,14 +232,13 @@ lemma corres_injection:
\<Longrightarrow> corres (f \<oplus> r) P P' (t m) (t' m')"
apply (simp add: injection_handler_def handleE'_def x y)
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated)
defer
apply (rule corres_split)
apply assumption
apply (rule wp_post_taut)
apply (rule wp_post_taut)
apply simp
apply simp
apply (case_tac v, (clarsimp simp: z)+)
apply (rule wp_post_taut)
apply (rule wp_post_taut)
apply simp
apply simp
done
lemma rethrowFailure_injection:
@ -425,9 +424,8 @@ lemma corres_empty_on_failure:
apply (simp add: empty_on_failure_def emptyOnFailure_def)
apply (rule corres_guard_imp)
apply (rule corres_split_catch)
apply assumption
apply (rule corres_trivial, simp)
apply (erule corres_rel_imp)
apply (case_tac x; simp)
apply wp+
apply simp+
done
@ -466,11 +464,9 @@ lemma corres_const_on_failure:
apply (simp add: const_on_failure_def constOnFailure_def)
apply (rule corres_guard_imp)
apply (rule corres_split_catch)
apply assumption
apply (rule corres_trivial, simp)
apply (erule corres_rel_imp)
apply (case_tac xa)
apply (clarsimp simp: const_def)
apply simp
apply wp+
apply simp+
done

90
proof/refine/ARM/CNodeInv_R.thy
View File

@ -172,9 +172,12 @@ lemma decodeCNodeInvocation_corres:
split del: if_split
cong: if_cong list.case_cong)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE[OF ensureEmptySlot_corres])
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (rule corres_splitEE)
apply (rule ensureEmptySlot_corres; simp)
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (simp(no_asm) add: liftE_bindE del: de_Morgan_conj split del: if_split)
apply (rule corres_split[OF get_cap_corres'])
apply (simp add: split_def)
@ -211,12 +214,11 @@ lemma decodeCNodeInvocation_corres:
\<comment> \<open>Revoke\<close>
apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
apply (rule corres_guard_imp, rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_guard_imp, rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (simp add: split_beta)
apply (rule corres_returnOkTT)
apply simp
apply simp
apply simp
apply wp+
apply (auto elim!: valid_cnode_capI)[1]
apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
@ -224,12 +226,11 @@ lemma decodeCNodeInvocation_corres:
apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (simp add: split_beta)
apply (rule corres_returnOkTT)
apply simp
apply simp
apply simp
apply wp+
apply (auto elim!: valid_cnode_capI)[1]
apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def)
@ -237,16 +238,13 @@ lemma decodeCNodeInvocation_corres:
apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (simp add: split_beta)
apply (rule corres_split_norE)
apply (rule corres_returnOkTT)
apply simp
apply (rule ensureEmptySlot_corres)
apply simp
apply wp+
apply simp
apply simp
apply (rule corres_returnOkTT)
apply simp
apply (wp hoare_drop_imps)+
apply (auto elim!: valid_cnode_capI)[1]
@ -255,14 +253,15 @@ lemma decodeCNodeInvocation_corres:
apply (simp add: decode_cnode_invocation_def decodeCNodeInvocation_def
isCap_simps Let_def unlessE_whenE del: ser_def split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (simp(no_asm) add: split_beta liftE_bindE)
apply (rule corres_split[OF get_cap_corres'])
apply (rule corres_split[OF get_cap_corres'], simp)
apply (rule corres_split_norE)
apply (rule corres_trivial)
apply (clarsimp simp add: returnOk_def)
apply (simp add: cancelSendRightsEq)
apply (rule corres_trivial, auto simp add: whenE_def returnOk_def)[1]
apply (rule corres_trivial)
apply (clarsimp simp add: returnOk_def)
apply (wp get_cap_wp getCTE_wp | simp only: whenE_def | clarsimp)+
apply (rule hoare_trivE_R[where P="\<top>"])
apply (simp add: cte_wp_at_ctes_of pred_conj_def cong: conj_cong)
@ -274,9 +273,10 @@ lemma decodeCNodeInvocation_corres:
apply (simp add: le_diff_conv2 split_def decode_cnode_invocation_def decodeCNodeInvocation_def
isCap_simps Let_def unlessE_whenE whenE_whenE_body
del: disj_not1 ser_def split del: if_split)
apply (rule corres_guard_imp, rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_guard_imp, rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (rename_tac dest_slot destSlot)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])+
apply (rule corres_splitEE, (rule lookupSlotForCNodeOp_corres; simp))+
apply (rule_tac R = "\<lambda>s. cte_at pivot_slot s \<and> cte_at dest_slot s
\<and> cte_at src_slot s \<and> invs s" in
whenE_throwError_corres' [where R' = \<top>])
@ -290,6 +290,20 @@ lemma decodeCNodeInvocation_corres:
apply (clarsimp simp add: split_def)
apply (drule (2) cte_map_inj_eq, clarsimp+)[1]
apply (rule corres_split_norE)
apply (rule_tac F = "(src_slot \<noteq> dest_slot) = (srcSlot \<noteq> destSlot)"
and P = "\<lambda>s. cte_at src_slot s \<and> cte_at dest_slot s \<and> invs s" and P' = invs' in corres_req)
apply simp
apply rule
apply clarsimp
apply clarsimp
apply (drule (2) cte_map_inj_eq, clarsimp+)[1]
apply (rule corres_guard_imp)
apply (erule corres_whenE)
apply (rule ensureEmptySlot_corres)
apply clarsimp
apply simp
apply clarsimp
apply clarsimp
apply (simp add: liftE_bindE del: de_Morgan_conj disj_not1 split del: if_split)
apply (rule corres_split_liftM2, simp only: split_beta, rule get_cap_corres)
apply (rule whenE_throwError_corres)
@ -307,29 +321,12 @@ lemma decodeCNodeInvocation_corres:
apply (intro conjI)
apply (erule cap_map_update_data)+
apply (wp hoare_drop_imps)+
apply (rule_tac F = "(src_slot \<noteq> dest_slot) = (srcSlot \<noteq> destSlot)"
and P = "\<lambda>s. cte_at src_slot s \<and> cte_at dest_slot s \<and> invs s" and P' = invs' in corres_req)
apply simp
apply rule
apply clarsimp
apply clarsimp
apply (drule (2) cte_map_inj_eq, clarsimp+)[1]
apply (rule corres_guard_imp)
apply (erule corres_whenE)
apply (rule ensureEmptySlot_corres)
apply clarsimp
apply simp
apply clarsimp
apply clarsimp
apply (wp hoare_whenE_wp)+
apply simp
apply simp
apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid')
apply (simp add: if_apply_def2)
apply (wp hoare_drop_imps)
apply wp
apply simp
apply simp
apply (wp lsfco_cte_at' lookup_cap_valid lookup_cap_valid' hoare_drop_imps
| simp add: if_apply_def2 del: de_Morgan_conj split del: if_split)+
apply (auto elim!: valid_cnode_capI)[1]
@ -350,9 +347,9 @@ lemma decodeCNodeInvocation_corres:
cnode_invok_case_cleanup
split del: if_split cong: if_cong)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (rule corres_trivial, clarsimp split: list.split_asm)
apply simp+
apply wp+
apply (auto elim!: valid_cnode_capI)[1]
apply fastforce
@ -361,10 +358,10 @@ lemma decodeCNodeInvocation_corres:
split del: if_split cong: if_cong)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres _ wp_post_tautE wp_post_tautE])
apply simp
apply simp
apply (clarsimp simp: list_all2_Cons1 list_all2_Nil
split: list.split_asm split del: if_split)
apply simp
apply simp
apply (auto elim!: valid_cnode_capI)[1]
apply fastforce
done
@ -6714,9 +6711,9 @@ proof -
show ?thesis
unfolding spec_corres_def
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated)
apply (erule w)
apply (rule corres_split)
apply (rule x[unfolded spec_corres_def])
apply (erule w)
apply (wp z)
apply (rule univ_wp)
apply (rule z)
@ -8623,8 +8620,8 @@ lemma invokeCNode_corres:
apply simp
apply simp
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated [OF cteMove_corres])
apply assumption
apply (rule corres_split)
apply (erule cteMove_corres)
apply (erule cteMove_corres)
apply wp
apply (simp add: cte_wp_at_caps_of_state)
@ -8656,6 +8653,7 @@ lemma invokeCNode_corres:
prefer 2
apply (simp add: cte_map_def tcb_cnode_index_def tcbCallerSlot_def cte_level_bits_def objBits_defs)
apply (rule corres_split[OF getSlotCap_corres])
apply simp
apply (rule_tac P="\<lambda>s. (is_reply_cap cap \<or> cap = cap.NullCap) \<and>
(is_reply_cap cap \<longrightarrow>
(einvs and cte_at (threada, tcb_cnode_index 3) and

25
proof/refine/ARM/CSpace1_R.thy
View File

@ -3759,7 +3759,7 @@ lemma getCTE_get:
done
lemma setUntypedCapAsFull_corres:
"\<lbrakk>cap_relation c c'; src' = cte_map src; dest' = cte_map dest;
"\<lbrakk>cap_relation c c'; src' = cte_map src;
cap_relation src_cap (cteCap srcCTE); rv = cap.NullCap;
cteCap rv' = capability.NullCap; mdbPrev (cteMDBNode rv') = nullPointer \<and>
mdbNext (cteMDBNode rv') = nullPointer\<rbrakk>
@ -5036,7 +5036,8 @@ lemma cteInsert_corres:
R'="\<lambda>r. ?P' and cte_wp_at' ((=) rv') (cte_map dest) and
cte_wp_at' ((=) (CTE (maskedAsFull (cteCap srcCTE) c') (cteMDBNode srcCTE)))
(cte_map src)"
in corres_split_deprecated[where r'=dc])
in corres_split[where r'=dc])
apply (rule setUntypedCapAsFull_corres; simp)
apply (rule corres_stronger_no_failI)
apply (rule no_fail_pre)
apply (wp hoare_weak_lift_imp)
@ -5062,9 +5063,9 @@ lemma cteInsert_corres:
apply (subgoal_tac "no_mloop (cdt a)")
prefer 2
apply (simp add: valid_mdb_def)
apply (clarsimp simp: exec_gets update_cdt_def bind_assoc
set_cdt_def
exec_get exec_put set_original_def modify_def simp del: fun_upd_apply
apply (clarsimp simp: exec_gets update_cdt_def bind_assoc set_cdt_def
exec_get exec_put set_original_def modify_def
simp del: fun_upd_apply
| (rule bind_execI[where f="cap_insert_ext x y z i p" for x y z i p], clarsimp simp: exec_gets exec_get put_def mdb_insert_abs.cap_insert_ext_det_def2 update_cdt_list_def set_cdt_list_def, rule refl))+
apply (clarsimp simp: put_def state_relation_def)
apply (drule updateCap_stuff)
@ -5076,12 +5077,10 @@ lemma cteInsert_corres:
prev_update_modify_mdb_relation)
apply (subgoal_tac "cte_map dest \<noteq> 0")
prefer 2
apply (clarsimp simp: valid_mdb'_def
valid_mdb_ctes_def no_0_def)
apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
apply (subgoal_tac "cte_map src \<noteq> 0")
prefer 2
apply (clarsimp simp: valid_mdb'_def
valid_mdb_ctes_def no_0_def)
apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
apply (thin_tac "ksMachineState t = p" for p t)+
apply (thin_tac "ksCurThread t = p" for p t)+
apply (thin_tac "ksIdleThread t = p" for p t)+
@ -5198,7 +5197,6 @@ lemma cteInsert_corres:
apply(simp_all)[2]
apply(erule_tac x="(aa, bb)" in allE)+
subgoal by(fastforce)
apply(frule(1) next_childD)
apply(simp add: mdb_insert_abs.next_slot)
apply(case_tac "ca=src")
@ -5259,8 +5257,7 @@ lemma cteInsert_corres:
apply simp
apply (subst (asm) revokable_eq, assumption, assumption)
apply (rule derived_sameRegionAs)
apply (subst is_derived_eq[symmetric], assumption,
assumption, assumption, assumption, assumption)
apply (subst is_derived_eq[symmetric]; assumption)
apply assumption
subgoal by (clarsimp simp: cte_wp_at_def is_derived_def is_cap_simps cap_master_cap_simps
dest!:cap_master_cap_eqDs)
@ -5424,10 +5421,6 @@ lemma cteInsert_corres:
apply (subgoal_tac "cte_map (aa,bb) \<noteq> cte_map dest")
subgoal by (clarsimp simp: modify_map_def split: if_split_asm)
apply (erule (5) cte_map_inj)
(* FIXME *)
apply (rule setUntypedCapAsFull_corres)
apply simp+
apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb
set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap
setUntypedCapAsFull_cte_wp_at | clarsimp simp: cte_wp_at_caps_of_state| wps)+

23
proof/refine/ARM/CSpace_R.thy
View File

@ -3441,11 +3441,11 @@ lemma lookupSlotForCNodeOp_corres:
word_bits_def toInteger_nat fromIntegral_def fromInteger_nat)
apply (rule corres_lookup_error)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF rab_corres'])
apply (rule corres_splitEE)
apply (rule rab_corres'; simp)
apply (rule corres_trivial)
apply (clarsimp simp: returnOk_def lookup_failure_map_def
split: list.split)
apply simp+
apply wp+
apply clarsimp
apply clarsimp
@ -4738,7 +4738,8 @@ lemma cteInsert_simple_corres:
R'="\<lambda>r. ?P' and cte_wp_at' ((=) rv') (cte_map dest)
and cte_wp_at' ((=) (CTE (maskedAsFull (cteCap srcCTE) c') (cteMDBNode srcCTE))) (cte_map src)
and (\<lambda>s. safe_parent_for' (ctes_of s) src' c')"
in corres_split_deprecated[where r'=dc])
in corres_split[where r'=dc])
apply (rule setUntypedCapAsFull_corres; simp)
apply (rule corres_stronger_no_failI)
apply (rule no_fail_pre, wp hoare_weak_lift_imp)
apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def)
@ -4808,12 +4809,10 @@ lemma cteInsert_simple_corres:
apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def prev_update_modify_mdb_relation)
apply (subgoal_tac "cte_map dest \<noteq> 0")
prefer 2
apply (clarsimp simp: valid_mdb'_def
valid_mdb_ctes_def no_0_def)
apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
apply (subgoal_tac "cte_map src \<noteq> 0")
prefer 2
apply (clarsimp simp: valid_mdb'_def
valid_mdb_ctes_def no_0_def)
apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
apply (subgoal_tac "should_be_parent_of src_cap (is_original_cap a src) c (revokable src_cap c) = True")
prefer 2
apply (subst should_be_parent_of_masked_as_full[symmetric])
@ -4862,11 +4861,10 @@ lemma cteInsert_simple_corres:
apply (subgoal_tac "cte_map (aa,bb) \<noteq> cte_map dest")
subgoal by (clarsimp simp: modify_map_def split: if_split_asm)
apply (erule (5) cte_map_inj)
apply (rule setUntypedCapAsFull_corres)
apply simp+
apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb set_untyped_cap_as_full_valid_list
set_untyped_cap_as_full_cte_wp_at setUntypedCapAsFull_valid_cap
setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for' | clarsimp | wps)+
apply (wp set_untyped_cap_full_valid_objs set_untyped_cap_as_full_valid_mdb
set_untyped_cap_as_full_valid_list set_untyped_cap_as_full_cte_wp_at
setUntypedCapAsFull_valid_cap setUntypedCapAsFull_cte_wp_at setUntypedCapAsFull_safe_parent_for'
| clarsimp | wps)+
apply (clarsimp simp:cte_wp_at_caps_of_state )
apply (case_tac rv',clarsimp simp:cte_wp_at_ctes_of maskedAsFull_def)
apply (wp getCTE_wp' get_cap_wp)+
@ -4882,7 +4880,6 @@ lemma cteInsert_simple_corres:
prefer 2
subgoal by (fastforce simp: cte_wp_at_def)
apply (erule conjE)
apply (subgoal_tac "mdb_insert (ctes_of b) (cte_map src) (maskedAsFull src_cap' c') src_node
(cte_map dest) NullCap dest_node")
prefer 2

2
proof/refine/ARM/Detype_R.thy
View File

@ -660,7 +660,7 @@ lemma deleteObjects_corres:
valid_pspace' s" in corres_underlying_split)
apply (rule corres_bind_return)
apply (rule corres_guard_imp[where r=dc])
apply (rule corres_split_deprecated[OF cNodeNoPartialOverlap])
apply (rule corres_split[OF _ cNodeNoPartialOverlap])
apply (rule corres_machine_op[OF corres_Id], simp+)
apply (rule no_fail_freeMemory, simp+)
apply (wp hoare_vcg_ex_lift)+

6
proof/refine/ARM/Finalise_R.thy
View File

@ -3450,8 +3450,8 @@ lemma unbindNotification_corres:
apply (rule corres_split[OF getNotification_corres])
apply clarsimp
apply (rule corres_split[OF setNotification_corres])
apply (rule setBoundNotification_corres)
apply (clarsimp simp: ntfn_relation_def split:Structures_A.ntfn.splits)
apply (rule setBoundNotification_corres)
apply (wp gbn_wp' gbn_wp)+
apply (clarsimp elim!: obj_at_valid_objsE
dest!: bound_tcb_at_state_refs_ofD invs_valid_objs
@ -3476,8 +3476,8 @@ lemma unbindMaybeNotification_corres:
apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
apply (rule corres_return_trivial)
apply (rule corres_split[OF setNotification_corres])
apply (rule setBoundNotification_corres)
apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
apply (rule setBoundNotification_corres)
apply (wp get_simple_ko_wp getNotification_wp)+
apply (clarsimp elim!: obj_at_valid_objsE
dest!: bound_tcb_at_state_refs_ofD invs_valid_objs
@ -3539,8 +3539,8 @@ lemma cap_delete_one_corres:
apply (rule corres_split[OF isFinalCapability_corres[where ptr=ptr]])
apply (simp add: split_def bind_assoc [THEN sym])
apply (rule corres_split[OF fast_finaliseCap_corres[where sl=ptr]])
apply (rule emptySlot_corres)
apply simp+
apply (rule emptySlot_corres, simp)
apply (wp hoare_drop_imps)+
apply (wp isFinalCapability_inv | wp (once) isFinal[where x="cte_map ptr"])+
apply (rule corres_trivial, simp)

6
proof/refine/ARM/InterruptAcc_R.thy
View File

@ -31,15 +31,15 @@ lemma setIRQState_corres:
apply (subgoal_tac "(state = irq_state.IRQInactive) = (state' = irqstate.IRQInactive)")
apply (rule corres_guard_imp)
apply (rule corres_split_nor)
apply (rule corres_machine_op)
apply (rule corres_Id | simp)+
apply (rule no_fail_maskInterrupt)
apply (simp add: getInterruptState_def setInterruptState_def
simpler_gets_def simpler_modify_def bind_def)
apply (simp add: simpler_modify_def[symmetric])
apply (rule corres_trivial, rule corres_modify)
apply (simp add: state_relation_def swp_def)
apply (clarsimp simp: interrupt_state_relation_def)
apply (rule corres_machine_op)
apply (rule corres_Id | simp)+
apply (rule no_fail_maskInterrupt)
apply (wp | simp)+
apply (clarsimp simp: irq_state_relation_def
split: irq_state.split_asm irqstate.split_asm)

79
proof/refine/ARM/Interrupt_R.thy
View File

@ -221,8 +221,10 @@ lemma arch_decodeIRQControlInvocation_corres:
apply (clarsimp simp add: minIRQ_def maxIRQ_def ucast_nat_def)
apply (rule corres_split_eqr[OF is_irq_active_corres])
apply (rule whenE_throwError_corres, clarsimp, clarsimp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE[OF ensureEmptySlot_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (rule corres_splitEE)
apply (rule ensureEmptySlot_corres; simp)
apply (rule corres_returnOkTT)
apply (clarsimp simp: arch_irq_control_inv_relation_def )
apply ((wpsimp wp: isIRQActive_inv arch_check_irq_maxIRQ_valid' checkIRQ_inv
@ -273,8 +275,10 @@ lemma decodeIRQControlInvocation_corres:
apply (clarsimp simp add: minIRQ_def maxIRQ_def ucast_nat_def)
apply (rule corres_split_eqr[OF is_irq_active_corres])
apply (rule whenE_throwError_corres, clarsimp, clarsimp)
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply (rule corres_splitEE[OF ensureEmptySlot_corres])
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres; simp)
apply (rule corres_splitEE)
apply (rule ensureEmptySlot_corres; simp)
apply (rule corres_returnOkTT)
apply (clarsimp simp: arch_irq_control_inv_relation_def )
apply (wpsimp wp: isIRQActive_inv arch_check_irq_maxIRQ_valid' checkIRQ_inv
@ -492,13 +496,12 @@ lemma arch_performIRQControl_corres:
apply (cases x2; simp add: ARM_H.performIRQControl_def invoke_irq_control.cases IRQ_def)
apply (rule corres_guard_imp)
apply (rule corres_split_nor)
apply (rule setIRQTrigger_corres)
apply (rule corres_split_nor)
apply (rule cteInsert_simple_corres; simp)
apply (rule setIRQState_corres)
apply (simp add: irq_state_relation_def)
apply (rule cteInsert_simple_corres; simp)
apply (wp | simp add: irq_state_relation_def IRQHandler_valid IRQHandler_valid')+
apply (rule setIRQTrigger_corres)
apply wp+
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def cte_wp_at_caps_of_state
is_simple_cap_def is_cap_simps arch_irq_control_inv_valid_def
safe_parent_for_def)
@ -519,9 +522,9 @@ lemma performIRQControl_corres:
apply (cases i, simp_all add: performIRQControl_def)
apply (rule corres_guard_imp)
apply (rule corres_split_nor[OF setIRQState_corres])
apply (simp add: irq_state_relation_def)
apply (rule cteInsert_simple_corres)
apply (wp | simp add: irq_state_relation_def
IRQHandler_valid IRQHandler_valid')+
apply (wp | simp add: IRQHandler_valid IRQHandler_valid')+
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
cte_wp_at_caps_of_state is_simple_cap_def
is_cap_simps safe_parent_for_def)
@ -655,7 +658,31 @@ lemma timerTick_corres:
apply simp
apply (rule corres_split[OF getThreadState_corres])
apply (rename_tac state state')
apply (rule corres_split_deprecated[where r' = dc ])
apply (rule corres_split[where r' = dc ])
apply (rule corres_if[where Q = \<top> and Q' = \<top>])
apply (case_tac state,simp_all)[1]
apply (simp add: Let_def)
apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres])
apply (simp add:etcb_relation_def)
apply (rename_tac ts ts')
apply (rule_tac R="1 < ts" in corres_cases)
apply (simp)
apply (unfold thread_set_time_slice_def)
apply (rule ethread_set_corres, simp+)
apply (clarsimp simp: etcb_relation_def)
apply simp
apply (rule corres_split)
apply (rule ethread_set_corres; simp)
apply (simp add: etcb_relation_def)
apply (rule corres_split[OF tcbSchedAppend_corres])
apply (rule rescheduleRequired_corres)
apply (wp)[1]
apply (rule hoare_strengthen_post)
apply (rule tcbSchedAppend_invs_but_ct_not_inQ',
clarsimp simp: sch_act_wf_weak)
apply (wp threadSet_timeslice_invs threadSet_valid_queues
threadSet_valid_queues' threadSet_pred_tcb_at_state)+
apply simp
apply simp
apply (rule corres_when,simp)
apply (rule corres_split[OF decDomainTime_corres])
@ -667,30 +694,6 @@ lemma timerTick_corres:
apply wp+
apply (simp add:decDomainTime_def)
apply wp
apply (rule corres_if[where Q = \<top> and Q' = \<top>])
apply (case_tac state,simp_all)[1]
apply (simp add: Let_def)
apply (rule_tac r'="(=)" in corres_split[OF ethreadget_corres])
apply (rename_tac ts ts')
apply (rule_tac R="1 < ts" in corres_cases)
apply (simp)
apply (unfold thread_set_time_slice_def)
apply (rule ethread_set_corres, simp+)
apply (clarsimp simp: etcb_relation_def)
apply simp
apply (rule corres_split[OF ethread_set_corres])
apply (rule corres_split[OF tcbSchedAppend_corres])
apply (rule rescheduleRequired_corres)
apply (wp)[1]
apply (rule hoare_strengthen_post)
apply (rule tcbSchedAppend_invs_but_ct_not_inQ', clarsimp simp: sch_act_wf_weak)
apply (simp add: sch_act_wf_weak etcb_relation_def pred_conj_def)+
apply (wp threadSet_timeslice_invs threadSet_valid_queues
threadSet_valid_queues' threadSet_pred_tcb_at_state)+
apply (simp add:etcb_relation_def)
apply (wp threadSet_timeslice_invs threadSet_valid_queues
threadSet_valid_queues' threadSet_pred_tcb_at_state)
apply simp
apply (wp|wpc|unfold Let_def|simp)+
apply (wp static_imp_wp threadSet_timeslice_invs threadSet_valid_queues threadSet_valid_queues'
threadSet_pred_tcb_at_state threadSet_weak_sch_act_wf tcbSchedAppend_valid_objs'
@ -736,7 +739,7 @@ lemma handleInterrupt_corres:
defer
apply (wp getIRQState_prop getIRQState_inv do_machine_op_bind doMachineOp_bind | simp add: do_machine_op_bind doMachineOp_bind )+
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated)
apply (rule corres_split)
apply (rule corres_machine_op, rule corres_eq_trivial ; (simp add: dc_def no_fail_maskInterrupt no_fail_bind no_fail_ackInterrupt)+)+
apply ((wp | simp)+)[4]
apply (rule corres_gen_asm2)
@ -754,17 +757,17 @@ lemma handleInterrupt_corres:
apply (rule corres_guard_imp, rule sendSignal_corres)
apply (clarsimp simp: valid_cap_def valid_cap'_def do_machine_op_bind doMachineOp_bind
arch_mask_irq_signal_def maskIrqSignal_def)+
apply (rule corres_split_deprecated)
apply (rule corres_split)
apply (rule corres_machine_op, rule corres_eq_trivial
; (simp add: no_fail_maskInterrupt no_fail_bind no_fail_ackInterrupt)+)+
apply ((wp | simp)+)
apply clarsimp
apply fastforce
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated)
apply simp
apply (rule corres_split)
apply (rule corres_split[OF timerTick_corres corres_machine_op])
apply (rule corres_eq_trivial, simp+)
apply wp+
apply (rule corres_machine_op)
apply (rule corres_eq_trivial, (simp add: no_fail_ackInterrupt)+)
apply wp+

83
proof/refine/ARM/IpcCancel_R.thy
View File

@ -199,9 +199,9 @@ lemma blocked_cancelIPC_corres:
apply simp
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (simp add: ep_relation_def)
apply (rule setThreadState_corres)
apply simp
apply (simp add: ep_relation_def)
apply (simp add: valid_tcb_state_def pred_conj_def)
apply (wp weak_sch_act_wf_lift)+
apply (clarsimp simp: st_tcb_at_tcb_at)
@ -222,9 +222,9 @@ lemma blocked_cancelIPC_corres:
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (simp add: ep_relation_def)
apply (rule setThreadState_corres)
apply simp
apply (simp add: ep_relation_def)
apply (wp)+
apply (clarsimp simp: st_tcb_at_tcb_at)
apply (clarsimp simp: st_tcb_at_def obj_at_def)
@ -247,9 +247,9 @@ lemma blocked_cancelIPC_corres:
apply simp
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (simp add: ep_relation_def)
apply (rule setThreadState_corres)
apply simp
apply (simp add: ep_relation_def)
apply (simp add: valid_tcb_state_def pred_conj_def)
apply (wp weak_sch_act_wf_lift)+
apply (clarsimp simp: st_tcb_at_tcb_at)
@ -270,9 +270,9 @@ lemma blocked_cancelIPC_corres:
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (simp add: ep_relation_def)
apply (rule setThreadState_corres)
apply simp
apply (simp add: ep_relation_def)
apply (wp)+
apply (clarsimp simp: st_tcb_at_tcb_at)
apply (clarsimp simp: st_tcb_at_def obj_at_def)
@ -325,15 +325,15 @@ lemma cancelSignal_corres:
apply (rule_tac R="remove1 t list = []" in corres_cases)
apply (simp del: dc_simp)
apply (rule corres_split[OF setNotification_corres])
apply (simp add: ntfn_relation_def)
apply (rule setThreadState_corres)
apply simp
apply (simp add: ntfn_relation_def)
apply (wp)+
apply (simp add: list_case_If del: dc_simp)
apply (rule corres_split[OF setNotification_corres])
apply (clarsimp simp add: ntfn_relation_def neq_Nil_conv)
apply (rule setThreadState_corres)
apply simp
apply (clarsimp simp add: ntfn_relation_def neq_Nil_conv)
apply (wp)+
apply (simp add: isWaitingNtfn_def ntfn_relation_def)
apply (wp getNotification_wp)+
@ -1244,20 +1244,21 @@ lemma tcbSchedDequeue_corres':
apply (simp add: ready_queues_relation_def)
apply (simp add: unless_def when_def)
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres, simp add: etcb_relation_def)
apply (simp split del: if_split)
apply (rule corres_split_eqr[OF ethreadget_corres])
apply (rule corres_split_eqr)
apply (rule ethreadget_corres, simp add: etcb_relation_def)
apply (rule corres_split_eqr[OF getQueue_corres])
apply (simp split del: if_split)
apply (subst bind_return_unit, rule corres_split_deprecated[where r'=dc])
apply (rule corres_split_noop_rhs)
apply (simp add: dc_def[symmetric])
apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
apply (clarsimp, rule removeFromBitmap_corres_noop)
apply wp
apply (subst bind_return_unit, rule corres_split[where r'=dc])
apply (simp add: tcb_sched_dequeue_def)
apply (rule setQueue_corres)
apply (wp | simp add: etcb_relation_def)+
apply (rule corres_split_noop_rhs)
apply (clarsimp, rule removeFromBitmap_corres_noop)
apply (simp add: dc_def[symmetric])
apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
apply (wp | simp)+
done
lemma setQueue_valid_inQ_queues:
@ -1412,11 +1413,6 @@ lemma (in delete_one) suspend_corres:
apply (rule corres_split_nor[OF cancel_ipc_corres])
apply (rule corres_split[OF getThreadState_corres])
apply (rule corres_split_nor)
apply (rule corres_split_nor[OF setThreadState_corres])
apply (rule tcbSchedDequeue_corres')
apply wpsimp
apply wp
apply wpsimp
apply (rule corres_if)
apply (case_tac state; simp)
apply (simp add: update_restart_pc_def updateRestartPC_def)
@ -1428,6 +1424,9 @@ lemma (in delete_one) suspend_corres:
apply (rule corres_underlying_trivial)
apply (wpsimp simp: ARM.setRegister_def ARM.getRegister_def)
apply (rule corres_return_trivial)
apply (rule corres_split_nor[OF setThreadState_corres])
apply simp
apply (rule tcbSchedDequeue_corres')
apply (wpsimp simp: update_restart_pc_def updateRestartPC_def)+
apply (rule hoare_post_imp[where Q = "\<lambda>rv s. tcb_at t s \<and> is_etcb_at t s"])
apply simp
@ -1904,7 +1903,7 @@ lemma ep_cancel_corres_helper:
in corres_mapM_x)
apply clarsimp
apply (rule corres_guard_imp)
apply (subst bind_return_unit, rule corres_split_deprecated [OF tcbSchedEnqueue_corres])
apply (subst bind_return_unit, rule corres_split[OF _ tcbSchedEnqueue_corres])
apply simp
apply (rule corres_guard_imp [OF setThreadState_corres])
apply simp
@ -1950,7 +1949,7 @@ proof -
apply (rule corres_underlying_split)
apply (rule corres_guard_imp [OF setEndpoint_corres])
apply (simp add: ep_relation_def)+
apply (rule corres_split_deprecated [OF rescheduleRequired_corres])
apply (rule corres_split[OF _ rescheduleRequired_corres])
apply (rule ep_cancel_corres_helper)
apply (rule mapM_x_wp')
apply (wp weak_sch_act_wf_lift_linear set_thread_state_runnable_weak_valid_sched_action | simp)+
@ -1990,8 +1989,8 @@ lemma set_ntfn_tcb_obj_at' [wp]:
"\<lbrace>obj_at' (P::tcb \<Rightarrow> bool) t\<rbrace>
setNotification ntfn v
\<lbrace>\<lambda>_. obj_at' P t\<rbrace>"
apply (clarsimp simp: setNotification_def, wp)
done
apply (clarsimp simp: setNotification_def, wp)
done
lemma cancelAllSignals_corres:
"corres dc (invs and valid_sched and ntfn_at ntfn) (invs' and ntfn_at' ntfn)
@ -2003,7 +2002,8 @@ lemma cancelAllSignals_corres:
apply (case_tac "ntfn_obj ntfna", simp_all add: ntfn_relation_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF setNotification_corres])
apply (rule corres_split_deprecated [OF rescheduleRequired_corres])
apply (simp add: ntfn_relation_def)
apply (rule corres_split[OF _ rescheduleRequired_corres])
apply (rule ep_cancel_corres_helper)
apply (wp mapM_x_wp'[where 'b="det_ext state"]
weak_sch_act_wf_lift_linear setThreadState_not_st
@ -2014,12 +2014,9 @@ lemma cancelAllSignals_corres:
in hoare_post_add)
apply (rule mapM_x_wp')
apply (rule hoare_name_pre_state)
apply (wp hoare_vcg_const_Ball_lift
apply (wpsimp wp: hoare_vcg_const_Ball_lift
sts_st_tcb' sts_valid_queues setThreadState_not_st
tcbSchedEnqueue_not_st
| (clarsimp simp: valid_tcb_state'_def)
| fastforce elim: obj_at'_weakenE)+
apply (simp add: ntfn_relation_def)
simp: valid_tcb_state'_def)
apply (wp hoare_vcg_const_Ball_lift set_ntfn_aligned' set_ntfn_valid_objs'
weak_sch_act_wf_lift_linear
| simp)+
@ -2600,18 +2597,15 @@ lemma cancelBadgedSends_corres:
(cancel_badged_sends epptr bdg) (cancelBadgedSends epptr bdg)"
apply (simp add: cancel_badged_sends_def cancelBadgedSends_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF getEndpoint_corres get_simple_ko_sp get_ep_sp',
apply (rule corres_split[OF getEndpoint_corres _ get_simple_ko_sp get_ep_sp',
where Q="invs and valid_sched" and Q'=invs'])
apply simp_all
apply (case_tac ep, simp_all add: ep_relation_def)
apply (simp add: filterM_mapM list_case_return cong: list.case_cong)
apply (rule corres_guard_imp)
apply (rule corres_split_nor[OF setEndpoint_corres])
apply (simp add: ep_relation_def)
apply (rule corres_split_eqr[OF _ _ _ hoare_post_add[where R="\<lambda>_. valid_objs'"]])
apply (rule corres_split_deprecated [OF rescheduleRequired_corres])
apply (rule setEndpoint_corres)
apply (simp split: list.split add: ep_relation_def)
apply (wp weak_sch_act_wf_lift_linear)+
apply (rule_tac S="(=)"
and Q="\<lambda>xs s. (\<forall>x \<in> set xs. (epptr, TCBBlockedSend) \<in> state_refs_of s x) \<and> distinct xs \<and> valid_etcbs s"
and Q'="\<lambda>xs s. (\<forall>x \<in> set xs. tcb_at' x s) \<and> weak_sch_act_wf (ksSchedulerAction s) s \<and> Invariants_H.valid_queues s \<and> valid_queues' s \<and> valid_objs' s"
@ -2624,25 +2618,28 @@ lemma cancelBadgedSends_corres:
in corres_gen_asm)
apply (clarsimp simp: o_def dc_def[symmetric] liftM_def)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule corres_split[OF tcbSchedEnqueue_corres])
apply (rule corres_trivial)
apply simp
apply wp+
apply simp
apply (wp sts_valid_queues gts_st_tcb_at)+
apply (clarsimp simp: valid_tcb_state_def tcb_at_def st_tcb_def2
st_tcb_at_refs_of_rev
dest!: state_refs_of_elemD elim!: tcb_at_is_etcb_at[rotated])
apply (simp add: is_tcb_def)
apply (wp hoare_vcg_const_Ball_lift gts_wp | clarsimp)+
apply (wp gts_st_tcb_at hoare_vcg_const_Ball_lift hoare_vcg_imp_lift
weak_sch_act_wf_lift_linear mapM_wp'
sts_st_tcb' sts_valid_queues setThreadState_valid_objs'
apply (wp gts_st_tcb_at hoare_vcg_imp_lift
sts_st_tcb' sts_valid_queues
| clarsimp simp: valid_tcb_state'_def)+
apply (rule corres_split[OF _ rescheduleRequired_corres])
apply (rule setEndpoint_corres)
apply (simp split: list.split add: ep_relation_def)
apply (wp weak_sch_act_wf_lift_linear)+
apply (wp gts_st_tcb_at hoare_vcg_imp_lift mapM_wp'
sts_st_tcb' sts_valid_queues
set_thread_state_runnable_weak_valid_sched_action
| clarsimp simp: valid_tcb_state'_def)+
apply (simp add: ep_relation_def)
apply (wp hoare_vcg_const_Ball_lift weak_sch_act_wf_lift_linear set_ep_valid_objs'
| simp)+
apply (wp hoare_vcg_const_Ball_lift set_ep_valid_objs')+
apply (clarsimp simp: conj_comms)
apply (frule sym_refs_ko_atD, clarsimp+)
apply (rule obj_at_valid_objsE, assumption+, clarsimp+)

125
proof/refine/ARM/Ipc_R.thy
View File

@ -149,11 +149,11 @@ lemma getReceiveSlots_corres:
apply (simp add: split_def liftE_bindE unlessE_whenE)
apply (rule corres_split[OF get_cap_corres])
apply (rule corres_split_norE)
apply (rule corres_trivial, simp add: returnOk_def)
apply (rule corres_whenE)
apply (case_tac cap, auto)[1]
apply (rule corres_trivial, simp)
apply simp
apply (rule corres_trivial, simp add: returnOk_def)
apply (wp lookup_cap_valid lookup_cap_valid' lsfco_cte_at | simp)+
done
@ -422,11 +422,11 @@ next
apply (rule corres_if2)
apply (case_tac "fst x", auto simp add: isCap_simps)[1]
apply (rule corres_split[OF corres_set_extra_badge])
apply (clarsimp simp: is_cap_simps)
apply (drule conjunct1)
apply simp
apply (rule corres_rel_imp, rule Cons.hyps, simp_all)[1]
apply (case_tac mi, simp)
apply (clarsimp simp: is_cap_simps)
apply (simp add: split_def)
apply (wp hoare_vcg_const_Ball_lift)
apply (subgoal_tac "obj_ref_of (fst x) = capEPPtr (fst y)")
@ -446,6 +446,11 @@ next
apply (simp add: remove_rights_def)
apply clarsimp
apply (rule corres_split_norE)
apply (rule corres_whenE)
apply (case_tac cap', auto)[1]
apply (rule corres_trivial, simp)
apply (case_tac mi, simp)
apply simp
apply (simp add: liftE_bindE)
apply (rule corres_split_nor)
apply (rule cteInsert_corres, simp_all add: hd_map)[1]
@ -459,13 +464,8 @@ next
cteInsert_valid_pspace
| simp add: split_def)+
apply (wp cteInsert_weak_cte_wp_at hoare_valid_ipc_buffer_ptr_typ_at')+
apply (wp hoare_vcg_const_Ball_lift cteInsert_cte_wp_at valid_case_option_post_wp
| simp add:split_def)+
apply (rule corres_whenE)
apply (case_tac cap', auto)[1]
apply (rule corres_trivial, simp)
apply (case_tac mi, simp)
apply simp
apply (wpsimp wp: hoare_vcg_const_Ball_lift cteInsert_cte_wp_at valid_case_option_post_wp
simp: split_def)
apply (unfold whenE_def)
apply wp+
apply (clarsimp simp: conj_comms ball_conj_distrib split del: if_split)
@ -1280,12 +1280,12 @@ lemma lookupCapAndSlot_corres:
apply (rule corres_guard_imp)
apply (rule_tac r'="\<lambda>rv rv'. rv' = cte_map (fst rv)"
in corres_splitEE)
apply (rule corres_split[OF getSlotCap_corres])
apply (rule corres_returnOkTT, simp)
apply simp
apply wp+
apply (rule corres_rel_imp, rule lookupSlotForThread_corres)
apply (simp add: split_def)
apply (rule corres_split[OF getSlotCap_corres])
apply simp
apply (rule corres_returnOkTT, simp)
apply wp+
apply (wp | simp add: liftE_bindE[symmetric])+
done
@ -1378,28 +1378,28 @@ lemma doNormalTransfer_corres:
(doNormalTransfer sender send_buf ep badge can_grant receiver recv_buf)"
apply (simp add: do_normal_transfer_def doNormalTransfer_def)
apply (rule corres_guard_imp)
apply (rule corres_split_mapr[OF getMessageInfo_corres])
apply (rule_tac F="valid_message_info mi" in corres_gen_asm)
apply (rule_tac r'="list_all2 (\<lambda>x y. cap_relation (fst x) (fst y) \<and> snd y = cte_map (snd x))"
in corres_split)
apply (rule corres_if[OF refl])
apply (rule corres_split_catch)
apply (rule lookupExtraCaps_corres; simp)
apply (rule corres_trivial, simp)
apply (rule lookupExtraCaps_corres, simp+)
apply wp+
apply (rule corres_trivial, simp)
apply simp
apply (rule corres_split_eqr[OF copyMRs_corres])
apply (rule corres_split[OF transferCaps_corres])
apply (rule corres_split)
apply (rule transferCaps_corres; simp)
apply (rename_tac mi' mi'')
apply (rule_tac F="mi_label mi' = mi_label mi"
in corres_gen_asm)
apply (rule corres_split_nor[OF setMessageInfo_corres])
apply (case_tac mi', clarsimp)
apply (simp add: badge_register_def badgeRegister_def)
apply (fold dc_def)
apply (rule asUser_setRegister_corres)
apply (case_tac mi', clarsimp)
apply wp
apply simp+
apply ((wp valid_case_option_post_wp hoare_vcg_const_Ball_lift
@ -1567,15 +1567,15 @@ lemma doFaultTransfer_corres:
apply (rule corres_split_eqr[OF makeFaultMessage_corres])
apply (rule corres_split_eqr[OF setMRs_corres [OF refl]])
apply (rule corres_split_nor[OF setMessageInfo_corres])
apply (rule asUser_setRegister_corres)
apply simp
apply (rule asUser_setRegister_corres)
apply (wp | simp)+
apply (rule corres_guard_imp)
apply (rule corres_split_eqr[OF makeFaultMessage_corres])
apply (rule corres_split_eqr[OF setMRs_corres [OF refl]])
apply (rule corres_split_nor[OF setMessageInfo_corres])
apply (rule asUser_setRegister_corres)
apply simp
apply (rule asUser_setRegister_corres)
apply (wp | simp)+
done
@ -1778,8 +1778,7 @@ lemma handle_fault_reply_registers_corres:
od)"
apply (rule corres_guard_imp)
apply (clarsimp simp: arch_get_sanitise_register_info_def getSanitiseRegisterInfo_def)
apply (rule corres_split_deprecated)
apply (rule corres_trivial, simp)
apply (rule corres_split)
apply (rule asUser_corres')
apply(simp add: setRegister_def sanitise_register_def
sanitiseRegister_def syscallMessage_def)
@ -2079,8 +2078,8 @@ lemma doReplyTransfer_corres:
apply (rule corres_split[OF doIPCTransfer_corres])
apply (rule corres_split[OF cap_delete_one_corres])
apply (rule corres_split[OF setThreadState_corres])
apply (rule possibleSwitchTo_corres)
apply simp
apply (rule possibleSwitchTo_corres)
apply (wp set_thread_state_runnable_valid_sched set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_st_tcb' sts_valid_queues sts_valid_objs' delete_one_tcbDomain_obj_at'
| simp add: valid_tcb_state'_def)+
apply (strengthen cte_wp_at_reply_cap_can_fast_finalise)
@ -2115,24 +2114,27 @@ lemma doReplyTransfer_corres:
apply (rule corres_split_eqr[OF getMRs_corres])
apply (simp(no_asm) del: dc_simp)
apply (rule corres_split_eqr[OF handleFaultReply_corres])
apply (rule corres_split[OF threadset_corresT])
apply (rule_tac Q="valid_sched and cur_tcb and tcb_at receiver"
and Q'="tcb_at' receiver and cur_tcb'
apply simp
apply (rule corres_split)
apply (rule threadset_corresT;
clarsimp simp add: tcb_relation_def fault_rel_optionation_def
tcb_cap_cases_def tcb_cte_cases_def exst_same_def)
apply (rule_tac P="valid_sched and cur_tcb and tcb_at receiver"
and P'="tcb_at' receiver and cur_tcb'
and (\<lambda>s. weak_sch_act_wf (ksSchedulerAction s) s)
and Invariants_H.valid_queues and valid_queues' and valid_objs'"
in corres_guard_imp)
in corres_inst)
apply (case_tac rvb, simp_all)[1]
apply (rule corres_guard_imp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (fold dc_def, rule possibleSwitchTo_corres)
apply simp
apply (wp static_imp_wp static_imp_conj_wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
sts_st_tcb' sts_valid_queues | simp | force simp: valid_sched_def valid_sched_action_def valid_tcb_state'_def)+
apply (rule corres_guard_imp)
apply (rule setThreadState_corres)
apply (simp_all)[20]
apply (clarsimp simp add: tcb_relation_def fault_rel_optionation_def
tcb_cap_cases_def tcb_cte_cases_def exst_same_def)+
apply clarsimp+
apply (wp threadSet_cur weak_sch_act_wf_lift_linear threadSet_pred_tcb_no_state
thread_set_not_state_valid_sched threadSet_valid_queues threadSet_valid_queues'
threadSet_tcbDomain_triv threadSet_valid_objs'
@ -2214,6 +2216,8 @@ lemma setupCallerCap_corres:
getThreadCallerSlot_def)
apply (rule stronger_corres_guard_imp)
apply (rule corres_split_nor)
apply (rule setThreadState_corres)
apply (simp split: option.split)
apply (rule corres_symb_exec_r)
apply (rule_tac F="\<exists>r. cteCap masterCTE = capability.ReplyCap sender True r
\<and> mdbNext (cteMDBNode masterCTE) = nullPointer"
@ -2240,8 +2244,6 @@ lemma setupCallerCap_corres:
apply blast
apply (rule no_fail_pre, wp)
apply (clarsimp simp: cte_wp_at_ctes_of)
apply (rule setThreadState_corres)
apply (simp split: option.split)
apply (wp sts_valid_pspace_hangers
| simp add: cte_wp_at_ctes_of)+
apply (clarsimp simp: valid_tcb_state_def st_tcb_at_reply_cap_valid
@ -2353,9 +2355,9 @@ proof -
apply (simp add: ep_relation_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule setEndpoint_corres)
apply (simp add: ep_relation_def)
apply (simp add: fault_rel_optionation_def)
apply wp+
apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
apply clarsimp
@ -2363,9 +2365,9 @@ proof -
apply (simp add: ep_relation_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule setEndpoint_corres)
apply (simp add: ep_relation_def)
apply (simp add: fault_rel_optionation_def)
apply wp+
apply (clarsimp simp: st_tcb_at_tcb_at valid_tcb_state_def)
apply clarsimp
@ -2379,6 +2381,7 @@ proof -
apply (clarsimp split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (simp add: ep_relation_def split: list.split)
apply (simp add: isReceive_def split del:if_split)
apply (rule corres_split[OF getThreadState_corres])
apply (rule_tac
@ -2388,9 +2391,9 @@ proof -
simp del: dc_simp split del: if_split cong: if_cong)
apply (rule corres_split[OF doIPCTransfer_corres])
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule corres_split[OF possibleSwitchTo_corres])
apply (fold when_def)[1]
apply (rule_tac P="call" and P'="call"
in corres_symmetric_bool_cases, blast)
apply (simp add: when_def dc_def[symmetric] split del: if_split)
@ -2416,7 +2419,6 @@ proof -
apply (simp add: valid_tcb_state'_def)
apply (wp weak_sch_act_wf_lift_linear tcb_in_cur_domain'_lift hoare_drop_imps)[1]
apply (wp gts_st_tcb_at)+
apply (simp add: ep_relation_def split: list.split)
apply (simp add: pred_conj_def cong: conj_cong)
apply (wp hoare_post_taut)
apply (simp)
@ -2460,6 +2462,7 @@ proof -
apply (clarsimp split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (simp add: ep_relation_def split: list.split)
apply (rule corres_split[OF getThreadState_corres])
apply (rule_tac
F="\<exists>data. recv_state = Structures_A.BlockedOnReceive ep data"
@ -2468,10 +2471,9 @@ proof -
split del: if_split cong: if_cong)
apply (rule corres_split[OF doIPCTransfer_corres])
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule possibleSwitchTo_corres)
apply (simp add: if_apply_def2)
apply (wp hoare_drop_imps)
apply (simp add: if_apply_def2)
apply ((wp sts_cur_tcb set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at_cases |
simp add: if_apply_def2 split del: if_split)+)[1]
apply (wp setThreadState_valid_queues' sts_valid_queues sts_weak_sch_act_wf
@ -2483,7 +2485,6 @@ proof -
apply (strengthen sch_act_wf_weak)
apply (wp weak_sch_act_wf_lift_linear hoare_drop_imps)
apply (wp gts_st_tcb_at)+
apply (simp add: ep_relation_def split: list.split)
apply (simp add: pred_conj_def cong: conj_cong)
apply (wp hoare_post_taut)
apply simp
@ -2554,11 +2555,11 @@ lemma sendSignal_corres:
Structures_H.thread_state.splits)
apply (rule corres_split[OF cancel_ipc_corres])
apply (rule corres_split[OF setThreadState_corres])
apply (clarsimp simp: thread_state_relation_def)
apply (simp add: badgeRegister_def badge_register_def)
apply (rule corres_split[OF asUser_setRegister_corres])
apply (rule possibleSwitchTo_corres)
apply wp
apply (clarsimp simp: thread_state_relation_def)
apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at'
sts_valid_queues sts_st_tcb' hoare_disjI2
cancel_ipc_cte_wp_at_not_reply_state
@ -2586,7 +2587,9 @@ lemma sendSignal_corres:
apply (rule_tac F="list \<noteq> []" in corres_gen_asm)
apply (simp add: list_case_helper split del: if_split)
apply (rule corres_split[OF setNotification_corres])
apply (simp add: ntfn_relation_def)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (simp add: badgeRegister_def badge_register_def)
apply (rule corres_split[OF asUser_setRegister_corres])
apply (rule possibleSwitchTo_corres)
@ -2602,7 +2605,6 @@ lemma sendSignal_corres:
apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
setThreadState_st_tcb
| simp)+
apply (simp add: ntfn_relation_def)
apply (wp set_simple_ko_valid_objs set_ntfn_aligned' set_ntfn_valid_objs'
hoare_vcg_disj_lift weak_sch_act_wf_lift_linear
| simp add: valid_tcb_state_def valid_tcb_state'_def)+
@ -2617,7 +2619,9 @@ lemma sendSignal_corres:
apply (rule_tac F="list \<noteq> []" in corres_gen_asm)
apply (simp add: list_case_helper)
apply (rule corres_split[OF setNotification_corres])
apply (simp add: ntfn_relation_def split:list.splits)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (simp add: badgeRegister_def badge_register_def)
apply (rule corres_split[OF asUser_setRegister_corres])
apply (rule possibleSwitchTo_corres)
@ -2627,7 +2631,6 @@ lemma sendSignal_corres:
apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
setThreadState_st_tcb
| simp)+
apply (simp add: ntfn_relation_def split:list.splits)
apply (wp set_ntfn_aligned' set_simple_ko_valid_objs set_ntfn_valid_objs'
hoare_vcg_disj_lift weak_sch_act_wf_lift_linear
| simp add: valid_tcb_state_def valid_tcb_state'_def)+
@ -3040,6 +3043,7 @@ lemma replyFromKernel_corres:
apply (rule corres_split_eqr[OF lookupIPCBuffer_corres])
apply (rule corres_split[OF asUser_setRegister_corres])
apply (rule corres_split_eqr[OF setMRs_corres])
apply simp
apply (rule setMessageInfo_corres)
apply (wp hoare_case_option_wp hoare_valid_ipc_buffer_ptr_typ_at'
| clarsimp)+
@ -3104,7 +3108,12 @@ lemma receiveIPC_corres:
apply (rule corres_split[OF getEndpoint_corres])
apply (rule corres_guard_imp)
apply (rule corres_split[OF getBoundNotification_corres])
apply (rule_tac r'="ntfn_relation" in corres_split_deprecated)
apply (rule_tac r'="ntfn_relation" in corres_split)
apply (rule corres_option_split[rotated 2])
apply (rule getNotification_corres)
apply clarsimp
apply (rule corres_trivial, simp add: ntfn_relation_def default_notification_def
default_ntfn_def)
apply (rule corres_if)
apply (clarsimp simp: ntfn_relation_def Ipc_A.isActive_def Endpoint_H.isActive_def
split: Structures_A.ntfn.splits Structures_H.notification.splits)
@ -3124,9 +3133,9 @@ lemma receiveIPC_corres:
apply (rule corres_guard_imp)
apply (case_tac isBlocking; simp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule setEndpoint_corres)
apply (simp add: ep_relation_def)
apply simp
apply wp+
apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
apply simp
@ -3141,6 +3150,7 @@ lemma receiveIPC_corres:
apply (case_tac list, simp_all split del: if_split)[1]
apply (rule corres_guard_imp)
apply (rule corres_split[OF setEndpoint_corres])
apply (case_tac lista, simp_all add: ep_relation_def)[1]
apply (rule corres_split[OF getThreadState_corres])
apply (rule_tac
F="\<exists>data.
@ -3175,8 +3185,8 @@ lemma receiveIPC_corres:
apply simp
apply simp
apply (rule corres_split[OF setThreadState_corres])
apply (rule possibleSwitchTo_corres)
apply simp
apply (rule possibleSwitchTo_corres)
apply (wp sts_st_tcb_at' set_thread_state_runnable_weak_valid_sched_action
| simp)+
apply (wp sts_st_tcb_at'_cases sts_valid_queues setThreadState_valid_queues'
@ -3189,7 +3199,6 @@ lemma receiveIPC_corres:
apply (rule_tac Q="\<lambda>_ s. sch_act_wf (ksSchedulerAction s) s"
in hoare_post_imp, erule sch_act_wf_weak)
apply (wp sts_st_tcb' gts_st_tcb_at | simp)+
apply (case_tac lista, simp_all add: ep_relation_def)[1]
apply (simp cong: list.case_cong)
apply wp
apply simp
@ -3205,19 +3214,14 @@ lemma receiveIPC_corres:
apply (rule_tac corres_guard_imp)
apply (case_tac isBlocking; simp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule setEndpoint_corres)
apply (simp add: ep_relation_def)
apply simp
apply wp+
apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp)
apply simp
apply (clarsimp simp: valid_tcb_state_def)
apply (clarsimp simp add: valid_tcb_state'_def)
apply (rule corres_option_split[rotated 2])
apply (rule getNotification_corres)
apply clarsimp
apply (rule corres_trivial, simp add: ntfn_relation_def default_notification_def
default_ntfn_def)
apply (wp get_simple_ko_wp[where f=Notification] getNotification_wp gbn_wp gbn_wp'
hoare_vcg_all_lift hoare_vcg_imp_lift hoare_vcg_if_lift
| wpc | simp add: ep_at_def2[symmetric, simplified] | clarsimp)+
@ -3255,9 +3259,9 @@ lemma receiveSignal_corres:
apply (rule corres_guard_imp)
apply (case_tac isBlocking; simp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule setNotification_corres)
apply (simp add: ntfn_relation_def)
apply simp
apply wp+
apply (rule corres_guard_imp, rule doNBRecvFailedTransfer_corres, simp+)
\<comment> \<open>WaitingNtfn\<close>
@ -3265,9 +3269,9 @@ lemma receiveSignal_corres:
apply (rule corres_guard_imp)
apply (case_tac isBlocking; simp)
apply (rule corres_split[OF setThreadState_corres])
apply simp
apply (rule setNotification_corres)
apply (simp add: ntfn_relation_def)
apply simp
apply wp+
apply (rule corres_guard_imp)
apply (rule doNBRecvFailedTransfer_corres, simp+)
@ -3310,7 +3314,9 @@ lemma sendFaultIPC_corres:
apply (simp add: send_fault_ipc_def sendFaultIPC_def
liftE_bindE Let_def)
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated [where r'="\<lambda>fh fh'. fh = to_bl fh'"])
apply (rule corres_split [where r'="\<lambda>fh fh'. fh = to_bl fh'"])
apply (rule threadGet_corres)
apply (simp add: tcb_relation_def)
apply simp
apply (rule corres_splitEE)
apply (rule corres_cap_fault)
@ -3343,9 +3349,6 @@ lemma sendFaultIPC_corres:
apply auto[1]
apply (clarsimp simp: lookup_failure_map_def)
apply wp+
apply (rule threadGet_corres)
apply (simp add: tcb_relation_def)
apply wp+
apply (fastforce elim: st_tcb_at_tcb_at)
apply fastforce
done
@ -4131,17 +4134,17 @@ lemma handleFault_corres:
apply (simp add: handle_fault_def handleFault_def)
apply (rule corres_guard_imp)
apply (subst return_bind [symmetric],
rule corres_split_deprecated [where P="tcb_at thread",
OF _ gets_the_noop_corres [where x="()"]])
rule corres_split[where P="tcb_at thread",
OF gets_the_noop_corres [where x="()"]])
apply (simp add: tcb_at_def)
apply (rule corres_split_catch)
apply (rule handleDoubleFault_corres)
apply (rule_tac F="valid_fault f" in corres_gen_asm)
apply (rule sendFaultIPC_corres, assumption)
apply simp
apply (rule handleDoubleFault_corres)
apply wp+
apply (rule hoare_post_impErr, rule sfi_invs_plus', simp_all)[1]
apply clarsimp
apply (simp add: tcb_at_def)
apply wp+
apply (clarsimp simp: st_tcb_at_tcb_at st_tcb_def2 invs_def
valid_state_def valid_idle_def)

7
proof/refine/ARM/Refine.thy
View File

@ -588,14 +588,14 @@ lemma kernel_corres:
apply (rule corres_guard_imp)
apply (rule corres_add_noop_lhs2)
apply (simp only: bind_assoc[symmetric])
apply (rule corres_split_deprecated[where r'=dc and
apply (rule corres_split[where r'=dc and
R="\<lambda>_ s. 0 < domain_time s \<and> valid_domain_list s" and
R'="\<lambda>_. \<top>"])
apply (simp only: bind_assoc)
apply (rule kernel_corres')
apply (rule corres_bind_return2, rule corres_stateAssert_assume_stronger)
apply simp
apply (simp add: kernelExitAssertions_def state_relation_def)
apply (simp only: bind_assoc)
apply (rule kernel_corres')
apply (wp call_kernel_domain_time_inv_det_ext call_kernel_domain_list_inv_det_ext)
apply wp
apply clarsimp
@ -679,6 +679,7 @@ lemma do_user_op_corres:
apply (rule_tac F = "dom (rvc \<circ> addrFromPPtr) \<subseteq> dom rvd" in corres_gen_asm)
apply simp
apply (rule_tac r'="(=)" in corres_split[OF corres_select])
apply simp
apply (rule corres_underlying_split[OF corres_machine_op])
apply simp
apply (rule corres_underlying_trivial)

94
proof/refine/ARM/Retype_R.thy
View File

@ -1422,16 +1422,20 @@ lemma objBitsKO_gt_0: "0 < objBitsKO ko"
apply (simp_all add:archObjSize_def pageBits_def pteBits_def pdeBits_def)
done
lemma kheap_ekheap_double_gets: "(\<And>rv erv rv'. pspace_relation rv rv' \<Longrightarrow> ekheap_relation erv rv' \<Longrightarrow> corres r (R rv erv) (R' rv') (b rv erv) (d rv')) \<Longrightarrow>
corres r (\<lambda>s. R (kheap s) (ekheap s) s) (\<lambda>s. R' (ksPSpace s) s) (do x \<leftarrow> gets kheap; xa \<leftarrow> gets ekheap; b x xa od) (gets ksPSpace >>= d)"
lemma kheap_ekheap_double_gets:
"(\<And>rv erv rv'. \<lbrakk>pspace_relation rv rv'; ekheap_relation erv rv'\<rbrakk>
\<Longrightarrow> corres r (R rv erv) (R' rv') (b rv erv) (d rv')) \<Longrightarrow>
corres r (\<lambda>s. R (kheap s) (ekheap s) s) (\<lambda>s. R' (ksPSpace s) s)
(do x \<leftarrow> gets kheap; xa \<leftarrow> gets ekheap; b x xa od) (gets ksPSpace >>= d)"
apply (rule corres_symb_exec_l)
apply (rule corres_guard_imp)
apply (rule_tac r'= "\<lambda>erv rv'. ekheap_relation erv rv' \<and> pspace_relation x rv'" in corres_split_deprecated)
apply clarsimp
apply assumption
apply (rule_tac r'= "\<lambda>erv rv'. ekheap_relation erv rv' \<and> pspace_relation x rv'"
in corres_split)
apply (subst corres_gets[where P="\<lambda>s. x = kheap s" and P'=\<top>])
apply clarsimp
apply (simp add: state_relation_def)
apply clarsimp
apply assumption
apply (wp gets_exs_valid | simp)+
done
@ -1787,12 +1791,7 @@ proof -
apply (simp add: not_less modify_modify bind_assoc[symmetric]
obj_bits_api[symmetric] shiftl_t2n upto_enum_red'
range_cover.unat_of_nat_n[OF cover])
apply (rule corres_split_nor[OF corres_trivial])
apply (clarsimp simp: retype_addrs_fold[symmetric] ptr_add_def upto_enum_red' not_zero'
range_cover.unat_of_nat_n[OF cover] word_le_sub1
simp del: word_of_nat_eq_0_iff)
apply (rule_tac f=g in arg_cong)
apply clarsimp
apply (rule corres_split_nor[OF _ corres_trivial])
apply (rename_tac x eps ps)
apply (rule_tac P="\<lambda>s. x = kheap s \<and> eps = ekheap (s) \<and> ?P s" and
P'="\<lambda>s. ps = ksPSpace s \<and> ?P' s" in corres_modify)
@ -1800,6 +1799,11 @@ proof -
apply (erule retype_state_relation[OF _ _ _ _ _ _ _ _ _ cover _ _ orr],
simp_all add: ko not_zero obj_bits_api
bound[simplified obj_bits_api ko])[1]
apply (clarsimp simp: retype_addrs_fold[symmetric] ptr_add_def upto_enum_red' not_zero'
range_cover.unat_of_nat_n[OF cover] word_le_sub1
simp del: word_of_nat_eq_0_iff)
apply (rule_tac f=g in arg_cong)
apply clarsimp
apply wp+
apply (clarsimp split: option.splits)
apply (intro conjI impI)
@ -2533,6 +2537,7 @@ lemma copyGlobalMappings_corres:
pd_bits_def pdBits_def mapM_x_mapM)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule corres_trivial, clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule_tac F ="is_aligned pd 6 \<and> is_aligned global_pd 6" in corres_gen_asm)
apply (simp add: liftM_def[symmetric])
apply (rule_tac S="(=)" and r'=dc
@ -2542,16 +2547,14 @@ lemma copyGlobalMappings_corres:
and Q'="\<lambda>xs s. \<forall>x \<in> set xs. pde_at' (global_pd + (x << 2)) s
\<and> pde_at' (pd + (x << 2)) s"
in corres_mapM_list_all2, (simp add: pdeBits_def)+)
apply (rule corres_guard_imp, rule corres_split_deprecated)
apply (erule storePDE_corres[OF _ refl])
apply (rule corres_rel_imp)
apply (rule corres_guard_imp, rule corres_split)
apply (rule_tac getObject_PDE_corres[OF refl])
apply (rule storePDE_corres[OF _ refl])
apply clarsimp
apply (drule(1) pde_relation_aligned_eq)
apply fastforce
apply (wp hoare_vcg_const_Ball_lift | simp)+
apply (simp add: kernel_base_def ARM.pptrBase_def pptrBase_def list_all2_refl pageBits_def)
apply (rule corres_trivial, clarsimp simp: state_relation_def arch_state_relation_def)
apply wp+
apply (clarsimp simp: valid_arch_state_def)
apply (auto elim: page_directory_pde_atI is_aligned_weaken[OF pd_aligned])[1]
@ -5280,19 +5283,19 @@ lemma corres_retype_region_createNewCaps:
split del: if_split)[9] (* not PageDirectoryObject *)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule corres_split_nor)
apply (rule corres_trivial, simp)
apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2
objBits_simps APIType_map2_def)
apply (simp add: APIType_map2_def)
apply (rule retype_region2_extra_ext_mapM_x_corres)
apply wp
apply wp
apply (rule corres_retype[where 'a = tcb],
simp_all add: obj_bits_api_def objBits_simps' pageBits_def
APIType_map2_def makeObjectKO_def
other_objs_default_relation)[1]
apply (fastforce simp: range_cover_def)
apply (rule corres_split_nor)
apply (simp add: APIType_map2_def)
apply (rule retype_region2_extra_ext_mapM_x_corres)
apply (rule corres_trivial, simp)
apply (clarsimp simp: list_all2_same list_all2_map1 list_all2_map2
objBits_simps APIType_map2_def)
apply wp
apply wp
apply ((wp retype_region2_obj_at | simp add: APIType_map2_def)+)[1]
apply ((wp createObjects_tcb_at'[where sz=sz] | simp add: APIType_map2_def objBits_simps' obj_bits_api_def)+)[1]
apply simp
@ -5430,22 +5433,18 @@ lemma corres_retype_region_createNewCaps:
\<comment> \<open>PageDirectory\<close>
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule corres_retype[where ty = "Inr PageDirectoryObject" and 'a = pde
, simplified, folded retype_region2_ext_retype_region_ArchObject_PageDirectoryObj],
simp_all add: APIType_map2_def obj_bits_api_def
default_arch_object_def objBits_simps
archObjSize_def pdBits_def pageBits_def
pteBits_def pdeBits_def
makeObjectKO_def)[1]
apply (simp add: range_cover_def)+
apply (rule pagedirectory_relation_retype)
apply (simp add: init_arch_objects_def APIType_map2_def
bind_assoc)
apply (rule corres_split_nor)
apply (simp add: liftM_def[symmetric] o_def list_all2_map1
list_all2_map2 list_all2_same
arch_default_cap_def mapM_x_mapM)
apply (simp add: dc_def[symmetric])
apply (rule corres_machine_op)
apply (rule corres_Id)
apply (simp add: shiftl_t2n shiftL_nat
pdBits_def ptBits_def pageBits_def pt_bits_def)
defer
apply simp
apply (simp add: mapM_discarded[where g = "return ()",simplified,symmetric])
apply (rule no_fail_pre)
apply (wp no_fail_mapM|clarsimp)+
apply (simp add: mapM_x_mapM)
apply (rule corres_underlying_split[where r' = dc])
apply (rule_tac Q="\<lambda>xs s. (\<forall>x \<in> set xs. page_directory_at x s)
@ -5460,16 +5459,19 @@ lemma corres_retype_region_createNewCaps:
apply (rule corres_return[where P =\<top> and P'=\<top>,THEN iffD2])
apply simp
apply wp+
apply (rule corres_retype[where ty = "Inr PageDirectoryObject" and 'a = pde
, simplified, folded retype_region2_ext_retype_region_ArchObject_PageDirectoryObj],
simp_all add: APIType_map2_def obj_bits_api_def
default_arch_object_def objBits_simps
archObjSize_def pdBits_def pageBits_def
pteBits_def pdeBits_def
makeObjectKO_def)[1]
apply (simp add: range_cover_def)+
apply (rule pagedirectory_relation_retype)
apply (wp | simp)+
apply (simp add: liftM_def[symmetric] o_def list_all2_map1
list_all2_map2 list_all2_same
arch_default_cap_def mapM_x_mapM)
apply (simp add: dc_def[symmetric])
apply (rule corres_machine_op)
apply (rule corres_Id)
apply (simp add: shiftl_t2n shiftL_nat
pdBits_def ptBits_def pageBits_def pt_bits_def)
defer
apply simp
apply (simp add: mapM_discarded[where g = "return ()",simplified,symmetric])
apply (rule no_fail_pre)
apply (wp no_fail_mapM|clarsimp)+
apply (rule hoare_vcg_conj_lift)
apply (rule hoare_post_imp)
prefer 2

80
proof/refine/ARM/Schedule_R.thy
View File

@ -49,12 +49,12 @@ proof -
apply (subst P)
apply (rule corres_guard_imp)
apply (rule corres_split[OF x])
apply assumption
apply (rule corres_if2)
apply (case_tac ra, clarsimp+)[1]
apply (rule corres_trivial, clarsimp)
apply (case_tac ra, simp_all)[1]
apply (erule(1) meta_mp [OF _ suffix_ConsD])
apply assumption
apply (rule Q)
apply (rule hoare_post_imp [OF _ z])
apply simp+
@ -118,21 +118,30 @@ lemma tcbSchedAppend_corres:
apply clarsimp
apply (clarsimp simp: unless_def when_def cong: if_cong)
apply (rule stronger_corres_guard_imp)
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split_deprecated[where r'="(=)"])
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres)
apply (simp add: etcb_relation_def)
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres)
apply (simp add: etcb_relation_def)
apply (rule corres_split[where r'="(=)"])
apply simp
apply (rule getQueue_corres)
apply (rule corres_split_noop_rhs2)
apply (rule corres_split_noop_rhs2)
apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
apply (rule addToBitmap_if_null_noop_corres)
apply wp+
apply (simp add: tcb_sched_append_def)
apply (intro conjI impI)
apply (rule corres_guard_imp)
apply (rule setQueue_corres)
prefer 3
apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
apply (wp getQueue_corres getObject_tcb_wp | simp add: etcb_relation_def threadGet_def)+
apply simp
apply simp
apply simp
apply (rule corres_split_noop_rhs2)
apply (rule addToBitmap_if_null_noop_corres)
apply (rule threadSet_corres_noop, simp_all add: tcb_relation_def exst_same_def)[1]
apply wp+
apply (wp getObject_tcb_wp | simp add: threadGet_def)+
apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
projectKO_eq project_inject)
done
@ -1698,11 +1707,11 @@ lemma scheduleChooseNewThread_fragment_corres:
apply (subst bind_dummy_ret_val)
apply (subst bind_dummy_ret_val)
apply (rule corres_guard_imp)
apply (rule corres_split[OF corres_when])
apply (rule corres_split)
apply (rule corres_when, simp)
apply (rule nextDomain_corres)
apply simp
apply (rule chooseThread_corres)
apply simp
apply (rule nextDomain_corres)
apply (wp nextDomain_invs_no_cicd')+
apply (clarsimp simp: valid_sched_def invs'_def valid_state'_def all_invs_but_ct_idle_or_in_cur_domain'_def)+
done
@ -1817,30 +1826,38 @@ lemma schedule_corres:
(* choose thread *)
apply clarsimp
apply (rule corres_split[OF thread_get_isRunnable_corres])
apply (rule corres_split[OF corres_when])
apply (rule corres_split)
apply (rule corres_when, simp)
apply (rule tcbSchedEnqueue_corres)
apply (rule scheduleChooseNewThread_corres, simp)
apply (rule tcbSchedEnqueue_corres, simp)
apply (wp thread_get_wp' tcbSchedEnqueue_invs' hoare_vcg_conj_lift hoare_drop_imps
| clarsimp)+
(* switch to thread *)
apply (rule corres_split[OF thread_get_isRunnable_corres],
rename_tac was_running wasRunning)
apply (rule corres_split[OF corres_when])
apply (rule corres_split)
apply (rule corres_when, simp)
apply (rule tcbSchedEnqueue_corres)
apply (rule corres_split[OF getIdleThread_corres], rename_tac it it')
apply (rule_tac F="was_running \<longrightarrow> ct \<noteq> it" in corres_gen_asm)
apply (rule corres_split[OF ethreadget_corres[where r="(=)"]],
rename_tac tp tp')
apply (rule corres_split[OF ethread_get_when_corres[where r="(=)"]],
rename_tac cp cp')
apply (rule corres_split[OF scheduleSwitchThreadFastfail_corres])
apply (rule corres_split)
apply (rule ethreadget_corres[where r="(=)"])
apply (clarsimp simp: etcb_relation_def)
apply (rename_tac tp tp')
apply (rule corres_split)
apply (rule ethread_get_when_corres[where r="(=)"])
apply (clarsimp simp: etcb_relation_def)
apply (rename_tac cp cp')
apply (rule corres_split)
apply (rule scheduleSwitchThreadFastfail_corres; simp)
apply (rule corres_split[OF curDomain_corres])
apply (rule corres_split[OF isHighestPrio_corres]; simp only:)
apply (rule corres_if, simp)
apply (rule corres_split[OF tcbSchedEnqueue_corres])
apply (simp, fold dc_def)
apply (rule corres_split[OF setSchedulerAction_corres])
apply (rule scheduleChooseNewThread_corres, simp)
apply (rule corres_split)
apply (rule setSchedulerAction_corres; simp)
apply (rule scheduleChooseNewThread_corres)
apply (wp | simp)+
apply (simp add: valid_sched_def)
apply wp
@ -1849,14 +1866,12 @@ lemma schedule_corres:
apply (wpsimp wp: setSchedulerAction_invs')+
apply (wp tcb_sched_action_enqueue_valid_blocked hoare_vcg_all_lift enqueue_thread_queued)
apply (wp tcbSchedEnqueue_invs'_not_ResumeCurrentThread)
apply (rule corres_if, fastforce)
apply (rule corres_split[OF tcbSchedAppend_corres])
apply (simp, fold dc_def)
apply (rule corres_split[OF setSchedulerAction_corres])
apply (rule scheduleChooseNewThread_corres, simp)
apply (rule corres_split)
apply (rule setSchedulerAction_corres; simp)
apply (rule scheduleChooseNewThread_corres)
apply (wp | simp)+
apply (simp add: valid_sched_def)
apply wp
@ -1877,9 +1892,6 @@ lemma schedule_corres:
apply (simp add: if_apply_def2)
apply ((wp (once) hoare_drop_imp)+)[1]
apply wpsimp+
apply (wpsimp simp: etcb_relation_def)+
apply (rule tcbSchedEnqueue_corres)
apply wpsimp+
apply (clarsimp simp: conj_ac cong: conj_cong)
apply wp
@ -2269,7 +2281,9 @@ lemma possibleSwitchTo_corres:
apply (simp add: possible_switch_to_def possibleSwitchTo_def cong: if_cong)
apply (rule corres_guard_imp)
apply (rule corres_split[OF curDomain_corres], simp)
apply (rule corres_split[OF ethreadget_corres[where r="(=)"]])
apply (rule corres_split)
apply (rule ethreadget_corres[where r="(=)"])
apply (clarsimp simp: etcb_relation_def)
apply (rule corres_split[OF getSchedulerAction_corres])
apply (rule corres_if, simp)
apply (rule tcbSchedEnqueue_corres)
@ -2279,7 +2293,7 @@ lemma possibleSwitchTo_corres:
apply (rule tcbSchedEnqueue_corres)
apply (wp rescheduleRequired_valid_queues'_weak)+
apply (rule setSchedulerAction_corres, simp)
apply (wpsimp simp: etcb_relation_def if_apply_def2
apply (wpsimp simp: if_apply_def2
wp: hoare_drop_imp[where f="ethread_get a b" for a b])+
apply (wp hoare_drop_imps)[1]
apply wp+

67
proof/refine/ARM/Syscall_R.thy
View File

@ -139,7 +139,11 @@ lemma decodeDomainInvocation_corres:
apply (simp+)[2]
apply (case_tac "args", simp_all)
apply (rule corres_guard_imp)
apply (rule_tac r'="\<lambda>domain domain'. domain = domain'" and R="\<lambda>_. \<top>" and R'="\<lambda>_. \<top>" in corres_splitEE)
apply (rule_tac r'="\<lambda>domain domain'. domain = domain'" and R="\<lambda>_. \<top>" and R'="\<lambda>_. \<top>"
in corres_splitEE) apply (rule whenE_throwError_corres)
apply (simp+)[2]
apply (rule corres_returnOkTT)
apply simp
apply (rule whenE_throwError_corres_initial)
apply simp
apply (case_tac "cs")
@ -152,11 +156,8 @@ lemma decodeDomainInvocation_corres:
apply (case_tac "cs")
apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2])
apply (case_tac "cs'", ((simp add: list_all2_map2 list_all2_map1)+)[2])
apply (rule whenE_throwError_corres)
apply (simp+)[2]
apply (rule corres_returnOkTT)
apply (wp | simp)+
done
done
lemma decodeInvocation_corres:
"\<lbrakk>cptr = to_bl cptr'; mi' = message_info_map mi;
@ -266,9 +267,9 @@ lemma hinv_corres_assist:
\<comment> \<open>switched over to argument of corres_cap_fault\<close>
apply (rule lookupCapAndSlot_corres, simp)
apply (rule corres_split[OF lookupIPCBuffer_corres])
apply (rule corres_splitEE[OF lookupExtraCaps_corres])
apply (rule corres_splitEE)
apply (rule lookupExtraCaps_corres; simp)
apply (rule corres_returnOkTT)
apply simp+
apply (wp | simp)+
apply auto
done
@ -350,17 +351,18 @@ lemma setDomain_corres:
apply (rule corres_guard_imp)
apply (rule corres_split[OF getCurThread_corres])
apply (rule corres_split[OF tcbSchedDequeue_corres])
apply (rule corres_split[OF ethread_set_corres])
apply (rule corres_split)
apply (rule ethread_set_corres; simp)
apply (clarsimp simp: etcb_relation_def)
apply (rule corres_split[OF isRunnable_corres])
apply simp
apply (rule corres_split_deprecated[OF corres_when[OF refl]])
apply (rule rescheduleRequired_corres)
apply (rule corres_split)
apply clarsimp
apply (rule corres_when[OF refl])
apply (rule tcbSchedEnqueue_corres)
apply (wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+
apply (clarsimp simp: etcb_relation_def)
apply ((wp hoare_vcg_conj_lift hoare_vcg_disj_lift | clarsimp)+)[1]
apply (rule corres_when[OF refl])
apply (rule rescheduleRequired_corres)
apply ((wp hoare_drop_imps hoare_vcg_conj_lift | clarsimp| assumption)+)[5]
apply clarsimp
apply (rule_tac Q="\<lambda>_. valid_objs' and valid_queues' and valid_queues and
(\<lambda>s. sch_act_wf (ksSchedulerAction s) s) and tcb_at' tptr"
@ -397,19 +399,20 @@ lemma performInvocation_corres:
apply (case_tac i)
apply (clarsimp simp: o_def liftE_bindE)
apply (rule corres_guard_imp)
apply (rule corres_split_norE[OF corres_returnOkTT])
apply simp
apply (rule corres_split_norE)
apply (rule corres_rel_imp, rule inv_untyped_corres)
apply simp
apply (case_tac x, simp_all)[1]
apply (rule corres_returnOkTT)
apply simp
apply wp+
apply simp+
apply (rule corres_guard_imp)
apply (rule corres_split[OF getCurThread_corres])
apply simp
apply (rule corres_split[OF sendIPC_corres])
apply (rule corres_trivial)
apply simp
apply (rule corres_trivial)
apply simp
apply wp+
apply (clarsimp simp: ct_in_state_def)
@ -449,8 +452,8 @@ lemma performInvocation_corres:
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF invokeCNode_corres])
apply (rule corres_trivial, simp add: returnOk_def)
apply assumption
apply (rule corres_trivial, simp add: returnOk_def)
apply wp+
apply (clarsimp+)[2]
apply (clarsimp simp: liftME_def[symmetric] o_def dc_def[symmetric])
@ -1231,24 +1234,26 @@ lemma handleInvocation_corres:
apply (clarsimp simp: when_def)
apply (rule replyFromKernel_corres)
apply (rule corres_split[OF setThreadState_corres])
apply (rule corres_splitEE[OF performInvocation_corres])
apply simp
apply (rule corres_splitEE)
apply (rule performInvocation_corres; simp)
apply simp
apply (rule corres_split[OF getThreadState_corres])
apply (rename_tac state state')
apply (case_tac state, simp_all)[1]
apply (fold dc_def)[1]
apply (rule corres_split_deprecated [OF setThreadState_corres])
apply simp
apply (rule corres_split)
apply (rule corres_when [OF refl replyFromKernel_corres])
apply (rule setThreadState_corres)
apply simp
apply (simp add: when_def)
apply (rule conjI, rule impI)
apply (rule reply_from_kernel_tcb_at)
apply (rule impI, wp+)
apply (simp)+
apply simp+
apply (wp hoare_drop_imps)+
apply (simp)
apply (wp)
apply (simp)
apply simp
apply wp
apply simp
apply (rule_tac Q="\<lambda>rv. einvs and simple_sched_action and valid_invocation rve
and (\<lambda>s. thread = cur_thread s)
@ -1503,7 +1508,6 @@ lemma handleRecv_isBlocking_corres':
apply (rule corres_split_eqr[OF getCurThread_corres])
apply (rule corres_split_eqr[OF asUser_getRegister_corres])
apply (rule corres_split_catch)
apply (erule handleFault_corres)
apply (rule corres_cap_fault)
apply (rule corres_splitEE[OF lookupCap_corres])
apply (rule_tac P="?pre1 and tcb_at thread
@ -1526,17 +1530,21 @@ lemma handleRecv_isBlocking_corres':
apply (rename_tac rights)
apply (case_tac "AllowRead \<in> rights"; simp)
apply (rule_tac r'=ntfn_relation in corres_splitEE)
apply clarsimp
apply (rule getNotification_corres)
apply (rule corres_if)
apply (clarsimp simp: ntfn_relation_def)
apply (clarsimp, rule receiveSignal_corres)
prefer 3
apply (rule corres_trivial)
apply (clarsimp simp: lookup_failure_map_def)+
apply (rule getNotification_corres)
apply (wp get_simple_ko_wp getNotification_wp | wpcw | simp)+
apply (clarsimp simp: lookup_failure_map_def)
apply (clarsimp simp: valid_cap_def ct_in_state_def)
apply (clarsimp simp: valid_cap'_def capAligned_def)
apply wp+
apply (rule handleFault_corres)
apply simp
apply (wp get_simple_ko_wp | wpcw | simp)+
apply (rule hoare_vcg_E_elim)
apply (simp add: lookup_cap_def lookup_slot_for_thread_def)
@ -2039,10 +2047,11 @@ proof -
apply (rule corres_split_eqr[where R="\<lambda>rv. einvs"
and R'="\<lambda>rv s. \<forall>x. rv = Some x \<longrightarrow> R'' x s"
for R''])
apply (case_tac rv, simp_all add: doMachineOp_return)[1]
apply (rule handleInterrupt_corres)
apply (rule corres_machine_op)
apply (rule corres_Id, simp+)
apply wp
apply (case_tac rv, simp_all add: doMachineOp_return)[1]
apply (rule handleInterrupt_corres)
apply (wp hoare_vcg_all_lift
doMachineOp_getActiveIRQ_IRQ_active'
| simp
@ -2053,8 +2062,8 @@ proof -
apply (rule_tac corres_underlying_split)
apply (rule corres_guard_imp, rule getCurThread_corres, simp+)
apply (rule corres_split_catch)
apply (erule handleFault_corres)
apply (rule handleVMFault_corres)
apply (erule handleFault_corres)
apply (rule hoare_elim_pred_conjE2)
apply (rule hoare_vcg_E_conj, rule valid_validE_E, wp)
apply (wp handle_vm_fault_valid_fault)

113
proof/refine/ARM/TcbAcc_R.thy
View File

@ -410,10 +410,10 @@ lemma threadSet_corres_noop_splitT:
apply (rule corres_guard_imp)
apply (subst return_bind[symmetric])
apply (rule corres_split_nor[OF threadSet_corres_noopT])
apply (rule z)
apply (simp add: x)
apply (rule y)
apply (rule e)
apply (rule z)
apply (wp w)+
apply simp
apply simp
@ -1345,11 +1345,14 @@ lemma asUser_corres':
show ?thesis
apply (simp add: as_user_def asUser_def)
apply (rule corres_guard_imp)
apply (rule_tac r'="\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con" in corres_split_deprecated)
apply (rule corres_split[OF L4])
apply (rule_tac r'="\<lambda>tcb con. (arch_tcb_context_get o tcb_arch) tcb = con"
in corres_split)
apply simp
apply (rule L1[simplified])
apply (rule corres_split)
apply (rule L4; simp)
apply clarsimp
apply (rule corres_split_nor)
apply (rule corres_trivial, simp)
apply (simp add: threadSet_def)
apply (rule corres_symb_exec_r)
prefer 4
@ -1358,9 +1361,6 @@ lemma asUser_corres':
apply simp
apply simp
apply (wp select_f_inv | simp)+
apply (rule L1[simplified])
apply wp+
apply auto
done
qed
@ -1795,18 +1795,24 @@ proof -
apply (rule ready_queues_helper; auto)
apply (clarsimp simp: when_def)
apply (rule stronger_corres_guard_imp)
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split_deprecated[where r'="(=)"])
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres)
apply (simp add: etcb_relation_def)
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres)
apply (simp add: etcb_relation_def)
apply (rule corres_split[where r'="(=)"])
apply simp
apply (rule getQueue_corres)
apply (rule corres_split_noop_rhs2)
apply (rule corres_split_noop_rhs2)
apply (fastforce intro: threadSet_corres_noop simp: tcb_relation_def exst_same_def)
apply (fastforce intro: addToBitmap_noop_corres)
apply wp+
apply (simp add: tcb_sched_enqueue_def split del: if_split)
apply (rule_tac P=\<top> and Q="K (t \<notin> set queuea)" in corres_assume_pre)
apply (wp setQueue_corres[unfolded dc_def] | simp)+
apply (wp getQueue_corres getObject_tcb_wp | simp add: etcb_relation_def threadGet_def)+
apply simp
apply (rule setQueue_corres[unfolded dc_def])
apply (rule corres_split_noop_rhs2)
apply (fastforce intro: addToBitmap_noop_corres)
apply (fastforce intro: threadSet_corres_noop simp: tcb_relation_def exst_same_def)
apply (wp getObject_tcb_wp | simp add: threadGet_def)+
apply (fastforce simp: valid_queues_def valid_queues_no_bitmap_def obj_at'_def inQ_def
projectKO_eq project_inject)
done
@ -1843,14 +1849,15 @@ lemma rescheduleRequired_corres:
apply (rule corres_guard_imp)
apply (rule corres_split[OF getSchedulerAction_corres])
apply (rule_tac P="case action of switch_thread t \<Rightarrow> P t | _ \<Rightarrow> \<top>"
and P'="case actiona of SwitchToThread t \<Rightarrow> P' t | _ \<Rightarrow> \<top>" for P P' in corres_split_deprecated[where r'=dc])
apply (rule setSchedulerAction_corres)
apply simp
and P'="case actiona of SwitchToThread t \<Rightarrow> P' t | _ \<Rightarrow> \<top>" for P P'
in corres_split[where r'=dc])
apply (case_tac action)
apply simp
apply simp
apply (rule tcbSchedEnqueue_corres)
apply simp
apply (rule setSchedulerAction_corres)
apply simp
apply (wp | wpc | simp)+
apply (force dest: st_tcb_weakenE simp: in_monad weak_valid_sched_action_def valid_etcbs_def
split: Deterministic_A.scheduler_action.split)
@ -1996,15 +2003,19 @@ lemma tcbSchedDequeue_corres:
apply (simp add: exec_gets simpler_modify_def get_etcb_def ready_queues_relation_def cong: if_cong get_tcb_queue_def)
apply (simp add: when_def)
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split_deprecated[where r'="(=)", OF _ ethreadget_corres])
apply (rule corres_split_deprecated[where r'="(=)"])
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres, simp add: etcb_relation_def)
apply (rule corres_split[where r'="(=)"])
apply (rule ethreadget_corres, simp add: etcb_relation_def)
apply (rule corres_split[where r'="(=)"])
apply (simp, rule getQueue_corres)
apply (rule corres_split_noop_rhs2)
apply (simp add: tcb_sched_dequeue_def)
apply (rule setQueue_corres)
apply (rule corres_split_noop_rhs)
apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
apply (clarsimp, rule removeFromBitmap_corres_noop)
apply (rule setQueue_corres | rule getQueue_corres |
wp | simp add: tcb_sched_dequeue_def etcb_relation_def)+
apply (rule threadSet_corres_noop; simp_all add: tcb_relation_def exst_same_def)
apply (wp | simp)+
done
lemma thread_get_test: "do cur_ts \<leftarrow> get_thread_state cur; g (test cur_ts) od =
@ -2034,8 +2045,8 @@ lemma setThreadState_corres:
apply (simp add: set_thread_state_ext_def[abs_def])
apply (subst bind_assoc[symmetric], subst thread_set_def[simplified, symmetric])
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated[where r'=dc])
apply simp
apply (rule corres_split[where r'=dc])
apply (rule threadset_corres, (simp add: tcb_relation_def exst_same_def)+)
apply (subst thread_get_test[where test="runnable"])
apply (rule corres_split[OF thread_get_isRunnable_corres])
apply (rule corres_split[OF getCurThread_corres])
@ -2046,7 +2057,6 @@ lemma setThreadState_corres:
apply clarsimp+
apply (case_tac rva,simp_all)[1]
apply (wp rescheduleRequired_corres_simple corres_return_trivial | simp)+
apply (rule threadset_corres, (simp add: tcb_relation_def exst_same_def)+)
apply (wp hoare_vcg_conj_lift[where Q'="\<top>\<top>"] | simp add: sch_act_simple_def)+
done
@ -3157,7 +3167,13 @@ lemma storeWordUser_corres:
apply (rule corres_guard2_imp)
apply (rule_tac F = "is_aligned a msg_align_bits" in corres_gen_asm2)
apply (rule corres_guard1_imp)
apply (rule_tac r'=dc in corres_split_deprecated)
apply (rule_tac r'=dc in corres_split)
apply (simp add: stateAssert_def)
apply (rule_tac r'=dc in corres_split)
apply (rule corres_trivial)
apply simp
apply (rule corres_assert)
apply wp+
apply (rule corres_machine_op)
apply (rule corres_Id [OF refl])
apply simp
@ -3166,11 +3182,6 @@ lemma storeWordUser_corres:
apply (erule_tac n=msg_align_bits in aligned_add_aligned)
apply (rule is_aligned_mult_triv2 [where n = 2, simplified])
apply (simp add: word_bits_conv msg_align_bits)+
apply (simp add: stateAssert_def)
apply (rule_tac r'=dc in corres_split_deprecated)
apply (rule corres_assert)
apply (rule corres_trivial)
apply simp
apply wp+
apply (simp add: in_user_frame_eq[OF y])
apply simp
@ -3226,7 +3237,7 @@ lemma getMRs_corres:
apply (case_tac mi, simp add: get_mrs_def getMRs_def split del: if_split)
apply (case_tac buf)
apply (rule corres_guard_imp)
apply (rule corres_split_deprecated [where R = "\<lambda>_. \<top>" and R' = "\<lambda>_. \<top>", OF _ T])
apply (rule corres_split [where R = "\<lambda>_. \<top>" and R' = "\<lambda>_. \<top>", OF T])
apply simp
apply wp+
apply simp
@ -3236,7 +3247,6 @@ lemma getMRs_corres:
apply (simp only: option.simps return_bind fun_app_def
load_word_offs_def doMachineOp_mapM ef_loadWord)
apply (rule corres_split_eqr)
apply (rule corres_trivial, simp)
apply (simp only: mapM_map_simp msgMaxLength_def msgLengthBits_def
msg_max_length_def o_def upto_enum_word)
apply (rule corres_mapM [where r'="(=)" and S="{a. fst a = snd a \<and> fst a < unat max_ipc_words}"])
@ -3251,6 +3261,7 @@ lemma getMRs_corres:
apply simp
apply (clarsimp simp: set_zip)
apply (simp add: msgRegisters_unfold max_ipc_words nth_append)
apply (rule corres_trivial, simp)
apply (wp hoare_vcg_all_lift | simp add: valid_ipc_buffer_ptr'_def)+
done
qed
@ -3326,11 +3337,11 @@ proof -
apply (clarsimp simp: msgRegisters_unfold setRegister_def2 zipWithM_x_Nil zipWithM_x_modify
take_min_len zip_take_triv2 min.commute)
apply (rule corres_guard_imp)
apply (rule corres_split_nor[OF asUser_corres'], rule corres_trivial, simp)
apply (rule corres_split_nor[OF asUser_corres'])
apply (rule corres_modify')
apply (fastforce simp: fold_fun_upd[symmetric] msgRegisters_unfold
cong: if_cong simp del: the_index.simps)
apply ((wp |simp)+)[5]
apply ((wp |simp)+)[6]
\<comment> \<open>buf = Some a\<close>
using if_split[split del]
apply (clarsimp simp: msgRegisters_unfold setRegister_def2 zipWithM_x_Nil zipWithM_x_modify
@ -3339,7 +3350,11 @@ proof -
apply (simp add: msg_max_length_def)
apply (rule corres_guard_imp)
apply (rule corres_split_nor[OF asUser_corres'])
apply (rule corres_split_nor, rule corres_trivial, clarsimp simp: min.commute)
apply (rule corres_modify')
apply (simp only: msgRegisters_unfold cong: if_cong)
apply (fastforce simp: fold_fun_upd[symmetric])
apply clarsimp
apply (rule corres_split_nor)
apply (rule_tac S="{((x, y), (x', y')). y = y' \<and> x' = (a + (of_nat x * 4)) \<and> x < unat max_ipc_words}"
in zipWithM_x_corres)
apply (fastforce intro: storeWordUser_corres)
@ -3348,10 +3363,8 @@ proof -
apply (simp add: wordSize_def wordBits_def word_size max_ipc_words
upt_Suc_append[symmetric] upto_enum_word)
apply simp
apply (rule corres_trivial, clarsimp simp: min.commute)
apply wp+
apply (rule corres_modify')
apply (simp only: msgRegisters_unfold cong: if_cong)
apply (fastforce simp: fold_fun_upd[symmetric])
apply (wp | clarsimp simp: valid_ipc_buffer_ptr'_def)+
done
qed
@ -3419,13 +3432,13 @@ proof -
apply (rename_tac sb_ptr rb_ptr)
apply (rule corres_split_nor[OF as_user_bit])
apply (rule corres_split_eqr)
apply (rule corres_trivial, simp)
apply (rule_tac S="{(x, y). y = of_nat x \<and> x < unat max_ipc_words}" in corres_mapM, simp+)
apply (rule_tac S="{(x, y). y = of_nat x \<and> x < unat max_ipc_words}"
in corres_mapM, simp+)
apply (rule corres_split_eqr)
apply (rule storeWordUser_corres)
apply simp
apply (rule loadWordUser_corres)
apply simp
apply (rule storeWordUser_corres)
apply simp
apply (wp hoare_vcg_all_lift | simp)+
apply (clarsimp simp: upto_enum_def)
apply arith
@ -3436,6 +3449,7 @@ proof -
max_ipc_words)
apply (erule order_less_trans)
apply simp
apply (rule corres_trivial, simp)
apply (wp hoare_vcg_all_lift mapM_wp'
| simp add: valid_ipc_buffer_ptr'_def)+
done
@ -3522,8 +3536,10 @@ lemma lookupIPCBuffer_corres':
apply (simp add: lookup_ipc_buffer_def ARM_H.lookupIPCBuffer_def)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr[OF threadGet_corres])
apply (simp add: tcb_relation_def)
apply (simp add: getThreadBufferSlot_def locateSlot_conv)
apply (rule corres_split[OF getSlotCap_corres])
apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def tcbIPCBufferSlot_def)
apply (rule_tac F="valid_ipc_buffer_cap rv buffer_ptr"
in corres_gen_asm)
apply (rule_tac P="valid_cap rv" and Q="no_0_obj'"
@ -3552,9 +3568,7 @@ lemma lookupIPCBuffer_corres':
apply (drule state_relation_pspace_relation)
apply (clarsimp simp: valid_cap_def obj_at_def no_0_obj_kheap
obj_relation_cuts_def3 no_0_obj'_def split:if_split_asm)
apply (simp add: cte_map_def tcb_cnode_index_def cte_level_bits_def tcbIPCBufferSlot_def)
apply (wp get_cap_valid_ipc get_cap_aligned)+
apply (simp add: tcb_relation_def)
apply (wp thread_get_obj_at_eq)+
apply (clarsimp elim!: tcb_at_cte_at)
apply clarsimp
@ -4385,11 +4399,10 @@ lemma get_cap_corres_all_rights_P:
apply (subst bind_return [symmetric])
apply (rule corres_guard_imp)
apply (rule corres_split[OF get_cap_corres_P [where P=P]])
defer
apply (insert cap_relation_masks, simp)
apply (wp getCTE_wp')+
apply simp
apply fastforce
apply (insert cap_relation_masks, simp)
done
lemma asUser_irq_handlers':

166
proof/refine/ARM/Tcb_R.thy
View File

@ -68,8 +68,8 @@ lemma bindNotification_corres:
apply (rule corres_guard_imp)
apply (rule corres_split[OF getNotification_corres])
apply (rule corres_split[OF setNotification_corres])
apply (rule setBoundNotification_corres)
apply (clarsimp simp: ntfn_relation_def split: Structures_A.ntfn.splits)
apply (rule setBoundNotification_corres)
apply (wp)+
apply auto
done
@ -213,8 +213,10 @@ lemma restart_corres:
apply (rule corres_split_nor[OF cancel_ipc_corres])
apply (rule corres_split_nor[OF setupReplyMaster_corres])
apply (rule corres_split_nor[OF setThreadState_corres])
apply clarsimp
apply (rule corres_split[OF tcbSchedEnqueue_corres possibleSwitchTo_corres])
apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_valid_queues sts_st_tcb' | clarsimp simp: valid_tcb_state'_def)+
apply (wp set_thread_state_runnable_weak_valid_sched_action sts_st_tcb_at' sts_valid_queues sts_st_tcb'
| clarsimp simp: valid_tcb_state'_def)+
apply (rule_tac Q="\<lambda>rv. valid_sched and cur_tcb" in hoare_strengthen_post)
apply wp
apply (simp add: valid_sched_def valid_sched_action_def)
@ -226,7 +228,6 @@ lemma restart_corres:
apply (clarsimp simp add: invs'_def valid_state'_def sch_act_wf_weak)
done
lemma restart_invs':
"\<lbrace>invs' and ex_nonz_cap_to' t and (\<lambda>s. t \<noteq> ksIdleThread s)\<rbrace>
ThreadDecls_H.restart t \<lbrace>\<lambda>rv. invs'\<rbrace>"
@ -289,6 +290,8 @@ lemma invokeTCB_ReadRegisters_corres:
frameRegisters_def gpRegisters_def)
apply (rule corres_guard_imp)
apply (rule corres_split_nor)
apply (rule corres_when[OF refl])
apply (rule suspend_corres)
apply (rule corres_split[OF getCurThread_corres])
apply (simp add: liftM_def[symmetric])
apply (rule asUser_corres)
@ -298,9 +301,6 @@ lemma invokeTCB_ReadRegisters_corres:
apply (rule no_fail_mapM)
apply (simp add: no_fail_getRegister)
apply wp+
apply (rule corres_when [OF refl])
apply (rule suspend_corres)
apply wp+
apply (clarsimp simp: invs_def valid_state_def valid_pspace_def
dest!: idle_no_ex_cap)
apply (clarsimp simp: invs'_def valid_state'_def dest!: global'_no_ex_cap)
@ -406,12 +406,12 @@ proof -
apply clarsimp
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule asUser_getRegister_corres)
apply (simp add: setRegister_def)
apply (rule asUser_corres)
apply (rule corres_modify')
apply simp
apply simp
apply (rule asUser_getRegister_corres)
apply (simp | wp)+
done
have R: "\<And>src src' des des' xs ys. \<lbrakk> src = src'; des = des'; xs = ys \<rbrakk> \<Longrightarrow>
@ -443,31 +443,32 @@ proof -
apply (rule corres_split[OF corres_when [OF refl suspend_corres]], simp)
apply (rule corres_split[OF corres_when [OF refl restart_corres]], simp)
apply (rule corres_split_nor)
apply (rule corres_when[OF refl])
apply (rule corres_split_nor)
apply (rule R[OF refl refl])
apply (simp add: frame_registers_def frameRegisters_def)
apply (simp add: getRestartPC_def setNextPC_def dc_def[symmetric])
apply (rule Q[OF refl refl])
apply ((wp mapM_x_wp' static_imp_wp | simp)+)[2]
apply (rule corres_split_nor)
apply (rule corres_when[OF refl])
apply (rule R[OF refl refl])
apply (simp add: gpRegisters_def)
apply (rule corres_split_eqr[OF getCurThread_corres])
apply (rule corres_split_nor[OF asUser_postModifyRegisters_corres[simplified]])
apply (rule corres_split[OF corres_when[OF refl rescheduleRequired_corres]])
apply (rule_tac P=\<top> and P'=\<top> in corres_inst)
apply simp
apply (wp static_imp_wp)+
apply (rule corres_when[OF refl])
apply (rule R[OF refl refl])
apply (simp add: gpRegisters_def)
apply ((wp static_imp_wp)+)[6]
apply (rule_tac Q="\<lambda>_. einvs and tcb_at dest" in hoare_strengthen_post[rotated])
apply (clarsimp simp: invs_def valid_sched_weak_strg valid_sched_def)
prefer 2
apply (rule_tac Q="\<lambda>_. invs' and tcb_at' dest" in hoare_strengthen_post[rotated])
apply (clarsimp simp: invs'_def valid_state'_def invs_weak_sch_act_wf)
apply (wp mapM_x_wp' | simp)+
apply (rule corres_when[OF refl])
apply (rule corres_split_nor)
apply (simp add: getRestartPC_def setNextPC_def dc_def[symmetric])
apply (rule Q[OF refl refl])
apply (rule R[OF refl refl])
apply (simp add: frame_registers_def frameRegisters_def)
apply ((wp mapM_x_wp' static_imp_wp | simp)+)[2]
apply ((wp mapM_x_wp' static_imp_wp | simp)+)[1]
apply (wp mapM_x_wp' static_imp_wp | simp)+
apply ((wp static_imp_wp restart_invs' | wpc | clarsimp simp add: if_apply_def2)+)[2]
apply ((wp mapM_x_wp' static_imp_wp restart_invs' | wpc | clarsimp simp add: if_apply_def2)+)[2]
apply (wp suspend_nonz_cap_to_tcb static_imp_wp | simp add: if_apply_def2)+
apply (fastforce simp: invs_def valid_state_def valid_pspace_def
dest!: idle_no_ex_cap)
@ -635,6 +636,7 @@ lemma sp_corres2:
apply (rule stronger_corres_guard_imp)
apply (rule corres_split[OF tcbSchedDequeue_corres])
apply (rule corres_split[OF ethread_set_corres], simp_all)[1]
apply (simp add: etcb_relation_def)
apply (rule corres_split[OF isRunnable_corres])
apply (erule corres_when)
apply(rule corres_split[OF getCurThread_corres])
@ -642,8 +644,8 @@ lemma sp_corres2:
apply (rule rescheduleRequired_corres)
apply (rule possibleSwitchTo_corres)
apply ((clarsimp
| wp static_imp_wp hoare_vcg_if_lift hoare_wp_combs gts_wp isRunnable_wp
| simp add: etcb_relation_def)+)[5]
| wp static_imp_wp hoare_vcg_if_lift hoare_wp_combs gts_wp
isRunnable_wp)+)[4]
apply (wp hoare_vcg_imp_lift' hoare_vcg_if_lift hoare_vcg_all_lift)
apply clarsimp
apply ((wp hoare_drop_imps hoare_vcg_if_lift hoare_vcg_all_lift
@ -1452,20 +1454,19 @@ proof -
apply (case_tac b, simp_all add: newroot_rel_def)
apply (rule corres_guard_imp)
apply (rule corres_split_norE)
apply (rule cteDelete_corres)
apply (rule_tac F="is_aligned aa msg_align_bits" in corres_gen_asm2)
apply (rule corres_split_nor)
apply (rule threadset_corres,
(simp add: tcb_relation_def), (simp add: exst_same_def)+)[1]
apply (rule corres_split[OF getCurThread_corres], clarsimp)
apply (rule corres_when[OF refl rescheduleRequired_corres])
apply (wpsimp wp: gct_wp)+
apply (rule threadset_corres,
(simp add: tcb_relation_def), (simp add: exst_same_def)+)[1]
apply (wp hoare_drop_imp)
apply (rule threadcontrol_corres_helper1[unfolded pred_conj_def])
apply simp
apply (wp hoare_drop_imp)
apply (wp threadcontrol_corres_helper2 | wpc | simp)+
apply (rule cteDelete_corres)
apply wp
apply (wpsimp wp: cteDelete_invs' hoare_vcg_conj_lift)
apply (fastforce simp: emptyable_def)
apply fastforce
@ -1475,15 +1476,15 @@ proof -
apply (rule_tac F="is_aligned aa msg_align_bits" in corres_gen_asm)
apply (rule_tac F="isArchObjectCap ac" in corres_gen_asm2)
apply (rule corres_split_nor)
apply (rule threadset_corres,
simp add: tcb_relation_def, (simp add: exst_same_def)+)
apply (rule corres_split_nor)
apply (erule checkCapAt_cteInsert_corres)
apply (rule corres_split[OF getCurThread_corres], clarsimp)
apply (rule corres_when[OF refl rescheduleRequired_corres])
apply (wp gct_wp)+
apply (erule checkCapAt_cteInsert_corres)
apply (wp hoare_drop_imp threadcontrol_corres_helper3)[1]
apply (wp hoare_drop_imp threadcontrol_corres_helper4)[1]
apply (rule threadset_corres,
simp add: tcb_relation_def, (simp add: exst_same_def)+)
apply (wp thread_set_tcb_ipc_buffer_cap_cleared_invs
thread_set_cte_wp_at_trivial thread_set_not_state_valid_sched
| simp add: ran_tcb_cap_cases)+
@ -1558,11 +1559,11 @@ proof -
apply (rule corres_split_norE[OF T [OF x U], simplified])
apply (rule corres_split_norE[OF T [OF y V], simplified])
apply (rule corres_split_norE)
apply (rule T2[simplified])
apply (rule corres_split_nor[OF S, simplified])
apply (rule corres_returnOkTT, simp)
apply wp
apply wp
apply (rule T2[simplified])
apply (wpsimp wp: hoare_vcg_const_imp_lift_R hoare_vcg_const_imp_lift
hoare_vcg_all_lift_R hoare_vcg_all_lift as_user_invs cap_delete_deletes
thread_set_ipc_tcb_cap_valid thread_set_tcb_ipc_buffer_cap_cleared_invs
@ -1862,9 +1863,9 @@ lemma invokeTCB_corres:
apply (rule corres_split[OF TcbAcc_R.asUser_setRegister_corres])
apply (rule corres_split[OF Bits_R.getCurThread_corres])
apply (rule corres_split[OF Corres_UL.corres_when])
apply (rule corres_trivial, simp)
apply simp
apply (rule TcbAcc_R.rescheduleRequired_corres)
apply (rule corres_trivial, simp)
apply (wpsimp wp: hoare_drop_imp)+
apply (clarsimp simp: valid_sched_weak_strg einvs_valid_etcbs)
apply (clarsimp simp: Tcb_R.invs_valid_queues' Invariants_H.invs_queues)
@ -2070,7 +2071,8 @@ lemma checkPrio_corres:
apply (simp add: check_prio_def checkPrio_def)
apply (rule corres_guard_imp)
apply (simp add: liftE_bindE)
apply (rule corres_split[OF threadGet_corres])
apply (rule corres_split[OF threadGet_corres[where r="(=)"]])
apply (clarsimp simp: tcb_relation_def)
apply (rule_tac rvr = dc and
R = \<top> and
R' = \<top> in
@ -2079,7 +2081,6 @@ lemma checkPrio_corres:
apply (clarsimp simp: minPriority_def)
apply (rule corres_returnOkTT)
apply (simp add: minPriority_def)
apply (simp add: tcb_relation_def)
apply (wp gct_wp)+
apply (simp add: cur_tcb_def cur_tcb'_def)+
done
@ -2096,11 +2097,11 @@ lemma decodeSetPriority_corres:
clarsimp simp: decode_set_priority_def decodeSetPriority_def)
apply (rename_tac auth_cap auth_slot auth_path rest auth_cap' rest')
apply (rule corres_split_eqrE)
apply corressimp
apply (rule corres_splitEE[OF checkPrio_corres])
apply (rule corres_returnOkTT)
apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
apply wpsimp+
apply (corressimp simp: valid_cap_def valid_cap'_def)+
apply (wpsimp simp: valid_cap_def valid_cap'_def)+
done
lemma decodeSetMCPriority_corres:
@ -2115,11 +2116,11 @@ lemma decodeSetMCPriority_corres:
clarsimp simp: decode_set_mcpriority_def decodeSetMCPriority_def)
apply (rename_tac auth_cap auth_slot auth_path rest auth_cap' rest')
apply (rule corres_split_eqrE)
apply corressimp
apply (rule corres_splitEE[OF checkPrio_corres])
apply (rule corres_returnOkTT)
apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
apply wpsimp+
apply (corressimp simp: valid_cap_def valid_cap'_def)+
apply (wpsimp simp: valid_cap_def valid_cap'_def)+
done
lemma getMCP_sp:
@ -2226,12 +2227,13 @@ lemma decodeSetSchedParams_corres:
apply (clarsimp split: list.split simp: list_all2_Cons2)
apply (clarsimp simp: list_all2_Cons1 neq_Nil_conv val_le_length_Cons linorder_not_less)
apply (rule corres_split_eqrE)
apply corressimp
apply (rule corres_split_norE[OF checkPrio_corres])
apply (rule corres_splitEE[OF checkPrio_corres])
apply (rule corres_returnOkTT)
apply (clarsimp simp: newroot_rel_def elim!: is_thread_cap.elims(2))
apply (wpsimp wp: check_prio_inv checkPrio_inv)+
apply (corressimp simp: valid_cap_def valid_cap'_def)+
apply (wpsimp wp: check_prio_inv checkPrio_inv
simp: valid_cap_def valid_cap'_def)+
done
lemma checkValidIPCBuffer_corres:
@ -2287,7 +2289,8 @@ lemma decodeSetIPCBuffer_corres:
split del: if_split)
apply (clarsimp simp add: returnOk_def newroot_rel_def)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF deriveCap_corres])
apply (rule corres_splitEE)
apply (rule deriveCap_corres; simp)
apply (simp add: o_def newroot_rel_def split_def dc_def[symmetric])
apply (erule checkValidIPCBuffer_corres)
apply (wp hoareE_TrueI | simp)+
@ -2372,23 +2375,36 @@ lemma decodeSetSpace_corres:
apply (cases "3 \<le> length args \<and> 2 \<le> length extras'")
apply (clarsimp simp: val_le_length_Cons list_all2_Cons2
split del: if_split)
apply (simp add: liftE_bindE liftM_def
apply (simp add: liftE_bindE liftM_def unlessE_whenE
getThreadCSpaceRoot getThreadVSpaceRoot
split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_split[OF slotCapLongRunningDelete_corres])
apply (clarsimp simp: is_cap_simps get_tcb_ctable_ptr_def cte_map_tcb_0)
apply (rule corres_split[OF slotCapLongRunningDelete_corres])
apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified] objBits_defs)
apply (rule corres_split_norE)
apply (rule corres_whenE)
apply simp
apply (rule corres_trivial, simp)
apply simp
apply (simp(no_asm) add: split_def unlessE_throwError_returnOk
bindE_assoc cap_CNode_case_throw
bindE_assoc cap_CNode_case_throw unlessE_whenE
split del: if_split)
apply (rule corres_splitEE[OF deriveCap_corres])
apply (rule corres_splitEE)
apply (rule deriveCap_corres)
apply (clarsimp simp: cap_map_update_data)
apply simp
apply (rule corres_split_norE)
apply (rule corres_splitEE[OF deriveCap_corres])
apply (rule corres_whenE)
apply simp
apply (rule corres_trivial, simp)
apply simp
apply (rule corres_splitEE)
apply (rule deriveCap_corres)
apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data)
apply simp
apply (rule corres_split_norE)
apply (rule corres_trivial)
apply (clarsimp simp: returnOk_def newroot_rel_def is_cap_simps
list_all2_conv_all_nth split_def)
apply (unfold unlessE_whenE)
apply (rule corres_whenE)
apply (case_tac vroot_cap', simp_all add:
@ -2399,28 +2415,16 @@ lemma decodeSetSpace_corres:
apply (simp split: option.split)
apply (rule corres_trivial, simp)
apply simp
apply (rule corres_trivial)
apply (clarsimp simp: returnOk_def newroot_rel_def is_cap_simps
list_all2_conv_all_nth split_def)
apply wp+
apply (clarsimp simp: cap_map_update_data)
apply simp
apply ((simp only: simp_thms pred_conj_def | wp)+)[2]
apply (rule corres_whenE)
apply simp
apply (rule corres_trivial, simp)
apply simp
apply (unfold whenE_def, wp+)[2]
apply (fastforce dest: list_all2_nthD2[where p=0] simp: cap_map_update_data)
apply (fastforce dest: list_all2_nthD2[where p=0])
apply ((simp split del: if_split | wp | rule hoare_drop_imps)+)[2]
apply (rule corres_whenE)
apply simp
apply (rule corres_trivial, simp)
apply simp
apply (unfold whenE_def, wp+)[2]
apply (clarsimp simp: is_cap_simps get_tcb_vtable_ptr_def cte_map_tcb_1[simplified] objBits_defs)
apply simp
apply (wp hoare_drop_imps)+
apply (clarsimp simp: is_cap_simps get_tcb_ctable_ptr_def cte_map_tcb_0)
apply wp+
apply (clarsimp simp: get_tcb_ctable_ptr_def get_tcb_vtable_ptr_def
is_cap_simps valid_cap_def tcb_at_cte_at_0
tcb_at_cte_at_1[simplified])
@ -2511,8 +2515,10 @@ lemma decodeTCBConfigure_corres:
apply (clarsimp simp: linorder_not_less val_le_length_Cons list_all2_Cons1
priorityBits_def)
apply (rule corres_guard_imp)
apply (rule corres_splitEE[OF decodeSetIPCBuffer_corres])
apply (rule corres_splitEE[OF decodeSetSpace_corres])
apply (rule corres_splitEE)
apply (rule decodeSetIPCBuffer_corres; simp)
apply (rule corres_splitEE)
apply (rule decodeSetSpace_corres; simp)
apply (rule_tac F="is_thread_control set_params" in corres_gen_asm)
apply (rule_tac F="is_thread_control set_space" in corres_gen_asm)
apply (rule_tac F="tcThreadCapSlot setSpace = cte_map slot" in corres_gen_asm2)
@ -2568,15 +2574,14 @@ lemma tcb_real_cte_16:
by (clarsimp simp: obj_at'_def projectKOs objBitsKO_def ps_clear_16)
lemma corres_splitEE':
assumes x: "corres_underlying sr nf nf' (f \<oplus> r') P P' a c"
assumes y: "\<And>x y x' y'. r' (x, y) (x', y')
\<Longrightarrow> corres_underlying sr nf nf' (f \<oplus> r) (R x y) (R' x' y') (b x y) (d x' y')"
assumes "corres_underlying sr nf nf' (f \<oplus> r') P P' a c"
assumes x: "\<lbrace>Q\<rbrace> a \<lbrace>%(x, y). R x y \<rbrace>,\<lbrace>\<top>\<top>\<rbrace>" "\<lbrace>Q'\<rbrace> c \<lbrace>%(x, y). R' x y\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>"
assumes z: "\<lbrace>Q\<rbrace> a \<lbrace>%(x, y). R x y \<rbrace>,\<lbrace>\<top>\<top>\<rbrace>" "\<lbrace>Q'\<rbrace> c \<lbrace>%(x, y). R' x y\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>"
shows "corres_underlying sr nf nf' (f \<oplus> r) (P and Q) (P' and Q') (a >>=E (\<lambda>(x, y). b x y)) (c >>=E (\<lambda>(x, y). d x y))"
using assms
apply (unfold bindE_def validE_def split_def)
apply (rule corres_split_deprecated)
defer
apply (rule corres_split[rotated 2])
apply assumption+
apply (case_tac rv)
apply (clarsimp simp: lift_def y)+
@ -2594,33 +2599,32 @@ notes if_cong[cong] shows
apply (simp add: null_def returnOk_def)
apply (rule corres_guard_imp)
apply (rule corres_split_norE)
apply (rule corres_trivial)
apply (auto simp: returnOk_def whenE_def)[1]
apply (rule_tac F="extras \<noteq> []" in corres_gen_asm)
apply (rule corres_split_eqrE)
apply simp
apply (rule getBoundNotification_corres)
apply (rule corres_split_norE)
apply (rule corres_trivial, simp split: option.splits add: returnOk_def)
apply (rule corres_splitEE'[where r'="\<lambda>rv rv'. ((fst rv) = (fst rv')) \<and> ((snd rv') = (AllowRead \<in> (snd rv)))"])
apply (rule corres_trivial, simp)
apply (case_tac extras, simp, clarsimp simp: list_all2_Cons1)
apply (fastforce split: cap.splits capability.splits simp: returnOk_def)
apply (rule corres_split_norE)
apply (rule corres_trivial, clarsimp simp: whenE_def returnOk_def)
apply (clarsimp split del: if_split)
apply (rule corres_splitEE[where r'=ntfn_relation])
apply simp
apply (rule getNotification_corres)
apply (rule corres_trivial, simp split del: if_split)
apply (simp add: ntfn_relation_def
split: Structures_A.ntfn.splits Structures_H.ntfn.splits
option.splits)
apply simp
apply (rule getNotification_corres)
apply wp+
apply (rule corres_trivial, clarsimp simp: whenE_def returnOk_def)
apply (wp | simp add: whenE_def split del: if_split)+
apply (rule corres_trivial, simp)
apply (case_tac extras, simp, clarsimp simp: list_all2_Cons1)
apply (fastforce split: cap.splits capability.splits simp: returnOk_def)
apply (wp | wpc | simp)+
apply (rule corres_trivial, simp split: option.splits add: returnOk_def)
apply (wp | wpc | simp)+
apply (rule getBoundNotification_corres)
apply (simp | wp gbn_wp gbn_wp')+
apply (rule corres_trivial)
apply (auto simp: returnOk_def whenE_def)[1]
apply (simp add: whenE_def split del: if_split | wp)+
apply (fastforce simp: valid_cap_def valid_cap'_def dest: hd_in_set)+
done
@ -2633,11 +2637,11 @@ lemma decodeUnbindNotification_corres:
apply (simp add: decode_unbind_notification_def decodeUnbindNotification_def)
apply (rule corres_guard_imp)
apply (rule corres_split_eqrE)
apply simp
apply (rule getBoundNotification_corres)
apply (rule corres_trivial)
apply (simp split: option.splits)
apply (simp add: returnOk_def)
apply simp
apply (rule getBoundNotification_corres)
apply wp+
apply auto
done

100
proof/refine/ARM/Untyped_R.thy
View File

@ -87,12 +87,11 @@ lemma corres_check_no_children:
apply (clarsimp simp:const_on_failure_def constOnFailure_def)
apply (rule corres_guard_imp)
apply (rule corres_split_catch[where E = dc and E'=dc])
apply simp
apply (rule corres_guard_imp[OF corres_splitEE])
apply (rule corres_returnOkTT)
apply simp
apply (rule ensureNoChildren_corres)
apply simp
apply (rule corres_returnOkTT)
apply simp
apply wp+
apply simp+
apply (clarsimp simp:dc_def,wp)+
@ -295,7 +294,20 @@ next
apply (clarsimp simp: fromAPIType_def)
apply (rule whenE_throwError_corres, simp)
apply (clarsimp simp: fromAPIType_def)
apply (rule_tac r' = "\<lambda>cap cap'. cap_relation cap cap'" in corres_splitEE[OF corres_if])
apply (rule_tac r' = "\<lambda>cap cap'. cap_relation cap cap'"
in corres_splitEE)
apply (rule corres_if, simp)
apply (rule corres_returnOkTT)
apply (rule crel)
apply simp
apply (rule corres_splitEE)
apply (rule lookupSlotForCNodeOp_corres)
apply (rule crel)
apply simp
apply simp
apply (rule getSlotCap_corres,simp)
apply (wp lookup_slot_for_cnode_op_inv
hoare_drop_impE_R hoare_vcg_all_lift_R)+
apply (rule_tac corres_split_norE)
apply (rule corres_if)
apply simp
@ -340,6 +352,20 @@ next
apply (simp add: word_le_nat_alt)
apply (simp add:liftE_bindE[symmetric] free_index_of_def)
apply (rule corres_split_norE)
apply (clarsimp simp:is_cap_simps simp del:ser_def)
apply (simp add: mapME_x_map_simp del: ser_def)
apply (rule_tac P = "valid_cap (cap.CNodeCap r bits g) and invs" in corres_guard_imp [where P' = invs'])
apply (rule mapME_x_corres_inv [OF _ _ _ refl])
apply (simp del: ser_def)
apply (rule ensureEmptySlot_corres)
apply (clarsimp simp: is_cap_simps)
apply (simp, wp)
apply (simp, wp)
apply clarsimp
apply (clarsimp simp add: xs is_cap_simps bits_of_def valid_cap_def)
apply (erule cap_table_at_cte_at)
apply (simp add: nat_to_cref_def word_bits_conv)
apply simp
apply (subst liftE_bindE)+
apply (rule corres_split_eqr[OF corres_check_no_children])
apply (simp only: free_index_of_def cap.simps if_res_def[symmetric])
@ -361,20 +387,6 @@ next
apply (strengthen if_res_2n, wp)
apply simp
apply wp
apply (clarsimp simp:is_cap_simps simp del:ser_def)
apply (simp add: mapME_x_map_simp del: ser_def)
apply (rule_tac P = "valid_cap (cap.CNodeCap r bits g) and invs" in corres_guard_imp [where P' = invs'])
apply (rule mapME_x_corres_inv [OF _ _ _ refl])
apply (simp del: ser_def)
apply (rule ensureEmptySlot_corres)
apply (clarsimp simp: is_cap_simps)
apply (simp, wp)
apply (simp, wp)
apply clarsimp
apply (clarsimp simp add: xs is_cap_simps bits_of_def valid_cap_def)
apply (erule cap_table_at_cte_at)
apply (simp add: nat_to_cref_def word_bits_conv)
apply simp
apply (wp mapME_x_inv_wp
validE_R_validE[OF valid_validE_R[OF ensure_empty_inv]]
validE_R_validE[OF valid_validE_R[OF ensureEmpty_inv]])+
@ -387,17 +399,6 @@ next
apply (simp add: unat_arith_simps)
apply wp+
apply simp
apply (rule corres_returnOkTT)
apply (rule crel)
apply simp
apply (rule corres_splitEE[OF lookupSlotForCNodeOp_corres])
apply simp
apply (rule getSlotCap_corres,simp)
apply (rule crel)
apply simp
apply (wp lookup_slot_for_cnode_op_inv
hoare_drop_impE_R hoare_vcg_all_lift_R
| clarsimp)+
apply (rule hoare_strengthen_post [where Q = "\<lambda>r. invs and valid_cap r and cte_at slot"])
apply wp+
apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def
@ -408,7 +409,7 @@ next
apply wp+
apply (rule hoare_strengthen_post [where Q = "\<lambda>r. invs' and cte_at' (cte_map slot)"])
apply wp+
apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' )
apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct')
apply auto[1]
apply (wp whenE_throwError_wp | wp (once) hoare_drop_imps)+
apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct'
@ -919,12 +920,12 @@ lemma corres_list_all2_mapM_':
apply (clarsimp simp add: mapM_x_def sequence_x_def)
apply (rule corres_guard_imp)
apply (rule corres_split[OF y])
apply assumption
apply assumption
apply assumption
apply (clarsimp dest!: suffix_ConsD)
apply (erule meta_allE, (drule(1) meta_mp)+)
apply assumption
apply assumption
apply assumption
apply assumption
apply (erule(1) z)+
apply simp+
done
@ -1516,7 +1517,8 @@ shows
apply (rule corres_underlying_symb_exec_l [OF set_original_symb_exec_l])
apply (rule corres_cong[OF refl refl _ refl refl, THEN iffD1])
apply (rule bind_return[THEN fun_cong])
apply (rule corres_split[OF setCTE_corres])
apply (rule corres_split)
apply (rule setCTE_corres; simp)
apply (subst bind_return[symmetric],
rule corres_split)
apply (simp add: dc_def[symmetric])
@ -4182,6 +4184,7 @@ lemma resetUntypedCap_corres:
liftE_bindE)
apply (rule corres_guard_imp)
apply (rule corres_split[OF getSlotCap_corres])
apply simp
apply (rule_tac F="cap = cap.UntypedCap dev ptr sz idx
\<and> (\<exists>s. s \<turnstile> cap)" in corres_gen_asm)
apply (clarsimp simp: bits_of_def free_index_of_def unlessE_def
@ -4189,17 +4192,20 @@ lemma resetUntypedCap_corres:
apply (rule corres_if[OF refl])
apply (rule corres_returnOk[where P=\<top> and P'=\<top>], simp)
apply (simp add: liftE_bindE bits_of_def split del: if_split)
apply (rule corres_split[OF deleteObjects_corres])
apply (rule corres_split)
apply (rule deleteObjects_corres)
apply (clarsimp simp: valid_cap_def cap_aligned_def)
apply (clarsimp simp: valid_cap_def cap_aligned_def untyped_min_bits_def)
apply (rule corres_if)
apply simp
apply (simp add: bits_of_def shiftL_nat)
apply (rule corres_split_nor)
apply (rule updateFreeIndex_corres, simp)
apply (simp add: free_index_of_def)
apply (simp add: unless_def)
apply (rule corres_when, simp)
apply (rule corres_machine_op)
apply (rule corres_Id, simp, simp, wp)
apply (rule updateFreeIndex_corres, simp)
apply (simp add: free_index_of_def)
apply (wp | simp only: unless_def)+
apply (rule_tac F="sz < word_bits \<and> idx \<le> 2 ^ sz
\<and> ptr \<noteq> 0 \<and> is_aligned ptr sz
@ -4218,8 +4224,13 @@ lemma resetUntypedCap_corres:
in mapME_x_corres_same_xs)
apply (rule corres_guard_imp)
apply (rule corres_split_nor)
apply (rule corres_split_nor[OF updateFreeIndex_corres])
apply (rule preemptionPoint_corres)
apply (rule corres_machine_op)
apply (rule corres_Id)
apply (simp add: shiftL_nat getFreeRef_def shiftl_t2n mult.commute)
apply simp
apply wp
apply (rule corres_split_nor)
apply (rule updateFreeIndex_corres)
apply simp
apply (simp add: getFreeRef_def getFreeIndex_def free_index_of_def)
apply clarify
@ -4237,11 +4248,7 @@ lemma resetUntypedCap_corres:
rule_tac n=sz in power_strict_increasing; simp add: word_bits_def)
apply (erule order_less_le_trans; simp)
apply simp
apply wp+
apply (rule corres_machine_op)
apply (rule corres_Id)
apply (simp add: shiftL_nat getFreeRef_def shiftl_t2n mult.commute)
apply simp
apply (rule preemptionPoint_corres)
apply wp+
apply (clarsimp simp: cte_wp_at_caps_of_state)
apply (clarsimp simp: getFreeRef_def valid_pspace'_def cte_wp_at_ctes_of
@ -4292,8 +4299,6 @@ lemma resetUntypedCap_corres:
apply (erule order_less_le_trans; simp)
apply simp
apply simp
apply (clarsimp simp add: valid_cap_def cap_aligned_def)
apply (clarsimp simp add: valid_cap_def cap_aligned_def untyped_min_bits_def)
apply (simp add: if_apply_def2)
apply (strengthen invs_valid_objs invs_psp_aligned invs_distinct)
apply (wp hoare_vcg_const_imp_lift)
@ -4839,11 +4844,10 @@ lemma inv_untyped_corres':
sz (if reset then 0 else idx)" in corres_gen_asm)
apply (rule corres_add_noop_lhs)
apply (rule corres_split_nor[OF cNodeNoOverlap _ return_wp stateAssert_wp])
apply (rule corres_split[OF updateFreeIndex_corres,rotated])
apply (rule corres_split[OF updateFreeIndex_corres])
apply (simp add:isCap_simps)+
apply (clarsimp simp:getFreeIndex_def bits_of_def shiftL_nat shiftl_t2n
free_index_of_def)
prefer 3
apply (insert range_cover.range_cover_n_less[OF cover] vslot)
apply (rule createNewObjects_corres_helper)
apply simp+

244
proof/refine/ARM/VSpace_R.thy
View File

@ -185,6 +185,10 @@ lemma findPDForASIDAssert_corres:
findPDForASIDAssert_def liftM_def)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule corres_split_catch[OF find_pd_for_asid_corres'[where pd=pd]])
apply (rule_tac P="\<bottom>" and P'="\<top>" in corres_inst)
apply (simp add: corres_fail)
apply (wp find_pd_for_asid_valids[where pd=pd])+
apply (rule_tac F="is_aligned pda pdBits
\<and> pda = pd" in corres_gen_asm)
apply (clarsimp simp add: is_aligned_mask[symmetric])
@ -235,9 +239,6 @@ lemma findPDForASIDAssert_corres:
apply (erule(3) pspace_relation_pd)
apply (simp add: pde_at_def pd_bits_def pdBits_def
is_aligned_neg_mask_eq pdeBits_def pageBits_def)
apply (rule corres_split_catch[OF find_pd_for_asid_corres'[where pd=pd]])
apply (rule_tac P="\<bottom>" and P'="\<top>" in corres_inst)
apply (simp add: corres_fail)
apply (wp find_pd_for_asid_valids[where pd=pd])+
apply (clarsimp simp: word_neq_0_conv valid_vspace_objs_def)
apply simp
@ -309,6 +310,8 @@ lemma storeHWASID_corres:
apply (rule corres_guard_imp)
apply (rule corres_split[OF findPDForASIDAssert_corres[where pd=pd]])
apply (rule corres_split_eqr)
apply (rule corres_trivial)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule corres_split)
apply (rule corres_trivial, rule corres_modify)
apply (clarsimp simp: state_relation_def)
@ -316,15 +319,12 @@ lemma storeHWASID_corres:
apply (rule ext)
apply simp
apply (rule corres_split_eqr)
apply (rule corres_trivial)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule corres_trivial, rule corres_modify)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule ext)
apply simp
apply (rule corres_trivial)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply ((wp | simp)+)[4]
apply (rule corres_trivial)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (wp | simp)+
done
@ -368,12 +368,12 @@ lemma invalidateHWASIDEntry_corres:
apply (simp add: invalidate_hw_asid_entry_def invalidateHWASIDEntry_def)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule corres_trivial, rule corres_modify)
defer
apply (rule corres_trivial)
apply (wp | clarsimp simp: state_relation_def arch_state_relation_def)+
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule corres_trivial, rule corres_modify)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule ext)
apply simp
apply (wp | clarsimp)+
done
lemma findFreeHWASID_corres:
@ -388,7 +388,9 @@ lemma findFreeHWASID_corres:
apply (simp add: find_free_hw_asid_def findFreeHWASID_def)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr[OF corres_trivial])
apply (clarsimp simp: arch_state_relation_def state_relation_def)
apply (rule corres_split_eqr[OF corres_trivial])
apply (clarsimp simp: arch_state_relation_def state_relation_def)
apply (subgoal_tac "take (length [minBound .e. maxBound :: hardware_asid])
([next_asid .e. maxBound] @ [minBound .e. next_asid])
= [next_asid .e. maxBound] @ init [minBound .e. next_asid]")
@ -405,13 +407,13 @@ lemma findFreeHWASID_corres:
apply fastforce
apply (rule corres_split)
apply (rule invalidateHWASIDEntry_corres)
apply (rule corres_split_deprecated)
apply (rule corres_trivial)
apply simp
apply (rule corres_split)
apply (rule corres_trivial)
apply (rule corres_modify)
apply (simp add: minBound_word maxBound_word
state_relation_def arch_state_relation_def)
apply (rule corres_trivial)
apply simp
apply (wp | simp split del: if_split)+
apply (rule corres_trivial, clarsimp)
apply (cut_tac x=next_asid in leq_maxBound)
@ -419,7 +421,7 @@ lemma findFreeHWASID_corres:
apply (simp add: init_def upto_enum_word
minBound_word
del: upt.simps)
apply (wp | clarsimp simp: arch_state_relation_def state_relation_def)+
apply wp+
apply (clarsimp dest!: findNoneD)
apply (drule bspec, rule UnI1, simp, rule order_refl)
apply (clarsimp simp: valid_arch_state_def)
@ -635,13 +637,15 @@ lemma setCurrentPD_corres:
apply (rule corres_machine_op)
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule corres_underlying_trivial)
apply (wp setCurrentPD_no_fails)
apply (rule corres_split_eqr)
apply (rule corres_underlying_trivial)
apply (wp setCurrentPD_no_fails)
apply (rule corres_rel_imp)
apply (wp
| rule corres_underlying_trivial
| rule setCurrentPD_no_fails
| rule setCurrentPD_no_irqs
| simp add: dc_def)+
apply (rule corres_underlying_trivial)
apply (wp setCurrentPD_no_fails)
apply wpsimp+
done
lemma setVMRoot_corres:
@ -662,9 +666,9 @@ proof -
od)"
apply (rule corres_guard_imp)
apply (rule corres_split_eqr)
apply (rule setCurrentPD_corres)
apply (subst corres_gets)
apply (clarsimp simp: state_relation_def arch_state_relation_def)
apply (rule setCurrentPD_corres)
apply (wp | simp)+
done
have Q: "\<And>P P'. corres dc P P'
@ -678,8 +682,8 @@ proof -
od))"
apply (rule corres_guard_imp)
apply (rule corres_split_catch [where f=lfr])
apply (simp, rule P)
apply (subst corres_throwError, simp add: lookup_failure_map_def)
apply (simp, rule P)
apply (wp | simp)+
done
show ?thesis
@ -696,7 +700,8 @@ proof -
pspace_aligned and pspace_distinct and
cte_wp_at ((=) thread_root) thread_root_slot"
and R'="\<lambda>thread_root. pspace_aligned' and pspace_distinct' and no_0_obj'"
in corres_split[OF getSlotCap_corres])
in corres_split)
apply (rule getSlotCap_corres; simp)
apply (insert Q)
apply (case_tac rv, simp_all add: isCap_simps Q[simplified])[1]
apply (rename_tac arch_cap)
@ -706,6 +711,14 @@ proof -
apply (clarsimp simp: cap_asid_def)
apply (rule corres_guard_imp)
apply (rule corres_split_catch [where f=lfr])
apply (rule corres_split_eqrE)
apply (rule find_pd_for_asid_corres; simp)
apply (rule whenE_throwError_corres)
apply (simp add: lookup_failure_map_def)
apply simp
apply simp
apply (rule armv_contextSwitch_corres)
apply (wp hoare_drop_imps)+
apply (simp add: checkPDNotInASIDMap_def
checkPDASIDMapMembership_def)
apply (rule_tac P'="(Not \<circ> vspace_at_asid aa word) and K (aa \<le> mask asid_bits)
@ -724,14 +737,7 @@ proof -
apply (clarsimp simp: pd_at_uniq_def restrict_map_def)
apply (erule notE, rule_tac a=x in ranI)
apply simp
apply (rule corres_split_eqrE[OF find_pd_for_asid_corres])
apply (rule whenE_throwError_corres)
apply (simp add: lookup_failure_map_def)
apply simp
apply simp
apply (rule armv_contextSwitch_corres)
apply ((wp find_pd_for_asid_pd_at_asid_again
| simp add: if_apply_def2 | wp (once) hoare_drop_imps)+)
apply (wp find_pd_for_asid_pd_at_asid_again)+
apply clarsimp
apply (frule page_directory_cap_pd_at_uniq, simp+)
apply (frule(1) cte_wp_at_valid_objs_valid_cap)
@ -792,10 +798,10 @@ lemma invalidateASIDEntry_corres:
apply (rule corres_guard_imp)
apply (rule corres_split[OF loadHWASID_corres[where pd=pd]])
apply (rule corres_split[OF corres_when])
apply (rule invalidateASID_corres[where pd=pd])
apply simp
apply simp
apply (rule invalidateHWASIDEntry_corres)
apply (rule invalidateASID_corres[where pd=pd])
apply (wp load_hw_asid_wp
| clarsimp cong: if_cong)+
apply (simp add: pd_at_asid_uniq)
@ -1087,14 +1093,15 @@ proof -
apply (simp add: set_vm_root_for_flush_def setVMRootForFlush_def getThreadVSpaceRoot_def locateSlot_conv)
apply (rule corres_guard_imp)
apply (rule corres_split[OF getCurThread_corres])
apply (rule corres_split_deprecated [where R="\<lambda>_. vspace_at_asid asid pd and K (asid \<noteq> 0 \<and> asid \<le> mask asid_bits)
apply (rule corres_split[where R="\<lambda>_. vspace_at_asid asid pd and K (asid \<noteq> 0 \<and> asid \<le> mask asid_bits)
and valid_asid_map and valid_vs_lookup
and valid_vspace_objs and valid_global_objs
and unique_table_refs o caps_of_state
and valid_arch_state
and pspace_aligned and pspace_distinct"
and R'="\<lambda>_. pspace_aligned' and pspace_distinct' and no_0_obj'",
OF _ getSlotCap_corres])
and R'="\<lambda>_. pspace_aligned' and pspace_distinct' and no_0_obj'"])
apply (rule getSlotCap_corres)
apply (simp add: cte_map_def tcb_cnode_index_def tcbVTableSlot_def to_bl_1)
apply (case_tac "isArchObjectCap rv' \<and>
isPageDirectoryCap (capCap rv') \<and>
capPDMappedASID (capCap rv') \<noteq> None \<and>
@ -1105,8 +1112,6 @@ proof -
apply (case_tac rv, simp_all add: isCap_simps[simplified] X[simplified])[1]
apply (rename_tac arch_cap)
apply (case_tac arch_cap, auto simp: X[simplified] split: option.splits)[1]
apply (simp add: cte_map_def objBits_simps tcb_cnode_index_def
tcbVTableSlot_def to_bl_1 cte_level_bits_def)
apply wp+
apply (clarsimp simp: cur_tcb_def)
apply (erule tcb_at_cte_at)
@ -1288,15 +1293,15 @@ lemma flushTable_corres:
apply (rule corres_split[OF load_hw_asid_corres2[where pd=pd]])
apply (clarsimp cong: corres_weak_cong)
apply (rule corres_when, rule refl)
apply (rule corres_split_deprecated[where r' = dc, OF corres_when corres_machine_op])
apply (rule corres_split[where r' = dc, OF corres_machine_op corres_when])
apply (rule corres_Id[OF refl])
apply simp
apply (rule no_fail_invalidateLocalTLB_ASID)
apply simp
apply (rule corres_split[OF getCurThread_corres])
apply (simp, rule setVMRoot_corres)
apply ((wp mapM_wp' hoare_vcg_const_imp_lift get_pte_wp getPTE_wp|
wpc|simp|fold cur_tcb_def cur_tcb'_def)+)[4]
apply (rule corres_Id[OF refl])
apply simp
apply (rule no_fail_invalidateLocalTLB_ASID)
apply (wp hoare_drop_imps | simp)+
apply (wp load_hw_asid_wp hoare_drop_imps |
simp add: cur_tcb'_def [symmetric] cur_tcb_def [symmetric] )+
@ -1324,14 +1329,14 @@ lemma flushPage_corres:
apply (clarsimp cong: corres_weak_cong)
apply (rule corres_when, rule refl)
apply (rule corres_split[OF corres_machine_op [where r=dc]])
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_pre, wp no_fail_invalidateLocalTLB_VAASID)
apply simp
apply (rule corres_when, rule refl)
apply (rule corres_split[OF getCurThread_corres])
apply simp
apply (rule setVMRoot_corres)
apply wp+
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_pre, wp no_fail_invalidateLocalTLB_VAASID)
apply simp
apply (simp add: cur_tcb_def [symmetric] cur_tcb'_def [symmetric])
apply (wp hoare_drop_imps)[1]
apply (assumption | wp hoare_drop_imps load_hw_asid_wp
@ -1361,8 +1366,8 @@ lemma pageTableMapped_corres:
apply (simp add: page_table_mapped_def pageTableMapped_def)
apply (rule corres_guard_imp)
apply (rule corres_split_catch)
apply (rule corres_trivial, simp)
apply (rule corres_split_eqrE[OF find_pd_for_asid_corres])
apply simp
apply (simp add: liftE_bindE)
apply (rule corres_split[OF getObject_PDE_corres'])
apply (rule corres_trivial)
@ -1395,14 +1400,14 @@ lemma unmapPageTable_corres:
apply (rule corres_split_eqr[OF pageTableMapped_corres])
apply (simp add: case_option_If2 split del: if_split)
apply (rule corres_if2[OF refl])
apply (rule corres_split[OF storePDE_corres'])
apply (rule corres_split)
apply (rule storePDE_corres')
apply (simp add:pde_relation_aligned_def)
apply (rule corres_split[OF corres_machine_op])
apply (rule flushTable_corres)
apply (rule corres_Id, rule refl, simp)
apply (wp no_fail_cleanByVA_PoU)+
apply (simp, wp+)
apply (simp add:pde_relation_aligned_def)+
apply (wp store_pde_pd_at_asid store_pde_vspace_objs_invalid)
apply (wp no_fail_cleanByVA_PoU)
apply (rule flushTable_corres)
apply (wpsimp wp: store_pde_pd_at_asid store_pde_vspace_objs_invalid)+
apply (rule hoare_vcg_conj_lift)
apply (simp add: store_pde_def)
apply (wp set_pd_vs_lookup_unmap)+
@ -1439,10 +1444,10 @@ lemma corres_split_strengthen_ftE:
\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,-; \<lbrace>Q'\<rbrace> j \<lbrace>R'\<rbrace>,- \<rbrakk>
\<Longrightarrow> corres (dc \<oplus> r) (P and Q) (P' and Q') (f >>=E (\<lambda>rv. g rv)) (j >>=E (\<lambda>rv'. k rv'))"
apply (rule_tac r'=r' in corres_splitEE)
apply (rule corres_rel_imp, assumption)
apply (case_tac x, auto)[1]
apply (erule corres_rel_imp)
apply (case_tac x, auto)[1]
apply (rule corres_rel_imp, assumption)
apply (case_tac x, auto)[1]
apply (simp add: validE_R_def)+
done
@ -1501,10 +1506,11 @@ lemma unmapPage_corres:
(unmapPage sz asid vptr pptr)"
apply (clarsimp simp: unmap_page_def unmapPage_def ignoreFailure_def const_def largePagePTEOffsets_def)
apply (rule corres_guard_imp)
apply (rule corres_split_catch [where E="\<lambda>_. \<top>" and E'="\<lambda>_. \<top>"], simp)
apply (rule corres_split_catch [where E="\<lambda>_. \<top>" and E'="\<lambda>_. \<top>"])
apply (rule corres_split_strengthen_ftE[where ftr'=dc],
rule find_pd_for_asid_corres,simp)
apply (rule corres_splitEE)
prefer 2
apply clarsimp
apply (rule flushPage_corres)
apply (rule_tac F = "vptr < kernel_base" in corres_gen_asm)
@ -1524,13 +1530,14 @@ lemma unmapPage_corres:
apply simp
apply (rule corres_splitEE[OF checkMappingPPtr_corres])
apply simp
apply (rule corres_split[OF storePTE_corres'])
apply (rule corres_split)
apply (rule storePTE_corres')
apply (simp add: pte_relation_aligned_def)
apply (rule corres_machine_op)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanByVA_PoU)
apply (wp hoare_drop_imps lookup_pt_slot_inv
lookupPTSlot_inv lookup_pt_slot_is_aligned
| simp add: pte_relation_aligned_def)+
apply (wpsimp wp: hoare_drop_imps lookup_pt_slot_inv
lookupPTSlot_inv lookup_pt_slot_is_aligned)+
apply (clarsimp simp: page_directory_pde_at_lookupI
page_directory_at_aligned_pd_bits vmsz_aligned_def)
apply (simp add:valid_unmap_def pageBits_def)
@ -1543,13 +1550,10 @@ lemma unmapPage_corres:
apply (simp add: is_aligned_mask[symmetric])
apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres])
apply (simp add: largePagePTEOffsets_def pteBits_def)
apply (rule corres_split[OF corres_mapM])
prefer 8
apply (rule corres_split)
apply (rule corres_mapM)
prefer 7
apply (rule order_refl)
apply (rule corres_machine_op)
apply (clarsimp simp: last_byte_pte_def objBits_simps archObjSize_def)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanCacheRange_PoU)
apply simp
apply simp
apply clarsimp
@ -1559,7 +1563,12 @@ lemma unmapPage_corres:
apply (rule storePTE_corres', simp add:pte_relation_aligned_def)
apply clarsimp
apply clarsimp
apply (wp store_pte_typ_at hoare_vcg_const_Ball_lift | simp | wp (once) hoare_drop_imps)+
apply (wpsimp wp: store_pte_typ_at hoare_vcg_const_Ball_lift)+
apply (rule corres_machine_op)
apply (clarsimp simp: last_byte_pte_def objBits_simps archObjSize_def)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanCacheRange_PoU)
apply (wp hoare_drop_imps | simp)+
apply (wp lookup_pt_slot_ptes lookup_pt_slot_inv lookupPTSlot_inv
lookup_pt_slot_is_aligned lookup_pt_slot_is_aligned_6)+
apply (clarsimp simp: page_directory_pde_at_lookupI vmsz_aligned_def pd_aligned
@ -1571,12 +1580,13 @@ lemma unmapPage_corres:
apply (rule corres_guard_imp)
apply (rule corres_split_strengthen_ftE[OF checkMappingPPtr_corres])
apply simp
apply (rule corres_split[OF storePDE_corres'])
apply (rule corres_split)
apply (rule storePDE_corres')
apply (simp add:pde_relation_aligned_def)
apply (rule corres_machine_op)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanByVA_PoU)
apply (wp | simp add:pde_relation_aligned_def
| wp (once) hoare_drop_imps)+
apply (wp | simp | wp (once) hoare_drop_imps)+
apply (clarsimp simp: page_directory_pde_at_lookupI
pg_entry_align_def)
apply (clarsimp simp:lookup_pd_slot_def)
@ -1589,12 +1599,7 @@ lemma unmapPage_corres:
apply (rule_tac F="is_aligned (lookup_pd_slot pd vptr) 6"
in corres_gen_asm)
apply (simp add: is_aligned_mask[symmetric])
apply (rule corres_split_deprecated)
apply (rule corres_machine_op)
apply (clarsimp simp: last_byte_pde_def objBits_simps archObjSize_def
superSectionPDEOffsets_def pdeBits_def)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanCacheRange_PoU)
apply (rule corres_split)
apply (rule_tac P="page_directory_at pd and pspace_aligned and valid_etcbs
and K (valid_unmap sz (asid, vptr))"
in corres_mapM [where r=dc], simp, simp)
@ -1607,7 +1612,13 @@ lemma unmapPage_corres:
apply (erule (2) pde_at_aligned_vptr)
apply (simp add: valid_unmap_def)
apply assumption
apply (wp | simp add: superSectionPDEOffsets_def pdeBits_def | wp (once) hoare_drop_imps)+
apply (wp | simp add: superSectionPDEOffsets_def pdeBits_def)+
apply (rule corres_machine_op)
apply (clarsimp simp: last_byte_pde_def objBits_simps archObjSize_def
superSectionPDEOffsets_def pdeBits_def)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanCacheRange_PoU)
apply (wp hoare_drop_imps)+
apply (clarsimp simp: valid_unmap_def page_directory_pde_at_lookupI
lookup_pd_slot_aligned_6 pg_entry_align_def
pd_aligned vmsz_aligned_def)
@ -1618,13 +1629,14 @@ lemma unmapPage_corres:
store_pde_invs_unmap store_pde_pd_at_asid mapM_swp_store_pde_invs_unmap
| wpc | simp | wp hoare_drop_imps
| wp mapM_wp')+
apply (auto simp: invs_vspace_objs[simplified])[1]
apply (fastforce simp: invs_vspace_objs[simplified])
apply (wp lookupPTSlot_inv mapM_wp' | wpc | clarsimp)+
apply (wp hoare_vcg_const_imp_lift_R
| strengthen lookup_pd_slot_kernel_mappings_strg not_in_global_refs_vs_lookup
page_directory_at_lookup_mask_aligned_strg lookup_pd_slot_kernel_mappings_set_strg
page_directory_at_lookup_mask_add_aligned_strg
| wp hoare_vcg_const_Ball_lift_R)+
| wp hoare_vcg_const_Ball_lift_R
| simp)+
apply (clarsimp simp add: valid_unmap_def valid_asid_def)
apply (case_tac sz)
apply (auto simp: invs_def valid_state_def
@ -2123,29 +2135,30 @@ proof -
apply (clarsimp simp: mapM_Cons bind_assoc split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_split[OF pteCheckIfMapped_corres])
apply (rule corres_split[OF storePTE_corres'])
apply (rule corres_split_deprecated[where r' = dc, OF _ corres_store_pte_with_invalid_tail])
apply (rule corres_split_deprecated[where r'=dc, OF _ corres_machine_op[OF corres_Id]])
apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]])
apply (clarsimp simp add: when_def)
apply (rule invalidate_tlb_by_asid_corres_ex)
apply wp
apply wp
apply (rule corres_split)
apply (rule storePTE_corres')
apply (clarsimp simp: pte_relation_aligned_def
dest!: valid_slots_duplicated_pteD')
apply (rule corres_split[where r' = dc])
apply (rule corres_store_pte_with_invalid_tail)
apply (clarsimp dest!: valid_slots_duplicated_pteD')
apply (rule corres_split[where r'=dc])
apply (rule corres_machine_op[OF corres_Id])
apply (simp add: last_byte_pte_def objBits_simps archObjSize_def pteBits_def)
apply simp
apply (rule no_fail_cleanCacheRange_PoU)
apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]])
apply (clarsimp simp add: when_def)
apply (rule invalidate_tlb_by_asid_corres_ex)
apply (wp hoare_vcg_ex_lift)+
apply (clarsimp simp: pte_relation_aligned_def)
apply (clarsimp dest!: valid_slots_duplicated_pteD')
apply (rule_tac Q="\<lambda>_. K (word \<le> mask asid_bits \<and> word \<noteq> 0) and invs
and (\<lambda>s. \<exists>pd. vspace_at_asid word pd s)" in hoare_strengthen_post)
and (\<lambda>s. \<exists>pd. vspace_at_asid word pd s)"
in hoare_strengthen_post)
prefer 2
apply (auto simp: invs_vspace_objs[simplified])[1]
apply (wp mapM_swp_store_pte_invs[where pte="ARM_A.pte.InvalidPTE", simplified]
hoare_vcg_ex_lift)
apply (wp mapM_UNIV_wp | simp add: swp_def del: fun_upd_apply)+
apply (clarsimp simp:pte_relation_aligned_def)
apply (clarsimp dest!:valid_slots_duplicated_pteD')
apply (clarsimp simp del: fun_upd_apply simp add: cte_wp_at_caps_of_state)
apply (wp hoare_vcg_const_Ball_lift store_pte_typ_at store_pte_cte_wp_at
hoare_vcg_ex_lift)+
@ -2174,20 +2187,22 @@ proof -
apply (clarsimp simp: mapM_Cons bind_assoc split del:if_split)
apply (rule corres_guard_imp)
apply (rule corres_split[OF pdeCheckIfMapped_corres])
apply (rule corres_split[OF storePDE_corres'])
apply (rule corres_split_deprecated[where r'=dc, OF _ corres_store_pde_with_invalid_tail])
apply (rule corres_split_deprecated[where r'=dc,OF _ corres_machine_op[OF corres_Id]])
apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]])
apply (clarsimp simp: when_def)
apply (rule invalidate_tlb_by_asid_corres_ex)
apply wp
apply wp
apply (rule corres_split)
apply (rule storePDE_corres')
apply (clarsimp simp: pde_relation_aligned_def
dest!: valid_slots_duplicated_pdeD')
apply (rule corres_split[where r'=dc])
apply (rule corres_store_pde_with_invalid_tail)
apply (clarsimp dest!: valid_slots_duplicated_pdeD')
apply (rule corres_split[where r'=dc])
apply (rule corres_machine_op[OF corres_Id])
apply (simp add: last_byte_pde_def objBits_simps archObjSize_def pdeBits_def)
apply simp
apply (rule no_fail_cleanCacheRange_PoU)
apply (rule corres_split[where r'=dc, OF _ corres_return_eq_same[OF refl]])
apply (clarsimp simp: when_def)
apply (rule invalidate_tlb_by_asid_corres_ex)
apply (wp hoare_vcg_ex_lift)+
apply (clarsimp simp: pde_relation_aligned_def)
apply (clarsimp dest!:valid_slots_duplicated_pdeD' )
apply (rule_tac Q="\<lambda>_. K (word \<le> mask asid_bits \<and> word \<noteq> 0) and invs
and (\<lambda>s. \<exists>pd. vspace_at_asid word pd s)" in hoare_strengthen_post)
prefer 2
@ -2195,8 +2210,6 @@ proof -
apply (wp mapM_swp_store_pde_invs_unmap[where pde="ARM_A.pde.InvalidPDE", simplified]
hoare_vcg_ex_lift)
apply (wp mapM_UNIV_wp store_pde_pd_at_asid | clarsimp simp add: swp_def)+
apply (clarsimp simp: pde_relation_aligned_def)
apply (clarsimp dest!:valid_slots_duplicated_pdeD')
apply (clarsimp simp add: cte_wp_at_caps_of_state simp del: fun_upd_apply)
apply (wp hoare_vcg_const_Ball_lift store_pde_typ_at hoare_vcg_ex_lift
store_pde_pd_at_asid)
@ -2386,11 +2399,12 @@ lemma performPageTableInvocation_corres:
apply (rule corres_guard_imp)
apply (rule corres_split[OF updateCap_same_master])
apply assumption
apply (rule corres_split[OF storePDE_corres'])
apply (rule corres_split)
apply (rule storePDE_corres')
apply (simp add: pde_relation_aligned_def)
apply (rule corres_machine_op)
apply (rule corres_Id, rule refl, simp)
apply (rule no_fail_cleanByVA_PoU)
apply (simp add: pde_relation_aligned_def)
apply (wp set_cap_typ_at)+
apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state is_arch_update_def)
apply (clarsimp simp: is_cap_simps cap_master_cap_simps
@ -2409,20 +2423,20 @@ lemma performPageTableInvocation_corres:
apply (simp add: case_option_If2 getSlotCap_def split del: if_split)
apply (rule corres_guard_imp)
apply (rule corres_split_nor)
apply (rule corres_if[OF refl _ corres_trivial])
apply (rule corres_split[OF unmapPageTable_corres])
apply (rule corres_split_nor)
apply (simp add: pteBits_def)+
apply (rule clear_page_table_corres)
apply (rule corres_machine_op, rule corres_Id)
apply wpsimp+
apply (simp add: liftM_def)
apply (rule corres_split[OF get_cap_corres])
apply (rule_tac F="is_pt_cap x" in corres_gen_asm)
apply (rule updateCap_same_master)
apply (clarsimp simp: is_pt_cap_def update_map_data_def)
apply (wp get_cap_wp)+
apply (rule corres_if[OF refl])
apply (rule corres_split[OF unmapPageTable_corres])
apply (rule corres_split_nor)
apply (rule corres_machine_op, rule corres_Id)
apply (simp add: pteBits_def)+
apply (rule clear_page_table_corres)
apply wp+
apply (rule corres_trivial, simp)
apply (wp get_cap_wp)
apply wp
apply (simp add: cte_wp_at_caps_of_state pred_conj_def
split del: if_split)
apply (rule hoare_lift_Pf2[where f=caps_of_state])
@ -2463,6 +2477,7 @@ lemma performASIDPoolInvocation_corres:
apply (rename_tac word1 word2 prod)
apply (rule corres_guard_imp)
apply (rule corres_split[OF getSlotCap_corres])
apply simp
apply (rule_tac F="\<exists>p asid. rv = Structures_A.ArchObjectCap (ARM_A.PageDirectoryCap p asid)" in corres_gen_asm)
apply clarsimp
apply (rule_tac Q="valid_objs and pspace_aligned and pspace_distinct and asid_pool_at word2 and valid_etcbs and
@ -2487,7 +2502,6 @@ lemma performASIDPoolInvocation_corres:
apply (erule cte_wp_at_weakenE)
apply (clarsimp simp: is_cap_simps cap_master_cap_simps dest!: cap_master_cap_eqDs)
apply (wp getASID_wp)
apply (rule refl)
apply (wp get_cap_wp getCTE_wp)+
apply (clarsimp simp: valid_apinv_def cte_wp_at_def cap_master_cap_def is_pd_cap_def obj_at_def)
apply (clarsimp simp: a_type_def)

8
proof/refine/Move_R.thy
View File

@ -118,12 +118,12 @@ lemma corres_symb_exec_l':
assumes y: "\<lbrace>Q\<rbrace> m \<lbrace>Q'\<rbrace>"
shows "corres_underlying sr nf nf' r (P and Q) P' (m >>= (\<lambda>rv. x rv)) y"
apply (rule corres_guard_imp)
apply (subst gets_bind_ign[symmetric], rule corres_split_deprecated)
apply (rule z)
apply (subst gets_bind_ign[symmetric], rule corres_split)
apply (rule corres_noop3)
apply (erule x)
apply (rule gets_wp)
apply (rule non_fail_gets)
apply (rule z)
apply (rule y)
apply (rule gets_wp)
apply simp+
@ -136,8 +136,7 @@ lemma corres_symb_exec_r':
assumes nf: "nf' \<Longrightarrow> no_fail R' m"
shows "corres_underlying sr nf nf' r P (P' and Q' and R') x (m >>= (\<lambda>rv. y rv))"
apply (rule corres_guard_imp)
apply (subst gets_bind_ign[symmetric], rule corres_split_deprecated)
apply (rule z)
apply (subst gets_bind_ign[symmetric], rule corres_split)
apply (rule_tac P'="a' and a''" for a' a'' in corres_noop3)
apply (simp add: simpler_gets_def exs_valid_def)
apply clarsimp
@ -146,6 +145,7 @@ lemma corres_symb_exec_r':
apply (erule nf)
apply clarsimp
apply assumption
apply (rule z)
apply (rule gets_wp)
apply (rule y)
apply simp+