(*
 * Copyright 2014, General Dynamics C4 Systems
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory ArchCNodeInv_AI
imports CNodeInv_AI
begin

context Arch begin global_naming X64

named_theorems CNodeInv_AI_assms

lemma valid_cnode_capI:
  "\<lbrakk>cap_table_at n w s; valid_objs s; pspace_aligned s; n > 0; length g \<le> 64\<rbrakk>
   \<Longrightarrow> s \<turnstile> cap.CNodeCap w n g"
  apply (simp add: valid_cap_def cap_aligned_def)
  apply (rule conjI)
   apply (clarsimp simp add: pspace_aligned_def obj_at_def)
   apply (drule bspec, fastforce)
   apply (clarsimp simp: is_obj_defs wf_obj_bits)
  apply (clarsimp simp add: obj_at_def is_obj_defs valid_objs_def dom_def)
  apply (erule allE, erule impE, blast)
  apply (simp add: valid_obj_def valid_cs_def valid_cs_size_def)
  apply (simp add: word_bits_def cte_level_bits_def)
  done

(* unused *)
lemma derive_cap_objrefs [CNodeInv_AI_assms]:
  "\<lbrace>\<lambda>s. P (obj_refs cap)\<rbrace> derive_cap slot cap \<lbrace>\<lambda>rv s. rv \<noteq> NullCap \<longrightarrow> P (obj_refs rv)\<rbrace>,-"
  apply (cases cap, simp_all add: derive_cap_def is_zombie_def)
          apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11]
  apply (rename_tac arch_cap)
  apply (case_tac arch_cap, simp_all add: arch_derive_cap_def)
         by (wp | wpc | simp add: o_def)+

lemma derive_cap_zobjrefs [CNodeInv_AI_assms]:
  "\<lbrace>\<lambda>s. P (zobj_refs cap)\<rbrace> derive_cap slot cap \<lbrace>\<lambda>rv s. rv \<noteq> NullCap \<longrightarrow> P (zobj_refs rv)\<rbrace>,-"
  apply (cases cap, simp_all add: derive_cap_def is_zombie_def)
          apply ((wp ensure_no_children_inv | simp add: o_def | rule hoare_pre)+)[11]
  apply (rename_tac arch_cap)
  apply (case_tac arch_cap, simp_all add: arch_derive_cap_def)
         by (wp | wpc |simp add: o_def)+

lemma update_cap_objrefs [CNodeInv_AI_assms]:
  "\<lbrakk> update_cap_data P dt cap \<noteq> NullCap \<rbrakk> \<Longrightarrow>
     obj_refs (update_cap_data P dt cap) = obj_refs cap"
  by (case_tac cap,
      simp_all add: update_cap_data_closedform arch_update_cap_data_def Let_def
             split: if_split_asm arch_cap.splits)


lemma update_cap_zobjrefs [CNodeInv_AI_assms]:
  "\<lbrakk> update_cap_data P dt cap \<noteq> cap.NullCap \<rbrakk> \<Longrightarrow>
     zobj_refs (update_cap_data P dt cap) = zobj_refs cap"
  apply (case_tac cap,
      simp_all add: update_cap_data_closedform arch_update_cap_data_def Let_def
             split: if_split_asm arch_cap.splits)
  done


lemma copy_mask [simp, CNodeInv_AI_assms]:
  "copy_of (mask_cap R c) = copy_of c"
  apply (rule ext)
  apply (auto simp: copy_of_def is_cap_simps mask_cap_def
                    cap_rights_update_def same_object_as_def
                    bits_of_def acap_rights_update_def
         split: cap.splits arch_cap.splits bool.splits)
  done

lemma update_cap_data_mask_Null [simp, CNodeInv_AI_assms]:
  "(update_cap_data P x (mask_cap m c) = NullCap) = (update_cap_data P x c = NullCap)"
  unfolding update_cap_data_def mask_cap_def
  apply (cases c)
  apply (clarsimp simp: is_cap_simps cap_rights_update_def badge_update_def split: if_splits)+
  apply (rename_tac arch_cap)
  apply (case_tac arch_cap; clarsimp simp: arch_update_cap_data_def acap_rights_update_def split: if_splits)
  done

lemma cap_master_update_cap_data [CNodeInv_AI_assms]:
  "\<lbrakk> update_cap_data P x c \<noteq> NullCap \<rbrakk>
        \<Longrightarrow> cap_master_cap (update_cap_data P x c) = cap_master_cap c"
  apply (simp add: update_cap_data_def split del: if_split split: if_split_asm)
  apply (auto simp: is_cap_simps Let_def the_cnode_cap_def cap_master_cap_def
                    badge_update_def arch_update_cap_data_def
             split: arch_cap.split)
  done

lemma same_object_as_def2:
  "same_object_as cp cp' = (cap_master_cap cp = cap_master_cap cp'
                                \<and> \<not> cp = NullCap \<and> \<not> is_untyped_cap cp
                                \<and> \<not> is_zombie cp
                                \<and> (is_arch_cap cp \<longrightarrow>
                                     (case the_arch_cap cp of
                                         PageCap d x rs tp sz v \<Rightarrow> x \<le> x + 2 ^ pageBitsForSize sz - 1
                                       | _ \<Rightarrow> True)))"
  apply (simp add: same_object_as_def is_cap_simps split: cap.split)
  apply (auto simp: cap_master_cap_def bits_of_def is_cap_simps
             split: arch_cap.splits)
  done

lemma same_object_as_cap_master [CNodeInv_AI_assms]:
  "same_object_as cap cap' \<Longrightarrow> cap_master_cap cap = cap_master_cap cap'"
  by (simp add: same_object_as_def2)

lemma weak_derived_cap_is_device[CNodeInv_AI_assms]:
  "\<lbrakk>weak_derived c' c\<rbrakk> \<Longrightarrow>  cap_is_device c = cap_is_device c'"
  apply (auto simp: weak_derived_def copy_of_def is_cap_simps
                    same_object_as_def2
             split: if_split_asm
             dest!: master_cap_eq_is_device_cap_eq)
  done

lemma cap_asid_update_cap_data [CNodeInv_AI_assms]:
  "update_cap_data P x c \<noteq> NullCap
         \<Longrightarrow> cap_asid (update_cap_data P x c) = cap_asid c"
  apply (simp add: update_cap_data_def split del: if_split split: if_split_asm)
  apply (auto simp: is_cap_simps Let_def the_cnode_cap_def cap_master_cap_def
                    badge_update_def arch_update_cap_data_def
             split: arch_cap.split)
  done

