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

arch_split: CRefine checking up to Recycle_C

This commit is contained in:
Matthew Brecknell 2016-05-03 14:01:20 +10:00
parent 04803bdf61
commit b75fa2d4e2
9 changed files with 89 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
proof/crefine/CSpace_C.thy
View File

@ -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)

4
proof/crefine/Delete_C.thy
View File

@ -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'

10
proof/crefine/Finalise_C.thy
View File

@ -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])

6
proof/crefine/Interrupt_C.thy
View File

@ -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

8
proof/crefine/Recycle_C.thy
View File

@ -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)

66
proof/crefine/Retype_C.thy
View File

@ -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:

5
proof/crefine/StateRelation_C.thy
View File

@ -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"

24
proof/crefine/SyscallArgs_C.thy
View File

@ -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,16 +623,16 @@ 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)
done
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

2
proof/crefine/Syscall_C.thy
View File

@ -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)