(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

(*
RISCV-specific VSpace invariants
*)

theory ArchVSpace_AI
imports VSpacePre_AI
begin

context Arch begin global_naming RISCV64

definition kernel_mappings_only :: "(pt_index \<Rightarrow> pte) \<Rightarrow> 'z::state_ext state \<Rightarrow> bool" where
  "kernel_mappings_only pt s \<equiv>
     has_kernel_mappings pt s \<and> (\<forall>idx. idx \<notin> kernel_mapping_slots \<longrightarrow> pt idx = InvalidPTE)"

lemma find_vspace_for_asid_wp[wp]:
  "\<lbrace>\<lambda>s. (vspace_for_asid asid s = None \<longrightarrow> E InvalidRoot s) \<and>
        (\<forall>pt. vspace_for_asid asid s = Some pt \<longrightarrow> Q pt s) \<rbrace>
   find_vspace_for_asid asid \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
  unfolding find_vspace_for_asid_def
  by wpsimp

crunch pspace_in_kernel_window[wp]: perform_page_invocation "pspace_in_kernel_window"
  (simp: crunch_simps wp: crunch_wps)

lemma asid_word_bits [simp]: "asid_bits < word_bits"
  by (simp add: asid_bits_def word_bits_def)

lemma vspace_at_asid_vs_lookup:
  "vspace_at_asid asid pt s \<Longrightarrow>
   vs_lookup_table max_pt_level asid 0 s = Some (max_pt_level, pt)"
  by (simp add: vs_lookup_table_def vspace_at_asid_def vspace_for_asid_def in_omonad)

lemma pt_at_asid_unique:
  "\<lbrakk> vspace_at_asid asid pt s; vspace_at_asid asid' pt s;
     unique_table_refs s;
     valid_vs_lookup s; valid_vspace_objs s; valid_asid_table s;
     pspace_aligned s; valid_caps (caps_of_state s) s \<rbrakk>
       \<Longrightarrow> asid = asid'"
  by (drule vspace_at_asid_vs_lookup)+ (drule (1) unique_vs_lookup_table; simp)

lemma pt_at_asid_unique2:
  "\<lbrakk> vspace_at_asid asid pt s; vspace_at_asid asid pt' s \<rbrakk> \<Longrightarrow> pt = pt'"
  by (clarsimp simp: vspace_at_asid_def)

lemma dmo_pt_at_asid[wp]:
  "do_machine_op f \<lbrace>vspace_at_asid a pt\<rbrace>"
  by (wpsimp simp: do_machine_op_def vspace_at_asid_def)

crunch valid_vs_lookup[wp]: do_machine_op "valid_vs_lookup"

lemmas ackInterrupt_irq_masks = no_irq[OF no_irq_ackInterrupt]

crunches sfence, hwASIDFlush, setVSpaceRoot
  for underlying_memory_inv[wp]: "\<lambda>ms. P (underlying_memory ms)"

lemma ucast_ucast_low_bits:
  fixes x :: machine_word
  shows "x \<le> 2^asid_low_bits - 1 \<Longrightarrow> ucast (ucast x:: asid_low_index) = x"
  apply (simp add: ucast_ucast_mask)
  apply (rule less_mask_eq)
  apply (subst (asm) word_less_sub_le)
   apply (simp add: asid_low_bits_def word_bits_def)
  apply (simp add: asid_low_bits_def)
  done

lemma asid_high_bits_of_or:
  "x \<le> 2^asid_low_bits - 1 \<Longrightarrow> asid_high_bits_of (base || x) = asid_high_bits_of base"
  apply (rule word_eqI)
  apply (drule le_2p_upper_bits)
   apply (simp add: asid_low_bits_def word_bits_def)
  apply (simp add: asid_high_bits_of_def word_size nth_ucast nth_shiftr asid_low_bits_def word_bits_def)
  done

lemma vs_lookup_clear_asid_table:
  "vs_lookup_table bot_level asid vref (s\<lparr>arch_state := arch_state s \<lparr>riscv_asid_table :=
                                            (riscv_asid_table (arch_state s)) (pptr := None)\<rparr>\<rparr>)
     = Some (level, p)
   \<Longrightarrow> vs_lookup_table bot_level asid vref s = Some (level, p)"
  by (fastforce simp: vs_lookup_table_def in_omonad pool_for_asid_def split: if_split_asm)

lemma vs_lookup_target_clear_asid_table:
  "vs_lookup_target bot_level asid vref (s\<lparr>arch_state := arch_state s \<lparr>riscv_asid_table :=
                                            (riscv_asid_table (arch_state s)) (pptr := None)\<rparr>\<rparr>)
     = Some (level, p)
  \<Longrightarrow> vs_lookup_target bot_level asid vref s = Some (level, p)"
  apply (clarsimp simp: vs_lookup_target_def in_omonad vs_lookup_slot_def split: if_split_asm)
   apply (fastforce dest!: vs_lookup_clear_asid_table)
  apply (erule disjE, fastforce dest!: vs_lookup_clear_asid_table)
  apply clarify
  apply (drule vs_lookup_clear_asid_table)
  apply simp
  apply blast
  done

lemma valid_arch_state_unmap_strg:
  "valid_arch_state s \<longrightarrow>
   valid_arch_state(s\<lparr>arch_state := arch_state s\<lparr>riscv_asid_table := (riscv_asid_table (arch_state s))(ptr := None)\<rparr>\<rparr>)"
  apply (clarsimp simp: valid_arch_state_def valid_asid_table_def)
  apply (rule conjI)
   apply (clarsimp simp add: ran_def)
   apply blast
  apply (clarsimp simp: inj_on_def)
  done

lemma valid_vspace_objs_unmap_strg:
  "valid_vspace_objs s \<longrightarrow>
   valid_vspace_objs(s\<lparr>arch_state := arch_state s\<lparr>riscv_asid_table := (riscv_asid_table (arch_state s))(ptr := None)\<rparr>\<rparr>)"
  apply (clarsimp simp: valid_vspace_objs_def)
  apply (blast dest: vs_lookup_clear_asid_table)
  done

lemma valid_vs_lookup_unmap_strg:
  "valid_vs_lookup s \<longrightarrow>
   valid_vs_lookup(s\<lparr>arch_state := arch_state s\<lparr>riscv_asid_table := (riscv_asid_table (arch_state s))(ptr := None)\<rparr>\<rparr>)"
  apply (clarsimp simp: valid_vs_lookup_def)
  apply (blast dest: vs_lookup_target_clear_asid_table)
  done

lemma asid_high_bits_shl:
  "is_aligned base asid_low_bits \<Longrightarrow> ucast (asid_high_bits_of base) << asid_low_bits = base"
  unfolding asid_high_bits_of_def asid_low_bits_def is_aligned_mask
  by word_eqI_solve

lemma valid_asid_map_unmap:
  "valid_asid_map s \<and> is_aligned base asid_low_bits \<longrightarrow>
   valid_asid_map(s\<lparr>arch_state := arch_state s\<lparr>riscv_asid_table := (riscv_asid_table (arch_state s))(asid_high_bits_of base := None)\<rparr>\<rparr>)"
  by (clarsimp simp: valid_asid_map_def)

lemma asid_low_bits_word_bits:
  "asid_low_bits < word_bits"
  by (simp add: asid_low_bits_def word_bits_def)

lemma valid_vs_lookup_arch_update:
  "riscv_asid_table (f (arch_state s)) = riscv_asid_table (arch_state s) \<and>
   riscv_kernel_vspace (f (arch_state s)) = riscv_kernel_vspace (arch_state s)
     \<Longrightarrow> valid_vs_lookup (arch_state_update f s) = valid_vs_lookup s"
  by (simp add: valid_vs_lookup_def)

definition valid_unmap :: "vmpage_size \<Rightarrow> asid * vspace_ref \<Rightarrow> bool" where
  "valid_unmap sz \<equiv> \<lambda>(asid, vptr). 0 < asid \<and> is_aligned vptr (pageBitsForSize sz)"

definition
  "parent_for_refs \<equiv> \<lambda>(_, slot) cap.
     \<exists>m. cap = ArchObjectCap (PageTableCap (table_base slot) m) \<and> m \<noteq> None"

definition
  "same_ref \<equiv> \<lambda>(pte, slot) cap s.
     ((\<exists>p. pte_ref pte = Some p \<and> obj_refs cap = {p}) \<or> pte = InvalidPTE) \<and>
     (\<exists>level asid vref. vs_cap_ref cap = Some (asid, vref_for_level vref level) \<and>
                        vs_lookup_slot level asid vref s = Some (level, slot) \<and>
                        vref \<in> user_region \<and> level \<le> max_pt_level)"

definition
  "valid_page_inv pg_inv \<equiv> case pg_inv of
    PageMap acap ptr m \<Rightarrow>
      cte_wp_at (is_arch_update (ArchObjectCap acap)) ptr
      and (cte_wp_at (\<lambda>c. vs_cap_ref c = None) ptr or (\<lambda>s. cte_wp_at (\<lambda>c. same_ref m c s) ptr s))
      and cte_wp_at is_frame_cap ptr
      and same_ref m (ArchObjectCap acap)
      and valid_slots m
      and valid_arch_cap acap
      and K (is_PagePTE (fst m) \<or> fst m = InvalidPTE)
      and (\<lambda>s. \<exists>slot. cte_wp_at (parent_for_refs m) slot s)
  | PageUnmap acap cslot \<Rightarrow>
     \<lambda>s. \<exists>dev r R sz m.
            acap = FrameCap r R sz dev m \<and>
            case_option True (valid_unmap sz) m \<and>
            cte_wp_at ((=) (ArchObjectCap acap)) cslot s \<and>
            valid_arch_cap acap s
  | PageGetAddr ptr \<Rightarrow> \<top>"

definition
  "valid_pti pti \<equiv> case pti of
     PageTableMap acap cslot pte pt_slot \<Rightarrow>
       pte_at pt_slot and K (wellformed_pte pte \<and> is_PageTablePTE pte) and
       valid_arch_cap acap and
       cte_wp_at (\<lambda>c. is_arch_update (ArchObjectCap acap) c \<and> cap_asid c = None) cslot and
       invalid_pte_at pt_slot and
       (\<lambda>s. \<exists>p' level asid vref.
                vs_cap_ref_arch acap = Some (asid, vref_for_level vref level)
                \<and> vs_lookup_slot level asid vref s = Some (level, pt_slot)
                \<and> valid_pte level pte s
                \<and> pte_ref pte = Some p' \<and> obj_refs (ArchObjectCap acap) = {p'}
                \<and> (\<exists>ao. ko_at (ArchObj ao) p' s \<and> valid_vspace_obj (level-1) ao s)
                \<and> pts_of s p' = Some empty_pt
                \<and> vref \<in> user_region) and
       K (is_PageTableCap acap \<and> cap_asid_arch acap \<noteq> None)
   | PageTableUnmap acap cslot \<Rightarrow>
       cte_wp_at ((=) (ArchObjectCap acap)) cslot
       and real_cte_at cslot
       and valid_arch_cap acap
       and is_final_cap' (ArchObjectCap acap)
       and K (is_PageTableCap acap)
       and (\<lambda>s. \<forall>asid vref. vs_cap_ref_arch acap = Some (asid, vref) \<longrightarrow>
                            vspace_for_asid asid s \<noteq> aobj_ref acap)"

crunches unmap_page
  for aligned [wp]: pspace_aligned
  and "distinct" [wp]: pspace_distinct
  and valid_objs[wp]: valid_objs
  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
  (wp: crunch_wps simp: crunch_simps)