lemma cap_vptr_update_cap_data [CNodeInv_AI_assms]:
  "update_cap_data P x c \<noteq> NullCap
         \<Longrightarrow> cap_vptr (update_cap_data P x c) = cap_vptr c"
  apply (simp add: update_cap_data_def split del: if_split split: if_split_asm)
  apply (auto simp: is_cap_simps Let_def the_cnode_cap_def cap_master_cap_def
                    badge_update_def arch_update_cap_data_def
             split: arch_cap.split)
  done

lemma cap_asid_base_update_cap_data [CNodeInv_AI_assms]:
  "update_cap_data P x c \<noteq> NullCap
         \<Longrightarrow> cap_asid_base (update_cap_data P x c) = cap_asid_base c"
  apply (simp add: update_cap_data_def split del: if_split split: if_split_asm)
  apply (auto simp: is_cap_simps Let_def the_cnode_cap_def cap_master_cap_def
                    badge_update_def arch_update_cap_data_def
             split: arch_cap.split)
  done

lemma same_object_as_update_cap_data [CNodeInv_AI_assms]:
  "\<lbrakk> update_cap_data P x c \<noteq> NullCap; same_object_as c' c \<rbrakk> \<Longrightarrow>
  same_object_as c' (update_cap_data P x c)"
  apply (clarsimp simp: same_object_as_def is_cap_simps
                  split: cap.split_asm arch_cap.splits if_split_asm)
  apply (auto simp: update_cap_data_def badge_update_def cap_rights_update_def is_cap_simps
                   arch_update_cap_data_def
                   Let_def split_def the_cnode_cap_def bits_of_def
              split: if_split_asm cap.splits)
  done

lemma is_reply_update_cap_data[simp]:
  "is_reply_cap (update_cap_data P x c) = is_reply_cap c"
  by (simp add:is_reply_cap_def update_cap_data_def arch_update_cap_data_def the_cnode_cap_def
               is_arch_cap_def badge_update_def split:cap.split)

lemma is_master_reply_update_cap_data[simp]:
  "is_master_reply_cap (update_cap_data P x c) = is_master_reply_cap c"
  by (simp add:is_master_reply_cap_def update_cap_data_def arch_update_cap_data_def
               the_cnode_cap_def is_arch_cap_def badge_update_def split:cap.split)

lemma weak_derived_update_cap_data [CNodeInv_AI_assms]:
  "\<lbrakk>update_cap_data P x c \<noteq> NullCap; weak_derived c c'\<rbrakk>
  \<Longrightarrow> weak_derived (update_cap_data P x c) c'"
  apply (simp add: weak_derived_def copy_of_def
                   cap_master_update_cap_data cap_asid_update_cap_data
                   cap_asid_base_update_cap_data
                   cap_vptr_update_cap_data
              split del: if_split cong: if_cong)
  apply (erule disjE)
   apply (clarsimp split: if_split_asm)
     apply (clarsimp simp: is_cap_simps)
     apply (simp add: update_cap_data_def arch_update_cap_data_def is_cap_simps)
   apply (erule (1) same_object_as_update_cap_data)
  apply clarsimp
  apply (rule conjI, clarsimp simp: is_cap_simps update_cap_data_def split del: if_split)+
  apply clarsimp
  apply (clarsimp simp: same_object_as_def is_cap_simps
                 split: cap.split_asm arch_cap.splits if_split_asm)
  apply (auto simp: update_cap_data_def badge_update_def cap_rights_update_def is_cap_simps
                    arch_update_cap_data_def
                    Let_def split_def the_cnode_cap_def bits_of_def
             split: if_split_asm cap.splits arch_cap.splits)
  done

lemma cap_badge_update_cap_data [CNodeInv_AI_assms]:
  "update_cap_data False x c \<noteq> NullCap \<and> (bdg, cap_badge c) \<in> capBadge_ordering False
       \<longrightarrow> (bdg, cap_badge (update_cap_data False x c)) \<in> capBadge_ordering False"
  apply clarsimp
  apply (erule capBadge_ordering_trans)
  apply (simp add: update_cap_data_def split del: if_split split: if_split_asm)
  apply (auto simp: is_cap_simps Let_def the_cnode_cap_def cap_master_cap_def
                    badge_update_def arch_update_cap_data_def
             split: arch_cap.split)
  done


lemma cap_vptr_rights_update[simp, CNodeInv_AI_assms]:
  "cap_vptr (cap_rights_update f c) = cap_vptr c"
  by (simp add: cap_vptr_def cap_rights_update_def acap_rights_update_def
           split: cap.splits arch_cap.splits bool.splits)

lemma cap_vptr_mask[simp, CNodeInv_AI_assms]:
  "cap_vptr (mask_cap m c) = cap_vptr c"
  by (simp add: mask_cap_def)

lemma cap_asid_base_rights [simp, CNodeInv_AI_assms]:
  "cap_asid_base (cap_rights_update R c) = cap_asid_base c"
  by (auto simp add: cap_rights_update_def acap_rights_update_def
           split: cap.splits arch_cap.splits bool.splits)

lemma cap_asid_base_mask[simp, CNodeInv_AI_assms]:
  "cap_asid_base (mask_cap m c) = cap_asid_base c"
  by (simp add: mask_cap_def)

lemma weak_derived_mask [CNodeInv_AI_assms]:
  "\<lbrakk> weak_derived c c'; cap_aligned c \<rbrakk> \<Longrightarrow> weak_derived (mask_cap m c) c'"
  unfolding weak_derived_def
  apply simp
  apply (erule disjE)
   apply simp
  apply (simp add: mask_cap_def cap_rights_update_def
                   copy_of_def same_object_as_def bits_of_def
                   is_cap_simps acap_rights_update_def
            split: cap.split arch_cap.split)+
  apply (clarsimp simp: cap_aligned_def
                        is_aligned_no_overflow)
  done


lemma vs_cap_ref_update_cap_data[simp, CNodeInv_AI_assms]:
  "vs_cap_ref (update_cap_data P d cap) = vs_cap_ref cap"
  by (simp add: vs_cap_ref_def update_cap_data_closedform
                arch_update_cap_data_def Let_def
         split: arch_cap.splits cap.split if_splits)


lemma invs_irq_state_independent[intro!, simp, CNodeInv_AI_assms]:
  "invs (s\<lparr>machine_state := machine_state s\<lparr>irq_state := f (irq_state (machine_state s))\<rparr>\<rparr>)
   = invs s"
  by (clarsimp simp: irq_state_independent_A_def invs_def
      valid_state_def valid_pspace_def valid_mdb_def valid_ioc_def valid_idle_def
      only_idle_def if_unsafe_then_cap_def valid_reply_caps_def
      valid_reply_masters_def valid_global_refs_def valid_arch_state_def
      valid_irq_node_def valid_irq_handlers_def valid_machine_state_def
      valid_arch_caps_def valid_global_objs_def
      valid_kernel_mappings_def equal_kernel_mappings_def
      valid_asid_map_def valid_global_vspace_mappings_def
      pspace_in_kernel_window_def cap_refs_in_kernel_window_def
      cur_tcb_def sym_refs_def state_refs_of_def vspace_at_asid_def
      swp_def valid_irq_states_def)


