(* * Copyright 2014, General Dynamics C4 Systems * * This software may be distributed and modified according to the terms of * the GNU General Public License version 2. Note that NO WARRANTY is provided. * See "LICENSE_GPLv2.txt" for details. * * @TAG(GD_GPL) *) theory PageTableDuplicates imports Syscall_R begin context begin interpretation Arch . (*FIXME: arch_split*) lemma set_ep_valid_duplicate' [wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ setEndpoint ep v \\rv s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:setEndpoint_def) apply (clarsimp simp: setObject_def split_def valid_def in_monad projectKOs pspace_aligned'_def ps_clear_upd' objBits_def[symmetric] lookupAround2_char1 split: if_split_asm) apply (frule pspace_storable_class.updateObject_type[where v = v,simplified]) apply (clarsimp simp:updateObject_default_def assert_def bind_def alignCheck_def in_monad when_def alignError_def magnitudeCheck_def assert_opt_def return_def fail_def split:if_splits option.splits) apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I) apply simp+ apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I) apply simp+ done lemma set_ntfn_valid_duplicate' [wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ setNotification ep v \\rv s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:setNotification_def) apply (clarsimp simp: setObject_def split_def valid_def in_monad projectKOs pspace_aligned'_def ps_clear_upd' objBits_def[symmetric] lookupAround2_char1 split: if_split_asm) apply (frule pspace_storable_class.updateObject_type[where v = v,simplified]) apply (clarsimp simp:updateObject_default_def assert_def bind_def alignCheck_def in_monad when_def alignError_def magnitudeCheck_def assert_opt_def return_def fail_def split:if_splits option.splits) apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I) apply simp+ apply (rule_tac ko = ba in valid_duplicates'_non_pd_pt_I) apply simp+ done lemma setCTE_valid_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ setCTE p cte \\rv s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:setCTE_def) apply (clarsimp simp: setObject_def split_def valid_def in_monad projectKOs pspace_aligned'_def ps_clear_upd' objBits_def[symmetric] lookupAround2_char1 split: if_split_asm) apply (frule pspace_storable_class.updateObject_type[where v = cte,simplified]) apply (clarsimp simp:ObjectInstances_H.updateObject_cte assert_def bind_def alignCheck_def in_monad when_def alignError_def magnitudeCheck_def assert_opt_def return_def fail_def typeError_def split:if_splits option.splits Structures_H.kernel_object.splits) apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],simp+)+ done crunch valid_duplicates' [wp]: cteInsert "(\s. vs_valid_duplicates' (ksPSpace s))" (wp: crunch_wps) crunch valid_duplicates'[wp]: setupReplyMaster "(\s. vs_valid_duplicates' (ksPSpace s))" (wp: crunch_wps simp: crunch_simps) lemma doMachineOp_ksPSpace_inv[wp]: "\\s. P (ksPSpace s)\ doMachineOp f \\ya s. P (ksPSpace s)\" by (simp add:doMachineOp_def split_def | wp)+ crunch valid_duplicates'[wp]: threadSet, setBoundNotification "\s. vs_valid_duplicates' (ksPSpace s)" (wp: setObject_ksInterrupt updateObject_default_inv) crunch valid_duplicates'[wp]: setExtraBadge "\s. vs_valid_duplicates' (ksPSpace s)" (wp: setObject_ksInterrupt asUser_inv updateObject_default_inv mapME_wp) lemma transferCapsToSlots_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ transferCapsToSlots ep buffer n caps slots mi \\rv s. vs_valid_duplicates' (ksPSpace s)\" by (rule transferCapsToSlots_pres1; wp) crunch valid_duplicates'[wp]: transferCaps "\s. vs_valid_duplicates' (ksPSpace s)" (simp: unless_def wp: setObject_ksInterrupt asUser_inv updateObject_default_inv mapME_wp) crunch valid_duplicates'[wp]: sendFaultIPC "\s. vs_valid_duplicates' (ksPSpace s)" (ignore: transferCapsToSlots wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' simp: zipWithM_x_mapM ball_conj_distrib) crunch valid_duplicates'[wp]: handleFault "\s. vs_valid_duplicates' (ksPSpace s)" (ignore: transferCapsToSlots wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' simp: zipWithM_x_mapM ball_conj_distrib) crunch valid_duplicates'[wp]: replyFromKernel "\s. vs_valid_duplicates' (ksPSpace s)" (ignore: transferCapsToSlots wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' simp: zipWithM_x_mapM ball_conj_distrib) crunch valid_duplicates'[wp]: insertNewCap "\s. vs_valid_duplicates' (ksPSpace s)" (ignore: transferCapsToSlots wp: crunch_wps hoare_vcg_const_Ball_lift get_rs_cte_at' simp: zipWithM_x_mapM ball_conj_distrib) lemma koTypeOf_pte: "koTypeOf ko = ArchT PTET \ \pte. ko = KOArch (KOPTE pte)" "archTypeOf ako = PTET \ \pte. ako = KOPTE pte" apply (case_tac ko; simp) apply (rename_tac arch_kernel_object) apply (case_tac arch_kernel_object; simp) apply (case_tac ako; simp) done lemma mapM_x_storePTE_updates: "\\s. (\x\ set xs. pte_at' x s) \ Q (\x. if (x \ set xs) then Some (KOArch (KOPTE pte)) else (ksPSpace s) x) \ mapM_x (swp storePTE pte) xs \\r s. Q (ksPSpace s)\" apply (induct xs) apply (simp add: mapM_x_Nil) apply (simp add: mapM_x_Cons) apply (rule hoare_seq_ext, assumption) apply (thin_tac "valid P f Q" for P f Q) apply (simp add: storePTE_def setObject_def) apply (wp | simp add:split_def updateObject_default_def)+ apply clarsimp apply (intro conjI ballI) apply (drule(1) bspec) apply (clarsimp simp:typ_at'_def ko_wp_at'_def objBits_simps archObjSize_def dest!:koTypeOf_pte split: Structures_H.kernel_object.split_asm) apply (simp add:ps_clear_def dom_fun_upd2[unfolded fun_upd_def]) apply (erule rsubst[where P=Q]) apply (rule ext, clarsimp) apply (case_tac "(fst (lookupAround2 aa (ksPSpace s)))") apply (clarsimp simp:lookupAround2_None1) apply (clarsimp simp:lookupAround2_known1) done lemma is_aligned_plus_bound: assumes al: "is_aligned p sz" assumes cmp: "sz \ lz" assumes b: "b \ (2::word32) ^ sz - 1" assumes bound : "p < 2 ^ lz" assumes sz: "sz < word_bits" shows "p + b < 2 ^ lz" proof - have lower:"p + b \ p + (2 ^ sz - 1)" apply (rule word_plus_mono_right[OF b]) apply (rule is_aligned_no_overflow'[OF al]) done show ?thesis using bound sz apply - apply (rule le_less_trans[OF lower]) apply (rule ccontr) apply (simp add:not_less) apply (drule neg_mask_mono_le[where n = sz]) apply (subst (asm) is_aligned_neg_mask_eq) apply (rule is_aligned_weaken[OF is_aligned_triv cmp]) apply (subst (asm) is_aligned_add_helper[THEN conjunct2,OF al]) apply (simp add:word_bits_def) apply simp done qed lemma page_table_at_set_list: "\page_table_at' ptr s;pspace_aligned' s;sz \ ptBits; p && ~~ mask ptBits = ptr; is_aligned p sz; 2 \ sz\ \ set [p , p + 4 .e. p + mask sz] = {x. pte_at' x s \ x && ~~ mask sz = p}" apply (clarsimp simp:page_table_at'_def ptBits_def pteBits_def) apply (rule set_eqI) apply (rule iffI) apply (subst (asm) upto_enum_step_subtract) apply (simp add:field_simps mask_def) apply (erule is_aligned_no_overflow) apply (clarsimp simp:set_upto_enum_step_4 image_def pageBits_def) apply (drule_tac x= "((p && mask 10) >> 2) + xb" in spec) apply (erule impE) apply (rule is_aligned_plus_bound[where lz = 8 and sz = "sz - 2" ,simplified]) apply (rule is_aligned_shiftr) apply (rule is_aligned_andI1) apply (subgoal_tac "sz - 2 + 2 = sz") apply simp apply simp apply (simp add:field_simps) apply (simp add:shiftr_mask2) apply (simp add:mask_def not_less word_bits_def) apply (rule shiftr_less_t2n[where m = 8,simplified]) apply (rule le_less_trans[OF _ mask_lt_2pn]) apply (simp add:word_and_le1) apply simp apply (simp add:word_bits_def) apply (simp add:word_shiftl_add_distrib) apply (subst (asm) shiftr_shiftl1) apply simp+ apply (subst (asm) is_aligned_neg_mask_eq[where n = 2]) apply (rule is_aligned_weaken) apply (erule is_aligned_andI1) apply simp apply (simp add:mask_out_sub_mask field_simps) apply (clarsimp simp:typ_at'_def mask_add_aligned ko_wp_at'_def dom_def) apply (rule less_mask_eq[symmetric]) apply (subst (asm) shiftr_mask2) apply simp apply (simp add:shiftl_less_t2n word_shiftl_add_distrib word_bits_def mask_def shiftr_mask2) apply (clarsimp simp:objBits_simps pageBits_def archObjSize_def split:Structures_H.kernel_object.splits arch_kernel_object.splits) apply (subst upto_enum_step_subtract) apply (rule is_aligned_no_wrap'[OF is_aligned_neg_mask]) apply (rule le_refl) apply (simp add:mask_lt_2pn word_bits_def) apply (simp add:image_def) apply (rule_tac x = "x && mask sz" in bexI) apply (simp add:mask_out_sub_mask) apply (simp add:set_upto_enum_step_4 image_def) apply (rule_tac x = "x && mask sz >> 2" in bexI) apply (subst shiftr_shiftl1) apply simp apply simp apply (subst is_aligned_neg_mask_eq) apply (rule is_aligned_andI1) apply (clarsimp simp: typ_at'_def ko_wp_at'_def dest!: koTypeOf_pte) apply (drule pspace_alignedD') apply simp apply (simp add:objBits_simps archObjSize_def pteBits_def) apply simp apply clarsimp apply (rule le_shiftr) apply (simp add:word_and_le1) done lemma page_directory_at_set_list: "\page_directory_at' ptr s;pspace_aligned' s;sz \ pdBits; p && ~~ mask pdBits = ptr; is_aligned p sz; 2 \ sz\ \ set [p , p + 4 .e. p + mask sz] = {x. pde_at' x s \ x && ~~ mask sz = p}" apply (clarsimp simp:page_directory_at'_def pdBits_def pdeBits_def) apply (rule set_eqI) apply (rule iffI) apply (subst (asm) upto_enum_step_subtract) apply (simp add:field_simps mask_def) apply (erule is_aligned_no_overflow) apply (clarsimp simp:set_upto_enum_step_4 image_def pageBits_def) apply (drule_tac x= "((p && mask 14) >> 2) + xb" in spec) apply (erule impE) apply (rule is_aligned_plus_bound[where lz = 12 and sz = "sz - 2" ,simplified]) apply (rule is_aligned_shiftr) apply (rule is_aligned_andI1) apply (subgoal_tac "sz - 2 + 2 = sz") apply simp apply simp apply (simp add:field_simps) apply (simp add:shiftr_mask2) apply (simp add:mask_def not_less word_bits_def) apply (rule shiftr_less_t2n[where m = 12,simplified]) apply (rule le_less_trans[OF _ mask_lt_2pn]) apply (simp add:word_and_le1) apply simp apply (simp add:word_bits_def) apply (simp add:word_shiftl_add_distrib) apply (subst (asm) shiftr_shiftl1) apply simp+ apply (subst (asm) is_aligned_neg_mask_eq[where n = 2]) apply (rule is_aligned_weaken) apply (erule is_aligned_andI1) apply simp apply (simp add:mask_out_sub_mask field_simps) apply (clarsimp simp:typ_at'_def mask_add_aligned ko_wp_at'_def dom_def) apply (rule less_mask_eq[symmetric]) apply (subst (asm) shiftr_mask2) apply simp apply (simp add:shiftl_less_t2n word_shiftl_add_distrib word_bits_def mask_def shiftr_mask2) apply (clarsimp simp:objBits_simps pageBits_def archObjSize_def split:Structures_H.kernel_object.splits arch_kernel_object.splits) apply (subst upto_enum_step_subtract) apply (rule is_aligned_no_wrap'[OF is_aligned_neg_mask]) apply (rule le_refl) apply (simp add:mask_lt_2pn word_bits_def) apply (simp add:image_def) apply (rule_tac x = "x && mask sz" in bexI) apply (simp add:mask_out_sub_mask) apply (simp add:set_upto_enum_step_4 image_def) apply (rule_tac x = "x && mask sz >> 2" in bexI) apply (subst shiftr_shiftl1) apply simp apply simp apply (subst is_aligned_neg_mask_eq) apply (rule is_aligned_andI1) apply (clarsimp simp: typ_at'_def ko_wp_at'_def dest!: koTypeOf_pde) apply (drule pspace_alignedD') apply simp apply (simp add:objBits_simps archObjSize_def pdeBits_def) apply simp apply clarsimp apply (rule le_shiftr) apply (simp add:word_and_le1) done lemma page_table_at_pte_atD': "\page_table_at' p s;is_aligned p' 2; p' && ~~ mask ptBits = p\ \ pte_at' p' s" apply (clarsimp simp:page_table_at'_def) apply (drule_tac x = "p' && mask ptBits >> 2" in spec) apply (erule impE) apply (rule shiftr_less_t2n[where m = 8,simplified]) apply (rule le_less_trans[OF word_and_le1]) apply (simp add:ptBits_def mask_def pageBits_def pteBits_def) apply (subst (asm) shiftr_shiftl1) apply simp apply simp apply (subst (asm) is_aligned_neg_mask_eq[where n = 2]) apply (simp add: is_aligned_andI1) apply (simp add:mask_out_sub_mask) done lemma mapM_x_storePTE_update_helper: "\\s. vs_valid_duplicates' (ksPSpace s) \ pspace_aligned' s \ page_table_at' ptr s \ word && ~~ mask ptBits = ptr \ sz \ ptBits \ 6 \ sz \ is_aligned word sz \ xs = [word , word + 4 .e. word + (mask sz)] \ mapM_x (swp storePTE pte) xs \\y s. vs_valid_duplicates' (ksPSpace s)\" apply (wp mapM_x_storePTE_updates) apply clarsimp apply (frule(2) page_table_at_set_list) apply simp+ apply (subst vs_valid_duplicates'_def) apply clarsimp apply (intro conjI impI) apply clarsimp apply (thin_tac "x = y" for x y) apply (simp add:mask_lower_twice) apply (subgoal_tac "x && ~~ mask sz = y && ~~ mask sz") apply (drule(1) page_table_at_pte_atD') apply (drule mask_out_first_mask_some[where m = ptBits]) apply (simp add:vs_ptr_align_def split:ARM_H.pte.splits) apply (simp add:mask_lower_twice vs_ptr_align_def split:ARM_H.pte.splits) apply (clarsimp simp:typ_at'_def ko_wp_at'_def) apply (clarsimp simp:vs_ptr_align_def split:arch_kernel_obj.splits Structures_H.kernel_object.splits split:ARM_H.pte.splits) apply (drule mask_out_first_mask_some[where m = sz]) apply simp apply (simp add:mask_lower_twice) apply clarsimp apply (intro conjI impI) apply (thin_tac "x = y" for x y) apply (clarsimp split:option.splits) apply (subgoal_tac "x && ~~ mask sz = y && ~~ mask sz") apply (drule_tac p' = x in page_table_at_pte_atD') apply (drule pspace_alignedD') apply simp apply (simp add:objBits_simps' archObjSize_def pteBits_def is_aligned_weaken[where y = 2] pageBits_def pdeBits_def split:kernel_object.splits arch_kernel_object.splits) apply (simp add:mask_lower_twice) apply (drule mask_out_first_mask_some[where m = ptBits]) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply (subst (asm) mask_lower_twice) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply simp apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits) apply (simp add:mask_lower_twice) apply (drule mask_out_first_mask_some[where m = sz]) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply (subst (asm) mask_lower_twice) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply simp apply (clarsimp split:option.splits) apply (drule_tac p' = y in valid_duplicates'_D) apply simp+ done lemma page_directory_at_pde_atD': "\page_directory_at' p s;is_aligned p' 2; p' && ~~ mask pdBits = p\ \ pde_at' p' s" apply (clarsimp simp:page_directory_at'_def) apply (drule_tac x = "p' && mask pdBits >> 2" in spec) apply (erule impE) apply (rule shiftr_less_t2n[where m = 12,simplified]) apply (rule le_less_trans[OF word_and_le1]) apply (simp add:pdBits_def mask_def pageBits_def pdeBits_def) apply (subst (asm) shiftr_shiftl1) apply simp apply simp apply (subst (asm) is_aligned_neg_mask_eq[where n = 2]) apply (simp add: is_aligned_andI1) apply (simp add:mask_out_sub_mask) done lemma mapM_x_storePDE_updates: "\\s. (\x\ set xs. pde_at' x s) \ Q (\x. if (x \ set xs) then Some (KOArch (KOPDE pte)) else (ksPSpace s) x) \ mapM_x (swp storePDE pte) xs \\r s. Q (ksPSpace s)\" apply (induct xs) apply (simp add: mapM_x_Nil) apply (simp add: mapM_x_Cons) apply (rule hoare_seq_ext, assumption) apply (thin_tac "valid P f Q" for P f Q) apply (simp add: storePDE_def setObject_def) apply (wp | simp add:split_def updateObject_default_def)+ apply clarsimp apply (intro conjI ballI) apply (drule(1) bspec) apply (clarsimp simp:typ_at'_def ko_wp_at'_def objBits_simps archObjSize_def dest!:koTypeOf_pde split: Structures_H.kernel_object.split_asm arch_kernel_object.split_asm if_split) apply (simp add:ps_clear_def dom_fun_upd2[unfolded fun_upd_def]) apply (erule rsubst[where P=Q]) apply (rule ext, clarsimp) apply (case_tac "(fst (lookupAround2 aa (ksPSpace s)))") apply (clarsimp simp:lookupAround2_None1) apply (clarsimp simp:lookupAround2_known1) done lemma mapM_x_storePDE_update_helper: "\\s. vs_valid_duplicates' (ksPSpace s) \ pspace_aligned' s \ page_directory_at' ptr s \ word && ~~ mask pdBits = ptr \ sz \ pdBits \ 6 \ sz \ is_aligned word sz \ xs = [word , word + 4 .e. word + (mask sz)] \ mapM_x (swp storePDE pte) xs \\y s. vs_valid_duplicates' (ksPSpace s)\" apply (wp mapM_x_storePDE_updates) apply clarsimp apply (frule(2) page_directory_at_set_list) apply simp+ apply (subst vs_valid_duplicates'_def) apply clarsimp apply (intro conjI impI) apply clarsimp apply (thin_tac "x = y" for x y) apply (simp add:mask_lower_twice) apply (subgoal_tac "y && ~~ mask sz = x && ~~ mask sz") apply (drule(1) page_directory_at_pde_atD') apply (drule mask_out_first_mask_some[where m = pdBits]) apply (simp add:vs_ptr_align_def split:ARM_H.pde.splits) apply (simp add:mask_lower_twice vs_ptr_align_def split:ARM_H.pde.splits) apply (clarsimp simp:typ_at'_def ko_wp_at'_def) apply (clarsimp simp:vs_ptr_align_def split:arch_kernel_obj.splits Structures_H.kernel_object.splits split:ARM_H.pde.splits) apply (drule mask_out_first_mask_some[where m = sz]) apply simp apply (simp add:mask_lower_twice) apply clarsimp apply (intro conjI impI) apply (thin_tac "x = y" for x y) apply (clarsimp split:option.splits) apply (subgoal_tac "x && ~~ mask sz = y && ~~ mask sz") apply (drule_tac p' = x in page_directory_at_pde_atD') apply (drule pspace_alignedD') apply simp apply (simp add:objBits_simps' archObjSize_def pteBits_def is_aligned_weaken[where y = 2] pageBits_def pdeBits_def split:kernel_object.splits arch_kernel_object.splits) apply (simp add:mask_lower_twice) apply (drule mask_out_first_mask_some[where m = pdBits]) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply (subst (asm) mask_lower_twice) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply simp apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pde.splits) apply (simp add:mask_lower_twice) apply (drule mask_out_first_mask_some[where m = sz]) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply (subst (asm) mask_lower_twice) apply (simp add:vs_ptr_align_def split:kernel_object.splits arch_kernel_object.splits ARM_H.pte.splits ARM_H.pde.splits) apply simp apply (clarsimp split:option.splits) apply (drule_tac p' = y in valid_duplicates'_D) apply simp+ done lemma vs_ptr_align_upbound: "vs_ptr_align a \ 6" by (simp add:vs_ptr_align_def split:Structures_H.kernel_object.splits arch_kernel_object.splits ARM_H.pde.splits ARM_H.pte.splits) lemma is_aligned_le_mask: "\is_aligned a n; a\b\ \ a \ b && ~~ mask n" apply (drule neg_mask_mono_le) apply (subst (asm) is_aligned_neg_mask_eq) apply simp+ done lemma global_pd_offset: "\is_aligned ptr pdBits ; x \ {ptr + (kernelBase >> 20 << 2)..ptr + 2 ^ pdBits - 1}\ \ ptr + (x && mask pdBits) = x" apply (rule mask_eqI[where n = pdBits]) apply (simp add:mask_add_aligned mask_twice pdBits_def pageBits_def) apply (subst mask_out_sub_mask) apply (simp add:mask_add_aligned mask_twice pdBits_def pageBits_def pdeBits_def) apply clarsimp apply (drule neg_mask_mono_le[where n = 14]) apply (drule neg_mask_mono_le[where n = 14]) apply (simp add:field_simps) apply (frule_tac d1 = "0x3FFF" and p1="ptr" in is_aligned_add_helper[THEN conjunct2]) apply simp apply (frule_tac d1 = "kernelBase >> 20 << 2" and p1 = "ptr" in is_aligned_add_helper[THEN conjunct2]) apply (simp add: ARM.kernelBase_def kernelBase_def) apply simp done lemma globalPDEWindow_neg_mask: "\x && ~~ mask (vs_ptr_align a) = y && ~~ mask (vs_ptr_align a);is_aligned ptr pdBits\ \ y \ {ptr + (kernelBase >> 20 << 2)..ptr + (2 ^ (pdBits) - 1)} \ x \ {ptr + (kernelBase >> 20 << 2)..ptr + (2 ^ (pdBits) - 1)}" apply (clarsimp simp:kernelBase_def ARM.kernelBase_def) apply (intro conjI) apply (rule_tac y = "y &&~~ mask (vs_ptr_align a)" in order_trans) apply (rule is_aligned_le_mask) apply (rule is_aligned_weaken[OF _ vs_ptr_align_upbound]) apply (erule aligned_add_aligned[OF is_aligned_weaken[OF _ le_refl]]) apply (simp add:is_aligned_def) apply (simp add:pdBits_def pageBits_def) apply simp apply (drule sym) apply (simp add:word_and_le2) apply (drule_tac x = y in neg_mask_mono_le[where n = pdBits]) apply (subst (asm) is_aligned_add_helper) apply simp apply (simp add:pdBits_def pageBits_def pdeBits_def) apply (rule order_trans[OF and_neg_mask_plus_mask_mono[where n = pdBits]]) apply (drule mask_out_first_mask_some[where m = pdBits]) apply (cut_tac a = a in vs_ptr_align_upbound) apply (simp add:pdBits_def pageBits_def) apply (cut_tac a = a in vs_ptr_align_upbound) apply (drule le_trans[where k = 14]) apply simp apply (simp add:and_not_mask_twice max_def pdBits_def pageBits_def pdeBits_def) apply (simp add:mask_def) apply (subst add.commute) apply (subst add.commute[where a = ptr]) apply (rule word_plus_mono_right) apply simp apply (rule olen_add_eqv[THEN iffD2]) apply (simp add:field_simps) apply (erule is_aligned_no_wrap') apply simp done lemma copyGlobalMappings_ksPSpace_stable: notes blah[simp del] = atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff assumes ptr_al: "is_aligned ptr pdBits" shows "\\s. ksPSpace s x = ko \ pspace_distinct' s \ pspace_aligned' s \ is_aligned (armKSGlobalPD (ksArchState s)) pdBits\ copyGlobalMappings ptr \\_ s. ksPSpace s x = (if x \ {ptr + (kernelBase >> 20 << 2)..ptr + (2 ^ pdBits - 1)} then ksPSpace s ((armKSGlobalPD (ksArchState s)) + (x && mask pdBits)) else ko)\" proof - have not_aligned_eq_None: "\x s. \\ is_aligned x 2; pspace_aligned' s\ \ ksPSpace s x = None" apply (rule ccontr) apply clarsimp apply (drule(1) pspace_alignedD') apply (drule is_aligned_weaken[where y = 2]) apply (case_tac y, simp_all add: objBits_simps' pageBits_def) apply (simp add: archObjSize_def pageBits_def pteBits_def pdeBits_def split: arch_kernel_object.splits) done have ptr_eqD: "\p a b. \p + a = ptr + b;is_aligned p pdBits; a < 2^ pdBits; b < 2^pdBits \ \ p = ptr" apply (drule arg_cong[where f = "\x. x && ~~ mask pdBits"]) apply (subst (asm) is_aligned_add_helper[THEN conjunct2]) apply simp apply simp apply (subst (asm) is_aligned_add_helper[THEN conjunct2]) apply (simp add:ptr_al) apply simp apply simp done have postfix_listD: "\a as. suffix (a # as) [kernelBase >> 20.e.2 ^ (pdBits - 2) - 1] \ a \ set [kernelBase >> 20 .e. 2 ^ (pdBits - 2) - 1]" apply (clarsimp simp:suffix_def) apply (subgoal_tac "a \ set (zs @ a # as)") apply (drule sym) apply simp apply simp done have in_rangeD: "\x. \kernelBase >> 20 \ x; x \ 2 ^ (pdBits - 2) - 1\ \ ptr + (x << 2) \ {ptr + (kernelBase >> 20 << 2)..ptr + (2 ^ pdBits - 1)}" apply (clarsimp simp:blah) apply (intro conjI) apply (rule word_plus_mono_right) apply (simp add:ARM.kernelBase_def kernelBase_def pdBits_def pageBits_def pdeBits_def) apply (word_bitwise,simp) apply (rule is_aligned_no_wrap'[OF ptr_al]) apply (simp add:pdBits_def pageBits_def pdeBits_def) apply (word_bitwise,simp) apply (rule word_plus_mono_right) apply (simp add:pdBits_def pageBits_def pdeBits_def) apply (word_bitwise,simp) apply (rule is_aligned_no_wrap'[OF ptr_al]) apply (simp add:pdBits_def pageBits_def pdeBits_def) done have offset_bound: "\x. \is_aligned ptr 14;ptr + (kernelBase >> 20 << 2) \ x; x \ ptr + 0x3FFF\ \ x - ptr < 0x4000" apply (clarsimp simp: ARM.kernelBase_def kernelBase_def field_simps) apply unat_arith done show ?thesis apply (case_tac "\ is_aligned x 2") apply (rule hoare_name_pre_state) apply (clarsimp) apply (rule_tac Q = "\r s. is_aligned (armKSGlobalPD (ksArchState s)) 2 \ pspace_aligned' s" in hoare_post_imp) apply (frule_tac x = x in not_aligned_eq_None) apply simp apply (frule_tac x = x and s = sa in not_aligned_eq_None) apply simp apply clarsimp apply (drule_tac x = "armKSGlobalPD (ksArchState sa) + (x && mask pdBits)" and s = sa in not_aligned_eq_None[rotated]) apply (subst is_aligned_mask) apply (simp add: mask_add_aligned mask_twice) apply (simp add:is_aligned_mask pdBits_def mask_def) apply simp apply (wp|simp)+ apply (erule is_aligned_weaken) apply (simp add:pdBits_def) apply (simp add: copyGlobalMappings_def) apply (rule hoare_name_pre_state) apply (rule hoare_conjI) apply (rule hoare_pre) apply (rule hoare_vcg_const_imp_lift) apply wp apply (rule_tac V="\xs s. \x \ (set [kernelBase >> 20.e.2 ^ (pdBits - 2) - 1] - set xs). ksPSpace s (ptr + (x << 2)) = ksPSpace s (globalPD + (x << 2))" and I="\s'. globalPD = (armKSGlobalPD (ksArchState s')) \ globalPD = (armKSGlobalPD (ksArchState s))" in mapM_x_inv_wp2) apply (cut_tac ptr_al) apply (clarsimp simp:blah pdBits_def pageBits_def pdeBits_def) apply (drule_tac x="x - ptr >> 2" in spec) apply (frule offset_bound) apply simp+ apply (erule impE) apply (rule conjI) apply (rule le_shiftr[where u="kernelBase >> 18" and n=2, simplified shiftr_shiftr, simplified]) apply (rule word_le_minus_mono_left[where x=ptr and y="(kernelBase >> 18) + ptr", simplified]) apply (simp add: ARM.kernelBase_def kernelBase_def field_simps) apply (simp add:field_simps) apply (erule is_aligned_no_wrap') apply (simp add: ARM.kernelBase_def kernelBase_def pdBits_def pageBits_def) apply (drule le_m1_iff_lt[THEN iffD1,THEN iffD2,rotated]) apply simp apply (drule le_shiftr[where u = "x - ptr" and n = 2]) apply simp apply (cut_tac b = 2 and c = 2 and a = "x - ptr" in shiftr_shiftl1) apply simp apply simp apply (cut_tac n = 2 and p = "x - ptr" in is_aligned_neg_mask_eq) apply (erule aligned_sub_aligned) apply (erule is_aligned_weaken,simp) apply simp apply simp apply (drule_tac t = x in global_pd_offset[symmetric,unfolded pdBits_def pageBits_def pdeBits_def,simplified]) apply (clarsimp simp:blah field_simps) apply (subgoal_tac "x && mask 14 = x - ptr") apply clarsimp apply (simp add:field_simps) apply (wp hoare_vcg_all_lift getPDE_wp mapM_x_wp' | simp add: storePDE_def setObject_def split_def updateObject_default_def split: option.splits)+ apply (clarsimp simp:objBits_simps archObjSize_def) apply (clarsimp simp:obj_at'_def objBits_simps projectKO_def projectKO_opt_pde fail_def return_def split: Structures_H.kernel_object.splits arch_kernel_object.splits) apply (drule_tac x = xa in bspec) apply simp apply (rule ccontr) apply (simp add: pdeBits_def) apply clarsimp apply (drule(1) ptr_eqD) apply (rule shiftl_less_t2n) apply (simp add:pdBits_def pageBits_def ) apply (rule le_m1_iff_lt[THEN iffD1,THEN iffD1]) apply (simp add: pdeBits_def) apply (simp add: pdeBits_def) apply (simp add:pdBits_def pageBits_def pdeBits_def) apply (simp add: pdeBits_def) apply (rule shiftl_less_t2n) apply (drule postfix_listD) apply (clarsimp simp:pdBits_def pdeBits_def le_less_trans) apply (simp add:pdBits_def pageBits_def pdeBits_def) apply simp apply wp apply (clarsimp simp:objBits_simps archObjSize_def pdeBits_def) apply (rule hoare_name_pre_state) apply (rule hoare_pre) apply (rule hoare_vcg_const_imp_lift) apply wp apply (rule_tac Q = "\r s'. ksPSpace s' x = ksPSpace s x \ globalPD = armKSGlobalPD (ksArchState s)" in hoare_post_imp) apply (wp hoare_vcg_all_lift getPDE_wp mapM_x_wp' | simp add: storePDE_def setObject_def split_def updateObject_default_def split: option.splits)+ apply (clarsimp simp:objBits_simps archObjSize_def pdeBits_def dest!:in_rangeD) apply wp apply simp done qed lemma copyGlobalMappings_ksPSpace_same: notes blah[simp del] = atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff shows "\is_aligned ptr pdBits\ \ \\s. ksPSpace s x = ko \ pspace_distinct' s \ pspace_aligned' s \ is_aligned (armKSGlobalPD (ksArchState s)) pdBits \ ptr = armKSGlobalPD (ksArchState s)\ copyGlobalMappings ptr \\_ s. ksPSpace s x = ko\" apply (simp add:copyGlobalMappings_def) apply (rule hoare_name_pre_state) apply clarsimp apply (rule hoare_pre) apply wp apply (rule_tac Q = "\r s'. ksPSpace s' x = ksPSpace s x \ globalPD = armKSGlobalPD (ksArchState s)" in hoare_post_imp) apply simp apply (wp hoare_vcg_all_lift getPDE_wp mapM_x_wp' | simp add: storePDE_def setObject_def split_def updateObject_default_def split: option.splits)+ apply (clarsimp simp:objBits_simps archObjSize_def) apply (clarsimp simp:obj_at'_def objBits_simps projectKO_def projectKO_opt_pde fail_def return_def split: Structures_H.kernel_object.splits arch_kernel_object.splits) apply wp apply simp done lemmas copyGlobalMappings_ksPSpaceD = use_valid[OF _ copyGlobalMappings_ksPSpace_stable] lemmas copyGlobalMappings_ksPSpace_sameD = use_valid[OF _ copyGlobalMappings_ksPSpace_same] lemma copyGlobalMappings_ksPSpace_concrete: notes blah[simp del] = atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff assumes monad: "(r, s') \ fst (copyGlobalMappings ptr s)" and ps: "pspace_distinct' s" "pspace_aligned' s" and al: "is_aligned (armKSGlobalPD (ksArchState s)) pdBits" "is_aligned ptr pdBits" shows "ksPSpace s' = (\x. (if x \ {ptr + (kernelBase >> 20 << 2)..ptr + (2 ^ pdBits - 1)} then ksPSpace s ((x && mask pdBits) + armKSGlobalPD (ksArchState s)) else ksPSpace s x))" proof - have pd: "\pd. \\s. armKSGlobalPD (ksArchState s) = pd \ copyGlobalMappings ptr \\r s. armKSGlobalPD (ksArchState s) = pd \" by wp have comp: "\x. x \ {ptr + (kernelBase >> 20 << 2)..ptr + 2 ^ pdBits - 1} \ ptr + (x && mask pdBits) = x" using al apply - apply (rule mask_eqI[where n = pdBits]) apply (simp add:mask_add_aligned mask_twice pdBits_def pageBits_def) apply (subst mask_out_sub_mask) apply (simp add:mask_add_aligned mask_twice pdBits_def pageBits_def) apply (clarsimp simp:blah) apply (drule neg_mask_mono_le[where n = 14]) apply (drule neg_mask_mono_le[where n = 14]) apply (simp add:field_simps pdeBits_def) apply (frule_tac d1 = "0x3FFF" and p1="ptr" in is_aligned_add_helper[THEN conjunct2]) apply simp apply (frule_tac d1 = "kernelBase >> 20 << 2" and p1 = "ptr" in is_aligned_add_helper[THEN conjunct2]) apply (simp add:ARM.kernelBase_def kernelBase_def) apply simp done show ?thesis using ps al monad apply - apply (rule ext) apply (frule_tac x = x in copyGlobalMappings_ksPSpaceD) apply simp+ apply (clarsimp split:if_splits) apply (frule_tac x = "(armKSGlobalPD (ksArchState s') + (x && mask pdBits))" in copyGlobalMappings_ksPSpaceD) apply simp+ apply (drule use_valid[OF _ pd]) apply simp apply (clarsimp split: if_splits simp: field_simps) apply (clarsimp simp: mask_add_aligned) apply (frule comp) apply (clarsimp simp:pdBits_def pageBits_def mask_twice blah) apply (drule_tac y = "armKSGlobalPD a + b" for a b in neg_mask_mono_le[where n = 14]) apply (drule_tac x = "armKSGlobalPD a + b" for a b in neg_mask_mono_le[where n = 14]) apply (frule_tac d1 = "x && mask 14" in is_aligned_add_helper[THEN conjunct2]) apply (simp add:mask_def pdeBits_def) apply (rule le_less_trans[OF word_and_le1]) apply simp apply (frule_tac d1 = "kernelBase >> 20 << 2" in is_aligned_add_helper[THEN conjunct2]) apply (simp add:ARM.kernelBase_def kernelBase_def) apply (simp add:field_simps pdeBits_def) apply (frule_tac d1 = "0x3FFF" and p1="ptr" in is_aligned_add_helper[THEN conjunct2]) apply (simp add: pdeBits_def) apply (frule_tac d1 = "kernelBase >> 20 << 2" and p1 = "ptr" in is_aligned_add_helper[THEN conjunct2]) apply (simp add:ARM.kernelBase_def kernelBase_def pdeBits_def) apply (simp add: pdeBits_def) apply (cut_tac copyGlobalMappings_ksPSpace_sameD) apply simp apply (rule monad) apply (simp add:al) apply (simp add:al add.commute) done qed lemma copyGlobalMappings_valid_duplicates': notes blah[simp del] = atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff shows "\(\s. vs_valid_duplicates' (ksPSpace s)) and pspace_distinct' and pspace_aligned' and (\s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits) and K (is_aligned ptr pdBits)\ copyGlobalMappings ptr \\y s. vs_valid_duplicates' (ksPSpace s)\" proof - have neg_mask_simp: "\x ptr' ptr a. \is_aligned ptr pdBits\ \ x + ptr && ~~ mask (vs_ptr_align a) = (x && ~~ mask (vs_ptr_align a)) + ptr" apply (cut_tac a = a in vs_ptr_align_upbound) apply (subst add.commute) apply (subst mask_out_add_aligned[symmetric]) apply (erule is_aligned_weaken) apply (simp add: pdBits_def pageBits_def)+ done have eq_trans: "\a b c d f. (c = d) \ (a = f c) \ (b = f d) \ (a = b)" by auto have mask_sub_mask:"\m n x. ((x::word32) && mask n) && ~~ mask m = (x && ~~ mask m ) && mask n" by (rule word_eqI, auto) show ?thesis apply (clarsimp simp:valid_def) apply (subst vs_valid_duplicates'_def) apply (clarsimp split:option.splits) apply (drule copyGlobalMappings_ksPSpace_concrete) apply simp+ apply (intro conjI) apply clarsimp apply (frule_tac ptr = ptr in globalPDEWindow_neg_mask) apply simp apply simp apply (clarsimp split:if_splits) apply (drule_tac p' = "((y && mask pdBits) + armKSGlobalPD (ksArchState s))" in valid_duplicates'_D[rotated]) apply (erule aligned_add_aligned[OF is_aligned_andI1]) apply (erule is_aligned_weaken[where y = 2]) apply (simp add:pdBits_def) apply simp apply (frule_tac x = "x && mask pdBits" and a = x2 and ptr = "armKSGlobalPD (ksArchState s)" in neg_mask_simp) apply (drule_tac x = "y && mask pdBits" and a = x2 and ptr = "armKSGlobalPD (ksArchState s)" in neg_mask_simp) apply (simp add:mask_sub_mask) apply simp apply simp apply (clarsimp split:if_splits) apply (drule_tac ptr = ptr in globalPDEWindow_neg_mask[OF sym]) apply simp apply simp apply simp apply (drule_tac p' = y in valid_duplicates'_D[rotated]) apply simp+ done qed lemma foldr_data_map_insert[simp]: "foldr (\addr map a. if a = addr then Some b else map a) = foldr (\addr. data_map_insert addr b)" apply (rule ext)+ apply (simp add:data_map_insert_def[abs_def] fun_upd_def) done lemma new_cap_addrs_same_align_pdpt_bits: assumes inset: "p\set (new_cap_addrs (2 ^ us) ptr ko)" and lowbound: "vs_entry_align ko \ us" and pdpt_align:"p && ~~ mask (vs_ptr_align ko) = p' && ~~ mask (vs_ptr_align ko)" shows "\is_aligned ptr (objBitsKO ko + us); us < 30;is_aligned p' 2\ \ p' \ set (new_cap_addrs (2 ^ us) ptr ko)" apply (subgoal_tac "\x. \is_aligned ptr (Suc (Suc us)); us < 30; is_aligned p' 2; 4 \ us; ptr + (of_nat x << 2) && ~~ mask 6 = p' && ~~ mask 6; x < 2 ^ us\ \ \x\{0..<2 ^ us}. p' = ptr + (of_nat x << 2)") prefer 2 using lowbound inset apply - apply (drule mask_out_first_mask_some[where m = "us + 2"]) apply (simp add:mask_lower_twice)+ apply (subst (asm) is_aligned_add_helper[THEN conjunct2]) apply simp apply (rule shiftl_less_t2n) apply (simp add:of_nat_power) apply simp apply (rule_tac x= "unat (p' && mask (Suc (Suc us)) >> 2) " in bexI) apply simp apply (subst shiftr_shiftl1) apply simp+ apply (subst is_aligned_neg_mask_eq[where n = 2]) apply (erule is_aligned_andI1) apply (simp add:mask_out_sub_mask) apply simp apply (rule unat_less_power) apply (simp add:word_bits_def) apply (rule shiftr_less_t2n) apply (rule le_less_trans[OF word_and_le1]) apply (rule less_le_trans[OF mask_lt_2pn]) apply simp apply simp using pdpt_align apply (clarsimp simp: image_def vs_entry_align_def vs_ptr_align_def new_cap_addrs_def objBits_simps archObjSize_def pdeBits_def pteBits_def split:ARM_H.pde.splits ARM_H.pte.splits arch_kernel_object.splits Structures_H.kernel_object.splits) done lemma valid_duplicates'_insert_ko: "\ vs_valid_duplicates' m; is_aligned ptr (objBitsKO ko + us); vs_entry_align ko \ us; objBitsKO ko + us < 32; \x\ set (new_cap_addrs (2^us) ptr ko). m x = None \ \ vs_valid_duplicates' (foldr (\addr. data_map_insert addr ko) (new_cap_addrs (2^us) ptr ko) m)" apply (subst vs_valid_duplicates'_def) apply (clarsimp simp: vs_entry_align_def foldr_upd_app_if[folded data_map_insert_def]) apply (clarsimp split:option.splits simp:foldr_upd_app_if[unfolded data_map_insert_def[symmetric]]) apply (rule conjI) apply clarsimp apply (case_tac ko, simp_all add:vs_ptr_align_def) apply (rename_tac arch_kernel_object) apply (case_tac arch_kernel_object, simp_all split: ARM_H.pte.splits) apply (drule(1) bspec)+ apply (drule_tac p' = y in new_cap_addrs_same_align_pdpt_bits) apply (simp add:vs_entry_align_def) apply (simp add:vs_ptr_align_def) apply (simp add:objBits_simps archObjSize_def pteBits_def)+ apply (clarsimp split: ARM_H.pde.splits simp:objBits_simps) apply (drule(1) bspec)+ apply (drule_tac p' = y in new_cap_addrs_same_align_pdpt_bits) apply (simp add:vs_entry_align_def) apply (simp add:vs_ptr_align_def) apply (simp add:objBits_simps archObjSize_def pdeBits_def)+ apply clarsimp apply (intro conjI impI allI) apply (drule(1) valid_duplicates'_D) apply fastforce apply (simp add:vs_ptr_align_def) apply simp apply (drule(2) valid_duplicates'_D) apply (clarsimp simp:vs_ptr_align_def split: Structures_H.kernel_object.splits ARM_H.pde.splits ARM_H.pte.splits arch_kernel_object.splits) apply simp done lemma none_in_new_cap_addrs: "\is_aligned ptr (objBitsKO obj + us); objBitsKO obj + us < word_bits; pspace_no_overlap' ptr (objBitsKO obj + us) s; pspace_aligned' s\ \ \x\set (new_cap_addrs (2^us) ptr obj). ksPSpace s x = None" apply (rule ccontr,clarsimp) apply (drule not_in_new_cap_addrs[rotated - 1]) apply simp+ done lemma valid_duplicates'_update: "\is_aligned ptr (APIType_capBits ty us);pspace_aligned' s; vs_valid_duplicates' (ksPSpace s); vs_entry_align ko = 0; pspace_no_overlap' ptr (APIType_capBits ty us) s\ \ vs_valid_duplicates' (\a. if a = ptr then Some ko else ksPSpace s a)" apply (subst vs_valid_duplicates'_def) apply clarsimp apply (intro conjI impI allI) apply (case_tac ko, simp_all add: vs_ptr_align_def vs_entry_align_def) apply (rename_tac arch_kernel_object) apply (case_tac arch_kernel_object, simp_all split: ARM_H.pde.splits ARM_H.pte.splits) apply (clarsimp split:option.splits) apply (drule(2) pspace_no_overlap_base') apply (drule(2) valid_duplicates'_D) apply simp apply (clarsimp split: option.splits)+ apply (drule valid_duplicates'_D) apply simp+ done lemma createObject_valid_duplicates'[wp]: "\(\s. vs_valid_duplicates' (ksPSpace s)) and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr (getObjectSize ty us) and (\s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits) and K (is_aligned ptr (getObjectSize ty us)) and K (ty = APIObjectType apiobject_type.CapTableObject \ us < 28)\ RetypeDecls_H.createObject ty ptr us d \\xa s. vs_valid_duplicates' (ksPSpace s)\" apply (rule hoare_gen_asm) apply (simp add:createObject_def) apply (rule hoare_pre) apply (wpc | wp| simp add: ARM_H.createObject_def split del: if_split)+ apply (simp add: placeNewObject_def placeNewDataObject_def placeNewObject'_def split_def split del: if_split | wp hoare_unless_wp[where P="d"] hoare_unless_wp[where Q=\] | wpc | simp add: alignError_def split del: if_split)+ apply (rule copyGlobalMappings_valid_duplicates') apply ((wp hoare_unless_wp[where P="d"] hoare_unless_wp[where Q=\] | wpc | simp add: alignError_def placeNewObject_def placeNewObject'_def split_def split del: if_split)+)[2] apply (intro conjI impI) apply clarsimp+ apply (erule(2) valid_duplicates'_update) apply (clarsimp simp: vs_entry_align_def)+ apply (erule(2) valid_duplicates'_update) apply (clarsimp simp: vs_entry_align_def)+ apply ((clarsimp simp: new_cap_addrs_fold'[where n = "0x10",simplified] | (erule valid_duplicates'_insert_ko[where us = 4,simplified] , (simp add: toAPIType_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def)+)[1] | rule none_in_new_cap_addrs[where us = 4,simplified,THEN bspec,rotated -1] | simp add: objBits_simps pageBits_def word_bits_conv)+)[1] apply ((clarsimp simp: new_cap_addrs_fold'[where n = "0x10",simplified] | (erule valid_duplicates'_insert_ko[where us = 4,simplified] , (simp add: toAPIType_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def)+)[1] | rule none_in_new_cap_addrs[where us = 4,simplified,THEN bspec,rotated -1] | simp add: objBits_simps pageBits_def word_bits_conv)+)[1] apply ((clarsimp simp: new_cap_addrs_fold'[where n = "0x100",simplified] | (erule valid_duplicates'_insert_ko[where us = 8,simplified] , (simp add: toAPIType_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def)+)[1] | rule none_in_new_cap_addrs[where us = 8,simplified,THEN bspec,rotated -1] | simp add: objBits_simps pageBits_def word_bits_conv)+)[1] apply (clarsimp simp: new_cap_addrs_fold'[where n = "0x100",simplified]) apply (erule valid_duplicates'_insert_ko[where us = 8,simplified]) apply (simp add: toAPIType_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def)+ apply (rule none_in_new_cap_addrs[where us =8,simplified] ,(simp add: objBits_simps pageBits_def word_bits_conv)+)[1] apply (clarsimp simp: new_cap_addrs_fold'[where n = "0x1000",simplified]) apply (erule valid_duplicates'_insert_ko[where us = 12,simplified]) apply (simp add: toAPIType_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def)+ apply (rule none_in_new_cap_addrs[where us =12,simplified] ,(simp add: objBits_simps pageBits_def word_bits_conv)+)[1] apply (clarsimp simp: new_cap_addrs_fold'[where n = "0x1000",simplified]) apply (erule valid_duplicates'_insert_ko[where us = 12,simplified]) apply (simp add: ARM_H.toAPIType_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def)+ apply (rule none_in_new_cap_addrs[where us =12,simplified] ,(simp add: objBits_simps pageBits_def word_bits_conv)+)[1] apply (clarsimp simp: objBits_simps ptBits_def archObjSize_def pageBits_def) apply (cut_tac ptr=ptr in new_cap_addrs_fold'[where n = "0x100" and ko = "(KOArch (KOPTE makeObject))" ,simplified objBits_simps]) apply simp apply (clarsimp simp: archObjSize_def) apply (erule valid_duplicates'_insert_ko[where us = 8,simplified]) apply (simp add: toAPIType_def archObjSize_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def pdeBits_def pteBits_def split: ARM_H.pte.splits)+ apply (rule none_in_new_cap_addrs[where us =8,simplified] ,(simp add: objBits_simps pageBits_def word_bits_conv archObjSize_def pteBits_def)+)[1] apply clarsimp apply (cut_tac ptr=ptr in new_cap_addrs_fold'[where n = "0x1000" and ko = "(KOArch (KOPDE makeObject))" ,simplified objBits_simps]) apply simp apply (clarsimp simp: objBits_simps archObjSize_def pdBits_def pageBits_def) apply (frule(2) retype_aligned_distinct'[where n = 4096 and ko = "KOArch (KOPDE makeObject)"]) apply (simp add:objBits_simps archObjSize_def) apply (rule range_cover_rel[OF range_cover_full]) apply simp apply (simp add:APIType_capBits_def word_bits_def pdeBits_def)+ apply (frule(2) retype_aligned_distinct'(2)[where n = 4096 and ko = "KOArch (KOPDE makeObject)"]) apply (simp add:objBits_simps archObjSize_def) apply (rule range_cover_rel[OF range_cover_full]) apply simp apply (simp add:APIType_capBits_def word_bits_def pdeBits_def)+ apply (subgoal_tac "vs_valid_duplicates' (foldr (\addr. data_map_insert addr (KOArch (KOPDE makeObject))) (map (\n. ptr + (n << 2)) [0.e.2 ^ (pdBits - 2) - 1]) (ksPSpace s))") apply (simp add:APIType_capBits_def pdBits_def pageBits_def pdeBits_def data_map_insert_def[abs_def]) apply (clarsimp simp: archObjSize_def pdBits_def pageBits_def pdeBits_def) apply (rule valid_duplicates'_insert_ko[where us = 12,simplified]) apply (simp add: ARM_H.toAPIType_def archObjSize_def vs_entry_align_def APIType_capBits_def objBits_simps pageBits_def pdeBits_def split: ARM_H.pde.splits)+ apply (rule none_in_new_cap_addrs[where us =12,simplified] ,(simp add: objBits_simps pageBits_def word_bits_conv archObjSize_def pdeBits_def)+)[1] apply (intro conjI impI allI) apply simp apply clarsimp apply (drule(2) valid_duplicates'_update) prefer 3 apply fastforce apply (simp add: vs_entry_align_def) apply simp apply clarsimp apply (drule(2) valid_duplicates'_update) prefer 3 apply (fastforce simp: vs_entry_align_def)+ apply clarsimp apply (drule(2) valid_duplicates'_update) prefer 3 apply (fastforce simp: vs_entry_align_def)+ apply (clarsimp simp:ARM_H.toAPIType_def word_bits_def split:ARM_H.object_type.splits) apply (cut_tac ptr = ptr in new_cap_addrs_fold'[where n = "2^us" and ko = "(KOCTE makeObject)",simplified]) apply (rule word_1_le_power) apply (clarsimp simp: word_bits_def) apply (drule_tac ptr = ptr and ko = "KOCTE makeObject" in valid_duplicates'_insert_ko[where us = us,simplified]) apply (simp add: APIType_capBits_def is_aligned_mask ARM_H.toAPIType_def ARM_H.toAPIType_def split: ARM_H.object_type.splits) apply (simp add: vs_entry_align_def) apply (simp add: objBits_simps') apply (rule none_in_new_cap_addrs ,(simp add: objBits_simps' pageBits_def APIType_capBits_def ARM_H.toAPIType_def word_bits_conv archObjSize_def is_aligned_mask split: ARM_H.object_type.splits)+)[1] apply (clarsimp simp: word_bits_def) done crunch arch_inv[wp]: createNewObjects "\s. P (armKSGlobalPD (ksArchState s))" (simp: crunch_simps zipWithM_x_mapM wp: crunch_wps hoare_unless_wp) lemma createNewObjects_valid_duplicates'[wp]: "\ (\s. vs_valid_duplicates' (ksPSpace s)) and pspace_no_overlap' ptr sz and pspace_aligned' and pspace_distinct' and (\s. is_aligned (armKSGlobalPD (ksArchState s)) pdBits) and K (range_cover ptr sz (Types_H.getObjectSize ty us) (length dest) \ ptr \ 0 \ (ty = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \ us < 28) ) \ createNewObjects ty src dest ptr us d \\reply s. vs_valid_duplicates' (ksPSpace s)\" proof (induct rule:rev_induct ) case Nil show ?case by (simp add:createNewObjects_def zipWithM_x_mapM mapM_Nil | wp)+ next case (snoc dest dests) show ?case apply (rule hoare_gen_asm) apply clarsimp apply (frule range_cover.weak) apply (subst createNewObjects_Cons) apply (simp add: word_bits_def) apply wp apply (wp snoc.hyps) apply (rule hoare_vcg_conj_lift) apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]]) apply clarsimp apply (rule hoare_vcg_conj_lift) apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]]) apply clarsimp apply (rule hoare_vcg_conj_lift) apply (rule hoare_post_imp[OF _ createNewObjects_pspace_no_overlap'[where sz = sz]]) apply (rule pspace_no_overlap'_le) apply fastforce apply (simp add: range_cover.sz[where 'a=32, folded word_bits_def])+ apply wp apply clarsimp apply (frule range_cover.aligned) apply (intro conjI aligned_add_aligned) apply (erule range_cover_le,simp) apply (rule is_aligned_shiftl_self) apply simp apply simp done qed lemma valid_duplicates'_diffI: defines "heap_diff m m' \ {(x::word32). (m x \ m' x)}" shows "\vs_valid_duplicates' m; vs_valid_duplicates' (\x. if x \ (heap_diff m m') then m' x else None); vs_valid_duplicates' (\x. if x \ (heap_diff m m') then None else m' x)\ \ vs_valid_duplicates' m'" apply (subst vs_valid_duplicates'_def) apply (clarsimp simp: heap_diff_def split: option.splits) apply (case_tac "m x = m' x") apply simp apply (case_tac "m y = m' y") apply (drule(2) valid_duplicates'_D) apply simp+ apply (drule(2) valid_duplicates'_D) apply (thin_tac "vs_valid_duplicates' m" for m) apply (drule_tac p = x and ko = "the (m' x)" in valid_duplicates'_D) apply (clarsimp split:if_splits) apply assumption apply (clarsimp split:if_splits)+ apply (case_tac "m y = m' y") apply clarsimp apply (thin_tac "vs_valid_duplicates' m" for m) apply (drule_tac p = x and ko = "the (m' x)" in valid_duplicates'_D) apply (clarsimp split:if_splits) apply assumption apply (simp split:if_splits)+ apply (thin_tac "vs_valid_duplicates' m" for m) apply (drule_tac p = x and ko = "the (m' x)" in valid_duplicates'_D) apply (clarsimp split:if_splits) apply assumption apply (clarsimp split:if_splits)+ done lemma valid_duplicates_deleteObjects_helper: assumes vd:"vs_valid_duplicates' (m::(word32 \ Structures_H.kernel_object))" assumes inc: "\p ko. \m p = Some (KOArch ko);p \ {ptr .. ptr + 2 ^ sz - 1}\ \ 6 \ sz" assumes aligned:"is_aligned ptr sz" notes blah[simp del] = atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff shows "vs_valid_duplicates' (\x. if x \ {ptr .. ptr + 2 ^ sz - 1} then None else m x)" apply (rule valid_duplicates'_diffI,rule vd) apply (clarsimp simp: vs_valid_duplicates'_def split:option.splits) apply (clarsimp simp: vs_valid_duplicates'_def split:option.splits) apply (case_tac "the (m x)",simp_all add:vs_ptr_align_def) apply fastforce+ apply (rename_tac arch_kernel_object) apply (case_tac arch_kernel_object) apply fastforce+ apply (clarsimp split:ARM_H.pte.splits) apply auto[1] apply (drule_tac p' = y in valid_duplicates'_D[OF vd]) apply (simp add:vs_ptr_align_def)+ apply clarsimp apply (drule(1) inc) apply (drule(1) mask_out_first_mask_some) apply (simp add:mask_lower_twice) apply (simp add: mask_in_range[OF aligned,symmetric]) apply (drule_tac p' = y in valid_duplicates'_D[OF vd]) apply simp apply (simp add:vs_ptr_align_def) apply simp apply (drule_tac p' = y in valid_duplicates'_D[OF vd]) apply simp apply (simp add:vs_ptr_align_def) apply simp apply (clarsimp split:ARM_H.pde.splits) apply auto[1] apply (drule_tac p' = y in valid_duplicates'_D[OF vd]) apply simp apply (simp add:vs_ptr_align_def) apply (drule(1) inc) apply (drule(1) mask_out_first_mask_some) apply (simp add:mask_lower_twice) apply (simp add: mask_in_range[OF aligned,symmetric]) apply (drule_tac p' = y in valid_duplicates'_D[OF vd]) apply simp apply (simp add:vs_ptr_align_def) apply simp apply (drule_tac p' = y in valid_duplicates'_D[OF vd]) apply simp apply (simp add:vs_ptr_align_def) apply simp done lemma deleteObjects_valid_duplicates'[wp]: notes blah[simp del] = atLeastatMost_subset_iff atLeastLessThan_iff Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex atLeastAtMost_iff shows "\(\s. vs_valid_duplicates' (ksPSpace s)) and K (is_aligned ptr sz) \ deleteObjects ptr sz \\r s. vs_valid_duplicates' (ksPSpace s)\" apply (rule hoare_gen_asm) apply (clarsimp simp:deleteObjects_def2) apply (wp hoare_drop_imps|simp)+ apply clarsimp apply (simp add:deletionIsSafe_def) apply (erule valid_duplicates_deleteObjects_helper) apply fastforce apply simp done crunch arch_inv[wp]: resetUntypedCap "\s. P (ksArchState s)" (simp: crunch_simps wp: hoare_drop_imps hoare_unless_wp mapME_x_inv_wp preemptionPoint_inv ignore: freeMemory) crunch valid_duplicates[wp]: updateFreeIndex "\s. vs_valid_duplicates' (ksPSpace s)" lemma resetUntypedCap_valid_duplicates'[wp]: "\(\s. vs_valid_duplicates' (ksPSpace s)) and valid_objs' and cte_wp_at' (isUntypedCap o cteCap) slot\ resetUntypedCap slot \\r s. vs_valid_duplicates' (ksPSpace s)\" (is "\?P\ ?f \\_. ?Q\") apply (clarsimp simp: resetUntypedCap_def) apply (rule hoare_pre) apply (wp | simp add: unless_def)+ apply (wp mapME_x_inv_wp preemptionPoint_inv | simp | wp (once) hoare_drop_imps)+ apply (wp getSlotCap_wp) apply (clarsimp simp: cte_wp_at_ctes_of split del: if_split) apply (frule cte_wp_at_valid_objs_valid_cap'[OF ctes_of_cte_wpD], clarsimp+) apply (clarsimp simp add: isCap_simps valid_cap_simps' capAligned_def) done lemma is_aligned_armKSGlobalPD: "valid_arch_state' s \ is_aligned (armKSGlobalPD (ksArchState s)) pdBits" by (clarsimp simp: valid_arch_state'_def page_directory_at'_def) lemma new_CapTable_bound: "range_cover (ptr :: obj_ref) sz (APIType_capBits tp us) n \ tp = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \ us < 28" apply (frule range_cover.sz) apply (drule range_cover.sz(2)) apply (clarsimp simp: APIType_capBits_def objBits_simps' word_bits_def) done lemma invokeUntyped_valid_duplicates[wp]: notes hoare_whenE_wps[wp_split del] shows "\invs' and (\s. vs_valid_duplicates' (ksPSpace s)) and valid_untyped_inv' ui and ct_active'\ invokeUntyped ui \\rv s. vs_valid_duplicates' (ksPSpace s) \" apply (simp only: invokeUntyped_def updateCap_def) apply (rule hoare_name_pre_state) apply (cases ui) apply (clarsimp simp only: pred_conj_def valid_untyped_inv_wcap' Invocations_H.untyped_invocation.simps) apply (frule(2) invokeUntyped_proofs.intro) apply (rule hoare_pre) apply simp apply (wp add: updateFreeIndex_pspace_no_overlap') apply (rule hoare_post_impErr) apply (rule combine_validE) apply (rule_tac ui=ui in whenE_reset_resetUntypedCap_invs_etc) apply (rule hoare_whenE_wp) apply (rule valid_validE) apply (rule resetUntypedCap_valid_duplicates') defer apply simp apply (clarsimp simp del: valid_untyped_inv_wcap'.simps split del: if_split) apply (rule conjI, assumption) apply (auto simp: cte_wp_at_ctes_of isCap_simps)[1] apply (clarsimp simp: cte_wp_at_ctes_of) apply (frule new_CapTable_bound) apply (frule invokeUntyped_proofs.not_0_ptr) apply (strengthen is_aligned_armKSGlobalPD) apply (frule cte_wp_at_valid_objs_valid_cap'[OF ctes_of_cte_wpD], clarsimp+) apply (clarsimp simp add: isCap_simps valid_cap_simps' capAligned_def) apply (auto split: if_split_asm) done crunch valid_duplicates'[wp]: doReplyTransfer "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps isFinalCapability_inv simp: crunch_simps unless_def) crunch valid_duplicates'[wp]: setVMRoot "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) crunch valid_duplicates'[wp]: invalidateASIDEntry "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) crunch valid_duplicates'[wp]: flushSpace "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) lemma get_asid_valid_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ getObject param_b \\(pool::asidpool) s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:getObject_def split_def| wp)+ apply (simp add:loadObject_default_def|wp)+ done lemma set_asid_pool_valid_duplicates'[wp]: "\\s. vs_valid_duplicates' (ksPSpace s)\ setObject a (pool::asidpool) \\r s. vs_valid_duplicates' (ksPSpace s)\" apply (clarsimp simp: setObject_def split_def valid_def in_monad projectKOs pspace_aligned'_def ps_clear_upd' objBits_def[symmetric] lookupAround2_char1 split: if_split_asm) apply (frule pspace_storable_class.updateObject_type[where v = pool,simplified]) apply (clarsimp simp:updateObject_default_def assert_def bind_def alignCheck_def in_monad when_def alignError_def magnitudeCheck_def assert_opt_def return_def fail_def typeError_def split:if_splits option.splits Structures_H.kernel_object.splits) apply (erule valid_duplicates'_non_pd_pt_I[rotated 3],clarsimp+)+ done crunch valid_duplicates'[wp]: suspend "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def o_def) crunch valid_duplicates'[wp]: deletingIRQHandler "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) lemma storePDE_no_duplicates': "\\s. vs_valid_duplicates' (ksPSpace s) \ ko_wp_at' (\ko. vs_entry_align ko = 0 ) ptr s \ vs_entry_align (KOArch (KOPDE pde)) = 0 \ storePDE ptr pde \\ya s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:storePDE_def setObject_def split_def | wp | wpc)+ apply (simp add:updateObject_default_def) apply wp+ apply clarsimp apply (subst vs_valid_duplicates'_def) apply clarsimp apply (intro conjI impI) apply (clarsimp simp:vs_ptr_align_def vs_entry_align_def split:option.splits ARM_H.pde.splits) apply clarsimp apply (intro conjI impI) apply (clarsimp split:option.splits) apply (drule_tac p = x in valid_duplicates'_D) apply simp apply simp apply simp apply (clarsimp simp:ko_wp_at'_def vs_entry_align_def vs_ptr_align_def split:if_splits option.splits arch_kernel_object.splits Structures_H.kernel_object.splits ARM_H.pde.splits ARM_H.pte.splits) apply (clarsimp split:option.splits) apply (drule_tac p = x and p' = y in valid_duplicates'_D) apply simp+ done lemma storePTE_no_duplicates': "\\s. vs_valid_duplicates' (ksPSpace s) \ ko_wp_at' (\ko. vs_entry_align ko = 0 ) ptr s \ vs_entry_align (KOArch (KOPTE pte)) = 0 \ storePTE ptr pte \\ya s. vs_valid_duplicates' (ksPSpace s)\" apply (simp add:storePTE_def setObject_def split_def | wp | wpc)+ apply (simp add:updateObject_default_def) apply wp+ apply clarsimp apply (subst vs_valid_duplicates'_def) apply clarsimp apply (intro conjI impI) apply (clarsimp simp:vs_entry_align_def vs_ptr_align_def split:option.splits ARM_H.pte.splits) apply clarsimp apply (intro conjI impI) apply (clarsimp split:option.splits) apply (drule_tac p = x in valid_duplicates'_D) apply simp apply simp apply simp apply (clarsimp simp:ko_wp_at'_def vs_ptr_align_def vs_entry_align_def split:if_splits option.splits arch_kernel_object.splits Structures_H.kernel_object.splits ARM_H.pde.splits ARM_H.pte.splits) apply (clarsimp split:option.splits) apply (drule_tac p = x and p' = y in valid_duplicates'_D) apply simp+ done crunch valid_duplicates'[wp]: lookupPTSlot "\s. valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) lemma checkMappingPPtr_SmallPage: "\\\ checkMappingPPtr word ARMSmallPage (Inl p) \\x s. ko_wp_at' (\ko. vs_entry_align ko = 0) p s\,-" apply (simp add:checkMappingPPtr_def) apply (wp unlessE_wp getPTE_wp |wpc|simp add:)+ apply (clarsimp simp:ko_wp_at'_def obj_at'_def) apply (clarsimp simp:projectKO_def projectKO_opt_pte return_def fail_def vs_entry_align_def split:kernel_object.splits arch_kernel_object.splits option.splits) done lemma checkMappingPPtr_Section: "\\\ checkMappingPPtr word ARMSection (Inr p) \\x s. ko_wp_at' (\ko. vs_entry_align ko = 0) p s\,-" apply (simp add:checkMappingPPtr_def) apply (wp unlessE_wp getPDE_wp |wpc|simp add:)+ apply (clarsimp simp:ko_wp_at'_def obj_at'_def) apply (clarsimp simp:projectKO_def projectKO_opt_pde return_def fail_def vs_entry_align_def split:kernel_object.splits arch_kernel_object.splits option.splits) done lemma mapM_x_mapM_valid: "\ P \ mapM_x f xs \\r. Q\ \ \P\mapM f xs \\r. Q\" apply (simp add:NonDetMonadLemmaBucket.mapM_x_mapM) apply (clarsimp simp:valid_def return_def bind_def) apply (drule spec) apply (erule impE) apply simp apply (drule(1) bspec) apply fastforce done crunch valid_duplicates'[wp]: flushPage "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) crunch valid_duplicates'[wp]: findPDForASID "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) lemma lookupPTSlot_aligned: "\\s. valid_objs' s \ vmsz_aligned' vptr sz \ sz \ ARMSuperSection\ lookupPTSlot pd vptr \\rv s. is_aligned rv ((pageBitsForSize sz) - 10)\,-" apply (simp add:lookupPTSlot_def) apply (wp|wpc|simp)+ apply (wp getPDE_wp) apply (clarsimp simp:obj_at'_def vmsz_aligned'_def) apply (clarsimp simp:projectKO_def fail_def projectKO_opt_pde return_def lookup_pt_slot_no_fail_def split:option.splits Structures_H.kernel_object.splits arch_kernel_object.splits) apply (erule(1) valid_objsE') apply (rule aligned_add_aligned) apply (simp add:valid_obj'_def) apply (erule is_aligned_ptrFromPAddr_n) apply (simp add:ptBits_def pageBits_def pteBits_def) apply (rule is_aligned_shiftl) apply (rule is_aligned_andI1) apply (rule is_aligned_shiftr) apply (case_tac sz,simp_all)[1] apply (simp add:ptBits_def word_bits_def pageBits_def) apply (case_tac sz,simp_all add:ptBits_def pageBits_def pteBits_def) done crunch valid_arch_state'[wp]: flushPage valid_arch_state' (wp: crunch_wps getHWASID_valid_arch' simp: crunch_simps unless_def) crunch valid_arch_state'[wp]: flushTable "\s. vs_valid_duplicates' (ksPSpace s)" (wp: crunch_wps simp: crunch_simps unless_def) lemma unmapPage_valid_duplicates'[wp]: notes checkMappingPPtr_inv[wp del] shows "\pspace_aligned' and valid_objs' and (\s. vs_valid_duplicates' (ksPSpace s)) and K (vmsz_aligned' vptr vmpage_size)\