lemma set_cap_valid_slots[wp]:
  "set_cap cap p \<lbrace>valid_slots slots\<rbrace>"
  apply (cases slots, clarsimp simp: valid_slots_def)
  apply (wpsimp wp: hoare_vcg_ball_lift hoare_vcg_all_lift hoare_vcg_imp_lift')
  apply blast
  done

lemma pt_lookup_from_level_inv[wp]:
  "\<lbrace>Q and E\<rbrace> pt_lookup_from_level level pt_ptr vptr target_pt_ptr \<lbrace>\<lambda>_. Q\<rbrace>,\<lbrace>\<lambda>_. E\<rbrace>"
proof (induct level arbitrary: pt_ptr)
  case 0
  then show ?case by (wpsimp simp: pt_lookup_from_level_simps)
next
  case (minus level)
  note IH = minus(1)
  from \<open>0 < level\<close>  show ?case by (subst pt_lookup_from_level_simps) (wpsimp wp: IH)
qed

crunches unmap_page_table
  for aligned[wp]: pspace_aligned
  and valid_objs[wp]: valid_objs
  and "distinct"[wp]: pspace_distinct
  and caps_of_state[wp]: "\<lambda>s. P (caps_of_state s)"
  and typ_at[wp]: "\<lambda>s. P (typ_at T p s)"
  (wp: crunch_wps)

definition
  "valid_apinv ap \<equiv> case ap of
    Assign asid p slot \<Rightarrow>
      (\<lambda>s. \<exists>pool. asid_pools_of s p = Some pool \<and> pool (ucast asid) = None)
      and cte_wp_at (\<lambda>cap. is_pt_cap cap \<and> cap_asid cap = None) slot
      and K (0 < asid)
      and (\<lambda>s. pool_for_asid asid s = Some p)"

crunch device_state_inv[wp]: ackInterrupt "\<lambda>ms. P (device_state ms)"

lemmas setIRQTrigger_irq_masks = no_irq[OF no_irq_setIRQTrigger]

lemma dmo_setIRQTrigger_invs[wp]: "\<lbrace>invs\<rbrace> do_machine_op (setIRQTrigger irq b) \<lbrace>\<lambda>y. invs\<rbrace>"
  apply (wp dmo_invs)
   apply (simp add: machine_op_lift_device_state setIRQTrigger_def)
  apply safe
   apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p = underlying_memory m p" in use_valid)
     apply ((wpsimp simp: setIRQTrigger_def machine_op_lift_def machine_rest_lift_def split_def)+)[3]
  apply (erule (1) use_valid[OF _ setIRQTrigger_irq_masks])
  done

lemma dmo_ackInterrupt[wp]: "\<lbrace>invs\<rbrace> do_machine_op (ackInterrupt irq) \<lbrace>\<lambda>y. invs\<rbrace>"
  apply (wp dmo_invs)
  apply safe
   apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p = underlying_memory m p" in use_valid)
     apply ((clarsimp simp: ackInterrupt_def machine_op_lift_def
                            machine_rest_lift_def split_def | wp)+)[3]
  apply(erule (1) use_valid[OF _ ackInterrupt_irq_masks])
  done

lemma dmo_setVMRoot[wp]:
  "do_machine_op (setVSpaceRoot pt asid) \<lbrace>invs\<rbrace>"
  apply (wp dmo_invs)
  apply (auto simp: setVSpaceRoot_def machine_op_lift_def machine_rest_lift_def in_monad select_f_def)
  done

lemma dmo_sfence[wp]:
  "do_machine_op sfence \<lbrace>invs\<rbrace>"
  apply (wp dmo_invs)
  apply (auto simp: sfence_def machine_op_lift_def machine_rest_lift_def in_monad select_f_def)
  done

lemma find_vspace_for_asid_inv[wp]:
  "\<lbrace>P and Q\<rbrace> find_vspace_for_asid asid \<lbrace>\<lambda>_. P\<rbrace>, \<lbrace>\<lambda>_. Q\<rbrace>"
  unfolding find_vspace_for_asid_def by wpsimp

lemma set_vm_root_typ_at[wp]:
  "set_vm_root t \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace>"
  unfolding set_vm_root_def
  by (wpsimp simp: if_distribR wp: get_cap_wp)

lemma set_vm_root_invs[wp]:
  "set_vm_root t \<lbrace>invs\<rbrace>"
  unfolding set_vm_root_def
  by (wpsimp simp: if_distribR wp: get_cap_wp)

crunch pred_tcb_at[wp]: set_vm_root "pred_tcb_at proj P t"
  (simp: crunch_simps)

lemmas set_vm_root_typ_ats [wp] = abs_typ_at_lifts [OF set_vm_root_typ_at]

lemma valid_pte_lift3:
  assumes x: "(\<And>P T p. \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace> f \<lbrace>\<lambda>rv s. P (typ_at T p s)\<rbrace>)"
  shows "\<lbrace>\<lambda>s. P (valid_pte level pte s)\<rbrace> f \<lbrace>\<lambda>rv s. P (valid_pte level pte s)\<rbrace>"
  apply (insert bool_function_four_cases[where f=P])
  apply (erule disjE)
   apply (cases pte)
     apply (simp add: data_at_def | wp hoare_vcg_const_imp_lift hoare_vcg_disj_lift x)+
  apply (erule disjE)
   apply (cases pte)
     apply (simp add: data_at_def | wp hoare_vcg_disj_lift hoare_vcg_const_imp_lift x)+
  apply (erule disjE)
   apply (simp | wp)+
  done

lemma set_cap_valid_pte_stronger:
  "set_cap cap p \<lbrace>\<lambda>s. P (valid_pte level pte s)\<rbrace>"
  by (wp valid_pte_lift3 set_cap_typ_at)

(* FIXME: move *)
lemma valid_cap_to_pt_cap:
  "\<lbrakk>valid_cap c s; obj_refs c = {p}; pt_at p s\<rbrakk> \<Longrightarrow> is_pt_cap c"
  by (clarsimp simp: valid_cap_def obj_at_def is_obj_defs is_pt_cap_def valid_arch_cap_ref_def
              split: cap.splits option.splits arch_cap.splits if_splits)

lemma set_cap_invalid_pte[wp]:
  "set_cap cap p' \<lbrace>invalid_pte_at p\<rbrace>"
  unfolding invalid_pte_at_def by wpsimp

lemma valid_cap_obj_ref_pt:
  "\<lbrakk> s \<turnstile> cap; s \<turnstile> cap'; obj_refs cap = obj_refs cap' \<rbrakk>
       \<Longrightarrow> is_pt_cap cap \<longrightarrow> is_pt_cap cap'"
  by (auto simp: is_cap_simps valid_cap_def valid_arch_cap_ref_def
                 obj_at_def is_ep is_ntfn is_cap_table is_tcb a_type_def
          split: cap.split_asm if_split_asm arch_cap.split_asm option.split_asm)

lemma is_pt_cap_asid_None_table_ref:
  "is_pt_cap cap \<Longrightarrow> (table_cap_ref cap = None) = (cap_asid cap = None)"
  by (auto simp: is_cap_simps table_cap_ref_def cap_asid_def
          split: option.split_asm)

lemma no_cap_to_obj_with_diff_ref_map:
  "\<lbrakk> caps_of_state s p = Some cap; is_pt_cap cap;
     table_cap_ref cap = None;
     unique_table_caps s;
     valid_objs s; obj_refs cap = obj_refs cap' \<rbrakk>
       \<Longrightarrow> no_cap_to_obj_with_diff_ref cap' {p} s"
  apply (clarsimp simp: no_cap_to_obj_with_diff_ref_def
                        cte_wp_at_caps_of_state)
  apply (frule(1) caps_of_state_valid_cap[where p=p])
  apply (frule(1) caps_of_state_valid_cap[where p="(a, b)" for a b])
  apply (drule(1) valid_cap_obj_ref_pt, simp)
  apply (drule(1) unique_table_capsD[rotated, where cps="caps_of_state s"]; simp?)
  apply (simp add: vs_cap_ref_table_cap_ref_eq)
  done

lemmas store_pte_cte_wp_at1[wp]
    = hoare_cte_wp_caps_of_state_lift [OF store_pte_caps_of_state]

lemma mdb_cte_at_store_pte[wp]:
  "store_pte y pte \<lbrace>\<lambda>s. mdb_cte_at (swp (cte_wp_at ((\<noteq>) cap.NullCap)) s) (cdt s)\<rbrace>"
  apply (clarsimp simp:mdb_cte_at_def)
  apply (simp only: imp_conv_disj)
  apply (wpsimp wp: hoare_vcg_disj_lift hoare_vcg_all_lift simp: store_pte_def set_pt_def)
  done

crunches store_pte
  for global_refs[wp]: "\<lambda>s. P (global_refs s)"

(* FIXME: move *)
lemma vs_cap_ref_table_cap_ref_None:
  "vs_cap_ref x = None \<Longrightarrow> table_cap_ref x = None"
  by (simp add: vs_cap_ref_def arch_cap_fun_lift_def vs_cap_ref_arch_def
         split: cap.splits arch_cap.splits)

(* FIXME: move *)
lemma master_cap_eq_is_device_cap_eq:
  "cap_master_cap c = cap_master_cap d \<Longrightarrow> cap_is_device c = cap_is_device d"
  by (simp add: cap_master_cap_def
         split: cap.splits arch_cap.splits)

lemma vs_cap_ref_eq_imp_table_cap_ref_eq':
  "\<lbrakk> vs_cap_ref cap = vs_cap_ref cap'; cap_master_cap cap = cap_master_cap cap' \<rbrakk>
   \<Longrightarrow> table_cap_ref cap = table_cap_ref cap'"
  by (simp add: vs_cap_ref_def vs_cap_ref_arch_def arch_cap_fun_lift_def cap_master_cap_def
           split: cap.splits arch_cap.splits option.splits prod.splits)

lemma arch_update_cap_invs_map:
  "\<lbrace>cte_wp_at (is_arch_update cap and
               (\<lambda>c. \<forall>r. vs_cap_ref c = Some r \<longrightarrow> vs_cap_ref cap = Some r)) p
             and invs and valid_cap cap\<rbrace>
  set_cap cap p
  \<lbrace>\<lambda>rv. invs\<rbrace>"
  apply (simp add: invs_def valid_state_def)
  apply (rule hoare_pre)
   apply (wp arch_update_cap_pspace arch_update_cap_valid_mdb set_cap_idle
             update_cap_ifunsafe valid_irq_node_typ set_cap_typ_at
             set_cap_irq_handlers set_cap_valid_arch_caps
             set_cap_cap_refs_respects_device_region_spec[where ptr = p])
  apply (clarsimp simp: cte_wp_at_caps_of_state
              simp del: imp_disjL)
  apply (frule(1) valid_global_refsD2)
  apply (frule(1) cap_refs_in_kernel_windowD)
  apply (clarsimp simp: is_cap_simps is_arch_update_def
              simp del: imp_disjL)
  apply (frule master_cap_cap_range, simp del: imp_disjL)
  apply (thin_tac "cap_range a = cap_range b" for a b)
  apply (rule conjI)
   apply (clarsimp simp: is_valid_vtable_root_def vs_cap_ref_def vs_cap_ref_arch_def split: cap.splits)
   apply (simp split: arch_cap.splits option.splits;
          clarsimp simp: cap_master_cap_simps vs_cap_ref_arch_def)
  apply (rule conjI)
   apply (rule ext)
   apply (simp add: cap_master_cap_def split: cap.splits arch_cap.splits)
  apply (rule context_conjI)
   apply (simp add: appropriate_cte_cap_irqs)
   apply (clarsimp simp: cap_irqs_def cap_irq_opt_def cap_master_cap_def
                  split: cap.split)
  apply (rule conjI)
   apply (drule(1) if_unsafe_then_capD [OF caps_of_state_cteD])
    apply (clarsimp simp: cap_master_cap_def)
   apply (erule ex_cte_cap_wp_to_weakenE)
   apply (clarsimp simp: appropriate_cte_cap_def cap_master_cap_def
                  split: cap.split_asm)
  apply (rule conjI)
   apply (frule master_cap_obj_refs)
   apply simp
  apply (rule conjI)
   apply (frule master_cap_obj_refs)
   apply (case_tac "table_cap_ref capa =
                    table_cap_ref (ArchObjectCap a)")
    apply (frule unique_table_refs_no_cap_asidE[where S="{p}"])
     apply (simp add: valid_arch_caps_def)
    apply (simp add: no_cap_to_obj_with_diff_ref_def Ball_def)
   apply (case_tac "table_cap_ref capa")
    apply clarsimp
    apply (erule no_cap_to_obj_with_diff_ref_map,
           simp_all)[1]
      apply (clarsimp simp: table_cap_ref_def cap_master_cap_simps
                            is_cap_simps table_cap_ref_arch_def
                     split: cap.split_asm arch_cap.split_asm
                     dest!: cap_master_cap_eqDs)
     apply (simp add: valid_arch_caps_def)
    apply (simp add: valid_pspace_def)
   apply (erule swap)
   apply (rule vs_cap_ref_eq_imp_table_cap_ref_eq')
    apply (frule table_cap_ref_vs_cap_ref_Some)
    apply fastforce
   apply fastforce
  apply (rule conjI)
   apply (clarsimp simp del: imp_disjL)
   apply (clarsimp simp: is_pt_cap_def cap_master_cap_simps
                         cap_asid_def vs_cap_ref_def
                  dest!: cap_master_cap_eqDs split: option.split_asm prod.split_asm)
   apply (drule valid_table_capsD[OF caps_of_state_cteD])
      apply (clarsimp simp: invs_def valid_state_def valid_arch_caps_def)
     apply (simp add: is_pt_cap_def)
    apply (simp add: cap_asid_def split: option.splits)
   apply simp
  apply (clarsimp simp: is_cap_simps is_pt_cap_def cap_master_cap_simps
                        cap_asid_def vs_cap_ref_def ranI
                 dest!: cap_master_cap_eqDs split: option.split_asm if_split_asm
                 elim!: ranE cong: master_cap_eq_is_device_cap_eq
             | rule conjI)+
  apply (clarsimp dest!: master_cap_eq_is_device_cap_eq)
  done

lemma pool_for_asid_ap_at:
  "\<lbrakk> pool_for_asid asid s = Some p; valid_arch_state s \<rbrakk> \<Longrightarrow> asid_pool_at p s"
  by (fastforce dest!: pool_for_asid_validD simp: valid_arch_state_def asid_pools_at_eq)

lemma arch_update_cap_invs_unmap_page:
  "\<lbrace>(\<lambda>s. \<exists>cap'.
             caps_of_state s p = Some cap' \<and>
             (\<forall>p'\<in>obj_refs cap'.
                 \<forall>asid vref.
                    vs_cap_ref cap' = Some (asid, vref) \<longrightarrow>
                    (\<forall>level. vs_lookup_target level asid vref s \<noteq> Some (level, p'))) \<and>
             is_arch_update cap cap')
             and invs and valid_cap cap
             and K (is_frame_cap cap)\<rbrace>
  set_cap cap p
  \<lbrace>\<lambda>rv. invs\<rbrace>"
  apply (simp add: cte_wp_at_caps_of_state)
  apply (simp add: invs_def valid_state_def)
  apply (rule hoare_pre)
   apply (wp arch_update_cap_pspace arch_update_cap_valid_mdb set_cap_idle
             update_cap_ifunsafe valid_irq_node_typ set_cap_typ_at
             set_cap_irq_handlers set_cap_valid_arch_caps
             set_cap_cap_refs_respects_device_region_spec[where ptr = p])
  apply clarsimp
  apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_update_def
                        is_cap_simps cap_master_cap_simps
                        fun_eq_iff appropriate_cte_cap_irqs
                        is_pt_cap_def is_valid_vtable_root_def
                 dest!: cap_master_cap_eqDs
              simp del: imp_disjL)
  apply (rule conjI)
   apply (drule(1) if_unsafe_then_capD [OF caps_of_state_cteD])
    apply (clarsimp simp: cap_master_cap_def)
   apply (erule ex_cte_cap_wp_to_weakenE)
   apply (clarsimp simp: appropriate_cte_cap_def)
  apply (rule conjI)
   apply (drule valid_global_refsD2, clarsimp)
   subgoal by (simp add: cap_range_def)
  apply (rule conjI)
   apply (clarsimp simp: reachable_target_def reachable_frame_cap_def)
   apply (drule (1) pool_for_asid_ap_at)
   apply (clarsimp simp: valid_cap_def obj_at_def split: if_split_asm)
  apply (rule conjI[rotated])
   apply (frule(1) cap_refs_in_kernel_windowD)
   apply (simp add: cap_range_def)
  apply (drule unique_table_refs_no_cap_asidE[where S="{p}"])
   apply (simp add: valid_arch_caps_def)
  apply (simp add: no_cap_to_obj_with_diff_ref_def table_cap_ref_def Ball_def)
  done

lemma mask_cap_PageTableCap[simp]:
  "mask_cap R (ArchObjectCap (PageTableCap p data)) = ArchObjectCap (PageTableCap p data)"
  by (clarsimp simp: mask_cap_def cap_rights_update_def acap_rights_update_def)

lemma arch_update_cap_pspace':
  "\<lbrace>cte_wp_at (is_arch_update cap) p and real_cte_at p and valid_pspace and valid_cap cap\<rbrace>
   set_cap cap p
   \<lbrace>\<lambda>_. valid_pspace\<rbrace>"
  apply (simp add: valid_pspace_def)
  apply (rule hoare_pre)
   apply (wp set_cap_valid_objs update_cap_iflive arch_update_cap_zombies)
  apply clarsimp
  apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_update_def)
  apply (frule cap_master_cap_zobj_refs)
  apply clarsimp
  apply (drule caps_of_state_cteD)
  apply (drule (1) cte_wp_tcb_cap_valid)
  apply (erule real_cte_tcb_valid[rule_format])
  done

lemma arch_update_cap_invs_unmap_page_table:
  "\<lbrace>cte_wp_at (is_arch_update cap) p
             and real_cte_at p
             and invs and valid_cap cap
             and (\<lambda>s. cte_wp_at (\<lambda>c. is_final_cap' c s) p s)
             and (\<lambda>s. pts_of s (obj_ref_of cap) = Some empty_pt)
             and (\<lambda>s. cte_wp_at (\<lambda>c. \<forall>asid vref level. vs_cap_ref c = Some (asid, vref)
                                \<longrightarrow> vs_lookup_target level asid vref s \<noteq> Some (level, obj_ref_of cap)) p s)
             and K (is_pt_cap cap \<and> vs_cap_ref cap = None)\<rbrace>
  set_cap cap p
  \<lbrace>\<lambda>rv. invs\<rbrace>"
  apply (simp add: invs_def valid_state_def)
  apply (rule hoare_pre)
   apply (wp arch_update_cap_pspace' arch_update_cap_valid_mdb set_cap_idle
             update_cap_ifunsafe valid_irq_node_typ set_cap_typ_at
             set_cap_irq_handlers set_cap_valid_arch_caps
             set_cap_cap_refs_respects_device_region_spec[where ptr = p])
  apply (simp add: final_cap_at_eq)
  apply (clarsimp simp: cte_wp_at_caps_of_state is_arch_update_def
                        is_cap_simps cap_master_cap_simps is_valid_vtable_root_def
                        appropriate_cte_cap_irqs is_pt_cap_def
                        fun_eq_iff[where f="cte_refs cap" for cap]
                 dest!: cap_master_cap_eqDs
              simp del: imp_disjL)
  apply (rule conjI)
   apply (drule(1) if_unsafe_then_capD [OF caps_of_state_cteD])
    apply (clarsimp simp: cap_master_cap_def)
   apply (erule ex_cte_cap_wp_to_weakenE)
   apply (clarsimp simp: appropriate_cte_cap_def)
  apply (rule conjI)
   apply (drule valid_global_refsD2, clarsimp)
   apply (simp add: cap_range_def)
  apply (frule(1) cap_refs_in_kernel_windowD)
  apply (simp add: cap_range_def gen_obj_refs_def image_def)
  apply (rule conjI)
   apply (clarsimp simp: reachable_target_def reachable_frame_cap_def)
   apply (drule (1) pool_for_asid_ap_at)
   apply (clarsimp simp: valid_cap_def obj_at_def split: if_split_asm)
  apply (intro conjI)
    apply (clarsimp simp: no_cap_to_obj_with_diff_ref_def
                          cte_wp_at_caps_of_state)
    apply fastforce
   apply (clarsimp simp: obj_at_def empty_table_def in_omonad)
  apply fastforce
  done

lemma global_refs_arch_update_eq:
  "riscv_global_pts (f (arch_state s)) = riscv_global_pts (arch_state s) \<Longrightarrow>
   global_refs (arch_state_update f s) = global_refs s"
  by (simp add: global_refs_def)

lemma not_in_global_refs_vs_lookup:
  "(\<exists>\<rhd> (level,p)) s \<and> valid_vs_lookup s \<and> valid_global_refs s
            \<and> valid_arch_state s \<and> valid_global_objs s
            \<and> pt_at p s
        \<longrightarrow> p \<notin> global_refs s"
  apply clarsimp
  apply (cases "level = asid_pool_level"; simp)
   apply (simp add: vs_lookup_table_def in_omonad)
   apply (drule (1) pool_for_asid_ap_at)
   apply (clarsimp simp: obj_at_def)
  apply (drule (1) vs_lookup_table_target)
  apply (drule valid_vs_lookupD; clarsimp simp: vref_for_level_user_region)
  apply (drule(1) valid_global_refsD2)
  apply (simp add: cap_range_def)
  done

lemma no_irq_sfence[wp,intro!]: "no_irq sfence"
  by (wpsimp simp: sfence_def no_irq_def machine_op_lift_def machine_rest_lift_def)

lemma pt_lookup_from_level_wp:
  "\<lbrace>\<lambda>s. (\<forall>level pt' pte.
            pt_walk top_level level top_level_pt vref (ptes_of s) = Some (level, pt') \<longrightarrow>
            ptes_of s (pt_slot_offset level pt' vref) = Some pte \<longrightarrow>
            is_PageTablePTE pte \<longrightarrow>
            pte_ref pte = Some pt \<longrightarrow>
            Q (pt_slot_offset level pt' vref) s) \<and>
        ((\<forall>level < top_level.
            pt_walk top_level level top_level_pt vref (ptes_of s) \<noteq> Some (level, pt)) \<longrightarrow>
            E InvalidRoot s)\<rbrace>
  pt_lookup_from_level top_level top_level_pt vref pt
  \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
proof (induct top_level arbitrary: top_level_pt)
  case 0
  then show ?case
    by (wpsimp simp: pt_lookup_from_level_simps)
next
  case (minus top_level)
  note IH=minus(1)
  from \<open>0 < top_level\<close>
  show ?case
    apply (subst pt_lookup_from_level_simps)
    apply (wpsimp wp: IH)
    apply (rule conjI; clarsimp)
     prefer 2
     apply (subst (asm) (2) pt_walk.simps)
     apply (clarsimp)
    apply (rule conjI; clarsimp)
     apply (erule_tac x="top_level" in allE)
     apply (clarsimp simp: in_omonad is_PageTablePTE_def pptr_from_pte_def)
    apply (rule conjI; clarsimp)
     apply (rename_tac pt' pte)
     apply (frule pt_walk_max_level)
     apply (erule_tac x=level in allE)
     apply (erule_tac x=pt' in allE)
     apply simp
     apply (erule mp)
     apply (subst pt_walk.simps)
     apply (simp add: in_omonad bit0.leq_minus1_less)
    apply (subst (asm) (3) pt_walk.simps)
    apply (case_tac "level = top_level - 1"; clarsimp)
    apply (subgoal_tac "level < top_level - 1", fastforce)
    apply (frule bit0.zero_least)
    apply (subst (asm) bit0.leq_minus1_less[symmetric], assumption)
    apply simp
    done
qed

(* weaker than pspace_aligned_pts_ofD, but still sometimes useful because it matches better *)
lemma pts_of_Some_alignedD:
  "\<lbrakk> pts_of s p = Some pt; pspace_aligned s \<rbrakk> \<Longrightarrow> is_aligned p pt_bits"
  by (drule pspace_aligned_pts_ofD; simp)

lemma vs_lookup_target_not_global:
  "\<lbrakk> vs_lookup_target level asid vref s = Some (level, pt); vref \<in> user_region; invs s \<rbrakk>
   \<Longrightarrow> pt \<notin> global_refs s"
  apply (drule (1) valid_vs_lookupD; clarsimp)
  apply (drule valid_global_refsD2; clarsimp)
  apply (simp add: cap_range_def)
  done

lemma reachable_page_table_not_global:
  "\<lbrakk> vs_lookup_table level asid vref s = Some (level, p); level \<le> max_pt_level;
     vref \<in> user_region; invs s\<rbrakk>
   \<Longrightarrow> p \<notin> global_refs s"
  apply (drule (1) vs_lookup_table_target)
  apply (erule vs_lookup_target_not_global)
   apply (erule vref_for_level_user_region)
  apply assumption
  done

lemma unmap_page_table_invs[wp]:
  "\<lbrace>invs and K (vaddr \<in> user_region)\<rbrace>
     unmap_page_table asid vaddr pt
   \<lbrace>\<lambda>rv. invs\<rbrace>"
  apply (simp add: unmap_page_table_def)
  apply (rule hoare_pre)
   apply (wp dmo_invs | wpc | simp)+
     apply (rule_tac Q="\<lambda>_. invs" in hoare_post_imp)
      apply safe
       apply (drule_tac Q="\<lambda>_ m'. underlying_memory m' p =
                                  underlying_memory m p" in use_valid)
         apply ((wp | simp)+)[3]
      apply(erule use_valid, wp no_irq, assumption)
     apply (wpsimp wp: store_pte_invs_unmap pt_lookup_from_level_wp)+
  apply (frule pt_walk_max_level)
  apply (drule (2) pt_lookup_vs_lookupI)
  apply (frule (2) valid_vspace_objs_strongD[rotated]; clarsimp)
  apply (frule pts_of_Some_alignedD; clarsimp)
  apply (rule conjI)
   apply (drule (1) vs_lookup_table_target)
   apply (drule valid_vs_lookupD, erule vref_for_level_user_region, clarsimp)
   apply clarsimp
   apply (frule (1) cap_to_pt_is_pt_cap; clarsimp?)
    apply (fastforce intro: valid_objs_caps)
   apply (fastforce simp: is_cap_simps)
  apply (rule conjI; clarsimp?)
   apply (drule (3) vs_lookup_table_vspace)
   apply (simp add: table_index_max_level_slots)
  apply (drule (1) vs_lookup_table_target)
  apply (drule vs_lookup_target_not_global, erule vref_for_level_user_region; simp)
  done

lemma final_cap_lift:
  assumes x: "\<And>P. \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace> f \<lbrace>\<lambda>rv s. P (caps_of_state s)\<rbrace>"
  shows      "\<lbrace>\<lambda>s. P (is_final_cap' cap s)\<rbrace> f \<lbrace>\<lambda>rv s. P (is_final_cap' cap s)\<rbrace>"
  by (simp add: is_final_cap'_def2 cte_wp_at_caps_of_state, rule x)

lemmas dmo_final_cap[wp] = final_cap_lift [OF do_machine_op_caps_of_state]
lemmas store_pte_final_cap[wp] = final_cap_lift [OF store_pte_caps_of_state]
lemmas unmap_page_table_final_cap[wp] = final_cap_lift [OF unmap_page_table_caps_of_state]

lemma store_pte_vspace_for_asid[wp]:
  "store_pte p pte \<lbrace>\<lambda>s. P (vspace_for_asid asid s)\<rbrace>"
  by (wp vspace_for_asid_lift)

lemma mapM_swp_store_pte_invs_unmap:
  "\<lbrace>invs and
    (\<lambda>s. \<forall>sl\<in>set slots. table_base sl \<notin> global_refs s \<and>
                        (\<forall>asid. vspace_for_asid asid s \<noteq> Some (table_base sl))) and
    K (pte = InvalidPTE)\<rbrace>
  mapM (swp store_pte pte) slots \<lbrace>\<lambda>_. invs\<rbrace>"
  apply (rule hoare_post_imp)
   prefer 2
   apply (rule mapM_wp')
   apply simp
   apply (wp store_pte_invs hoare_vcg_const_Ball_lift hoare_vcg_ex_lift hoare_vcg_all_lift)
   apply (clarsimp simp: wellformed_pte_def)
  apply simp
  done

lemma mapM_x_swp_store_pte_invs_unmap:
  "\<lbrace>invs and (\<lambda>s. \<forall>sl \<in> set slots. table_base sl \<notin> global_refs s \<and>
                                    (\<forall>asid. vspace_for_asid asid s \<noteq> Some (table_base sl))) and
    K (pte = InvalidPTE)\<rbrace>
  mapM_x (swp store_pte pte) slots \<lbrace>\<lambda>_. invs\<rbrace>"
  by (simp add: mapM_x_mapM | wp mapM_swp_store_pte_invs_unmap)+

lemma vs_lookup_table_step:
  "\<lbrakk> vs_lookup_table level asid vref s = Some (level, pt'); level \<le> max_pt_level; 0 < level;
     ptes_of s (pt_slot_offset level pt' vref) = Some pte; is_PageTablePTE pte;
     pte_ref pte = Some pt \<rbrakk> \<Longrightarrow>
    vs_lookup_table (level-1) asid vref s = Some (level-1, pt)"
  apply (subst vs_lookup_split_Some[where level'=level]; assumption?)
   apply (simp add: order_less_imp_le)
  apply (subst pt_walk.simps)
  apply (clarsimp simp: in_omonad is_PageTablePTE_def pptr_from_pte_def)
  done

lemma pte_ref_Some_cases:
  "(pte_ref pte = Some ref) = ((is_PageTablePTE pte \<or> is_PagePTE pte) \<and> ref = pptr_from_pte pte)"
  by (cases pte) (auto simp: pptr_from_pte_def)

lemma max_pt_level_eq_minus_one:
  "level - 1 = max_pt_level \<Longrightarrow> level = asid_pool_level"
  unfolding level_defs by auto

lemma store_pte_invalid_vs_lookup_target_unmap:
  "\<lbrace>\<lambda>s. (\<exists>level'. vs_lookup_slot level' asid vref s = Some (level', p) \<and>
                  pte_refs_of s p = Some p') \<and>
         vref \<in> user_region \<and>
         pspace_aligned s \<and> valid_asid_table s \<and> valid_vspace_objs s \<and>
         unique_table_refs s \<and> valid_vs_lookup s \<and> valid_caps (caps_of_state s) s \<rbrace>
   store_pte p InvalidPTE
   \<lbrace>\<lambda>_ s. vs_lookup_target level asid vref s \<noteq> Some (level, p')\<rbrace>"
  unfolding store_pte_def set_pt_def
  supply fun_upd_apply[simp del]
  apply (wpsimp wp: set_object_wp simp: obj_at_def)
  apply (prop_tac "level' \<le> max_pt_level")
   apply (clarsimp simp: vs_lookup_slot_def pool_for_asid_vs_lookup split: if_split_asm)
   apply (drule (1) pool_for_asid_validD)
   apply (clarsimp simp: obj_at_def in_omonad)
   apply (frule_tac p=p in pspace_alignedD, assumption)
   apply (simp add: bit_simps)
  apply (frule (5) valid_vspace_objs_strong_slotD)
  apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
  apply (clarsimp simp: in_omonad pte_ref_Some_cases)
  apply (rename_tac pt_ptr pte)
  apply (frule (5) vs_lookup_table_is_aligned)
  apply clarsimp
  apply (clarsimp simp: vs_lookup_target_def vs_lookup_slot_def pool_for_asid_vs_lookup
                  split: if_split_asm)
   apply (prop_tac "asid_pools_of s pt_ptr = None")
    apply (clarsimp simp: opt_map_def)
   apply simp
   apply (prop_tac "vs_lookup_table max_pt_level asid vref s = Some (max_pt_level, p')")
    apply (clarsimp simp: vs_lookup_table_def in_omonad)
   apply (erule disjE)
    (* PageTablePTE: level' would have to be asid_pool_level, contradiction *)
    apply (drule (1) vs_lookup_table_step; simp?)
      apply (rule ccontr)
      apply (clarsimp simp flip: bit0.neq_0_conv simp: is_PageTablePTE_def)
     apply (fastforce simp: pte_ref_Some_cases)
    apply (drule (1) no_loop_vs_lookup_table; simp?)
   (* PagePTE *)
   apply (prop_tac "\<exists>sz. data_at sz p' s")
    apply (fastforce simp: is_PagePTE_def pptr_from_pte_def)
   apply clarsimp
   apply (drule (2) valid_vspace_objs_strongD[where level=max_pt_level]; clarsimp)
   apply (fastforce simp: data_at_def obj_at_def in_omonad)
  apply (clarsimp simp: in_omonad)
  apply (rename_tac pt_ptr' pte')
  apply (case_tac "level' \<le> level")
   apply (drule (9) vs_lookup_table_fun_upd_deep_idem)
   apply (frule (5) vs_lookup_table_is_aligned[where bot_level=level])
   apply (clarsimp simp: ptes_of_def fun_upd_apply in_omonad split: if_split_asm)
    apply (drule (1) no_loop_vs_lookup_table; simp)
   apply (rename_tac pt')
   apply (case_tac "level' = level", simp)
   apply (prop_tac "valid_pte level (pt' (table_index (pt_slot_offset level pt_ptr' vref))) s")
    apply (drule (2) valid_vspace_objsD[where bot_level=level])
     apply (simp add: in_omonad)
    apply simp
    apply (drule_tac x="table_index (pt_slot_offset level pt_ptr' vref)" in bspec)
     apply (fastforce dest: table_index_max_level_slots)
    apply fastforce
   apply (erule disjE)
    (* PageTablePTE *)
    apply (prop_tac "is_PageTablePTE (pt' (table_index (pt_slot_offset level pt_ptr' vref)))")
     apply (case_tac "pt' (table_index (pt_slot_offset level pt_ptr' vref))"; simp)
     apply (clarsimp simp: is_PageTablePTE_def obj_at_def data_at_def pptr_from_pte_def)
    apply (drule (1) vs_lookup_table_step; simp?)
      apply (rule ccontr)
      apply (clarsimp simp flip: bit0.neq_0_conv simp: is_PageTablePTE_def)
     apply (clarsimp simp: ptes_of_def in_omonad)
    apply (drule (1) vs_lookup_table_step)
           apply (rule ccontr)
           apply (clarsimp simp flip: bit0.neq_0_conv simp: is_PageTablePTE_def)
          apply (clarsimp simp: ptes_of_def in_omonad)
          apply (rule refl)
         apply simp
        apply (simp add: pte_ref_Some_cases)
    apply (simp add: pte_ref_Some_cases)
    apply (drule (1) no_loop_vs_lookup_table; simp)
   apply (prop_tac "\<not>is_PageTablePTE (pt' (table_index (pt_slot_offset level pt_ptr' vref)))")
     apply (case_tac "pt' (table_index (pt_slot_offset level pt_ptr' vref))"; simp)
     apply (clarsimp simp: is_PagePTE_def obj_at_def data_at_def pptr_from_pte_def)
   apply (drule_tac level=level' and level'=level in vs_lookup_splitD; clarsimp)
   apply (subst (asm) pt_walk.simps)
   apply (clarsimp simp: in_omonad ptes_of_def split: if_split_asm)
  apply (simp add: not_le)
   apply (drule_tac level=level and level'=level' in vs_lookup_splitD; simp?)
  apply clarsimp
  apply (drule (1) vs_lookup_table_fun_upd_deep_idem; simp)
  apply (subst (asm) pt_walk.simps)
  apply (clarsimp simp: in_omonad)
  apply (subst (asm) (3) pte_of_def)
  apply (clarsimp simp: in_omonad fun_upd_apply split: if_split_asm)
  done

lemma pt_lookup_from_level_wrp:
  "\<lbrace>\<lambda>s. \<exists>asid. vspace_for_asid asid s = Some top_level_pt \<and>
               (\<forall>level slot pte.
                   vs_lookup_slot level asid vref s = Some (level, slot) \<longrightarrow>
                   ptes_of s slot = Some pte \<longrightarrow>
                   is_PageTablePTE pte \<longrightarrow>
                   pte_ref pte = Some pt \<longrightarrow>
                   Q slot s) \<and>
               ((\<forall>level<max_pt_level. vs_lookup_table level asid vref s \<noteq> Some (level, pt)) \<longrightarrow>
                   E InvalidRoot s)\<rbrace>
   pt_lookup_from_level max_pt_level top_level_pt vref pt
   \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>"
  apply (wp pt_lookup_from_level_wp)
  apply (clarsimp simp: vspace_for_asid_def)
  apply (rule conjI; clarsimp)
   apply (frule pt_walk_max_level)
   apply (erule_tac x=level in allE)
   apply (erule allE, erule impE[where P="f = Some x" for f x])
    apply (clarsimp simp: vs_lookup_slot_def vs_lookup_table_def in_omonad)
    apply fastforce
   apply simp
  apply (erule allE, erule (1) impE)
  apply (clarsimp simp: vs_lookup_table_def split: if_split_asm)
  done

lemma unmap_page_table_not_target:
  "\<lbrace>\<lambda>s. pt_at pt s \<and> pspace_aligned s \<and> valid_asid_table s \<and> valid_vspace_objs s \<and>
        unique_table_refs s \<and> valid_vs_lookup s \<and> valid_caps (caps_of_state s) s \<and>
        0 < asid \<and> vref \<in> user_region \<and> vspace_for_asid asid s \<noteq> Some pt \<and>
        asid' = asid \<and> pt' = pt \<and> vref' = vref \<rbrace>
   unmap_page_table asid vref pt
   \<lbrace>\<lambda>_ s. vs_lookup_target level asid' vref' s \<noteq> Some (level, pt')\<rbrace>"
  unfolding unmap_page_table_def
  apply (wpsimp wp: store_pte_invalid_vs_lookup_target_unmap pt_lookup_from_level_wrp)
  apply (rule conjI; clarsimp)
   apply (clarsimp simp: vs_lookup_target_def vs_lookup_slot_def vs_lookup_table_def
                   split: if_split_asm;
          clarsimp simp: vspace_for_asid_def obind_def)
  apply (rule exI, rule conjI, assumption)
  apply (rule conjI; clarsimp)
   apply (fastforce simp: in_omonad)
  apply (clarsimp simp: vs_lookup_target_def split: if_split_asm)
   apply (clarsimp simp: pool_for_asid_vs_lookup vs_lookup_slot_def vspace_for_asid_def
                   split: if_split_asm)
  apply (rename_tac slot)
  apply (clarsimp simp: in_omonad)
  apply (rename_tac pte)
  apply (prop_tac "0 < level \<and> is_PageTablePTE pte")
   apply (drule (5) valid_vspace_objs_strong_slotD)
   apply clarsimp
   apply (case_tac pte; clarsimp simp: pte_ref_def)
   apply (clarsimp simp: data_at_def obj_at_def)
  apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
  apply (drule (4) vs_lookup_table_step, simp)
  apply (prop_tac "level - 1 < max_pt_level", erule (1) bit0.minus_one_leq_less)
  apply fastforce
  done

lemma is_final_cap_caps_of_state_2D:
  "\<lbrakk> caps_of_state s p = Some cap; caps_of_state s p' = Some cap';
     is_final_cap' cap'' s; gen_obj_refs cap \<inter> gen_obj_refs cap'' \<noteq> {};
     gen_obj_refs cap' \<inter> gen_obj_refs cap'' \<noteq> {} \<rbrakk>
       \<Longrightarrow> p = p'"
  apply (clarsimp simp: is_final_cap'_def3)
  apply (frule_tac x="fst p" in spec)
  apply (drule_tac x="snd p" in spec)
  apply (drule_tac x="fst p'" in spec)
  apply (drule_tac x="snd p'" in spec)
  apply (clarsimp simp: cte_wp_at_caps_of_state Int_commute
                        prod_eqI)
  done

crunch underlying_memory[wp]: ackInterrupt, hwASIDFlush, read_stval, setVSpaceRoot, sfence
  "\<lambda>m'. underlying_memory m' p = um"
  (simp: cache_machine_op_defs machine_op_lift_def machine_rest_lift_def split_def)

crunches storeWord, ackInterrupt, hwASIDFlush, read_stval, setVSpaceRoot, sfence
  for device_state_inv[wp]: "\<lambda>ms. P (device_state ms)"
  (simp: crunch_simps)

crunch pspace_respects_device_region[wp]: perform_page_invocation "pspace_respects_device_region"
  (simp: crunch_simps wp: crunch_wps set_object_pspace_respects_device_region
         pspace_respects_device_region_dmo)

lemma mapM_x_store_pte_caps_of_state[wp]:
  "mapM_x (swp store_pte InvalidPTE) slots \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace>"
  by (wpsimp wp: mapM_x_wp')

lemma mapM_x_store_pte_valid_cap[wp]:
  "mapM_x (swp store_pte InvalidPTE) slots \<lbrace>valid_cap cap\<rbrace>"
  by (wpsimp wp: mapM_x_wp')

lemma mapM_x_store_pte_final_cap[wp]:
  "mapM_x (swp store_pte InvalidPTE) slots \<lbrace>is_final_cap' cap\<rbrace>"
  by (wpsimp wp: final_cap_lift)

lemma mapM_x_store_pte_empty[wp]:
  "\<lbrace> \<lambda>s. slots = [p , p + (1 << pte_bits) .e. p + (1 << pt_bits) - 1] \<and>
         is_aligned p pt_bits \<and> pt_at p s \<rbrace>
   mapM_x (swp store_pte InvalidPTE) slots
   \<lbrace> \<lambda>_ s. pts_of s p = Some empty_pt \<rbrace>"
  apply wp_pre
   apply (rule_tac I="\<lambda>s. slots = [p , p + (1 << pte_bits) .e. p + (1 << pt_bits) - 1] \<and>
                          is_aligned p pt_bits \<and> pt_at p s" and
                   V="\<lambda>xs s. \<forall>p' \<in> set slots - set xs. ptes_of s p' = Some InvalidPTE"
                   in mapM_x_inv_wp2)
    apply (clarsimp simp: obj_at_def in_omonad)
    apply (rule ext)
    apply (rename_tac idx)
    apply (clarsimp simp: ptes_of_def in_omonad)
    apply (prop_tac "p + (ucast idx << pte_bits) \<in> set slots")
     apply clarsimp
     apply (subst upto_enum_step_shift_red, simp)
       apply (simp add: bit_simps)
      apply (simp add: bit_simps)
     apply (clarsimp simp: image_iff)
     apply (rule_tac x="unat idx" in bexI)
      apply (clarsimp simp: ucast_nat_def shiftl_t2n)
     apply (clarsimp simp: bit_simps)
     apply unat_arith
     apply fastforce
    apply (fastforce simp: table_index_plus_ucast table_base_plus_ucast)
   apply (wpsimp wp: store_pte_ptes_of)
  apply simp
  done

lemma vs_lookup_slot_pool_for_asid:
  "(vs_lookup_slot asid_pool_level asid vref s = Some (level, slot)) =
   (pool_for_asid asid s = Some slot \<and> level = asid_pool_level)"
  by (auto simp: vs_lookup_slot_def vs_lookup_table_def in_omonad)

lemma ptes_of_upd:
  "\<lbrakk> pts (table_base p) = Some pt; is_aligned p pte_bits \<rbrakk> \<Longrightarrow>
   (\<lambda>p'. pte_of p' (pts(table_base p \<mapsto> pt(table_index p := pte)))) =
   ((\<lambda>p'. pte_of p' pts)(p \<mapsto> pte))"
  by (rule ext) (auto simp: pte_of_def obind_def split: option.splits dest: pte_ptr_eq)

lemma pt_walk_upd_Invalid:
  "pt_walk top_level level pt_ptr vref (ptes(p \<mapsto> InvalidPTE)) = Some (level, p') \<Longrightarrow>
   pt_walk top_level level pt_ptr vref ptes = Some (level, p')"
  apply (induct top_level arbitrary: pt_ptr, simp)
  apply (subst (asm) (3) pt_walk.simps)
  apply (clarsimp simp: in_omonad split: if_split_asm)
  apply (erule disjE; clarsimp)
  apply (subst pt_walk.simps)
  apply (clarsimp simp: in_omonad)
  done

lemma store_pte_unreachable:
  "store_pte p InvalidPTE \<lbrace>\<lambda>s. vs_lookup_target level asid vref s \<noteq> Some (level, p')\<rbrace>"
  unfolding store_pte_def set_pt_def
  supply fun_upd_apply[simp del] vs_lookup_slot_pool_for_asid[simp]
  apply (wpsimp wp: set_object_wp simp: obj_at_def)
  apply (prop_tac "asid_pools_of s (table_base p) = None", clarsimp simp: opt_map_def)
  apply (erule notE)
  apply (cases "level = asid_pool_level"; clarsimp simp: vs_lookup_target_def in_omonad)
  apply (clarsimp simp: in_omonad vs_lookup_slot_def simp flip: asid_pool_level_neq
                  split: if_split_asm)
  apply (rename_tac pt_ptr)
  apply (clarsimp simp: in_omonad vs_lookup_table_def ptes_of_upd split: if_split_asm)
  apply (drule pt_walk_upd_Invalid)
  apply (clarsimp cong: conj_cong)
  apply (rule conjI, clarsimp)
  apply (clarsimp simp: ptes_of_def in_omonad fun_upd_apply split: if_split_asm)
  done

lemma mapM_x_store_pte_unreachable:
  "mapM_x (swp store_pte InvalidPTE) slots
   \<lbrace>\<lambda>s. vs_lookup_target level asid vref s \<noteq> Some (level, p)\<rbrace>"
  by (wpsimp wp: mapM_x_wp' store_pte_unreachable)

lemma mapM_x_typ_at[wp]:
  "mapM_x (swp store_pte InvalidPTE) slots \<lbrace>\<lambda>s. P (typ_at T p s)\<rbrace>"
  by (wpsimp wp: mapM_x_wp')

crunches unmap_page_table
  for global_refs[wp]: "\<lambda>s. P (global_refs s)"
  and vspace_for_asid[wp]: "\<lambda>s. P (vspace_for_asid asid s)"
  and valid_cap[wp]: "valid_cap cap"

lemma vspace_for_asid_target:
  "vspace_for_asid asid s = Some pt \<Longrightarrow>
   vs_lookup_target asid_pool_level asid 0 s = Some (asid_pool_level, pt)"
  by (clarsimp simp: vs_lookup_target_def vs_lookup_slot_pool_for_asid vspace_for_asid_def in_omonad)

lemma perform_pt_inv_unmap_invs[wp]:
  "\<lbrace>invs and valid_pti (PageTableUnmap cap ct_slot)\<rbrace> perform_pt_inv_unmap cap ct_slot \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_pt_inv_unmap_def
  apply (wpsimp wp: arch_update_cap_invs_unmap_page_table get_cap_wp hoare_vcg_ex_lift
                    hoare_vcg_all_lift hoare_vcg_imp_lift' mapM_x_swp_store_pte_invs_unmap
                    mapM_x_store_pte_unreachable hoare_vcg_ball_lift
                    unmap_page_table_not_target real_cte_at_typ_valid
                simp: cte_wp_at_caps_of_state)
  apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state)
  apply (clarsimp simp: is_arch_update_def is_cap_simps is_PageTableCap_def
                        update_map_data_def valid_cap_def valid_arch_cap_def cap_aligned_def)
  apply (frule caps_of_state_valid_cap, clarsimp)
  apply (rule conjI; clarsimp)
   apply (simp add: valid_cap_def cap_aligned_def)
   apply (erule valid_table_caps_pdD, fastforce)
  apply (rename_tac p asid vref)
  apply (clarsimp simp: wellformed_mapdata_def valid_cap_def cap_aligned_def cap_master_cap_simps)
  apply (rule conjI)
   apply clarsimp
   apply (prop_tac "is_aligned p pt_bits", simp add: bit_simps)
   apply (subst (asm) upto_enum_step_shift_red; simp?)
     apply (simp add: bit_simps)
    apply (simp add: bit_simps)
   apply clarsimp
   apply (subst table_base_plus[simplified shiftl_t2n mult_ac], assumption)
    apply (simp add: mask_def bit_simps)
    apply unat_arith
    apply (subst (asm) unat_of_nat, simp)
   apply (subst table_base_plus[simplified shiftl_t2n mult_ac], assumption)
    apply (simp add: mask_def bit_simps)
    apply unat_arith
    apply (subst (asm) unat_of_nat, simp)
   apply (rule conjI; clarsimp)
    apply (drule valid_global_refsD2, clarsimp)
    apply (simp add: cap_range_def)
   apply (frule vspace_for_asid_target)
   apply (drule valid_vs_lookupD; clarsimp)
   apply (frule (1) cap_to_pt_is_pt_cap, clarsimp simp: in_omonad obj_at_def)
    apply (fastforce intro: valid_objs_caps)
   apply (drule (1) unique_table_refsD[rotated]; clarsimp)
   apply (clarsimp simp: is_cap_simps)
  apply (fastforce intro: valid_objs_caps simp: bit_simps)
  done

lemma set_cap_vspace_for_asid[wp]:
  "set_cap p cap \<lbrace>\<lambda>s. P (vspace_for_asid asid s)\<rbrace>"
  by (wpsimp wp: vspace_for_asid_lift)

lemma cap_asid_None_pt:
  "(cap_asid (ArchObjectCap (PageTableCap p m)) = None) = (m = None)"
  by (cases m; clarsimp simp: cap_asid_def)

lemma perform_pt_inv_map_invs[wp]:
  "\<lbrace>invs and valid_pti (PageTableMap cap ct_slot pte slot)\<rbrace>
   perform_pt_inv_map cap ct_slot pte slot
   \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_pt_inv_map_def
  apply (wpsimp wp: store_pte_invs arch_update_cap_invs_map hoare_vcg_all_lift hoare_vcg_imp_lift')
  apply (clarsimp simp: valid_pti_def cte_wp_at_caps_of_state is_arch_update_def is_cap_simps
                        is_PageTableCap_def cap_master_cap_simps invalid_pte_at_def)
  apply (rename_tac cap' p' level vref asid ao)
  apply (prop_tac "is_pt_cap cap'")
   apply (case_tac cap'; simp add: cap_master_cap_simps)
   apply (rename_tac acap, case_tac acap; simp add: cap_master_cap_simps)
  apply (clarsimp simp: is_cap_simps cap_master_cap_simps cap_asid_None_pt)
  apply (frule caps_of_state_valid_cap, fastforce)
  apply (clarsimp simp: vs_lookup_slot_def pool_for_asid_vs_lookup split: if_split_asm)
   apply (drule pool_for_asid_validD, clarsimp)
   apply (clarsimp simp: pte_at_def obj_at_def in_omonad)
   apply (frule_tac p=slot in pspace_alignedD, clarsimp)
   apply (prop_tac "is_aligned slot pt_bits", simp add: bit_simps)
   apply fastforce
  apply clarsimp
  apply (rename_tac pt_ptr)
  apply (prop_tac "is_aligned pt_ptr pt_bits", fastforce dest!: vs_lookup_table_is_aligned)
  apply clarsimp
  apply (rule conjI)
   apply (clarsimp simp: valid_cap_def cap_aligned_def valid_arch_cap_def)
  apply (rule conjI)
   apply (erule (3) reachable_page_table_not_global)
  apply (rule conjI, clarsimp)
   apply (rename_tac level' asid' vref')
   apply (prop_tac "level' \<le> max_pt_level")
    apply (frule (2) valid_vspace_objs_strongD[rotated]; clarsimp)
    apply (clarsimp simp: vs_lookup_table_def simp flip: asid_pool_level_neq)
    apply (drule_tac p=pt_ptr in pool_for_asid_validD, clarsimp)
    apply (clarsimp simp: in_omonad)
   apply (drule (1) vs_lookup_table_unique_level; simp)
   apply clarsimp
   apply (drule (1) vs_lookup_table_target)
   apply (drule valid_vs_lookupD, erule vref_for_level_user_region; clarsimp)
   apply (frule (1) cap_to_pt_is_pt_cap, simp, fastforce intro: valid_objs_caps)
   apply (clarsimp simp: is_cap_simps)
   apply (drule (1) unique_table_refsD[rotated]; clarsimp)
  apply (rule conjI, clarsimp)
   apply (frule (2) valid_vspace_objs_strongD[rotated]; clarsimp)
   apply (drule (1) vs_lookup_table_target)
   apply (drule valid_vs_lookupD, erule vref_for_level_user_region; clarsimp)
   apply (frule (1) cap_to_pt_is_pt_cap, simp, fastforce intro: valid_objs_caps)
   apply (clarsimp simp: is_cap_simps)
   apply (thin_tac "caps_of_state s ct_slot = Some cap" for cap)
   apply (drule (1) unique_table_refsD[rotated]; clarsimp)
  apply (rule conjI, clarsimp) (* top-level table, kernel_mapping_slots *)
   apply (drule vspace_for_asid_vs_lookup)
   apply (drule (1) vs_lookup_table_unique_level; clarsimp)
   apply (drule (1) table_index_max_level_slots, simp)
  apply clarsimp
  apply (rename_tac level' asid' vref')
  apply (prop_tac "level' \<le> max_pt_level")
   apply (frule (2) valid_vspace_objs_strongD[rotated]; clarsimp)
   apply (clarsimp simp: vs_lookup_table_def simp flip: asid_pool_level_neq)
   apply (drule_tac p=pt_ptr in pool_for_asid_validD, clarsimp)
   apply (clarsimp simp: in_omonad)
  apply (frule_tac level'=level' in vs_lookup_table_unique_level, assumption; clarsimp)
  apply (rule conjI, clarsimp) (* p \<noteq> pt_ptr *)
   apply (drule (1) vs_lookup_table_target)
   apply (drule valid_vs_lookupD, erule vref_for_level_user_region; clarsimp)
   apply (frule (1) cap_to_pt_is_pt_cap, simp, fastforce intro: valid_objs_caps)
   apply (clarsimp simp: is_cap_simps)
   apply (drule (1) unique_table_refsD[rotated]; clarsimp)
  apply (frule pt_slot_offset_vref_for_level; simp)
  apply (cases ct_slot, fastforce)
  done

lemma perform_page_table_invocation_invs[wp]:
  "\<lbrace>invs and valid_pti pti\<rbrace> perform_page_table_invocation pti \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_page_table_invocation_def by (cases pti; wpsimp)

crunch cte_wp_at [wp]: unmap_page "\<lambda>s. P (cte_wp_at P' p s)"
  (wp: crunch_wps simp: crunch_simps)

crunch typ_at [wp]: unmap_page "\<lambda>s. P (typ_at T p s)"
  (wp: crunch_wps simp: crunch_simps)

lemmas unmap_page_typ_ats [wp] = abs_typ_at_lifts [OF unmap_page_typ_at]

lemma pt_lookup_slot_cap_to:
  "\<lbrakk> invs s; \<exists>\<rhd>(max_pt_level, pt) s; is_aligned pt pt_bits; vptr \<in> user_region;
     pt_lookup_slot pt vptr (ptes_of s) = Some (level, slot) \<rbrakk>
   \<Longrightarrow> \<exists>p cap. caps_of_state s p = Some cap \<and> is_pt_cap cap \<and> obj_refs cap = {table_base slot} \<and>
               s \<turnstile> cap \<and> cap_asid cap \<noteq> None"
  apply (clarsimp simp: pt_lookup_slot_def pt_lookup_slot_from_level_def)
  apply (frule pt_walk_max_level)
  apply (rename_tac pt_ptr asid vref)
  apply (subgoal_tac "vs_lookup_table level asid vptr s = Some (level, pt_ptr)")
   prefer 2
   apply (drule pt_walk_level)
   apply (clarsimp simp: vs_lookup_table_def in_omonad)
  apply (frule_tac level=level in valid_vspace_objs_strongD[rotated]; clarsimp)
  apply (drule vs_lookup_table_target[where level=level], simp)
  apply (drule valid_vs_lookupD, erule vref_for_level_user_region; clarsimp)
  apply (frule (1) cap_to_pt_is_pt_cap, simp)
   apply (fastforce intro: valid_objs_caps)
  apply (frule pts_of_Some_alignedD, fastforce)
  apply (frule caps_of_state_valid, fastforce)
  apply (fastforce simp: cap_asid_def is_cap_simps)
  done

lemma find_vspace_for_asid_cap_to:
  "\<lbrace>invs\<rbrace>
   find_vspace_for_asid asid
   \<lbrace>\<lambda>rv s.  \<exists>a b cap. caps_of_state s (a, b) = Some cap \<and> obj_refs cap = {rv} \<and>
                      is_pt_cap cap \<and> s \<turnstile> cap \<and> is_aligned rv pt_bits\<rbrace>, -"
  apply wpsimp
  apply (drule vspace_for_asid_vs_lookup)
  apply (frule valid_vspace_objs_strongD[rotated]; clarsimp)
  apply (frule pts_of_Some_alignedD, fastforce)
  apply simp
  apply (drule vs_lookup_table_target, simp)
  apply (drule valid_vs_lookupD; clarsimp simp: vref_for_level_def)
  apply (frule (1) cap_to_pt_is_pt_cap, simp)
   apply (fastforce intro: valid_objs_caps)
  apply (fastforce intro: caps_of_state_valid cap_to_pt_is_pt_cap)
  done

lemma ex_pt_cap_eq:
  "(\<exists>ref cap. caps_of_state s ref = Some cap \<and> obj_refs cap = {p} \<and> is_pt_cap cap) =
   (\<exists>ref asid. caps_of_state s ref = Some (ArchObjectCap (PageTableCap p asid)))"
  by (fastforce simp add: is_pt_cap_def obj_refs_def is_PageTableCap_def)

lemma pt_bits_left_not_asid_pool_size:
  "pt_bits_left asid_pool_level \<noteq> pageBitsForSize sz"
  by (cases sz; simp add: pt_bits_left_def bit_simps asid_pool_level_size)

lemma unmap_page_invs:
  "\<lbrace>invs and K (vptr \<in> user_region \<and> vmsz_aligned vptr sz)\<rbrace>
   unmap_page sz asid vptr pptr
   \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding unmap_page_def
  apply (wpsimp wp: store_pte_invs_unmap)
  apply (rule conjI; clarsimp)
  apply (frule (1) pt_lookup_slot_vs_lookup_slotI)
  apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
  apply (rename_tac level pte pt_ptr)
  apply (drule vs_lookup_level)
  apply (frule (2) valid_vspace_objs_strongD[rotated]; clarsimp)
  apply (frule vs_lookup_table_target, simp)
  apply (frule pts_of_Some_alignedD, clarsimp)
  apply (frule vref_for_level_user_region)
  apply (frule (2) vs_lookup_target_not_global)
  apply simp
  apply (frule (1) valid_vs_lookupD; clarsimp)
  apply (frule (1) cap_to_pt_is_pt_cap; (clarsimp intro!: valid_objs_caps)?)
  apply (rule conjI, fastforce simp: is_cap_simps)
  apply clarsimp
  apply (drule (3) vs_lookup_table_vspace)
  apply (simp add: table_index_max_level_slots)
  done

lemma set_mi_invs[wp]: "\<lbrace>invs\<rbrace> set_message_info t a \<lbrace>\<lambda>x. invs\<rbrace>"
  by (simp add: set_message_info_def, wp)

lemma data_at_orth:
  "data_at a p s
   \<Longrightarrow> \<not> ep_at p s \<and> \<not> ntfn_at p s \<and> \<not> cap_table_at sz p s \<and> \<not> tcb_at p s \<and> \<not> asid_pool_at p s
         \<and> \<not> pt_at p s \<and> \<not> asid_pool_at p s"
  apply (clarsimp simp: data_at_def obj_at_def a_type_def)
  apply (case_tac "kheap s p",simp)
  subgoal for ko by (case_tac ko,auto simp add: is_ep_def is_ntfn_def is_cap_table_def is_tcb_def)
  done

lemma data_at_frame_cap:
  "\<lbrakk>data_at sz p s; valid_cap cap s; p \<in> obj_refs cap\<rbrakk> \<Longrightarrow> is_frame_cap cap"
  by (cases cap; clarsimp simp: is_frame_cap_def valid_cap_def valid_arch_cap_ref_def data_at_orth
                         split: option.splits arch_cap.splits)

lemma perform_pg_inv_get_addr[wp]:
  "\<lbrace>invs and valid_page_inv (PageGetAddr ptr)\<rbrace> perform_pg_inv_get_addr ptr \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_pg_inv_get_addr_def by wpsimp

lemma unmap_page_pool_for_asid[wp]:
  "unmap_page pgsz asid vref pt \<lbrace>\<lambda>s. P (pool_for_asid asid s)\<rbrace>"
  unfolding unmap_page_def by (wpsimp simp: pool_for_asid_def)

lemma data_at_level:
  "\<lbrakk> data_at pgsz p s; data_at (vmpage_size_of_level level) p s;
     pt_bits_left level' = pageBitsForSize pgsz; level \<le> max_pt_level \<rbrakk> \<Longrightarrow>
   level = level'"
  by (fastforce simp: data_at_def obj_at_def)

lemma pt_lookup_slot_vs_lookup_slotI0:
  "\<lbrakk> vspace_for_asid asid s = Some pt_ptr;
     pt_lookup_slot pt_ptr vref (ptes_of s) = Some (level, slot) \<rbrakk>
   \<Longrightarrow> vs_lookup_slot 0 asid vref s = Some (level, slot)"
  unfolding pt_lookup_slot_def pt_lookup_slot_from_level_def vs_lookup_slot_def
  apply (clarsimp simp: in_omonad)
  apply (drule (1) pt_lookup_vs_lookupI, simp)
  apply (rule_tac x=level in exI)
  apply clarsimp
  apply (drule vs_lookup_level)
  apply (fastforce dest: pt_walk_max_level)
  done

lemma unmap_page_not_target:
  "\<lbrace> data_at pgsz pptr and valid_asid_table and valid_vspace_objs and pspace_aligned
     and unique_table_refs and valid_vs_lookup and (\<lambda>s. valid_caps (caps_of_state s) s)
     and K (0 < asid \<and> vref \<in> user_region \<and> pptr' = pptr \<and> asid' = asid \<and> vref' = vref) \<rbrace>
   unmap_page pgsz asid vref pptr
   \<lbrace>\<lambda>_ s. vs_lookup_target level asid' vref' s \<noteq> Some (level, pptr')\<rbrace>"
  unfolding unmap_page_def
  supply pt_bits_left_not_asid_pool_size[simp]
         vs_lookup_slot_pool_for_asid[simp]
         pool_for_asid_vs_lookup[simp]
  apply (wpsimp wp: store_pte_invalid_vs_lookup_target_unmap)
  apply (rule conjI; clarsimp)
   apply (clarsimp simp: vs_lookup_target_def vspace_for_asid_def obind_def vs_lookup_slot_def
                         vs_lookup_table_def
                   split: if_split_asm option.splits)
  apply (frule (1) pt_lookup_slot_vs_lookup_slotI0)
  apply (rule conjI; clarsimp simp: in_omonad)
   apply (drule vs_lookup_slot_level)
   apply (rename_tac slot level' pte)
   apply (rule conjI; clarsimp)
    apply (rule conjI, fastforce)
    apply (clarsimp simp: pte_ref_def is_PagePTE_def pptr_from_pte_def)
   apply (rule conjI; clarsimp)
   apply (clarsimp simp: vs_lookup_target_def split: if_split_asm)
    apply (prop_tac "vs_lookup_table max_pt_level asid vref s = Some (max_pt_level, pptr)")
     apply (clarsimp simp: vs_lookup_table_def in_omonad)
    apply (drule (2) valid_vspace_objs_strongD; clarsimp)
    apply (clarsimp simp: data_at_def in_omonad obj_at_def)
   apply (clarsimp simp: in_omonad)
   apply (rename_tac pte')
   apply (frule (5) valid_vspace_objs_strong_slotD[where level=level])
   apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
   apply (rename_tac pt_ptr pt_ptr')
   apply (prop_tac "is_PagePTE pte'")
    apply (case_tac pte'; clarsimp simp: obj_at_def data_at_def)
   apply (case_tac "level = level'", simp add: pte_ref_Some_cases)
   apply (clarsimp simp: is_PagePTE_def)
   apply (drule (3) data_at_level, simp)
  (* lookup has stopped at wrong level for pgsz *)
  apply (rename_tac level')
  apply (clarsimp simp: vs_lookup_target_def split: if_split_asm)
   apply (prop_tac "vs_lookup_table max_pt_level asid vref s = Some (max_pt_level, pptr)")
    apply (clarsimp simp: vs_lookup_table_def in_omonad)
   apply (drule (2) valid_vspace_objs_strongD; clarsimp)
   apply (clarsimp simp: data_at_def in_omonad obj_at_def)
  apply (prop_tac "level' \<le> max_pt_level")
   apply (clarsimp simp: vs_lookup_slot_def vs_lookup_table_def split: if_split_asm)
   apply (drule pt_walk_max_level, simp)
  apply (clarsimp simp: in_omonad)
  apply (rename_tac pte)
  apply (frule (5) valid_vspace_objs_strong_slotD[where level=level], clarsimp)
  apply (prop_tac "is_PagePTE pte \<and> pgsz = vmpage_size_of_level level")
   apply (case_tac pte; fastforce simp: data_at_def obj_at_def)
  apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
  apply (rename_tac pt_ptr' pt_ptr)
  apply (case_tac "level' \<le> level")
   apply (drule vs_lookup_level)
   apply (drule_tac level'=level and level=level' in vs_lookup_splitD; assumption?)
   apply clarsimp
   apply (subst (asm) pt_walk.simps)
   apply (clarsimp simp: is_PagePTE_def split: if_split_asm)
  apply (simp add: not_le)
  apply (prop_tac "level' \<noteq> 0", clarsimp)
  apply (frule vs_lookup_table_stopped; clarsimp)
  apply (drule_tac level'=level' in vs_lookup_splitD; simp?)
  apply (drule vs_lookup_level)
  apply clarsimp
  apply (subst (asm) pt_walk.simps)
  apply clarsimp
  done

lemma perform_pg_inv_unmap[wp]:
  "\<lbrace>invs and valid_page_inv (PageUnmap cap ct_slot)\<rbrace> perform_pg_inv_unmap cap ct_slot \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_pg_inv_unmap_def
  apply (wpsimp wp: arch_update_cap_invs_unmap_page hoare_vcg_ex_lift hoare_vcg_ball_lift
                    hoare_vcg_all_lift hoare_vcg_const_imp_lift get_cap_wp unmap_page_cte_wp_at
                    hoare_vcg_imp_lift'
                    unmap_page_not_target unmap_page_invs)
  apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state is_cap_simps is_arch_update_def
                        update_map_data_def cap_master_cap_simps)
  apply (frule caps_of_state_valid, clarsimp)
  apply (case_tac m; simp)
   apply (clarsimp simp: valid_cap_def valid_arch_cap_def cap_aligned_def cap_master_cap_simps)
  apply (clarsimp simp: valid_unmap_def cap_master_cap_simps valid_cap_def wellformed_mapdata_def
                        cap_aligned_def)
  apply (fastforce simp: data_at_def split: if_split_asm intro: valid_objs_caps)
  done

lemma perform_pg_inv_map_invs[wp]:
  "\<lbrace>invs and valid_page_inv (PageMap cap ct_slot (pte, slot))\<rbrace>
   perform_pg_inv_map cap ct_slot pte slot
   \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_pg_inv_map_def
  apply (wpsimp wp: store_pte_invs arch_update_cap_invs_map hoare_vcg_all_lift hoare_vcg_imp_lift')
  apply (clarsimp simp: valid_page_inv_def cte_wp_at_caps_of_state is_arch_update_def is_cap_simps
                        cap_master_cap_simps parent_for_refs_def valid_slots_def same_ref_def)
  apply (rename_tac cref cidx asid vref)
  apply (frule caps_of_state_valid, clarsimp)
  apply (prop_tac "is_FrameCap cap")
   apply (cases cap; simp add: cap_master_cap_simps)
  apply (intro conjI)
  using vs_lookup_slot_unique_level apply blast
       apply (clarsimp simp: is_FrameCap_def cap_master_cap_simps valid_cap_def cap_aligned_def
                             valid_arch_cap_def)
  using reachable_page_table_not_global vs_lookup_slot_table_unfold apply blast
     apply (auto simp: is_PagePTE_def)[1]
    apply (clarsimp simp: is_FrameCap_def)
    apply (drule (1) unique_table_refsD[rotated], solves \<open>simp\<close>; clarsimp)
   apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
   apply (rename_tac pt_ptr)
   apply (frule vs_lookup_table_is_aligned; clarsimp)
   apply (drule vspace_for_asid_vs_lookup)
   apply (drule (1) vs_lookup_table_unique_level; clarsimp)
   apply (drule (1) table_index_max_level_slots, simp)
  apply clarsimp
  apply (rule conjI, clarsimp simp: is_PagePTE_def)
  apply (rule conjI)
   apply (erule allE, erule impE, fastforce)
   apply (clarsimp simp: is_PagePTE_def)
   apply (drule_tac p="(cref,cidx)" in caps_of_state_valid, clarsimp)
   apply (clarsimp simp: valid_cap_def obj_at_def data_at_def)
  apply (rename_tac level' asid' vref' p')
  apply (prop_tac "level' \<le> max_pt_level")
   apply (clarsimp simp flip: asid_pool_level_neq simp: pool_for_asid_vs_lookup)
   apply (drule pool_for_asid_validD, clarsimp)
   apply (drule_tac p="(cref,cidx)" in caps_of_state_valid, clarsimp)
   apply (clarsimp simp: valid_cap_def obj_at_def in_omonad)
  apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
  apply (rename_tac pt_ptr)
  apply (frule_tac bot_level=level in vs_lookup_table_is_aligned; clarsimp)
  apply (drule (1) vs_lookup_table_unique_level; clarsimp)
  apply (drule (1) pt_slot_offset_vref_for_level; simp)
  apply (cases ct_slot)
  apply fastforce
  done

lemma perform_page_invs [wp]:
  "\<lbrace>invs and valid_page_inv pg_inv\<rbrace> perform_page_invocation pg_inv \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding perform_page_invocation_def
  by (cases pg_inv; wpsimp)

lemma asid_high_low:
  "\<lbrakk> asid_high_bits_of asid = asid_high_bits_of asid';
     asid_low_bits_of asid = asid_low_bits_of asid' \<rbrakk> \<Longrightarrow>
   asid = asid'"
  unfolding asid_high_bits_of_def asid_low_bits_of_def asid_high_bits_def asid_low_bits_def
  by word_bitwise simp

end

locale asid_pool_map = Arch +
  fixes s ap pool asid ptp pt and s' :: "'a::state_ext state"
  defines "s' \<equiv> s\<lparr>kheap := kheap s(ap \<mapsto> ArchObj (ASIDPool (pool(asid_low_bits_of asid \<mapsto> ptp))))\<rparr>"
  assumes ap:  "asid_pools_of s ap = Some pool"
  assumes new: "pool (asid_low_bits_of asid) = None"
  assumes pt:  "pts_of s ptp = Some pt"
  assumes empty: "kernel_mappings_only pt s"
  assumes lookup: "pool_for_asid asid s = Some ap"
  assumes valid_vspace_objs: "valid_vspace_objs s"
  assumes valid_asids: "valid_asid_table s"
  assumes aligned: "is_aligned ptp pt_bits"
begin

lemma arch_state[simp]:
  "arch_state s' = arch_state s"
  by (simp add: s'_def)

lemma pool_for_asid[simp]:
  "pool_for_asid a s' = pool_for_asid a s"
  by (simp add: pool_for_asid_def)

lemma asid_pools_of[simp]:
  "asid_pools_of s' = (asid_pools_of s)(ap \<mapsto> pool(asid_low_bits_of asid \<mapsto> ptp))"
  by (simp add: s'_def)

lemma pts_of[simp]:
  "pts_of s' = pts_of s"
proof -
  from ap
  have "pts_of s ap = None" by (simp add: opt_map_def split: option.splits)
  thus ?thesis by (simp add: s'_def)
qed

lemma empty_for_user:
  "vref \<in> user_region \<Longrightarrow>
   pt (table_index (pt_slot_offset max_pt_level ptp vref)) = InvalidPTE"
  using empty aligned
  by (clarsimp simp: kernel_mappings_only_def table_index_max_level_slots)

lemma vs_lookup_table:
  "vref \<in> user_region \<Longrightarrow>
   vs_lookup_table level asid' vref s' =
     (if asid' = asid \<and> level \<le> max_pt_level
      then Some (max_pt_level, ptp)
      else vs_lookup_table level asid' vref s)"
  apply clarsimp
  apply (rule conjI; clarsimp)
   using lookup
   apply (clarsimp simp: vs_lookup_table_def vspace_for_pool_def in_omonad pool_for_asid_def)
   apply (rule conjI, clarsimp)
   apply (subst pt_walk.simps)
   using pt aligned
   apply (clarsimp simp: obind_def ptes_of_def empty_for_user)
   apply (simp add: pt_slot_offset_def)
   apply (erule notE)
   apply (rule is_aligned_add)
    apply (erule is_aligned_weaken)
    apply (simp add: bit_simps)
   apply (rule is_aligned_shift)
  apply (clarsimp simp: vs_lookup_table_def)
  apply (rule obind_eqI, simp)
  apply clarsimp
  using ap lookup new
  apply (clarsimp simp: obind_def split: option.splits)
  apply (rule conjI; clarsimp)
   apply (clarsimp simp: vspace_for_pool_def obind_def split: option.splits if_split_asm)
  apply (rule conjI; clarsimp)
   apply (clarsimp simp: vspace_for_pool_def obind_def split: option.splits if_split_asm)
   apply (clarsimp simp: pool_for_asid_def)
   using valid_asids
   apply (clarsimp simp: valid_asid_table_def)
   apply (drule (2) inj_on_domD[rotated])
   apply (drule (1) asid_high_low)
   apply clarsimp
  apply (clarsimp simp: vspace_for_pool_def split: if_split_asm)
  done

lemma vs_lookup_slot:
  "vref \<in> user_region \<Longrightarrow>
   vs_lookup_slot level asid' vref s' =
     (if asid' = asid \<and> level \<le> max_pt_level
      then Some (max_pt_level, pt_slot_offset max_pt_level ptp vref)
      else vs_lookup_slot level asid' vref s)"
  apply (simp add: vs_lookup_slot_def)
  apply (rule conjI; clarsimp)
   apply (clarsimp simp: in_omonad vs_lookup_table)
  apply (rule obind_eqI; clarsimp simp: vs_lookup_table)
  done

lemma pte_refs_of_None:
  "vref \<in> user_region \<Longrightarrow> pte_refs_of s (pt_slot_offset max_pt_level ptp vref) = None"
  using aligned pt
  by (clarsimp simp: ptes_of_def obind_def opt_map_def empty_for_user split: option.splits)

lemma vs_lookup_table_None:
  "level \<le> max_pt_level \<Longrightarrow> vs_lookup_table level asid vref s = None"
  using lookup new ap
  by (clarsimp simp: vs_lookup_table_def obind_def pool_for_asid_def vspace_for_pool_def
               split: option.splits)

lemma vs_lookup_slot_None:
  "level \<le> max_pt_level \<Longrightarrow> vs_lookup_slot level asid vref s = None"
  by (clarsimp simp: vs_lookup_slot_def obind_def vs_lookup_table_None)

lemma vs_lookup_target:
  "vref \<in> user_region \<Longrightarrow>
   vs_lookup_target level asid' vref s' =
     (if asid' = asid \<and> level = asid_pool_level
      then Some (level, ptp)
      else vs_lookup_target level asid' vref s)"
  apply clarsimp
  apply (rule conjI; clarsimp)
   apply (clarsimp simp: vs_lookup_target_def in_omonad vs_lookup_slot)
   apply (clarsimp simp: vs_lookup_slot_def vs_lookup_table_def in_omonad)
   using lookup
   apply (simp add: pool_for_asid_def vspace_for_pool_def in_omonad)
  apply (cases "asid' = asid")
   apply clarsimp
   apply (clarsimp simp: vs_lookup_target_def)
   apply (clarsimp simp: obind_def vs_lookup_slot_None vs_lookup_slot pte_refs_of_None)
  apply clarsimp
  apply (simp add: vs_lookup_target_def obind_def)
  apply (clarsimp simp: vs_lookup_slot)
  apply (cases "vs_lookup_slot level asid' vref s"; clarsimp)
  apply (rule conjI; clarsimp)
   prefer 2
   apply (simp split: option.splits)
  apply (clarsimp simp: vs_lookup_slot_def split: if_split_asm)
  apply (clarsimp simp: vs_lookup_table_def in_omonad split: if_split_asm)
  apply (erule disjE; clarsimp)
   apply (drule pt_walk_max_level, simp)
  apply (rename_tac ap')
  apply (subgoal_tac "ap' \<noteq> ap \<or> asid_low_bits_of asid' \<noteq> asid_low_bits_of asid")
   using ap
   apply (simp add: vspace_for_pool_def obind_def split: option.splits)
  using lookup valid_asids
  apply (clarsimp simp: valid_asid_table_def pool_for_asid_def)
  apply (drule (2) inj_on_domD[rotated])
  apply (drule (1) asid_high_low)
  apply clarsimp
  done

lemma valid_pool:
  "valid_vspace_obj asid_pool_level (ASIDPool pool) s"
proof -
  from lookup
  have "vs_lookup_table asid_pool_level asid 0 s = Some (asid_pool_level, ap)"
    by (clarsimp simp: vs_lookup_table_def in_omonad)
  with valid_vspace_objs ap
  show ?thesis by (fastforce dest: valid_vspace_objsD simp: in_omonad)
qed

lemma valid_pte:
  "valid_pte level pte s \<Longrightarrow> valid_pte level pte s'"
  using ap
  apply (cases pte; simp add: pt_at_eq)
  apply (clarsimp simp: data_at_def obj_at_def s'_def in_omonad)
  done

lemma valid_vspace_obj:
  "valid_vspace_obj level ao s \<Longrightarrow> valid_vspace_obj level ao s'"
  by (cases ao; simp add: pt_at_eq valid_pte)

end

context Arch begin global_naming RISCV64

lemma set_asid_pool_arch_objs_map:
  "\<lbrace>valid_vspace_objs and valid_arch_state and valid_global_objs and
    valid_kernel_mappings and pspace_aligned and
    (\<lambda>s. asid_pools_of s ap = Some pool) and
    K (pool (asid_low_bits_of asid) = None) and
    (\<lambda>s. pool_for_asid asid s = Some ap) and
    (\<lambda>s. \<exists>pt. pts_of s pt_ptr = Some pt \<and> kernel_mappings_only pt s) \<rbrace>
  set_asid_pool ap (pool(asid_low_bits_of asid \<mapsto> pt_ptr))
  \<lbrace>\<lambda>rv. valid_vspace_objs\<rbrace>"
  unfolding set_asid_pool_def
  supply fun_upd_apply[simp del]
  apply (wpsimp wp: set_object_wp)
  apply (frule (5) asid_pool_map.intro)
    apply (clarsimp simp: valid_arch_state_def)
   apply (erule pspace_aligned_pts_ofD, simp)
  apply (subst valid_vspace_objs_def)
  apply (clarsimp simp: asid_pool_map.vs_lookup_table split: if_split_asm)
   apply (clarsimp simp: in_omonad fun_upd_apply kernel_mappings_only_def split: if_split_asm)
  apply (clarsimp simp: in_omonad fun_upd_apply split: if_split_asm)
   prefer 2
   apply (frule (2) valid_vspace_objsD)
    apply (simp add: in_omonad)
   apply (simp add: asid_pool_map.valid_vspace_obj)
  apply (clarsimp simp: obj_at_def fun_upd_apply)
  apply (rule conjI; clarsimp)
  apply (frule asid_pool_map.valid_pool)
  apply (fastforce simp: obj_at_def)
  done

lemma caps_of_state_fun_upd:
  "obj_at (same_caps val) p s \<Longrightarrow>
   (caps_of_state (s\<lparr>kheap := (kheap s) (p \<mapsto> val)\<rparr>)) = caps_of_state s"
  apply (drule caps_of_state_after_update)
  apply (simp add: fun_upd_def)
  done

lemma set_asid_pool_valid_arch_caps_map:
  "\<lbrace>valid_arch_caps and valid_arch_state and valid_global_objs and valid_objs
    and valid_vspace_objs and pspace_aligned and
    (\<lambda>s. asid_pools_of s ap = Some pool \<and> pool_for_asid asid s = Some ap \<and>
         (\<exists>ptr cap. caps_of_state s ptr = Some cap \<and> obj_refs cap = {pt_ptr} \<and>
                    vs_cap_ref cap = Some (asid, 0)))
    and (\<lambda>s. \<exists>pt. pts_of s pt_ptr = Some pt \<and> kernel_mappings_only pt s)
    and K (pool (asid_low_bits_of asid) = None \<and> 0 < asid)\<rbrace>
  set_asid_pool ap (pool(asid_low_bits_of asid \<mapsto> pt_ptr))
  \<lbrace>\<lambda>rv. valid_arch_caps\<rbrace>"
  unfolding set_asid_pool_def
  supply fun_upd_apply[simp del]
  apply (wpsimp wp: set_object_wp)
  apply (frule (5) asid_pool_map.intro)
    apply (clarsimp simp: valid_arch_state_def)
   apply (erule pspace_aligned_pts_ofD, simp)
  apply (clarsimp simp: valid_arch_caps_def)
  apply (simp add: caps_of_state_fun_upd obj_at_def)
  apply (subgoal_tac "pts_of s ap = None")
   prefer 2
   apply (clarsimp simp: opt_map_def)
  apply simp
  apply (clarsimp simp: valid_vs_lookup_def caps_of_state_fun_upd obj_at_def)
  apply (clarsimp simp: asid_pool_map.vs_lookup_target split: if_split_asm)
  by (fastforce simp: vref_for_level_asid_pool user_region_def)

lemma kernel_mappings_only_has:
  "kernel_mappings_only pt s \<Longrightarrow> has_kernel_mappings pt s"
  by (simp add: kernel_mappings_only_def)

lemma toplevel_pt_has_kernel_mappings:
  assumes ap: "pool_for_asid asid s = Some ap"
  assumes pool: "asid_pools_of s ap = Some pool"
  assumes p: "p \<in> ran pool"
  assumes pt: "pts_of s p = Some pt"
  assumes km: "equal_kernel_mappings s"
  assumes vsl: "valid_vs_lookup s"
  shows "has_kernel_mappings pt s"
proof -
  from ap
  have "vs_lookup_table asid_pool_level asid 0 s = Some (asid_pool_level, ap)"
    by (simp add: vs_lookup_table_def in_omonad)
  with pool p
  obtain asid' where
    vs_target: "vs_lookup_target asid_pool_level asid' 0 s = Some (asid_pool_level, p)"
    by (auto dest: vs_lookup_table_ap_step)
  with vsl
  have "asid' \<noteq> 0" by (fastforce simp add: valid_vs_lookup_def)
  with vs_target
  have "vspace_for_asid asid' s = Some p"
    by (clarsimp simp: vspace_for_pool_def in_omonad vs_lookup_target_def vs_lookup_slot_def
                       vs_lookup_table_def vspace_for_asid_def word_neq_0_conv)
  with km pt
  show ?thesis by (simp add: equal_kernel_mappings_def)
qed

lemma set_asid_pool_invs_map:
  "\<lbrace>invs and
    (\<lambda>s. asid_pools_of s ap = Some pool \<and> pool_for_asid asid s = Some ap \<and>
         (\<exists>ptr cap. caps_of_state s ptr = Some cap \<and> obj_refs cap = {pt_ptr} \<and>
                    vs_cap_ref cap = Some (asid, 0)))
    and (\<lambda>s. \<exists>pt. pts_of s pt_ptr = Some pt \<and> kernel_mappings_only pt s)
    and K (pool (asid_low_bits_of asid) = None \<and> 0 < asid)\<rbrace>
  set_asid_pool ap (pool(asid_low_bits_of asid \<mapsto> pt_ptr))
  \<lbrace>\<lambda>rv. invs\<rbrace>"
  apply (simp add: invs_def valid_state_def valid_pspace_def valid_asid_map_def)
  apply (wpsimp wp: valid_irq_node_typ set_asid_pool_typ_at set_asid_pool_arch_objs_map
                    valid_irq_handlers_lift set_asid_pool_valid_arch_caps_map)
  apply (erule disjE, clarsimp simp: kernel_mappings_only_has)
  apply (erule (4) toplevel_pt_has_kernel_mappings)
  apply (simp add: valid_arch_caps_def)
  done

lemma ako_asid_pools_of:
  "ako_at (ASIDPool pool) ap s = (asid_pools_of s ap = Some pool)"
  by (clarsimp simp: obj_at_def in_omonad)

lemma copy_global_mappings_asid_pools[wp]:
  "copy_global_mappings pt_ptr \<lbrace>\<lambda>s. P (asid_pools_of s)\<rbrace>"
  unfolding copy_global_mappings_def by (wpsimp wp: mapM_x_wp')

lemma copy_global_mappings_pool_for_asid[wp]:
  "copy_global_mappings pt_ptr \<lbrace>\<lambda>s. P (pool_for_asid asid s)\<rbrace>"
  unfolding copy_global_mappings_def by (wpsimp wp: mapM_x_wp' simp: pool_for_asid_def)

lemma copy_global_mappings_caps_of_state[wp]:
  "copy_global_mappings pt_ptr \<lbrace>\<lambda>s. P (caps_of_state s)\<rbrace>"
  unfolding copy_global_mappings_def by (wpsimp wp: mapM_x_wp')

lemma store_pte_vs_lookup_target_unreachable:
  "\<lbrace>\<lambda>s. (\<forall>level. \<not> \<exists>\<rhd> (level, table_base p) s) \<and>
        vref \<in> user_region \<and>
        vs_lookup_target bot_level asid vref s \<noteq> Some (level, p') \<and>
        pspace_aligned s \<and> valid_vspace_objs s \<and> valid_asid_table s \<rbrace>
   store_pte p pte
   \<lbrace>\<lambda>rv s. vs_lookup_target bot_level asid vref s \<noteq> Some (level, p')\<rbrace>"
  unfolding store_pte_def set_pt_def
  apply (wpsimp wp: set_object_wp)
  apply (subst (asm) vs_lookup_target_unreachable_upd_idem; clarsimp)
  done

lemma store_pte_vs_lookup_table_unreachable:
  "\<lbrace>\<lambda>s. (\<forall>level. \<not> \<exists>\<rhd> (level, table_base p) s) \<and>
        vref \<in> user_region \<and>
        vs_lookup_table bot_level asid vref s \<noteq> Some (level, p') \<and>
        pspace_aligned s \<and> valid_vspace_objs s \<and> valid_asid_table s \<rbrace>
   store_pte p pte
   \<lbrace>\<lambda>rv s. vs_lookup_table bot_level asid vref s \<noteq> Some (level, p')\<rbrace>"
  unfolding store_pte_def set_pt_def
  apply (wpsimp wp: set_object_wp)
  apply (subst (asm) vs_lookup_table_unreachable_upd_idem'; clarsimp)
  done

lemma store_pte_valid_arch_state_unreachable:
  "\<lbrace>valid_arch_state and valid_global_vspace_mappings and (\<lambda>s. table_base p \<notin> global_refs s) \<rbrace>
   store_pte p pte
   \<lbrace>\<lambda>_. valid_arch_state\<rbrace>"
  unfolding valid_arch_state_def by (wpsimp wp: store_pte_valid_global_tables)

lemma store_pte_valid_vs_lookup_unreachable:
  "\<lbrace>valid_vs_lookup and pspace_aligned and valid_vspace_objs and valid_asid_table and
    (\<lambda>s. \<forall>level. \<not> \<exists>\<rhd> (level, table_base p) s)\<rbrace>
   store_pte p pte
   \<lbrace>\<lambda>_. valid_vs_lookup\<rbrace>"
  unfolding valid_vs_lookup_def
  apply (wpsimp wp: hoare_vcg_all_lift hoare_vcg_imp_lift' store_pte_vs_lookup_target_unreachable)
  apply (erule disjE; clarsimp)
  done

lemma store_pte_valid_arch_caps_unreachable:
  "\<lbrace> invs and
     (\<lambda>s. \<forall>level. \<not> \<exists>\<rhd> (level, table_base p) s) and
     (\<lambda>s. \<forall>slot asidopt. caps_of_state s slot = Some (ArchObjectCap (PageTableCap (table_base p) asidopt))
                          \<longrightarrow> asidopt \<noteq> None) and
     (\<lambda>s. table_base p \<notin> global_refs s) \<rbrace>
   store_pte p pte
   \<lbrace> \<lambda>_. valid_arch_caps \<rbrace>"
  unfolding valid_arch_caps_def
  apply (wpsimp wp: store_pte_valid_vs_lookup_unreachable store_pte_valid_table_caps)
  by (fastforce simp: invs_def valid_state_def valid_arch_caps_def intro: valid_objs_caps)

lemma store_pte_invs_unreachable:
  "\<lbrace>invs and
    (\<lambda>s. \<forall>level. \<not> \<exists>\<rhd> (level, table_base p) s) and
    K (wellformed_pte pte) and
    (\<lambda>s. \<forall>slot asidopt. caps_of_state s slot = Some (ArchObjectCap (PageTableCap (table_base p) asidopt))
                         \<longrightarrow> asidopt \<noteq> None) and
    (\<lambda>s. table_base p \<notin> global_refs s) \<rbrace>
  store_pte p pte \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding invs_def valid_state_def valid_pspace_def
  apply (wpsimp wp: store_pte_valid_arch_state_unreachable store_pte_valid_arch_caps_unreachable
                    store_pte_equal_kernel_mappings_no_kernel_slots
                    store_pte_valid_global_vspace_mappings
                    store_pte_valid_vspace_objs)
  apply (simp add: invs_def valid_state_def valid_pspace_def valid_arch_state_def
                   valid_arch_caps_def valid_objs_caps
              cong: conj_cong)
  apply (rule conjI, fastforce dest!: vspace_for_asid_vs_lookup)
  apply (fastforce simp: valid_arch_state_def dest: riscv_global_pt_in_global_refs)
  done

lemma invs_valid_global_vspace_mappings[elim!]:
  "invs s \<Longrightarrow> valid_global_vspace_mappings s"
  by (clarsimp simp: invs_def valid_state_def)

lemma is_aligned_pte_offset:
  "is_aligned pt_ptr pt_bits \<Longrightarrow>
   is_aligned (pt_ptr + (i << pte_bits)) pte_bits"
  apply (rule is_aligned_add)
   apply (erule is_aligned_weaken, simp add: bit_simps)
  apply (simp add: is_aligned_shiftl)
  done

lemma ptes_of_from_pt:
  "\<lbrakk> pts pt_ptr = Some pt; is_aligned pt_ptr pt_bits; i \<le> mask ptTranslationBits \<rbrakk> \<Longrightarrow>
   pte_of (pt_ptr + (i << pte_bits)) pts = Some (pt (ucast i))"
  by (clarsimp simp: ptes_of_def in_omonad table_base_plus table_index_plus is_aligned_pte_offset)

lemma ptes_of_from_pt_ucast:
  "\<lbrakk> pts_of s pt_ptr = Some pt; is_aligned pt_ptr pt_bits \<rbrakk> \<Longrightarrow>
   ptes_of s (pt_ptr + (ucast (i::pt_index) << pte_bits)) = Some (pt i)"
  apply (drule (1) ptes_of_from_pt[where i="ucast i"])
   apply (rule ucast_leq_mask, simp add: bit_simps)
  apply (simp add: is_down_def target_size_def source_size_def word_size ucast_down_ucast_id)
  done

lemma copy_global_mappings_copies[wp]:
  "\<lbrace>invs and (\<lambda>s. pts_of s pt_ptr = Some empty_pt \<and> pt_ptr \<notin> global_refs s)\<rbrace>
   copy_global_mappings pt_ptr
   \<lbrace>\<lambda>_ s. \<exists>pt. pts_of s pt_ptr = Some pt \<and> kernel_mappings_only pt s\<rbrace>"
  unfolding copy_global_mappings_def
  apply wp
      apply (rule hoare_strengthen_post)
       apply (rule_tac I="\<lambda>s. (\<exists>pt. pts_of s pt_ptr = Some pt \<and>
                                    (\<forall>idx. idx \<notin> kernel_mapping_slots \<longrightarrow> pt idx = InvalidPTE)) \<and>
                              pt_at (riscv_global_pt (arch_state s)) s \<and>
                              pt_ptr \<noteq> riscv_global_pt (arch_state s) \<and>
                              is_aligned pt_ptr pt_bits \<and>
                              is_aligned global_pt pt_bits \<and>
                              global_pt = riscv_global_pt (arch_state s) \<and>
                              base = pt_index max_pt_level pptr_base \<and>
                              pt_size = 1 << ptTranslationBits" and
                       V="\<lambda>xs s. \<forall>i \<in> set xs. ptes_of s (pt_ptr + (i << pte_bits)) =
                                              ptes_of s (global_pt + (i << pte_bits))"
                       in mapM_x_inv_wp3)
        apply (wp store_pte_typ_ats|wps)+
       apply (clarsimp simp del: fun_upd_apply)
       apply (fold mask_2pm1)[1]
       apply (drule word_enum_decomp)
       apply (clarsimp simp: table_base_plus table_index_plus in_omonad)
       apply (subgoal_tac "ucast a \<in> kernel_mapping_slots")
        prefer 2
        apply (clarsimp simp: kernel_mapping_slots_def pt_index_def)
        apply (drule ucast_mono_le[where x="a && b" and 'b=pt_index_len for a b])
         apply (simp add: bit_simps mask_def)
         apply unat_arith
        apply (simp add: ucast_mask_drop bit_simps)
       apply (clarsimp simp: pt_at_eq ptes_of_from_pt)
       apply (drule (1) bspec)
       apply (clarsimp simp: ptes_of_from_pt in_omonad)
      apply (clarsimp simp: kernel_mappings_only_def)
      apply (clarsimp simp: has_kernel_mappings_def)
      apply (thin_tac "\<forall>idx. idx \<notin> kernel_mapping_slots \<longrightarrow> P idx" for P)
      apply (erule_tac x="ucast i" in allE)
      apply (erule impE)
       apply (simp add: kernel_mapping_slots_def pt_index_def)
       apply word_bitwise
       subgoal
         by (clarsimp simp: word_size bit_simps word_bits_def canonical_bit_def pt_bits_left_def
                            level_defs rev_bl_order_simps)
      apply (clarsimp simp: ptes_of_from_pt_ucast)
     apply wp+
   apply (fastforce elim!: pts_of_Some_alignedD
                    intro: invs_valid_global_arch_objs valid_global_arch_objs_pt_at
                           riscv_global_pt_in_global_refs valid_global_vspace_mappings_aligned)
  done

lemma copy_global_mappings_invs:
  "\<lbrace> invs and K (is_aligned pt_ptr pt_bits) and
     (\<lambda>s. \<forall>level. \<not> \<exists>\<rhd> (level, pt_ptr) s) and
     (\<lambda>s. \<forall>slot asidopt. caps_of_state s slot = Some (ArchObjectCap (PageTableCap pt_ptr asidopt))
                           \<longrightarrow> asidopt \<noteq> None) and
     (\<lambda>s. pt_ptr \<notin> global_refs s)\<rbrace>
   copy_global_mappings pt_ptr
   \<lbrace>\<lambda>_. invs\<rbrace>"
  unfolding copy_global_mappings_def
  apply wp
      apply (rule hoare_strengthen_post)
       apply (rule_tac P="invs and K (is_aligned pt_ptr pt_bits) and
                          (\<lambda>s. \<forall>level. \<not> \<exists>\<rhd> (level, pt_ptr) s) and
                          (\<lambda>s. \<forall>slot asidopt. caps_of_state s slot =
                                                Some (ArchObjectCap (PageTableCap pt_ptr asidopt))
                                                  \<longrightarrow> asidopt \<noteq> None) and
                          (\<lambda>s. pt_ptr \<notin> global_refs s \<and>
                               base = pt_index max_pt_level pptr_base \<and>
                               pt_size = 1 << ptTranslationBits)" in mapM_x_wp')
       apply (wpsimp wp: store_pte_invs_unreachable hoare_vcg_all_lift hoare_vcg_imp_lift'
                         store_pte_vs_lookup_table_unreachable)
       apply (fold mask_2pm1)[1]
       apply (clarsimp simp: table_base_plus table_index_plus)
       apply (rule conjI, erule ptes_of_wellformed_pte, clarsimp)
       apply clarsimp
       apply (frule invs_valid_asid_table)
       apply simp
       apply (erule impE, fastforce)+
       apply fastforce
      apply fastforce
     apply wp+
  apply clarsimp
  done

lemma cap_asid_pt_None[simp]:
  "(cap_asid (ArchObjectCap (PageTableCap p m)) = None) = (m = None)"
  by (simp add: cap_asid_def split: option.splits)

lemma perform_asid_pool_invs [wp]:
  "\<lbrace>invs and valid_apinv api\<rbrace> perform_asid_pool_invocation api \<lbrace>\<lambda>_. invs\<rbrace>"
  apply (clarsimp simp: perform_asid_pool_invocation_def store_asid_pool_entry_def
                  split: asid_pool_invocation.splits)
  apply (wpsimp wp: set_asid_pool_invs_map hoare_vcg_all_lift hoare_vcg_imp_lift'
                    copy_global_mappings_invs arch_update_cap_invs_map get_cap_wp set_cap_typ_at
                simp: ako_asid_pools_of
         | wp (once) hoare_vcg_ex_lift)+
  apply (clarsimp simp: cte_wp_at_caps_of_state valid_apinv_def cong: conj_cong)
  apply (rename_tac asid pool_ptr slot_ptr slot_idx s pool cap)
  apply (clarsimp simp: is_cap_simps update_map_data_def is_arch_update_def is_arch_cap_def
                        cap_master_cap_simps asid_low_bits_of_def)
  apply (frule caps_of_state_valid, clarsimp)
  apply (clarsimp simp: valid_cap_def cap_aligned_def wellformed_mapdata_def bit_simps)
  apply (frule valid_table_caps_pdD, fastforce)
  apply (frule valid_global_refsD2, fastforce)
  apply (clarsimp simp: cap_range_def)
  apply (rule conjI, clarsimp)
   apply (drule (1) vs_lookup_table_valid_cap; clarsimp)
   apply (frule (1) cap_to_pt_is_pt_cap, simp, fastforce intro: valid_objs_caps)
   apply (drule (1) unique_table_refsD[rotated]; clarsimp)
   apply (clarsimp simp: is_cap_simps)
  apply (rule conjI, clarsimp)
   apply (drule (1) unique_table_capsD[rotated]; clarsimp)
  apply fastforce
  done

lemma invs_aligned_pdD:
  "\<lbrakk> pspace_aligned s; valid_arch_state s \<rbrakk> \<Longrightarrow> is_aligned (riscv_global_pt (arch_state s)) pt_bits"
  by (clarsimp simp: valid_arch_state_def)

lemma do_machine_op_valid_kernel_mappings:
  "do_machine_op f \<lbrace>valid_kernel_mappings\<rbrace>"
  unfolding valid_kernel_mappings_def by wp

lemma valid_vspace_obj_default:
  assumes tyunt: "ty \<noteq> Structures_A.apiobject_type.Untyped"
  shows "ArchObj ao = default_object ty dev us \<Longrightarrow> valid_vspace_obj level ao s'"
  by (cases ty; simp add: default_object_def tyunt)

end

context begin interpretation Arch .
requalify_facts
  do_machine_op_valid_kernel_mappings
end

end


(*  Title:      HOL/Auth/n_g2kAbsAfter_lemma_inv__66_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_inv__66_on_rules imports n_g2kAbsAfter_lemma_on_inv__66
begin
section{*All lemmas on causal relation between inv__66*}
lemma lemma_inv__66_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)\<or>
    (\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)\<or>
    (r=n_n_SendReqS_j1  )\<or>
    (r=n_n_SendReqEI_i1  )\<or>
    (r=n_n_SendReqES_i1  )\<or>
    (r=n_n_RecvReq_i1  )\<or>
    (r=n_n_SendInvE_i1  )\<or>
    (r=n_n_SendInvS_i1  )\<or>
    (r=n_n_SendInvAck_i1  )\<or>
    (r=n_n_RecvInvAck_i1  )\<or>
    (r=n_n_SendGntS_i1  )\<or>
    (r=n_n_SendGntE_i1  )\<or>
    (r=n_n_RecvGntS_i1  )\<or>
    (r=n_n_RecvGntE_i1  )\<or>
    (r=n_n_ASendReqIS_j1  )\<or>
    (r=n_n_ASendReqSE_j1  )\<or>
    (r=n_n_ASendReqEI_i1  )\<or>
    (r=n_n_ASendReqES_i1  )\<or>
    (r=n_n_SendReqEE_i1  )\<or>
    (r=n_n_ARecvReq_i1  )\<or>
    (r=n_n_ASendInvE_i1  )\<or>
    (r=n_n_ASendInvS_i1  )\<or>
    (r=n_n_ASendInvAck_i1  )\<or>
    (r=n_n_ARecvInvAck_i1  )\<or>
    (r=n_n_ASendGntS_i1  )\<or>
    (r=n_n_ASendGntE_i1  )\<or>
    (r=n_n_ARecvGntS_i1  )\<or>
    (r=n_n_ARecvGntE_i1  )"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_Store_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_AStore_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqS_j1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEI_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqES_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_RecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvReq_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvE_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvS_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvAck_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_RecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvInvAck_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntS_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntE_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntS_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntE_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqIS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqIS_j1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqSE_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqSE_j1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqEI_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqES_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEE_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvReq_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvE_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvS_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvAck_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvInvAck_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntS_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntE_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntS_i1Vsinv__66) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntE_i1Vsinv__66) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end