lemma cte_at_nat_to_cref_zbits [CNodeInv_AI_assms]:
  "\<lbrakk> s \<turnstile> Zombie oref zb n; m < n \<rbrakk>
     \<Longrightarrow> cte_at (oref, nat_to_cref (zombie_cte_bits zb) m) s"
  apply (subst(asm) valid_cap_def)
  apply (cases zb, simp_all add: valid_cap_def)
   apply (clarsimp simp: obj_at_def is_tcb)
   apply (drule(1) tcb_cap_cases_lt [OF order_less_le_trans])
   apply clarsimp
   apply (rule cte_wp_at_tcbI, fastforce+)
  apply (clarsimp elim!: cap_table_at_cte_at simp: cap_aligned_def)
  apply (simp add: nat_to_cref_def word_bits_conv)
  done


lemma copy_of_cap_range [CNodeInv_AI_assms]:
  "copy_of cap cap' \<Longrightarrow> cap_range cap = cap_range cap'"
  apply (clarsimp simp: copy_of_def split: if_split_asm)
  apply (cases cap', simp_all add: same_object_as_def)
       apply (clarsimp simp: is_cap_simps bits_of_def cap_range_def
                      split: cap.split_asm)+
  apply (rename_tac acap' acap)
   apply (case_tac acap, simp_all)
       apply (clarsimp split: arch_cap.split_asm cap.split_asm)+
  done


lemma copy_of_zobj_refs [CNodeInv_AI_assms]:
  "copy_of cap cap' \<Longrightarrow> zobj_refs cap = zobj_refs cap'"
  apply (clarsimp simp: copy_of_def split: if_split_asm)
  apply (cases cap', simp_all add: same_object_as_def)
       apply (clarsimp simp: is_cap_simps bits_of_def
                      split: cap.split_asm)+
  apply (rename_tac acap' acap)
   apply (case_tac acap, simp_all)
       apply (clarsimp split: arch_cap.split_asm cap.split_asm)+
  done


lemma vs_cap_ref_master [CNodeInv_AI_assms]:
  "\<lbrakk> cap_master_cap cap = cap_master_cap cap';
           cap_asid cap = cap_asid cap';
           cap_asid_base cap = cap_asid_base cap';
           cap_vptr cap = cap_vptr cap' \<rbrakk>
        \<Longrightarrow> vs_cap_ref cap = vs_cap_ref cap'"
  apply (rule ccontr)
  apply (clarsimp simp: vs_cap_ref_def cap_master_cap_def
                 split: cap.split_asm)
  apply (clarsimp simp: cap_asid_def split: arch_cap.split_asm option.split_asm)
  done

lemma weak_derived_vs_cap_ref [CNodeInv_AI_assms]:
  "weak_derived c c' \<Longrightarrow> vs_cap_ref c = vs_cap_ref c'"
  by (auto simp: weak_derived_def copy_of_def
                 same_object_as_def2
          split: if_split_asm elim: vs_cap_ref_master[OF sym])

lemma weak_derived_table_cap_ref [CNodeInv_AI_assms]:
  "weak_derived c c' \<Longrightarrow> table_cap_ref c = table_cap_ref c'"
  apply (clarsimp simp: weak_derived_def copy_of_def
                 same_object_as_def2
          split: if_split_asm)
   apply (elim disjE,simp_all add:is_cap_simps)
  apply (elim disjE,simp_all)
  apply clarsimp
  apply (frule vs_cap_ref_master[OF sym],simp+)
  apply (drule vs_cap_ref_eq_imp_table_cap_ref_eq')
   apply simp
  apply simp
  done


lemma weak_derived_vspace_asid:
  "weak_derived c c' \<Longrightarrow> cap_asid c = cap_asid c'
                       \<and> is_pt_cap c = is_pt_cap c'
                       \<and> is_pd_cap c = is_pd_cap c'
                       \<and> is_pdpt_cap c = is_pdpt_cap c'
                       \<and> is_pml4_cap c = is_pml4_cap c'"
  by (auto simp: weak_derived_def copy_of_def is_cap_simps
                 same_object_as_def2 is_pt_cap_def
                 cap_master_cap_simps
          split: if_split_asm
          dest!: cap_master_cap_eqDs)

lemma weak_derived_ASIDPool1:
  "weak_derived (cap.ArchObjectCap (ASIDPoolCap ap asid)) cap =
  (cap = cap.ArchObjectCap (ASIDPoolCap ap asid))"
  apply (rule iffI)
   prefer 2
   apply simp
  apply (clarsimp simp: weak_derived_def copy_of_def split: if_split_asm)
  apply (clarsimp simp: same_object_as_def2 cap_master_cap_simps dest!: cap_master_cap_eqDs)
  done

lemma weak_derived_ASIDPool2:
  "weak_derived cap (ArchObjectCap (ASIDPoolCap ap asid)) =
  (cap = ArchObjectCap (ASIDPoolCap ap asid))"
  apply (rule iffI)
   prefer 2
   apply simp
  apply (clarsimp simp: weak_derived_def copy_of_def split: if_split_asm)
  apply (auto simp: same_object_as_def2 cap_master_cap_simps dest!: cap_master_cap_eqDs)
  done

lemmas weak_derived_ASIDPool [simp] =
  weak_derived_ASIDPool1 weak_derived_ASIDPool2


lemma swap_of_caps_valid_arch_caps [CNodeInv_AI_assms]:
  "\<lbrace>valid_arch_caps and
    cte_wp_at (weak_derived c) a and
    cte_wp_at (weak_derived c') b\<rbrace>
   do
     y \<leftarrow> set_cap c b;
     set_cap c' a
   od
   \<lbrace>\<lambda>rv. valid_arch_caps\<rbrace>"
  apply (rule hoare_pre)
   apply (simp add: valid_arch_caps_def
                    valid_vs_lookup_def valid_table_caps_def pred_conj_def
               del: split_paired_Ex split_paired_All imp_disjL)
   apply (wp hoare_vcg_all_lift hoare_convert_imp[OF set_cap.vs_lookup_pages]
             hoare_vcg_disj_lift hoare_convert_imp[OF set_cap_caps_of_state]
             hoare_use_eq[OF set_cap_arch set_cap_obj_at_impossible[where P="\<lambda>x. x"]])
  apply (clarsimp simp: valid_arch_caps_def cte_wp_at_caps_of_state
              simp del: split_paired_Ex split_paired_All imp_disjL)
  apply (frule weak_derived_obj_refs[where dcap=c])
  apply (frule weak_derived_obj_refs[where dcap=c'])
  apply (frule weak_derived_vspace_asid[where c=c])
  apply (frule weak_derived_vspace_asid[where c=c'])
  apply (intro conjI)
     apply (simp add: valid_vs_lookup_def del: split_paired_Ex split_paired_All)
     apply (elim allEI)
     apply (intro impI disjCI2)
     apply (simp del: split_paired_Ex split_paired_All)
     apply (elim conjE)
     apply (erule exfEI[where f="id (a := b, b := a)"])
     subgoal by (clarsimp dest!: weak_derived_vs_cap_ref, intro conjI; clarsimp)
    apply (simp add: valid_table_caps_def empty_table_caps_of
                del: split_paired_Ex split_paired_All imp_disjL)
   apply (simp add: unique_table_caps_def
               del: split_paired_Ex split_paired_All imp_disjL
                    split del: if_split)
   apply (erule allfEI[where f="id (a := b, b := a)"])
   apply (erule allfEI[where f="id (a := b, b := a)"])
   apply (clarsimp split del: if_split split: if_split_asm)
  apply (simp add: unique_table_refs_def
              del: split_paired_All split del: if_split)
  apply (erule allfEI[where f="id (a := b, b := a)"])
  apply (erule allfEI[where f="id (a := b, b := a)"])
  apply (clarsimp split del: if_split split: if_split_asm dest!:vs_cap_ref_to_table_cap_ref
                      dest!: weak_derived_table_cap_ref)
  done


lemma cap_swap_asid_map[wp, CNodeInv_AI_assms]:
  "\<lbrace>valid_asid_map and
    cte_wp_at (weak_derived c) a and
    cte_wp_at (weak_derived c') b\<rbrace>
     cap_swap c a c' b \<lbrace>\<lambda>rv. valid_asid_map\<rbrace>"
  apply (simp add: cap_swap_def set_cdt_def valid_asid_map_def vspace_at_asid_def)
  apply (rule hoare_pre)
   apply (wp set_cap.vs_lookup|simp
          |rule hoare_lift_Pf [where f=arch_state])+
  done


lemma cap_swap_cap_refs_in_kernel_window[wp, CNodeInv_AI_assms]:
  "\<lbrace>cap_refs_in_kernel_window and
    cte_wp_at (weak_derived c) a and
    cte_wp_at (weak_derived c') b\<rbrace>
     cap_swap c a c' b \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
  apply (simp add: cap_swap_def)
  apply (rule hoare_pre)
   apply (wp | simp split del: if_split)+
  apply (auto dest!: cap_refs_in_kernel_windowD
               simp: cte_wp_at_caps_of_state weak_derived_cap_range)
  done


lemma cap_swap_ioports[wp, CNodeInv_AI_assms]:
  "\<lbrace>valid_ioports and cte_wp_at (weak_derived c) a and cte_wp_at (weak_derived c') b\<rbrace>
     cap_swap c a c' b
   \<lbrace>\<lambda>rv. valid_ioports\<rbrace>"
  apply (simp add: valid_ioports_def all_ioports_issued_def ioports_no_overlap_def issued_ioports_def)
  apply (rule hoare_pre)
   apply (wp hoare_use_eq [where f=arch_state,
                           OF cap_swap_arch cap_swap_caps_of_state])
  apply (clarsimp simp: cte_wp_at_caps_of_state
                 elim!: ranE split: if_split_asm
                 dest!: weak_derived_cap_ioports)
  by (fastforce elim!: ranE split: if_split_asm)

lemma cap_swap_vms[wp, CNodeInv_AI_assms]:
  "\<lbrace>valid_machine_state\<rbrace>  cap_swap c a c' b \<lbrace>\<lambda>rv. valid_machine_state\<rbrace>"
  apply (simp add: valid_machine_state_def in_user_frame_def)
  apply (wp cap_swap_typ_at
            hoare_vcg_all_lift hoare_vcg_ex_lift hoare_vcg_disj_lift)
  done

(* FIXME x64: this could probably be generic *)
lemma unat_of_bl_nat_to_cref[CNodeInv_AI_assms]:
  "\<lbrakk> n < 2 ^ len; len < word_bits \<rbrakk>
    \<Longrightarrow> unat (of_bl (nat_to_cref len n) :: machine_word) = n"
  apply (simp add: nat_to_cref_def word_bits_conv of_drop_to_bl
                   word_size)
  apply (subst less_mask_eq)
   apply (rule order_less_le_trans)
    apply (erule of_nat_mono_maybe[rotated])
    apply (rule power_strict_increasing)
     apply simp
    apply simp
   apply simp
  apply (rule unat_of_nat_eq[where 'a=machine_word_len, unfolded word_bits_len_of])
  apply (erule order_less_trans)
  apply (rule power_strict_increasing)
   apply (simp add: word_bits_conv)
  apply simp
  done

lemma zombie_is_cap_toE_pre[CNodeInv_AI_assms]:
  "\<lbrakk> s \<turnstile> Zombie ptr zbits n; invs s; m < n \<rbrakk>
     \<Longrightarrow> (ptr, nat_to_cref (zombie_cte_bits zbits) m) \<in> cte_refs (Zombie ptr zbits n) irqn"
  apply (clarsimp simp add: valid_cap_def cap_aligned_def)
  apply (clarsimp split: option.split_asm)
   apply (simp add: unat_of_bl_nat_to_cref)
   apply (simp add: nat_to_cref_def word_bits_conv)
  apply (simp add: unat_of_bl_nat_to_cref)
  apply (simp add: nat_to_cref_def word_bits_conv)
  done

crunch st_tcb_at_halted[wp]: prepare_thread_delete "st_tcb_at halted t"

lemma finalise_cap_makes_halted_proof[CNodeInv_AI_assms]:
  "\<lbrace>invs and valid_cap cap and (\<lambda>s. ex = is_final_cap' cap s)
         and cte_wp_at ((=) cap) slot\<rbrace>
    finalise_cap cap ex
   \<lbrace>\<lambda>rv s. \<forall>t \<in> obj_refs (fst rv). halted_if_tcb t s\<rbrace>"
  apply (case_tac cap, simp_all)
            apply (wp unbind_notification_valid_objs
                   | clarsimp simp: o_def valid_cap_def cap_table_at_typ
                                    is_tcb obj_at_def
                   | clarsimp simp: halted_if_tcb_def
                             split: option.split
                   | intro impI conjI
                   | rule hoare_drop_imp)+
  apply (drule_tac final_zombie_not_live; (assumption | simp add: invs_iflive)?)
   apply (clarsimp simp: pred_tcb_at_def is_tcb obj_at_def live_def, elim disjE)
    apply (clarsimp; case_tac "tcb_state tcb"; simp)+
  apply (rename_tac arch_cap)
  apply (case_tac arch_cap, simp_all add: arch_finalise_cap_def)
      apply (wp
             | clarsimp simp: valid_cap_def obj_at_def is_tcb_def is_cap_table_def
                        split: option.splits bool.split
             | intro impI conjI)+
  done

lemmas finalise_cap_makes_halted = finalise_cap_makes_halted_proof

crunch emptyable[wp,CNodeInv_AI_assms]: finalise_cap "\<lambda>s. emptyable sl s"
  (simp: crunch_simps rule: emptyable_lift
     wp: crunch_wps suspend_emptyable unbind_notification_invs unbind_maybe_notification_invs)


lemma finalise_cap_not_reply_master_unlifted [CNodeInv_AI_assms]:
  "(rv, s') \<in> fst (finalise_cap cap sl s) \<Longrightarrow>
   \<not> is_master_reply_cap (fst rv)"
  by (case_tac cap, auto simp: is_cap_simps in_monad liftM_def
                               arch_finalise_cap_def
                        split: if_split_asm arch_cap.split_asm bool.split_asm option.split_asm)


lemma nat_to_cref_0_replicate [CNodeInv_AI_assms]:
  "\<And>n. n < word_bits \<Longrightarrow> nat_to_cref n 0 = replicate n False"
  apply (subgoal_tac "nat_to_cref n (unat (of_bl (replicate n False))) = replicate n False")
   apply simp
  apply (rule nat_to_cref_unat_of_bl')
   apply (simp add: word_bits_def)
  apply simp
  done

lemma prepare_thread_delete_thread_cap [CNodeInv_AI_assms]:
  "\<lbrace>\<lambda>s. caps_of_state s x = Some (cap.ThreadCap p)\<rbrace>
    prepare_thread_delete t
   \<lbrace>\<lambda>rv s. caps_of_state s x = Some (cap.ThreadCap p)\<rbrace>"
  by (wpsimp simp: prepare_thread_delete_def)

end


global_interpretation CNodeInv_AI?: CNodeInv_AI
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?)
  qed


termination rec_del by (rule rec_del_termination)


context Arch begin global_naming X64

lemma post_cap_delete_pre_is_final_cap':
  "\<And>rv s'' rva s''a s.
       \<lbrakk>valid_ioports s; caps_of_state s slot = Some cap; is_final_cap' cap s; cap_cleanup_opt cap \<noteq> NullCap\<rbrakk>
       \<Longrightarrow> post_cap_delete_pre (cap_cleanup_opt cap) ((caps_of_state s)(slot \<mapsto> NullCap))"
  apply (clarsimp simp: cap_cleanup_opt_def cte_wp_at_def post_cap_delete_pre_def
                      split: cap.split_asm if_split_asm
                      elim!: ranE dest!: caps_of_state_cteD)
   (* IRQHandlerCap case *)
   apply (drule(2) final_cap_duplicate_irq)
     apply simp+
   (* IOPort case *)
  apply (clarsimp simp: arch_cap_cleanup_opt_def arch_post_cap_delete_pre_def
                        clearable_ioport_range_def get_cap_caps_of_state
                 elim!: ranE
                 split: arch_cap.split_asm if_split_asm)
  apply (drule_tac s="Some c" for c in sym)
  apply (rule ccontr)
  apply (frule_tac p=slot and cap="ArchObjectCap (IOPortCap x31 x32)" and cap'=cap'
                  in valid_ioportsD; (fastforce simp: ran_def)?)
  apply (case_tac cap'; clarsimp)
  apply (case_tac x12; clarsimp)
  apply (frule_tac p=slot and p'="(a,b)" and cap''=cap and cap'=cap
                         in is_final_cap_caps_of_state_2D; auto simp: gen_obj_refs_def)
  done

lemma rec_del_invs'':
  notes Inr_in_liftE_simp[simp del]
  assumes set_cap_Q[wp]: "\<And>cap p. \<lbrace>Q and invs\<rbrace> set_cap cap p \<lbrace>\<lambda>_.Q\<rbrace>"
  assumes empty_slot_Q[wp]: "\<And>slot free_irq. \<lbrace>Q and invs\<rbrace> empty_slot slot free_irq\<lbrace>\<lambda>_.Q\<rbrace>"
  assumes finalise_cap_Q[wp]: "\<And>cap final. \<lbrace>Q and invs\<rbrace> finalise_cap cap final \<lbrace>\<lambda>_.Q\<rbrace>"
  assumes cap_swap_for_delete_Q[wp]: "\<And>a b. \<lbrace>Q and invs and cte_at a and cte_at b and K (a \<noteq> b)\<rbrace>
                                              cap_swap_for_delete a b
                                             \<lbrace>\<lambda>_.Q\<rbrace>"
  assumes preemption_point_Q: "\<And>cap final. \<lbrace>Q and invs\<rbrace> preemption_point \<lbrace>\<lambda>_.Q\<rbrace>"
  shows
  "s \<turnstile> \<lbrace>Q and invs and valid_rec_del_call call
           and (\<lambda>s. \<not> exposed_rdcall call
                       \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {})
                                (slot_rdcall call) s)
           and emptyable (slot_rdcall call)
           and (\<lambda>s. case call of ReduceZombieCall cap sl ex \<Rightarrow>
                               \<not> cap_removeable cap sl
                               \<and> (\<forall>t\<in>obj_refs cap. halted_if_tcb t s)
                        | _ \<Rightarrow> True)\<rbrace>
         rec_del call
       \<lbrace>\<lambda>rv s. Q s \<and> invs s \<and>
               (case call of FinaliseSlotCall sl x \<Rightarrow>
                             ((fst rv \<or> x) \<longrightarrow> cte_wp_at (replaceable s sl cap.NullCap) sl s)
                             \<and> (snd rv \<noteq> NullCap \<longrightarrow>
                                   post_cap_delete_pre (snd rv) ((caps_of_state s) (sl \<mapsto> cap.NullCap)))
                          | ReduceZombieCall cap sl x \<Rightarrow>
                             (\<not> x \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) sl s)
                          | _ \<Rightarrow> True) \<and>
               emptyable (slot_rdcall call) s\<rbrace>,
       \<lbrace>\<lambda>rv. Q and invs\<rbrace>"
proof (induct rule: rec_del.induct,
       simp_all only: rec_del_fails)
  case (1 slot exposed s)
  show ?case
    apply (subst rec_del.simps)
    apply (simp only: split_def)
    apply wp
     apply (simp(no_asm))
     apply (wp empty_slot_invs empty_slot_emptyable)[1]
    apply (rule hoare_pre_spec_validE)
     apply (rule spec_strengthen_postE, unfold slot_rdcall.simps)
      apply (rule "1.hyps"[simplified rec_del_call.simps slot_rdcall.simps])
     apply clarsimp
     apply (auto simp: cte_wp_at_caps_of_state)
    done
next
  case (2 slot exposed s)
  show ?case
    apply (subst rec_del.simps)
    apply (simp only: split_def)
    apply (rule split_spec_bindE[rotated])
     apply (rule drop_spec_validE, simp)
     apply (rule get_cap_sp)
    apply (rule hoare_pre_spec_validE)
     apply (wp replace_cap_invs | simp)+
        apply (erule finalise_cap_not_reply_master)
       apply (wp "2.hyps")
         apply (wp preemption_point_Q | simp)+
         apply (wp preemption_point_inv, simp+)
         apply (wp preemption_point_Q)
         apply ((wp preemption_point_inv irq_state_independent_A_conjI irq_state_independent_AI
                    emptyable_irq_state_independent invs_irq_state_independent
               | simp add: valid_rec_del_call_def irq_state_independent_A_def)+)[1]
        apply (simp(no_asm))
        apply (rule spec_strengthen_postE)
        apply (rule "2.hyps"[simplified rec_del_call.simps slot_rdcall.simps conj_assoc], assumption+)
       apply (simp add: cte_wp_at_eq_simp
                | wp replace_cap_invs set_cap_sets final_cap_same_objrefs
                     set_cap_cte_cap_wp_to hoare_weak_lift_imp
                | erule finalise_cap_not_reply_master)+
       apply (wp hoare_vcg_const_Ball_lift)+
      apply (rule hoare_strengthen_post)
       apply (rule_tac Q="\<lambda>fin s. Q s \<and> invs s \<and> replaceable s slot (fst fin) rv
                                 \<and> cte_wp_at ((=) rv) slot s \<and> s \<turnstile> (fst fin)
                                 \<and> ex_cte_cap_wp_to (appropriate_cte_cap rv) slot s
                                 \<and> emptyable slot s
                                 \<and> (\<forall>t\<in>obj_refs (fst fin). halted_if_tcb t s)"
                  in hoare_vcg_conj_lift)
        apply (wp finalise_cap_invs[where slot=slot]
                  finalise_cap_replaceable[where sl=slot]
                  finalise_cap_makes_halted[where slot=slot])[1]
       apply (rule finalise_cap_cases[where slot=slot])
      apply (clarsimp simp: cte_wp_at_caps_of_state)
      apply (erule disjE)
       apply clarsimp
       apply (rule post_cap_delete_pre_is_final_cap', clarsimp+)
      apply (rule conjI)
       apply clarsimp
       apply (subst replaceable_def)
       apply (clarsimp simp: is_cap_simps tcb_cap_valid_NullCapD
                             no_cap_to_obj_with_diff_ref_Null gen_obj_refs_eq
                        del: disjCI)
       apply (thin_tac "appropriate_cte_cap a = appropriate_cte_cap b" for a b)
       apply (rule conjI)
        apply (clarsimp simp: replaceable_def)
        apply (erule disjE)
         apply (simp only: zobj_refs.simps mem_simps)
        apply clarsimp+
       subgoal
         apply (drule sym, simp)
         apply (drule sym, simp)
         apply clarsimp
         apply (simp add: unat_eq_0)
         apply (drule of_bl_eq_0)
          apply (drule zombie_cte_bits_less, simp add: word_bits_def)
         by (clarsimp simp: cte_wp_at_caps_of_state)
      apply (drule_tac s="appropriate_cte_cap c" for c in sym)
      apply (clarsimp simp: is_cap_simps appropriate_Zombie gen_obj_refs_eq)
     apply (simp add: is_final_cap_def)
     apply wp
    apply (clarsimp simp: cte_wp_at_eq_simp)
    apply (rule conjI)
     apply (clarsimp simp: cte_wp_at_caps_of_state replaceable_def)
    apply (frule cte_wp_at_valid_objs_valid_cap, clarsimp+)
    apply (frule invs_valid_asid_table)
    apply (frule invs_sym_refs)
    apply (clarsimp simp: invs_def valid_state_def
                          invs_valid_objs invs_psp_aligned)
    apply (drule(1) if_unsafe_then_capD, clarsimp+)
    done
next
  have replicate_helper:
    "\<And>x n. True \<in> set x \<Longrightarrow> replicate n False \<noteq> x"
   by (clarsimp simp: replicate_not_True)
  case (3 ptr bits n slot s)
  show ?case
    apply simp
    apply wp+
    apply clarsimp
    apply (rule context_conjI')
     apply (rule context_conjI')
      apply (rule conjI)
       apply (erule zombie_is_cap_toE2)
        apply simp+
      apply (clarsimp simp: halted_emptyable)
      apply (rule conjI, clarsimp simp: cte_wp_at_caps_of_state)
       apply (erule tcb_valid_nonspecial_cap)
         apply fastforce
        apply (clarsimp simp: ran_tcb_cap_cases is_cap_simps
                       split: Structures_A.thread_state.splits)
       apply (clarsimp simp: is_cap_simps)
      apply (rule conjI)
       apply (drule cte_wp_valid_cap, clarsimp)
       apply (frule cte_at_nat_to_cref_zbits [where m=0], simp)
       apply (rule cte_wp_at_not_reply_master)
          apply (simp add: replicate_helper tcb_cnode_index_def)
         apply (subst(asm) nat_to_cref_0_replicate)
          apply (simp add: zombie_cte_bits_less)
         apply assumption
        apply clarsimp
       apply (simp add: invs_def valid_state_def)
      apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps)
     apply (erule cte_wp_at_weakenE | clarsimp)+
    done
next
  have nat_helper:
    "\<And>x n. \<lbrakk> x < Suc n; x \<noteq> n \<rbrakk> \<Longrightarrow> x < n"
    by (simp add: le_simps)
  case (4 ptr bits n slot s)
  show ?case
    apply simp
    apply (rule hoare_pre_spec_validE)
     apply (wp replace_cap_invs | simp add: is_cap_simps)+
      apply (rule_tac Q="\<lambda>rv s. Q s \<and> invs s \<and> cte_wp_at (\<lambda>cap. cap = rv) slot s
                             \<and> cte_wp_at (\<lambda>cap. cap = cap.NullCap
                                        \<or> \<not> False \<and> is_zombie cap
                                            \<and> (ptr, nat_to_cref (zombie_cte_bits bits) n)
                                                 \<in> fst_cte_ptrs cap)
                                    (ptr, nat_to_cref (zombie_cte_bits bits) n) s
                             \<and> \<not> cap_removeable (cap.Zombie ptr bits (Suc n)) slot"
                  in hoare_post_imp)
       apply (thin_tac "(a, b) \<in> fst c" for a b c)
       apply clarsimp
       apply (frule cte_wp_at_emptyableD, clarsimp, assumption)
       apply (rule conjI[rotated], (clarsimp simp: is_cap_simps)+)
       apply (frule cte_wp_at_valid_objs_valid_cap, clarsimp+)
       apply (frule if_unsafe_then_capD, clarsimp+)
       apply (rule conjI)
        apply (frule zombies_finalD, (clarsimp simp: is_cap_simps)+)
        apply (clarsimp simp: cte_wp_at_caps_of_state)
        apply (erule disjE[where P="val = cap.NullCap" for val])
         apply (clarsimp simp: replaceable_def cap_range_def is_cap_simps
                               gen_obj_refs_subset vs_cap_ref_def)
         apply (rule conjI[rotated])
          apply (rule conjI)
           apply (rule mp [OF tcb_cap_valid_imp'])
           apply (fastforce simp: ran_tcb_cap_cases is_cap_simps
                                 is_pt_cap_def vs_cap_ref_def
                                 valid_ipc_buffer_cap_def
                          split: Structures_A.thread_state.splits)
          apply (drule unique_table_refs_no_cap_asidD)
           apply (simp add: invs_def valid_state_def valid_arch_caps_def)
          apply (simp add: no_cap_to_obj_with_diff_ref_def Ball_def
                           table_cap_ref_def)
         apply clarsimp
         apply (rule ccontr, erule notE, erule nat_helper)
         apply clarsimp
         apply (erule disjE[where Q="val = slot" for val])
          apply (clarsimp simp: cte_wp_at_caps_of_state)
          apply (erule notE[rotated, where P="val = Some cap.NullCap" for val])
          apply (drule sym, simp, subst nat_to_cref_unat_of_bl)
           apply (drule zombie_cte_bits_less, simp add: word_bits_def)
          apply assumption
         apply clarsimp
         apply (drule sym, simp)
         apply (subst(asm) nat_to_cref_unat_of_bl)
          apply (drule zombie_cte_bits_less, simp add: word_bits_conv)
         apply simp
        apply (clarsimp simp: is_final_cap'_def3 simp del: split_paired_All)
        apply (frule_tac x=slot in spec)
        apply (drule_tac x="(ptr, nat_to_cref (zombie_cte_bits bits) n)" in spec)
        apply (clarsimp simp: cte_wp_at_caps_of_state fst_cte_ptrs_def
                              gen_obj_refs_Int)
        apply (drule(1) nat_to_cref_replicate_Zombie[OF sym])
         apply simp
        apply simp
       apply (clarsimp simp: valid_cap_def cap_aligned_def is_cap_simps
                             cte_wp_at_cte_at appropriate_Zombie
                      split: option.split_asm)
      apply (wp get_cap_cte_wp_at)[1]
     apply simp
     apply (subst conj_assoc[symmetric])
     apply (rule spec_valid_conj_liftE2)
      apply (wp rec_del_delete_cases[where ex=False, simplified])[1]
     apply (rule spec_strengthen_postE)
      apply (rule "4.hyps"[simplified rec_del_call.simps slot_rdcall.simps simp_thms pred_conj_def])
      apply (simp add: in_monad)
     apply simp
    apply (clarsimp simp: halted_emptyable)
    apply (erule(1) zombie_is_cap_toE)
     apply simp
    apply simp
    done
qed


lemmas rec_del_invs'[CNodeInv_AI_assms] = rec_del_invs'' [where Q=\<top>,
  simplified hoare_post_taut pred_conj_def simp_thms, OF TrueI TrueI TrueI TrueI, simplified]

end


global_interpretation CNodeInv_AI_2?: CNodeInv_AI_2
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?)
  qed


context Arch begin global_naming X64

lemma finalise_cap_rvk_prog [CNodeInv_AI_assms]:
   "\<lbrace>\<lambda>s. revoke_progress_ord m (\<lambda>x. map_option cap_to_rpo (caps_of_state s x))\<rbrace>
   finalise_cap a b
   \<lbrace>\<lambda>_ s. revoke_progress_ord m (\<lambda>x. map_option cap_to_rpo (caps_of_state s x))\<rbrace>"
  apply (case_tac a,simp_all add:liftM_def)
    apply (wp suspend_rvk_prog deleting_irq_handler_rvk_prog
      | clarsimp simp:is_final_cap_def comp_def)+
  done


lemma rec_del_rvk_prog [CNodeInv_AI_assms]:
  "st \<turnstile> \<lbrace>\<lambda>s. revoke_progress_ord m (option_map cap_to_rpo \<circ> caps_of_state s)
          \<and> (case args of ReduceZombieCall cap sl ex \<Rightarrow>
               cte_wp_at (\<lambda>c. c = cap) sl s \<and> is_final_cap' cap s
             | _ \<Rightarrow> True)\<rbrace>
     rec_del args
   \<lbrace>\<lambda>rv s. revoke_progress_ord m (option_map cap_to_rpo \<circ> caps_of_state s)\<rbrace>,\<lbrace>\<top>\<top>\<rbrace>"
proof (induct rule: rec_del.induct,
       simp_all only: rec_del_fails)
  case (1 slot exposed s)
  note wp = "1.hyps"[simplified rdcall_simps simp_thms]
  show ?case
    apply (subst rec_del.simps)
    apply (simp only: rdcall_simps simp_thms split_def)
    apply wp
     apply (simp(no_asm) del: o_apply)
     apply (wp empty_slot_rvk_prog)[1]
    apply (simp del: o_apply)
    apply (rule wp)
    done
next
  case (2 sl exp s)
  note wp = "2.hyps" [simplified rdcall_simps simp_thms]
  show ?case
    apply (subst rec_del.simps)
    apply (simp only: rdcall_simps simp_thms split_def)
    apply (rule hoare_pre_spec_validE)
     apply wp
         apply ((wp | simp)+)[1]
        apply (wp wp)
          apply ((wp preemption_point_inv | simp)+)[1]
         apply (simp(no_asm))
         apply (rule wp, assumption+)
        apply (wp final_cap_same_objrefs
                  set_cap_cte_wp_at_cases
                   | simp)+
       apply (rule hoare_strengthen_post)
        apply (rule_tac Q="\<lambda>fc s. cte_wp_at ((=) rv) sl s
                              \<and> revoke_progress_ord m (option_map cap_to_rpo \<circ> caps_of_state s)"
                 in hoare_vcg_conj_lift)
         apply (wp finalise_cap_rvk_prog[folded o_def])[1]
        apply (rule finalise_cap_cases[where slot=sl])
       apply (clarsimp simp: o_def)
       apply (strengthen rvk_prog_update_strg[unfolded fun_upd_def o_def])
       apply (clarsimp simp: cte_wp_at_caps_of_state)
       apply (erule disjE)
        apply clarsimp
       apply (clarsimp simp: is_cap_simps)
       apply (case_tac "is_zombie rv")
        apply (clarsimp simp: cap_to_rpo_def is_cap_simps fst_cte_ptrs_def)
        apply (simp add: is_final_cap'_def)
       apply (case_tac rv, simp_all add: cap_to_rpo_def is_cap_simps gen_obj_refs_eq)[1]
       apply (rename_tac arch_cap)
       apply (case_tac arch_cap, simp_all)[1]
      apply (simp add: is_final_cap_def, wp)
     apply (simp, wp get_cap_wp)
    apply (clarsimp simp: o_def)
    done
next
  case (3 ptr bits n slot s)
  show ?case
    apply simp
    apply (fold o_def)
    apply (rule hoare_pre_spec_validE)
     apply (simp del: o_apply | wp (once) cap_swap_fd_rvk_prog)+
    apply (clarsimp simp: cte_wp_at_caps_of_state cap_to_rpo_def)
    done
next
  case (4 ptr zb znum sl s)
  note wp = "4.hyps"[simplified rdcall_simps]
  show ?case
    apply (subst rec_del.simps)
    apply wp
        apply (wp | simp)+
      apply (wp get_cap_wp)[1]
     apply (rule spec_strengthen_postE)
      apply (rule wp, assumption+)
     apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_defs)
     apply (strengthen rvk_prog_update_strg[unfolded fun_upd_def o_def])
     apply (clarsimp simp: cte_wp_at_caps_of_state cap_to_rpo_def)
    apply (wp | simp add: o_def)+
    done
qed

end


global_interpretation CNodeInv_AI_3?: CNodeInv_AI_3
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?)
  qed


termination cap_revoke by (rule cap_revoke_termination)

declare cap_revoke.simps[simp del]


context Arch begin global_naming X64

crunch typ_at[wp, CNodeInv_AI_assms]: finalise_slot "\<lambda>s. P (typ_at T p s)"
  (wp: crunch_wps simp: crunch_simps filterM_mapM unless_def
   ignore: without_preemption filterM set_object clearMemory)


lemma weak_derived_appropriate [CNodeInv_AI_assms]:
  "weak_derived cap cap' \<Longrightarrow> appropriate_cte_cap cap = appropriate_cte_cap cap'"
  by (auto simp: weak_derived_def copy_of_def same_object_as_def2
                 appropriate_cte_master
          split: if_split_asm
          dest!: arg_cong[where f=appropriate_cte_cap])

end


global_interpretation CNodeInv_AI_4?: CNodeInv_AI_4
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?)
  qed


context Arch begin global_naming X64

lemma cap_move_ioports:
  "\<lbrace>valid_ioports and cte_wp_at ((=) cap.NullCap) ptr'
         and cte_wp_at (weak_derived cap) ptr
         and cte_wp_at (\<lambda>c. c \<noteq> cap.NullCap) ptr and K (ptr \<noteq> ptr')\<rbrace>
     cap_move cap ptr ptr'
   \<lbrace>\<lambda>rv. valid_ioports\<rbrace>"
  apply (simp add: valid_ioports_def all_ioports_issued_def ioports_no_overlap_def issued_ioports_def)
  apply (rule hoare_pre)
   apply (wp hoare_use_eq [where f=arch_state,
                           OF cap_move_arch cap_move_caps_of_state])
  apply (clarsimp simp: cte_wp_at_caps_of_state
                 elim!: ranE split: if_split_asm
                 dest!: weak_derived_cap_ioports)
  by (fastforce elim!: ranE split: if_split_asm)

lemma cap_move_invs[wp, CNodeInv_AI_assms]:
  "\<lbrace>invs and valid_cap cap and cte_wp_at ((=) cap.NullCap) ptr'
         and tcb_cap_valid cap ptr'
         and cte_wp_at (weak_derived cap) ptr
         and cte_wp_at (\<lambda>c. c \<noteq> cap.NullCap) ptr
         and ex_cte_cap_wp_to (appropriate_cte_cap cap) ptr' and K (ptr \<noteq> ptr')
         and K (\<not> is_master_reply_cap cap)\<rbrace>
     cap_move cap ptr ptr'
   \<lbrace>\<lambda>rv. invs\<rbrace>"
  unfolding invs_def valid_state_def valid_pspace_def
  apply (simp add: pred_conj_def conj_comms [where Q = "valid_mdb S" for S])
  apply wp
   apply (wpe cap_move_zombies_final)
   apply (wpe cap_move_if_live)
   apply (wpe cap_move_if_unsafe)
   apply (wpe cap_move_irq_handlers)
   apply (wpe cap_move_replies)
   apply (wpe cap_move_valid_arch_caps)
   apply (wpe cap_move_valid_ioc)
   apply (wpe cap_move_ioports)
   apply (simp add: cap_move_def set_cdt_def)
   apply (rule hoare_pre)
    apply (wp set_cap_valid_objs set_cap_idle set_cap_typ_at
              cap_table_at_lift_irq tcb_at_typ_at
              hoare_vcg_disj_lift hoare_vcg_all_lift
              set_cap_cap_refs_respects_device_region_NullCap
            | wp set_cap_cap_refs_respects_device_region_spec[where ptr=ptr]
            | simp del: split_paired_Ex split_paired_All
            | simp add: valid_irq_node_def valid_machine_state_def
                   del: split_paired_All split_paired_Ex)+
   apply (clarsimp simp: tcb_cap_valid_def cte_wp_at_caps_of_state)
   apply (frule(1) valid_global_refsD2[where ptr=ptr])
   apply (frule(1) cap_refs_in_kernel_windowD[where ptr=ptr])
   apply (frule weak_derived_cap_range)
   apply (frule weak_derived_is_reply_master)
   apply (simp add: cap_range_NullCap valid_ipc_buffer_cap_def[where c=cap.NullCap])
   apply (simp add: is_cap_simps)
   apply (subgoal_tac "tcb_cap_valid cap.NullCap ptr s")
    apply (simp add: tcb_cap_valid_def weak_derived_cap_is_device)
   apply (rule tcb_cap_valid_NullCapD)
    apply (erule(1) tcb_cap_valid_caps_of_stateD)
   apply (simp add: is_cap_simps)
   done

lemma arch_derive_is_arch:
  "\<lbrace>\<top>\<rbrace> arch_derive_cap c \<lbrace>\<lambda>rv s. rv \<noteq> NullCap \<longrightarrow> is_arch_cap rv\<rbrace>,-"
  by (wpsimp simp: is_arch_cap_def arch_derive_cap_def)

end


global_interpretation CNodeInv_AI_5?: CNodeInv_AI_5
  proof goal_cases
  interpret Arch .
  case 1 show ?case by (unfold_locales; (fact CNodeInv_AI_assms)?)
  qed


end