arch_split: CRefine checking up to Recycle_C
This commit is contained in:
parent
04803bdf61
commit
b75fa2d4e2
|
@ -2224,7 +2224,9 @@ definition
|
|||
irq_opt_relation_def:
|
||||
"irq_opt_relation (airq :: (10 word) option) (cirq :: word16) \<equiv>
|
||||
case airq of
|
||||
Some irq \<Rightarrow> (cirq = ucast irq \<and> irq \<noteq> scast irqInvalid \<and> ucast irq \<le> (scast maxIRQ :: word16))
|
||||
Some irq \<Rightarrow> (cirq = ucast irq \<and>
|
||||
irq \<noteq> scast irqInvalid \<and>
|
||||
ucast irq \<le> (scast Kernel_C.maxIRQ :: word16))
|
||||
| None \<Rightarrow> cirq = scast irqInvalid"
|
||||
|
||||
|
||||
|
@ -2233,7 +2235,7 @@ declare unat_ucast_up_simp[simp]
|
|||
|
||||
lemma setIRQState_ccorres:
|
||||
"ccorres dc xfdc
|
||||
(\<top> and (\<lambda>s. ucast irq \<le> (scast maxIRQ :: word16)))
|
||||
(\<top> and (\<lambda>s. ucast irq \<le> (scast Kernel_C.maxIRQ :: word16)))
|
||||
(UNIV \<inter> {s. irqState_' s = irqstate_to_C irqState}
|
||||
\<inter> {s. irq_' s = (ucast irq :: word16)} )
|
||||
[]
|
||||
|
@ -2260,7 +2262,7 @@ show ?thesis
|
|||
apply (clarsimp simp: simpler_modify_def)
|
||||
apply (clarsimp simp: rf_sr_def cstate_relation_def Let_def
|
||||
carch_state_relation_def cmachine_state_relation_def)
|
||||
apply (simp add: cinterrupt_relation_def maxIRQ_def)
|
||||
apply (simp add: cinterrupt_relation_def Kernel_C.maxIRQ_def)
|
||||
apply (clarsimp simp: word_sless_msb_less order_le_less_trans
|
||||
unat_ucast_no_overflow_le word_le_nat_alt ucast_ucast_b
|
||||
split: split_if )
|
||||
|
@ -2291,7 +2293,9 @@ qed
|
|||
|
||||
|
||||
lemma deletedIRQHandler_ccorres:
|
||||
"ccorres dc xfdc (\<lambda>s. ucast irq \<le> (scast maxIRQ :: 16 word)) (UNIV\<inter> {s. irq_' s = ucast irq}) []
|
||||
"ccorres dc xfdc
|
||||
(\<lambda>s. ucast irq \<le> (scast Kernel_C.maxIRQ :: 16 word))
|
||||
(UNIV\<inter> {s. irq_' s = ucast irq}) []
|
||||
(deletedIRQHandler irq)
|
||||
(Call deletedIRQHandler_'proc )"
|
||||
apply (cinit simp del: return_bind)
|
||||
|
|
|
@ -779,7 +779,7 @@ lemma finaliseSlot_ccorres:
|
|||
apply (rule ccorres_drop_cutMon,
|
||||
rule ccorres_split_throws)
|
||||
apply (rule_tac P="\<lambda>s. case (snd rvb) of None \<Rightarrow> True
|
||||
| Some v \<Rightarrow> ucast v \<le> maxIRQ"
|
||||
| Some v \<Rightarrow> ucast v \<le> Kernel_C.maxIRQ"
|
||||
in ccorres_from_vcg_throws[where P'=UNIV])
|
||||
apply (rule allI, rule conseqPre, vcg)
|
||||
apply (clarsimp simp: returnOk_def return_def
|
||||
|
@ -911,7 +911,7 @@ lemma finaliseSlot_ccorres:
|
|||
apply (clarsimp simp: capRemovable_def cte_wp_at_ctes_of
|
||||
split: option.split)
|
||||
apply (auto dest!: ctes_of_valid'
|
||||
simp: valid_cap'_def maxIRQ_def ARM.maxIRQ_def
|
||||
simp: valid_cap'_def Kernel_C.maxIRQ_def ARM.maxIRQ_def
|
||||
unat_ucast word_le_nat_alt)[1]
|
||||
apply (clarsimp dest!: isCapDs)
|
||||
subgoal by (auto dest!: valid_capAligned ctes_of_valid'
|
||||
|
|
|
@ -956,7 +956,9 @@ lemma offset_xf_for_sequence:
|
|||
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
crunch pde_mappings'[wp]: invalidateHWASIDEntry "valid_pde_mappings'"
|
||||
end
|
||||
|
||||
context kernel_m begin
|
||||
|
||||
|
@ -997,12 +999,14 @@ lemma invalidateASIDEntry_ccorres:
|
|||
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
crunch obj_at'[wp]: invalidateASIDEntry "obj_at' P p"
|
||||
crunch obj_at'[wp]: flushSpace "obj_at' P p"
|
||||
crunch valid_objs'[wp]: invalidateASIDEntry "valid_objs'"
|
||||
crunch valid_objs'[wp]: flushSpace "valid_objs'"
|
||||
crunch pde_mappings'[wp]: invalidateASIDEntry "valid_pde_mappings'"
|
||||
crunch pde_mappings'[wp]: flushSpace "valid_pde_mappings'"
|
||||
end
|
||||
|
||||
context kernel_m begin
|
||||
|
||||
|
@ -1809,7 +1813,7 @@ lemma deletingIRQHandler_ccorres:
|
|||
ghost_assertion_data_set_def)
|
||||
apply (simp add: cap_tag_defs)
|
||||
apply (clarsimp simp: cte_wp_at_ctes_of Collect_const_mem
|
||||
irq_opt_relation_def maxIRQ_def)
|
||||
irq_opt_relation_def Kernel_C.maxIRQ_def)
|
||||
apply (drule word_le_nat_alt[THEN iffD1])
|
||||
apply (clarsimp simp:uint_0_iff unat_gt_0 uint_up_ucast is_up unat_def[symmetric])
|
||||
done
|
||||
|
@ -2079,11 +2083,11 @@ lemma finaliseCap_ccorres:
|
|||
apply (frule(1) ccap_relation_IRQHandler_mask)
|
||||
apply (clarsimp simp: isCap_simps irqInvalid_def
|
||||
valid_cap'_def ARM.maxIRQ_def
|
||||
maxIRQ_def)
|
||||
Kernel_C.maxIRQ_def)
|
||||
apply (rule irq_opt_relation_Some_ucast', simp)
|
||||
apply (clarsimp simp: isCap_simps irqInvalid_def
|
||||
valid_cap'_def ARM.maxIRQ_def
|
||||
maxIRQ_def)
|
||||
Kernel_C.maxIRQ_def)
|
||||
apply fastforce
|
||||
apply clarsimp
|
||||
apply (frule cap_get_tag_to_H, erule(1) cap_get_tag_isCap [THEN iffD2])
|
||||
|
|
|
@ -294,7 +294,7 @@ lemma mask_of_mask[simp]:
|
|||
|
||||
lemma invokeIRQControl_ccorres:
|
||||
"ccorres (K (K \<bottom>) \<currency> dc) (liftxf errstate id (K ()) ret__unsigned_long_')
|
||||
(invs' and cte_at' parent and (\<lambda>_. (ucast irq) \<le> (scast maxIRQ :: word32)))
|
||||
(invs' and cte_at' parent and (\<lambda>_. (ucast irq) \<le> (scast Kernel_C.maxIRQ :: word32)))
|
||||
(UNIV \<inter> {s. irq_' s = ucast irq}
|
||||
\<inter> {s. controlSlot_' s = cte_Ptr parent}
|
||||
\<inter> {s. handlerSlot_' s = cte_Ptr slot}) []
|
||||
|
@ -337,11 +337,11 @@ lemma unat_ucast_16_32:
|
|||
|
||||
lemma isIRQActive_ccorres:
|
||||
"ccorres (\<lambda>rv rv'. rv' = from_bool rv) ret__unsigned_long_'
|
||||
(\<lambda>s. irq \<le> scast maxIRQ) (UNIV \<inter> {s. irq_' s = ucast irq}) []
|
||||
(\<lambda>s. irq \<le> scast Kernel_C.maxIRQ) (UNIV \<inter> {s. irq_' s = ucast irq}) []
|
||||
(isIRQActive irq) (Call isIRQActive_'proc)"
|
||||
apply (cinit lift: irq_')
|
||||
apply (simp add: getIRQState_def getInterruptState_def)
|
||||
apply (rule_tac P="irq \<le> scast maxIRQ \<and> unat irq < (160::nat)" in ccorres_gen_asm)
|
||||
apply (rule_tac P="irq \<le> scast Kernel_C.maxIRQ \<and> unat irq < (160::nat)" in ccorres_gen_asm)
|
||||
apply (rule ccorres_from_vcg_throws[where P=\<top> and P'=UNIV])
|
||||
apply (rule allI, rule conseqPre, vcg)
|
||||
apply (clarsimp simp: simpler_gets_def word_sless_msb_less maxIRQ_def
|
||||
|
|
|
@ -473,6 +473,7 @@ lemma ignoreFailure_liftM:
|
|||
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
crunch pde_mappings'[wp]: invalidateTLBByASID "valid_pde_mappings'"
|
||||
crunch ksArchState[wp]: invalidateTLBByASID "\<lambda>s. P (ksArchState s)"
|
||||
|
||||
|
@ -480,6 +481,7 @@ crunch gsMaxObjectSize[wp]: invalidateTLBByASID "\<lambda>s. P (gsMaxObjectSize
|
|||
crunch gsMaxObjectSize[wp]: deleteASIDPool "\<lambda>s. P (gsMaxObjectSize s)"
|
||||
(ignore: setObject getObject wp: crunch_wps getObject_inv loadObject_default_inv
|
||||
simp: crunch_simps)
|
||||
end
|
||||
|
||||
context kernel_m begin
|
||||
|
||||
|
@ -526,8 +528,8 @@ lemma clearMemory_setObject_PTE_ccorres:
|
|||
and (\<lambda>s. 2 ^ ptBits \<le> gsMaxObjectSize s)
|
||||
and (\<lambda>_. is_aligned ptr ptBits \<and> ptr \<noteq> 0 \<and> pstart = addrFromPPtr ptr))
|
||||
(UNIV \<inter> {s. ptr___ptr_to_unsigned_long_' s = Ptr ptr} \<inter> {s. bits_' s = of_nat ptBits}) []
|
||||
(do x \<leftarrow> mapM_x (\<lambda>a. setObject a Hardware_H.pte.InvalidPTE)
|
||||
[ptr , ptr + 2 ^ objBits Hardware_H.pte.InvalidPTE .e. ptr + 2 ^ ptBits - 1];
|
||||
(do x \<leftarrow> mapM_x (\<lambda>a. setObject a ARM_H.InvalidPTE)
|
||||
[ptr , ptr + 2 ^ objBits ARM_H.InvalidPTE .e. ptr + 2 ^ ptBits - 1];
|
||||
doMachineOp (cleanCacheRange_PoU ptr (ptr + 2 ^ ptBits - 1) pstart)
|
||||
od)
|
||||
(Call clearMemory_'proc)"
|
||||
|
@ -1149,11 +1151,13 @@ lemma cpspace_relation_ep_update_ep2:
|
|||
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
lemma setObject_tcb_ep_obj_at'[wp]:
|
||||
"\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) ptr\<rbrace> setObject ptr' (tcb :: tcb) \<lbrace>\<lambda>rv. obj_at' P ptr\<rbrace>"
|
||||
apply (rule obj_at_setObject2, simp_all)
|
||||
apply (clarsimp simp: updateObject_default_def in_monad)
|
||||
done
|
||||
end
|
||||
|
||||
crunch ep_obj_at'[wp]: setThreadState "obj_at' (P :: endpoint \<Rightarrow> bool) ptr"
|
||||
(ignore: getObject setObject simp: unless_def)
|
||||
|
|
|
@ -4787,18 +4787,24 @@ lemma placeNewObject_pde:
|
|||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
|
||||
definition "placeNewObject_with_memset regionBase us \<equiv>
|
||||
(do x \<leftarrow> placeNewObject regionBase UserData us;
|
||||
doMachineOp (mapM_x (\<lambda>p::word32. storeWord p (0::word32))
|
||||
[regionBase , regionBase + (4::word32) .e. regionBase + (2::word32) ^ (pageBits + us) - (1::word32)])
|
||||
od)"
|
||||
end
|
||||
|
||||
context Arch begin global_naming ARM_H
|
||||
lemmas createObject_def = ARM_H.createObject_def
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
crunch gsMaxObjectSize[wp]: placeNewObject_with_memset, createObject "\<lambda>s. P (gsMaxObjectSize s)"
|
||||
(wp: crunch_wps simp: unless_def)
|
||||
|
||||
end
|
||||
|
||||
shadow_facts (in Arch) createObject_def
|
||||
|
||||
context kernel_m begin
|
||||
|
||||
lemma placeNewObject_user_data:
|
||||
|
@ -5021,7 +5027,7 @@ proof -
|
|||
apply (frule range_cover.aligned)
|
||||
apply (cut_tac t)
|
||||
apply (case_tac newType,
|
||||
simp_all add: toAPIType_def ArchTypes_H.toAPIType_def
|
||||
simp_all add: toAPIType_def ARM_H.toAPIType_def
|
||||
ARM_H.createObject_def createPageObject_def bind_assoc
|
||||
ARMLargePageBits_def)
|
||||
|
||||
|
@ -5500,7 +5506,7 @@ proof -
|
|||
region_actually_is_bytes
|
||||
region_actually_is_bytes_def)
|
||||
apply (clarsimp simp: object_type_from_H_def
|
||||
ArchTypes_H.toAPIType_def Kernel_C_defs toAPIType_def
|
||||
ARM_H.toAPIType_def Kernel_C_defs toAPIType_def
|
||||
nAPIObjects_def word_sle_def createObject_c_preconds_def
|
||||
word_le_nat_alt split:
|
||||
apiobject_type.splits object_type.splits)
|
||||
|
@ -5511,7 +5517,7 @@ proof -
|
|||
|
||||
(* Untyped *)
|
||||
apply (clarsimp simp: Kernel_C_defs object_type_from_H_def
|
||||
toAPIType_def ArchTypes_H.toAPIType_def nAPIObjects_def
|
||||
toAPIType_def ARM_H.toAPIType_def nAPIObjects_def
|
||||
word_sle_def intro!: Corres_UL_C.ccorres_cond_empty
|
||||
Corres_UL_C.ccorres_cond_univ ccorres_rhs_assoc)
|
||||
apply (rule_tac
|
||||
|
@ -5526,7 +5532,7 @@ proof -
|
|||
apply (rule conseqPre, vcg, clarsimp)
|
||||
apply simp
|
||||
apply (clarsimp simp: ccap_relation_def cap_to_H_def
|
||||
getObjectSize_def ArchTypes_H.getObjectSize_def
|
||||
getObjectSize_def ARM_H.getObjectSize_def
|
||||
apiGetObjectSize_def Collect_const_mem
|
||||
cap_untyped_cap_lift to_bool_def true_def
|
||||
aligned_add_aligned
|
||||
|
@ -5540,7 +5546,7 @@ proof -
|
|||
|
||||
(* TCB *)
|
||||
apply (clarsimp simp: Kernel_C_defs object_type_from_H_def
|
||||
toAPIType_def ArchTypes_H.toAPIType_def nAPIObjects_def
|
||||
toAPIType_def ARM_H.toAPIType_def nAPIObjects_def
|
||||
word_sle_def intro!: Corres_UL_C.ccorres_cond_empty
|
||||
Corres_UL_C.ccorres_cond_univ ccorres_rhs_assoc)
|
||||
apply (rule_tac
|
||||
|
@ -5576,7 +5582,7 @@ proof -
|
|||
apply (frule invs_queues)
|
||||
apply (frule invs_sym')
|
||||
apply (simp add: getObjectSize_def objBits_simps word_bits_conv
|
||||
ArchTypes_H.getObjectSize_def apiGetObjectSize_def
|
||||
ARM_H.getObjectSize_def apiGetObjectSize_def
|
||||
tcbBlockSizeBits_def new_cap_addrs_def projectKO_opt_tcb)
|
||||
apply (clarsimp simp: range_cover.aligned
|
||||
region_actually_is_bytes_def APIType_capBits_def)
|
||||
|
@ -5593,7 +5599,7 @@ proof -
|
|||
region_actually_is_bytes_dom_s[OF _ order_refl, THEN subsetD]
|
||||
intro!: range_cover_simpleI)[1]
|
||||
apply (clarsimp simp: ccap_relation_def cap_to_H_def
|
||||
getObjectSize_def ArchTypes_H.getObjectSize_def
|
||||
getObjectSize_def ARM_H.getObjectSize_def
|
||||
apiGetObjectSize_def Collect_const_mem
|
||||
cap_thread_cap_lift to_bool_def true_def
|
||||
aligned_add_aligned
|
||||
|
@ -5611,7 +5617,7 @@ proof -
|
|||
|
||||
(* Endpoint *)
|
||||
apply (clarsimp simp: Kernel_C_defs object_type_from_H_def
|
||||
toAPIType_def ArchTypes_H.toAPIType_def nAPIObjects_def
|
||||
toAPIType_def ARM_H.toAPIType_def nAPIObjects_def
|
||||
word_sle_def intro!: ccorres_cond_empty ccorres_cond_univ
|
||||
ccorres_rhs_assoc)
|
||||
apply (rule_tac
|
||||
|
@ -5633,7 +5639,7 @@ proof -
|
|||
apply (rule conseqPre, vcg, clarsimp)
|
||||
apply wp
|
||||
apply (clarsimp simp: ccap_relation_def cap_to_H_def
|
||||
getObjectSize_def ArchTypes_H.getObjectSize_def
|
||||
getObjectSize_def ARM_H.getObjectSize_def
|
||||
objBits_simps apiGetObjectSize_def epSizeBits_def
|
||||
Collect_const_mem cap_endpoint_cap_lift
|
||||
to_bool_def true_def
|
||||
|
@ -5644,17 +5650,17 @@ proof -
|
|||
apply (frule invs_queues)
|
||||
apply (frule invs_sym')
|
||||
apply (auto simp: getObjectSize_def objBits_simps
|
||||
ArchTypes_H.getObjectSize_def apiGetObjectSize_def
|
||||
ARM_H.getObjectSize_def apiGetObjectSize_def
|
||||
epSizeBits_def word_bits_conv
|
||||
elim!: is_aligned_no_wrap' intro!: range_cover_simpleI)[1]
|
||||
|
||||
(* Notification *)
|
||||
apply (clarsimp simp: createObject_c_preconds_def)
|
||||
apply (clarsimp simp: getObjectSize_def objBits_simps
|
||||
ArchTypes_H.getObjectSize_def apiGetObjectSize_def
|
||||
ARM_H.getObjectSize_def apiGetObjectSize_def
|
||||
epSizeBits_def word_bits_conv word_sle_def word_sless_def)
|
||||
apply (clarsimp simp: Kernel_C_defs object_type_from_H_def
|
||||
toAPIType_def ArchTypes_H.toAPIType_def nAPIObjects_def
|
||||
toAPIType_def ARM_H.toAPIType_def nAPIObjects_def
|
||||
word_sle_def intro!: ccorres_cond_empty ccorres_cond_univ
|
||||
ccorres_rhs_assoc)
|
||||
apply (rule_tac
|
||||
|
@ -5676,7 +5682,7 @@ proof -
|
|||
apply (rule conseqPre, vcg, clarsimp)
|
||||
apply wp
|
||||
apply (clarsimp simp: ccap_relation_def cap_to_H_def
|
||||
getObjectSize_def ArchTypes_H.getObjectSize_def
|
||||
getObjectSize_def ARM_H.getObjectSize_def
|
||||
apiGetObjectSize_def ntfnSizeBits_def objBits_simps
|
||||
Collect_const_mem cap_notification_cap_lift to_bool_def true_def
|
||||
dest!: range_cover.aligned split: option.splits)
|
||||
|
@ -5686,17 +5692,17 @@ proof -
|
|||
apply (frule invs_queues)
|
||||
apply (frule invs_sym')
|
||||
apply (auto simp: getObjectSize_def objBits_simps
|
||||
ArchTypes_H.getObjectSize_def apiGetObjectSize_def
|
||||
ARM_H.getObjectSize_def apiGetObjectSize_def
|
||||
ntfnSizeBits_def word_bits_conv
|
||||
elim!: is_aligned_no_wrap' intro!: range_cover_simpleI)[1]
|
||||
|
||||
(* CapTable *)
|
||||
apply (clarsimp simp: createObject_c_preconds_def)
|
||||
apply (clarsimp simp: getObjectSize_def objBits_simps
|
||||
ArchTypes_H.getObjectSize_def apiGetObjectSize_def
|
||||
ARM_H.getObjectSize_def apiGetObjectSize_def
|
||||
ntfnSizeBits_def word_bits_conv)
|
||||
apply (clarsimp simp: Kernel_C_defs object_type_from_H_def
|
||||
toAPIType_def ArchTypes_H.toAPIType_def nAPIObjects_def
|
||||
toAPIType_def ARM_H.toAPIType_def nAPIObjects_def
|
||||
word_sle_def word_sless_def zero_le_sint
|
||||
intro!: ccorres_cond_empty ccorres_cond_univ ccorres_rhs_assoc
|
||||
ccorres_move_c_guards ccorres_Guard_Seq)
|
||||
|
@ -5732,7 +5738,7 @@ proof -
|
|||
apply (frule invs_sym')
|
||||
apply (frule(1) ghost_assertion_size_logic_no_unat)
|
||||
apply (clarsimp simp: getObjectSize_def objBits_simps
|
||||
ArchTypes_H.getObjectSize_def apiGetObjectSize_def
|
||||
ARM_H.getObjectSize_def apiGetObjectSize_def
|
||||
cteSizeBits_def word_bits_conv add.commute createObject_c_preconds_def
|
||||
region_actually_is_bytes_def
|
||||
elim!: is_aligned_no_wrap'
|
||||
|
@ -5744,7 +5750,7 @@ proof -
|
|||
apply (frule range_cover.aligned)
|
||||
apply (clarsimp simp: ccap_relation_def cap_to_H_def
|
||||
cap_cnode_cap_lift to_bool_def true_def
|
||||
getObjectSize_def ArchTypes_H.getObjectSize_def
|
||||
getObjectSize_def ARM_H.getObjectSize_def
|
||||
apiGetObjectSize_def cteSizeBits_def
|
||||
objBits_simps field_simps is_aligned_power2
|
||||
addr_card_wb is_aligned_weaken[where y=2]
|
||||
|
@ -6648,7 +6654,7 @@ shows "\<lbrace>P\<rbrace>createObject ty ptr us \<lbrace>\<lambda>m s. capRange
|
|||
using assms
|
||||
apply (simp add:createObject_def)
|
||||
apply (case_tac "ty")
|
||||
apply (simp_all add:toAPIType_def ArchTypes_H.toAPIType_def)
|
||||
apply (simp_all add:toAPIType_def ARM_H.toAPIType_def)
|
||||
apply (rule hoare_pre)
|
||||
apply wpc
|
||||
apply wp
|
||||
|
@ -6926,7 +6932,7 @@ shows
|
|||
apply (rule createObject_untypedRange)
|
||||
apply (clarsimp | wp)+
|
||||
apply (clarsimp simp: blah toAPIType_def APIType_capBits_def
|
||||
ArchTypes_H.toAPIType_def split: object_type.splits)
|
||||
ARM_H.toAPIType_def split: object_type.splits)
|
||||
apply (clarsimp simp:shiftl_t2n field_simps)
|
||||
apply (drule word_eq_zeroI)
|
||||
apply (drule(1) range_cover_no_0[where p = "Suc n"])
|
||||
|
@ -7129,10 +7135,22 @@ lemma APIType_capBits_min:
|
|||
|
||||
end
|
||||
|
||||
(*FIXME: arch_split crunch bug *)
|
||||
context Arch begin global_naming ARM_H'
|
||||
lemmas createObject_def = ARM_H.createObject_def
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
crunch gsCNodes[wp]: insertNewCap, Arch_createNewCaps, threadSet,
|
||||
"Arch.createObject" "\<lambda>s. P (gsCNodes s)"
|
||||
(wp: crunch_wps setObject_ksPSpace_only
|
||||
simp: unless_def updateObject_default_def ignore: getObject setObject)
|
||||
end
|
||||
|
||||
(*FIXME: arch_split crunch bug *)
|
||||
shadow_facts (in Arch) createObject_def
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
|
||||
lemma createNewCaps_1_gsCNodes_p:
|
||||
"\<lbrace>\<lambda>s. P (gsCNodes s p) \<and> p \<noteq> ptr\<rbrace> createNewCaps newType ptr 1 n \<lbrace>\<lambda>rv s. P (gsCNodes s p)\<rbrace>"
|
||||
|
@ -7156,7 +7174,7 @@ lemma createObject_cnodes_have_size:
|
|||
apply (simp add: createObject_def)
|
||||
apply (rule hoare_pre)
|
||||
apply (wp mapM_x_wp' | wpc | simp add: createObjects_def)+
|
||||
apply (cases newType, simp_all add: toAPIType_def ArchTypes_H.toAPIType_def)
|
||||
apply (cases newType, simp_all add: toAPIType_def ARM_H.toAPIType_def)
|
||||
apply (clarsimp simp: APIType_capBits_def objBits_simps
|
||||
cnodes_retype_have_size_def cte_level_bits_def)
|
||||
done
|
||||
|
@ -7175,6 +7193,8 @@ lemma range_cover_not_in_neqD:
|
|||
apply simp
|
||||
done
|
||||
|
||||
end
|
||||
|
||||
context kernel_m begin
|
||||
|
||||
lemma createNewObjects_ccorres:
|
||||
|
|
|
@ -116,7 +116,7 @@ definition
|
|||
(armKSGlobalsFrame s = symbol_table ''armKSGlobalsFrame'')"
|
||||
|
||||
definition
|
||||
carch_state_relation :: "ARM_H.kernel_state \<Rightarrow> globals \<Rightarrow> bool"
|
||||
carch_state_relation :: "Arch.kernel_state \<Rightarrow> globals \<Rightarrow> bool"
|
||||
where
|
||||
"carch_state_relation astate cstate \<equiv>
|
||||
armKSNextASID_' cstate = armKSNextASID astate \<and>
|
||||
|
@ -596,7 +596,8 @@ definition
|
|||
where
|
||||
"cinterrupt_relation airqs cnode cirqs \<equiv>
|
||||
cnode = Ptr (intStateIRQNode airqs) \<and>
|
||||
(\<forall>irq \<le> (ucast maxIRQ). irqstate_to_C (intStateIRQTable airqs irq) = index cirqs (unat irq))"
|
||||
(\<forall>irq \<le> (ucast Kernel_C.maxIRQ).
|
||||
irqstate_to_C (intStateIRQTable airqs irq) = index cirqs (unat irq))"
|
||||
|
||||
definition
|
||||
cscheduler_action_relation :: "Structures_H.scheduler_action \<Rightarrow> tcb_C ptr \<Rightarrow> bool"
|
||||
|
|
|
@ -15,6 +15,12 @@ imports
|
|||
StoreWord_C DetWP
|
||||
begin
|
||||
|
||||
(*FIXME: arch_split: C kernel names hidden by Haskell names *)
|
||||
context kernel_m begin
|
||||
abbreviation "msgRegistersC \<equiv> kernel_all_substitute.msgRegisters"
|
||||
lemmas msgRegistersC_def = kernel_all_substitute.msgRegisters_def
|
||||
end
|
||||
|
||||
context begin interpretation Arch . (*FIXME: arch_split*)
|
||||
|
||||
declare word_neq_0_conv[simp del]
|
||||
|
@ -617,7 +623,7 @@ lemma no_fail_getMRs:
|
|||
|
||||
lemma msgRegisters_scast:
|
||||
"n < unat (scast n_msgRegisters :: word32) \<Longrightarrow>
|
||||
unat (scast (index msgRegisters n)::word32) = unat (index msgRegisters n)"
|
||||
unat (scast (index msgRegistersC n)::word32) = unat (index msgRegistersC n)"
|
||||
apply (simp add: msgRegisters_def fupdate_def update_def n_msgRegisters_def fcp_beta
|
||||
Kernel_C.R2_def Kernel_C.R3_def Kernel_C.R4_def Kernel_C.R5_def
|
||||
Kernel_C.R6_def Kernel_C.R7_def)
|
||||
|
@ -625,8 +631,8 @@ lemma msgRegisters_scast:
|
|||
|
||||
lemma msgRegisters_ccorres:
|
||||
"n < unat n_msgRegisters \<Longrightarrow>
|
||||
register_from_H (ARM_H.msgRegisters ! n) = (index msgRegisters n)"
|
||||
apply (simp add: msgRegisters_def msgRegisters_unfold fupdate_def)
|
||||
register_from_H (ARM_H.msgRegisters ! n) = (index msgRegistersC n)"
|
||||
apply (simp add: msgRegistersC_def msgRegisters_unfold fupdate_def)
|
||||
apply (simp add: Arrays.update_def n_msgRegisters_def fcp_beta nth_Cons' split: split_if)
|
||||
done
|
||||
|
||||
|
@ -1089,13 +1095,13 @@ lemma getMRs_length:
|
|||
done
|
||||
|
||||
lemma index_msgRegisters_less':
|
||||
"n < 4 \<Longrightarrow> index msgRegisters n < 0x12"
|
||||
by (simp add: msgRegisters_def fupdate_def Arrays.update_def
|
||||
"n < 4 \<Longrightarrow> index msgRegistersC n < 0x12"
|
||||
by (simp add: msgRegistersC_def fupdate_def Arrays.update_def
|
||||
fcp_beta "StrictC'_register_defs")
|
||||
|
||||
lemma index_msgRegisters_less:
|
||||
"n < 4 \<Longrightarrow> index msgRegisters n <s 0x12"
|
||||
"n < 4 \<Longrightarrow> index msgRegisters n < 0x12"
|
||||
"n < 4 \<Longrightarrow> index msgRegistersC n <s 0x12"
|
||||
"n < 4 \<Longrightarrow> index msgRegistersC n < 0x12"
|
||||
using index_msgRegisters_less'
|
||||
by (simp_all add: word_sless_msb_less)
|
||||
|
||||
|
@ -1282,3 +1288,5 @@ lemma ccorres_equals_throwError:
|
|||
by simp
|
||||
|
||||
end
|
||||
|
||||
end
|
||||
|
|
|
@ -1540,7 +1540,7 @@ lemma getIRQState_sp:
|
|||
lemma ccorres_pre_getIRQState:
|
||||
assumes cc: "\<And>rv. ccorres r xf (P rv) (P' rv) hs (f rv) c"
|
||||
shows "ccorres r xf
|
||||
(\<lambda>s. irq \<le> ucast maxIRQ \<and> P (intStateIRQTable (ksInterruptState s) irq) s)
|
||||
(\<lambda>s. irq \<le> ucast Kernel_C.maxIRQ \<and> P (intStateIRQTable (ksInterruptState s) irq) s)
|
||||
{s. \<forall>rv. index (intStateIRQTable_' (globals s)) (unat irq) = irqstate_to_C rv \<longrightarrow> s \<in> P' rv }
|
||||
hs (getIRQState irq >>= (\<lambda>rv. f rv)) c"
|
||||
apply (rule ccorres_guard_imp)
|
||||
|
|
Loading…
Reference in New Issue